{-|

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 Safe (headDef)
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] -> Amount
forall a. a -> [a] -> a
headDef Amount
nullamt ([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