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

check-dates: rename --strict to --unique; improve output

Browse Source
This commit is contained in:
Simon Michael 2020-11-29 15:28:14 -08:00
parent c5b0eab37a
commit 78542ca32e
1 changed files with 14 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
hledger/Hledger/Cli/Commands/Checkdates.hs
View File

@ -15,7 +15,7 @@ import Text.Printf
checkdatesmode :: Mode RawOpts checkdatesmode :: Mode RawOpts
checkdatesmode = hledgerCommandMode checkdatesmode = hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Checkdates.txt") $(embedFileRelative "Hledger/Cli/Commands/Checkdates.txt")
[flagNone ["strict"] (setboolopt "strict") "makes date comparing strict"] [flagNone ["unique"] (setboolopt "unique") "require that dates are unique"]
[generalflagsgroup1] [generalflagsgroup1]
hiddenflags hiddenflags
([], Just $ argsFlag "[QUERY]") ([], Just $ argsFlag "[QUERY]")
@ -25,26 +25,24 @@ checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
let ropts = (rsOpts rspec){accountlistmode_=ALFlat} let ropts = (rsOpts rspec){accountlistmode_=ALFlat}
let ts = filter (rsQuery rspec `matchesTransaction`) $ let ts = filter (rsQuery rspec `matchesTransaction`) $
jtxns $ journalSelectingAmountFromOpts ropts j jtxns $ journalSelectingAmountFromOpts ropts j
let strict = boolopt "strict" rawopts let unique = boolopt "unique" rawopts
let date = transactionDateFn ropts let date = transactionDateFn ropts
let compare a b = let compare a b =
if strict if unique
then date a < date b then date a < date b
else date a <= date b else date a <= date b
case checkTransactions compare ts of case checkTransactions compare ts of
FoldAcc{fa_previous=Nothing} -> return () FoldAcc{fa_previous=Nothing} -> return ()
FoldAcc{fa_error=Nothing} -> return () FoldAcc{fa_error=Nothing} -> return ()
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
(putStrLn $ printf ("ERROR: transaction out of%s date order" putStrLn $ printf
++ "\nPrevious date: %s" ("Error: transaction's date is not in date order%s,\n"
++ "\nDate: %s" ++ "at %s:\n\n%sPrevious transaction's date was: %s")
++ "\nLocation: %s" (if unique then " and/or not unique" else "")
++ "\nTransaction:\n\n%s") (showGenericSourcePos $ tsourcepos error)
(if strict then " STRICT" else "") (showTransaction error)
(show $ date previous) (show $ date previous)
(show $ date error) exitFailure
(show $ tsourcepos error)
(showTransaction error)) >> exitFailure
data FoldAcc a b = FoldAcc data FoldAcc a b = FoldAcc
{ fa_error :: Maybe a { fa_error :: Maybe a