    {-|

    The @diff@ command compares two diff.

    -}

    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TemplateHaskell #-}

    module Hledger.Cli.Commands.Diff (
      diffmode
     ,diff
    ) where

    import Data.List.Extra ((\\), groupSortOn, nubBy, sortBy)
    import Data.Function (on)
    import Data.Ord (comparing)
    import Data.Maybe (fromJust)
    import Data.Time (diffDays)
    import Data.Either (partitionEithers)
    import qualified Data.Text.IO as T
    import Lens.Micro (set)
    import System.Exit (exitFailure)

    import Hledger
    import Hledger.Cli.CliOptions

    -- | Command line options for this command.
    diffmode :: Mode RawOpts
    diffmode = CommandDoc
    -> [Flag RawOpts]
    -> [(CommandDoc, [Flag RawOpts])]
    -> [Flag RawOpts]
    -> ([Arg RawOpts], Maybe (Arg RawOpts))
    -> Mode RawOpts
    hledgerCommandMode
      $(embedFileRelative "Hledger/Cli/Commands/Diff.txt")
      []
      [(CommandDoc, [Flag RawOpts])
    generalflagsgroup2]
      []
      ([], Arg RawOpts -> Maybe (Arg RawOpts)
    forall a. a -> Maybe a
    Just (Arg RawOpts -> Maybe (Arg RawOpts))
    -> Arg RawOpts -> Maybe (Arg RawOpts)
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> Arg RawOpts
    argsFlag CommandDoc
    "-f FILE1 -f FILE2 FULLACCOUNTTNAME")

    data PostingWithPath = PostingWithPath {
                         PostingWithPath -> Posting
    ppposting :: Posting,
                         PostingWithPath -> Int
    pptxnidx :: Int,
                         PostingWithPath -> Int
    pppidx :: Int }
                     deriving (Int -> PostingWithPath -> CommandDoc -> CommandDoc
    [PostingWithPath] -> CommandDoc -> CommandDoc
    PostingWithPath -> CommandDoc
    (Int -> PostingWithPath -> CommandDoc -> CommandDoc)
    -> (PostingWithPath -> CommandDoc)
    -> ([PostingWithPath] -> CommandDoc -> CommandDoc)
    -> Show PostingWithPath
    forall a.
    (Int -> a -> CommandDoc -> CommandDoc)
    -> (a -> CommandDoc) -> ([a] -> CommandDoc -> CommandDoc) -> Show a
    $cshowsPrec :: Int -> PostingWithPath -> CommandDoc -> CommandDoc
    showsPrec :: Int -> PostingWithPath -> CommandDoc -> CommandDoc
    $cshow :: PostingWithPath -> CommandDoc
    show :: PostingWithPath -> CommandDoc
    $cshowList :: [PostingWithPath] -> CommandDoc -> CommandDoc
    showList :: [PostingWithPath] -> CommandDoc -> CommandDoc
    Show)

    instance Eq PostingWithPath where
        PostingWithPath
    a == :: PostingWithPath -> PostingWithPath -> Bool
    == PostingWithPath
    b = PostingWithPath -> Int
    pptxnidx PostingWithPath
    a Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == PostingWithPath -> Int
    pptxnidx PostingWithPath
    b
              Bool -> Bool -> Bool
    && PostingWithPath -> Int
    pppidx PostingWithPath
    a Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == PostingWithPath -> Int
    pppidx PostingWithPath
    b

    pptxn :: PostingWithPath -> Transaction
    pptxn :: PostingWithPath -> Transaction
    pptxn = Maybe Transaction -> Transaction
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Transaction -> Transaction)
    -> (PostingWithPath -> Maybe Transaction)
    -> PostingWithPath
    -> Transaction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Posting -> Maybe Transaction
    ptransaction (Posting -> Maybe Transaction)
    -> (PostingWithPath -> Posting)
    -> PostingWithPath
    -> Maybe Transaction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PostingWithPath -> Posting
    ppposting

    ppamountqty :: PostingWithPath -> Quantity
    ppamountqty :: PostingWithPath -> Quantity
    ppamountqty = Amount -> Quantity
    aquantity (Amount -> Quantity)
    -> (PostingWithPath -> Amount) -> PostingWithPath -> Quantity
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Amount] -> Amount
    forall a. HasCallStack => [a] -> a
    head ([Amount] -> Amount)
    -> (PostingWithPath -> [Amount]) -> PostingWithPath -> Amount
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MixedAmount -> [Amount]
    amounts (MixedAmount -> [Amount])
    -> (PostingWithPath -> MixedAmount) -> PostingWithPath -> [Amount]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Posting -> MixedAmount
    pamount (Posting -> MixedAmount)
    -> (PostingWithPath -> Posting) -> PostingWithPath -> MixedAmount
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PostingWithPath -> Posting
    ppposting

    allPostingsWithPath :: Journal -> [PostingWithPath]
    allPostingsWithPath :: Journal -> [PostingWithPath]
    allPostingsWithPath Journal
    j = do
        (Int
    txnidx, Transaction
    txn) <- [Int] -> [Transaction] -> [(Int, Transaction)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] ([Transaction] -> [(Int, Transaction)])
    -> [Transaction] -> [(Int, Transaction)]
    forall a b. (a -> b) -> a -> b
    $ Journal -> [Transaction]
    jtxns Journal
    j
        (Int
    pidx, Posting
    p) <- [Int] -> [Posting] -> [(Int, Posting)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] ([Posting] -> [(Int, Posting)]) -> [Posting] -> [(Int, Posting)]
    forall a b. (a -> b) -> a -> b
    $ Transaction -> [Posting]
    tpostings Transaction
    txn
        PostingWithPath -> [PostingWithPath]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return PostingWithPath { ppposting :: Posting
    ppposting = Posting
    p, pptxnidx :: Int
    pptxnidx = Int
    txnidx, pppidx :: Int
    pppidx = Int
    pidx }

    combine :: ([a], [b]) -> [Either a b]
    combine :: forall a b. ([a], [b]) -> [Either a b]
    combine ([a]
    ls, [b]
    rs) = (a -> Either a b) -> [a] -> [Either a b]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Either a b
    forall a b. a -> Either a b
    Left [a]
    ls [Either a b] -> [Either a b] -> [Either a b]
    forall a. [a] -> [a] -> [a]
    ++ (b -> Either a b) -> [b] -> [Either a b]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Either a b
    forall a b. b -> Either a b
    Right [b]
    rs

    combinedBinBy :: Ord b => (a -> b) -> ([a], [a]) -> [([a], [a])]
    combinedBinBy :: forall b a. Ord b => (a -> b) -> ([a], [a]) -> [([a], [a])]
    combinedBinBy a -> b
    f = ([Either a a] -> ([a], [a])) -> [[Either a a]] -> [([a], [a])]
    forall a b. (a -> b) -> [a] -> [b]
    map [Either a a] -> ([a], [a])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers ([[Either a a]] -> [([a], [a])])
    -> (([a], [a]) -> [[Either a a]]) -> ([a], [a]) -> [([a], [a])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Either a a -> b) -> [Either a a] -> [[Either a a]]
    forall b a. Ord b => (a -> b) -> [a] -> [[a]]
    groupSortOn ((a -> b) -> (a -> b) -> Either a a -> b
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either a -> b
    f a -> b
    f) ([Either a a] -> [[Either a a]])
    -> (([a], [a]) -> [Either a a]) -> ([a], [a]) -> [[Either a a]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([a], [a]) -> [Either a a]
    forall a b. ([a], [b]) -> [Either a b]
    combine

    greedyMaxMatching :: (Eq a, Eq b) => [(a,b)] -> [(a,b)]
    greedyMaxMatching :: forall a b. (Eq a, Eq b) => [(a, b)] -> [(a, b)]
    greedyMaxMatching = [Either a b] -> [(a, b)] -> [(a, b)]
    forall a b. (Eq a, Eq b) => [Either a b] -> [(a, b)] -> [(a, b)]
    greedyMaxMatching' []

    greedyMaxMatching' :: (Eq a, Eq b) => [Either a b] -> [(a,b)] -> [(a,b)]
    greedyMaxMatching' :: forall a b. (Eq a, Eq b) => [Either a b] -> [(a, b)] -> [(a, b)]
    greedyMaxMatching' [Either a b]
    alreadyUsed ((a
    l,b
    r):[(a, b)]
    rest)
      | a -> Either a b
    forall a b. a -> Either a b
    Left a
    l Either a b -> [Either a b] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Either a b]
    alreadyUsed Bool -> Bool -> Bool
    || b -> Either a b
    forall a b. b -> Either a b
    Right b
    r Either a b -> [Either a b] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Either a b]
    alreadyUsed
          = [Either a b] -> [(a, b)] -> [(a, b)]
    forall a b. (Eq a, Eq b) => [Either a b] -> [(a, b)] -> [(a, b)]
    greedyMaxMatching' [Either a b]
    alreadyUsed [(a, b)]
    rest
      | Bool
    otherwise = (a
    l,b
    r) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [Either a b] -> [(a, b)] -> [(a, b)]
    forall a b. (Eq a, Eq b) => [Either a b] -> [(a, b)] -> [(a, b)]
    greedyMaxMatching' (a -> Either a b
    forall a b. a -> Either a b
    Left a
    l Either a b -> [Either a b] -> [Either a b]
    forall a. a -> [a] -> [a]
    : b -> Either a b
    forall a b. b -> Either a b
    Right b
    r Either a b -> [Either a b] -> [Either a b]
    forall a. a -> [a] -> [a]
    : [Either a b]
    alreadyUsed) [(a, b)]
    rest
    greedyMaxMatching' [Either a b]
    _ [] = []

    dateCloseness :: (PostingWithPath, PostingWithPath) -> Integer
    dateCloseness :: (PostingWithPath, PostingWithPath) -> Integer
    dateCloseness = Integer -> Integer
    forall a. Num a => a -> a
    negate (Integer -> Integer)
    -> ((PostingWithPath, PostingWithPath) -> Integer)
    -> (PostingWithPath, PostingWithPath)
    -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PostingWithPath -> PostingWithPath -> Integer)
    -> (PostingWithPath, PostingWithPath) -> Integer
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (Day -> Day -> Integer
    diffDays (Day -> Day -> Integer)
    -> (PostingWithPath -> Day)
    -> PostingWithPath
    -> PostingWithPath
    -> Integer
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Transaction -> Day
    tdate(Transaction -> Day)
    -> (PostingWithPath -> Transaction) -> PostingWithPath -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .PostingWithPath -> Transaction
    pptxn)

    type Matching = [(PostingWithPath, PostingWithPath)]

    matching :: [PostingWithPath] -> [PostingWithPath] -> Matching
    matching :: [PostingWithPath] -> [PostingWithPath] -> Matching
    matching [PostingWithPath]
    ppl [PostingWithPath]
    ppr = do
        ([PostingWithPath]
    left, [PostingWithPath]
    right) <- (PostingWithPath -> Quantity)
    -> ([PostingWithPath], [PostingWithPath])
    -> [([PostingWithPath], [PostingWithPath])]
    forall b a. Ord b => (a -> b) -> ([a], [a]) -> [([a], [a])]
    combinedBinBy PostingWithPath -> Quantity
    ppamountqty ([PostingWithPath]
    ppl, [PostingWithPath]
    ppr) -- TODO: probably not a correct choice of bins
        Matching -> Matching
    forall a b. (Eq a, Eq b) => [(a, b)] -> [(a, b)]
    greedyMaxMatching (Matching -> Matching) -> Matching -> Matching
    forall a b. (a -> b) -> a -> b
    $ ((PostingWithPath, PostingWithPath)
     -> (PostingWithPath, PostingWithPath) -> Ordering)
    -> Matching -> Matching
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((PostingWithPath, PostingWithPath) -> Integer)
    -> (PostingWithPath, PostingWithPath)
    -> (PostingWithPath, PostingWithPath)
    -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (PostingWithPath, PostingWithPath) -> Integer
    dateCloseness) [ (PostingWithPath
    l,PostingWithPath
    r) | PostingWithPath
    l <- [PostingWithPath]
    left, PostingWithPath
    r <- [PostingWithPath]
    right ]

    matchingPostings :: AccountName -> Journal -> [PostingWithPath]
    matchingPostings :: AccountName -> Journal -> [PostingWithPath]
    matchingPostings AccountName
    acct Journal
    j = (PostingWithPath -> Bool) -> [PostingWithPath] -> [PostingWithPath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((AccountName -> AccountName -> Bool
    forall a. Eq a => a -> a -> Bool
    == AccountName
    acct) (AccountName -> Bool)
    -> (PostingWithPath -> AccountName) -> PostingWithPath -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Posting -> AccountName
    paccount (Posting -> AccountName)
    -> (PostingWithPath -> Posting) -> PostingWithPath -> AccountName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PostingWithPath -> Posting
    ppposting) ([PostingWithPath] -> [PostingWithPath])
    -> [PostingWithPath] -> [PostingWithPath]
    forall a b. (a -> b) -> a -> b
    $ Journal -> [PostingWithPath]
    allPostingsWithPath Journal
    j

    pickSide :: Side -> (a,a) -> a
    pickSide :: forall a. Side -> (a, a) -> a
    pickSide Side
    L (a
    l,a
    _) = a
    l
    pickSide Side
    R (a
    _,a
    r) = a
    r

    unmatchedtxns :: Side -> [PostingWithPath] -> Matching -> [Transaction]
    unmatchedtxns :: Side -> [PostingWithPath] -> Matching -> [Transaction]
    unmatchedtxns Side
    s [PostingWithPath]
    pp Matching
    m =
        (PostingWithPath -> Transaction)
    -> [PostingWithPath] -> [Transaction]
    forall a b. (a -> b) -> [a] -> [b]
    map PostingWithPath -> Transaction
    pptxn ([PostingWithPath] -> [Transaction])
    -> [PostingWithPath] -> [Transaction]
    forall a b. (a -> b) -> a -> b
    $ (PostingWithPath -> PostingWithPath -> Bool)
    -> [PostingWithPath] -> [PostingWithPath]
    forall a. (a -> a -> Bool) -> [a] -> [a]
    nubBy (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (Int -> Int -> Bool)
    -> (PostingWithPath -> Int)
    -> PostingWithPath
    -> PostingWithPath
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` PostingWithPath -> Int
    pptxnidx) ([PostingWithPath] -> [PostingWithPath])
    -> [PostingWithPath] -> [PostingWithPath]
    forall a b. (a -> b) -> a -> b
    $ [PostingWithPath]
    pp [PostingWithPath] -> [PostingWithPath] -> [PostingWithPath]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ ((PostingWithPath, PostingWithPath) -> PostingWithPath)
    -> Matching -> [PostingWithPath]
    forall a b. (a -> b) -> [a] -> [b]
    map (Side -> (PostingWithPath, PostingWithPath) -> PostingWithPath
    forall a. Side -> (a, a) -> a
    pickSide Side
    s) Matching
    m

    -- | The diff command.
    diff :: CliOpts -> Journal -> IO ()
    diff :: CliOpts -> Journal -> IO ()
    diff CliOpts{file_ :: CliOpts -> [CommandDoc]
    file_=[CommandDoc
    f1, CommandDoc
    f2], reportspec_ :: CliOpts -> ReportSpec
    reportspec_=ReportSpec{_rsQuery :: ReportSpec -> Query
    _rsQuery=Acct Regexp
    acctRe}} Journal
    _ = do
      Journal
    j1 <- ExceptT CommandDoc IO Journal -> IO Journal
    forall (m :: * -> *) a. MonadIO m => ExceptT CommandDoc m a -> m a
    orDieTrying (ExceptT CommandDoc IO Journal -> IO Journal)
    -> ExceptT CommandDoc IO Journal -> IO Journal
    forall a b. (a -> b) -> a -> b
    $ InputOpts -> CommandDoc -> ExceptT CommandDoc IO Journal
    readJournalFile (ASetter InputOpts InputOpts Bool Bool
    -> Bool -> InputOpts -> InputOpts
    forall s t a b. ASetter s t a b -> b -> s -> t
    set ASetter InputOpts InputOpts Bool Bool
    forall c. HasBalancingOpts c => Lens' c Bool
    Lens' InputOpts Bool
    ignore_assertions Bool
    True InputOpts
    definputopts) CommandDoc
    f1
      Journal
    j2 <- ExceptT CommandDoc IO Journal -> IO Journal
    forall (m :: * -> *) a. MonadIO m => ExceptT CommandDoc m a -> m a
    orDieTrying (ExceptT CommandDoc IO Journal -> IO Journal)
    -> ExceptT CommandDoc IO Journal -> IO Journal
    forall a b. (a -> b) -> a -> b
    $ InputOpts -> CommandDoc -> ExceptT CommandDoc IO Journal
    readJournalFile (ASetter InputOpts InputOpts Bool Bool
    -> Bool -> InputOpts -> InputOpts
    forall s t a b. ASetter s t a b -> b -> s -> t
    set ASetter InputOpts InputOpts Bool Bool
    forall c. HasBalancingOpts c => Lens' c Bool
    Lens' InputOpts Bool
    ignore_assertions Bool
    True InputOpts
    definputopts) CommandDoc
    f2

      let acct :: AccountName
    acct = Regexp -> AccountName
    reString Regexp
    acctRe
      let pp1 :: [PostingWithPath]
    pp1 = AccountName -> Journal -> [PostingWithPath]
    matchingPostings AccountName
    acct Journal
    j1
      let pp2 :: [PostingWithPath]
    pp2 = AccountName -> Journal -> [PostingWithPath]
    matchingPostings AccountName
    acct Journal
    j2

      let m :: Matching
    m = [PostingWithPath] -> [PostingWithPath] -> Matching
    matching [PostingWithPath]
    pp1 [PostingWithPath]
    pp2

      let unmatchedtxn1 :: [Transaction]
    unmatchedtxn1 = Side -> [PostingWithPath] -> Matching -> [Transaction]
    unmatchedtxns Side
    L [PostingWithPath]
    pp1 Matching
    m
      let unmatchedtxn2 :: [Transaction]
    unmatchedtxn2 = Side -> [PostingWithPath] -> Matching -> [Transaction]
    unmatchedtxns Side
    R [PostingWithPath]
    pp2 Matching
    m

      CommandDoc -> IO ()
    putStrLn CommandDoc
    "These transactions are in the first file only:\n"
      (Transaction -> IO ()) -> [Transaction] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (AccountName -> IO ()
    T.putStr (AccountName -> IO ())
    -> (Transaction -> AccountName) -> Transaction -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transaction -> AccountName
    showTransaction) [Transaction]
    unmatchedtxn1

      CommandDoc -> IO ()
    putStrLn CommandDoc
    "These transactions are in the second file only:\n"
      (Transaction -> IO ()) -> [Transaction] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (AccountName -> IO ()
    T.putStr (AccountName -> IO ())
    -> (Transaction -> AccountName) -> Transaction -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transaction -> AccountName
    showTransaction) [Transaction]
    unmatchedtxn2

    diff CliOpts
    _ Journal
    _ = do
      CommandDoc -> IO ()
    putStrLn CommandDoc
    "Please specify two input files. Usage: hledger diff -f FILE1 -f FILE2 FULLACCOUNTNAME"
      IO ()
    forall a. IO a
    exitFailure