{-|

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]
  []
  ([], forall a. a -> Maybe a
Just 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 -> ShowS
[PostingWithPath] -> ShowS
PostingWithPath -> CommandDoc
forall a.
(Int -> a -> ShowS)
-> (a -> CommandDoc) -> ([a] -> ShowS) -> Show a
showList :: [PostingWithPath] -> ShowS
$cshowList :: [PostingWithPath] -> ShowS
show :: PostingWithPath -> CommandDoc
$cshow :: PostingWithPath -> CommandDoc
showsPrec :: Int -> PostingWithPath -> ShowS
$cshowsPrec :: Int -> PostingWithPath -> ShowS
Show)

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

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

ppamountqty :: PostingWithPath -> Quantity
ppamountqty :: PostingWithPath -> Quantity
ppamountqty = Amount -> Quantity
aquantity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount 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) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
    (Int
pidx, Posting
p) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
txn
    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) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left [a]
ls forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. [Either a b] -> ([a], [b])
partitionEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortOn (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> b
f a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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)
  | forall a b. a -> Either a b
Left a
l forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Either a b]
alreadyUsed Bool -> Bool -> Bool
|| forall a b. b -> Either a b
Right b
r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Either a b]
alreadyUsed
      = 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) forall a. a -> [a] -> [a]
: forall a b. (Eq a, Eq b) => [Either a b] -> [(a, b)] -> [(a, b)]
greedyMaxMatching' (forall a b. a -> Either a b
Left a
l forall a. a -> [a] -> [a]
: forall a b. b -> Either a b
Right b
r 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 = forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Day -> Day -> Integer
diffDays forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Transaction -> Day
tdateforall 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) <- 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
    forall a b. (Eq a, Eq b) => [(a, b)] -> [(a, b)]
greedyMaxMatching forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== AccountName
acct) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> AccountName
paccount forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingWithPath -> Posting
ppposting) 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 =
    forall a b. (a -> b) -> [a] -> [b]
map PostingWithPath -> Transaction
pptxn forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PostingWithPath -> Int
pptxnidx) forall a b. (a -> b) -> a -> b
$ [PostingWithPath]
pp forall a. Eq a => [a] -> [a] -> [a]
\\ forall a b. (a -> b) -> [a] -> [b]
map (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 <- forall (m :: * -> *) a. MonadIO m => ExceptT CommandDoc m a -> m a
orDieTrying forall a b. (a -> b) -> a -> b
$ InputOpts -> CommandDoc -> ExceptT CommandDoc IO Journal
readJournalFile (forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasBalancingOpts c => Lens' c Bool
ignore_assertions Bool
True InputOpts
definputopts) CommandDoc
f1
  Journal
j2 <- forall (m :: * -> *) a. MonadIO m => ExceptT CommandDoc m a -> m a
orDieTrying forall a b. (a -> b) -> a -> b
$ InputOpts -> CommandDoc -> ExceptT CommandDoc IO Journal
readJournalFile (forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasBalancingOpts c => Lens' c 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"
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (AccountName -> IO ()
T.putStr 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"
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (AccountName -> IO ()
T.putStr 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"
  forall a. IO a
exitFailure