slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

check: ordereddates now checks each file separately (fix #1493)

Browse Source
This commit is contained in:
Simon Michael 2021-03-03 06:44:50 -08:00
parent 2505c69f80
commit e9f04d5ed6
1 changed files with 23 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
hledger/Hledger/Cli/Commands/Check/Ordereddates.hs
View File

@ -11,30 +11,37 @@ import Data.Semigroup ((<>))
import qualified Data.Text as T
import Hledger
import Hledger.Cli.CliOptions
import Control.Monad (forM)
import Data.List (groupBy)
journalCheckOrdereddates :: CliOpts -> Journal -> Either String ()
journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
let
ropts = (rsOpts rspec){accountlistmode_=ALFlat}
ts = filter (rsQuery rspec `matchesTransaction`) $
jtxns $ journalSelectingAmountFromOpts ropts j
-- check date ordering within each file, not across files
filets =
groupBy (\t1 t2 -> transactionFile t1 == transactionFile t2) $
filter (rsQuery rspec `matchesTransaction`) $
jtxns $ journalSelectingAmountFromOpts ropts j
checkunique = False -- boolopt "unique" rawopts XXX was supported by checkdates command
compare a b = if checkunique then getdate a < getdate b else getdate a <= getdate b
where getdate = transactionDateFn ropts
case checkTransactions compare ts of
FoldAcc{fa_previous=Nothing} -> return ()
FoldAcc{fa_error=Nothing} -> return ()
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
let
datestr = if date2_ ropts then "2" else ""
uniquestr = if checkunique then " and/or not unique" else ""
positionstr = showGenericSourcePos $ tsourcepos error
txn1str = T.unpack . linesPrepend (T.pack " ") $ showTransaction previous
txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error
Left $
"transaction date" <> datestr <> " is out of order"
<> uniquestr <> "\nat " <> positionstr <> ":\n\n"
<> txn1str <> txn2str
either Left (const $ Right ()) $
forM filets $ \ts ->
case checkTransactions compare ts of
FoldAcc{fa_previous=Nothing} -> Right ()
FoldAcc{fa_error=Nothing} -> Right ()
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
let
datestr = if date2_ ropts then "2" else ""
uniquestr = if checkunique then " and/or not unique" else ""
positionstr = showGenericSourcePos $ tsourcepos error
txn1str = T.unpack . linesPrepend (T.pack " ") $ showTransaction previous
txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error
Left $
"transaction date" <> datestr <> " is out of order"
<> uniquestr <> "\nat " <> positionstr <> ":\n\n"
<> txn1str <> txn2str
data FoldAcc a b = FoldAcc
{ fa_error :: Maybe a