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