imp: consolidate ordereddates check under Hledger.Read.Checks too

And remove the last vestiges of older more complex behaviour.
ordereddates now always checks all transactions in each file,
unaffected by a query. (But still affected by --date2).
This commit is contained in:
Simon Michael 2022-05-08 23:46:10 -10:00
parent 810a868c88
commit db26456e1c
7 changed files with 22 additions and 35 deletions

View File

@ -11,6 +11,7 @@ module Hledger.Read.Checks (
journalCheckAccountsDeclared,
journalCheckCommoditiesDeclared,
journalCheckPayeesDeclared,
module Hledger.Read.Checks.Ordereddates,
module Hledger.Read.Checks.Uniqueleafnames,
)
where
@ -24,6 +25,7 @@ import Safe (atMay)
import Text.Printf (printf)
import Hledger.Data
import Hledger.Read.Checks.Ordereddates
import Hledger.Read.Checks.Uniqueleafnames
import Hledger.Read.Error

View File

@ -1,45 +1,39 @@
module Hledger.Cli.Commands.Check.Ordereddates (
module Hledger.Read.Checks.Ordereddates (
journalCheckOrdereddates
)
where
import Hledger
import Hledger.Cli.CliOptions
import Control.Monad (forM)
import Data.List (groupBy)
import Text.Printf (printf)
import Data.Maybe (fromMaybe)
import Hledger.Read.Error (makeTransactionErrorExcerpt)
-- XXX does this need CliOpts ? Can it move to Hledger.Read.Checks ?
journalCheckOrdereddates :: CliOpts -> Journal -> Either String ()
journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
import Hledger.Data
import Hledger.Read.Error
journalCheckOrdereddates :: WhichDate -> Journal -> Either String ()
journalCheckOrdereddates whichdate j = do
let
ropts = (_rsReportOpts rspec){accountlistmode_=ALFlat}
-- check date ordering within each file, not across files
filets =
groupBy (\t1 t2 -> transactionFile t1 == transactionFile t2) $
filter (_rsQuery rspec `matchesTransaction`) $
jtxns $ journalApplyValuationFromOpts rspec j -- XXX why apply valuation ?
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
-- we check date ordering within each file, not across files
-- note, relying on txns always being sorted by file here
txnsbyfile = groupBy (\t1 t2 -> transactionFile t1 == transactionFile t2) $ jtxns j
getdate = transactionDateOrDate2 whichdate
compare a b = getdate a <= getdate b
either Left (const $ Right ()) $
forM filets $ \ts ->
forM txnsbyfile $ \ts ->
case checkTransactions compare ts of
FoldAcc{fa_previous=Nothing} -> Right ()
FoldAcc{fa_error=Nothing} -> Right ()
FoldAcc{fa_error=Just t, fa_previous=Just tprev} -> Left $ printf
"%s:%d:%d-%d:\n%stransaction date%s is out of order with previous transaction date %s%s"
f l col col2 ex datenum tprevdate oruniquestr
"%s:%d:%d-%d:\n%stransaction date%s is out of order with previous transaction date %s"
f l col col2 ex datenum tprevdate
where
(f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols
col = maybe 0 fst mcols
col2 = maybe 0 (fromMaybe 0 . snd) mcols
finderrcols _t = Just (1, Just 10)
datenum = if date2_ ropts then "2" else ""
tprevdate = show $ (if date2_ ropts then transactionDate2 else tdate) tprev
oruniquestr = if checkunique then ", and/or not unique" else "" -- XXX still used ?
datenum = if whichdate==SecondaryDate then "2" else ""
tprevdate = show $ getdate tprev
data FoldAcc a b = FoldAcc
{ fa_error :: Maybe a

View File

@ -64,6 +64,7 @@ library
Hledger.Query
Hledger.Read
Hledger.Read.Checks
Hledger.Read.Checks.Ordereddates
Hledger.Read.Checks.Uniqueleafnames
Hledger.Read.Common
Hledger.Read.CsvReader

View File

@ -116,6 +116,7 @@ library:
- Hledger.Query
- Hledger.Read
- Hledger.Read.Checks
- Hledger.Read.Checks.Ordereddates
- Hledger.Read.Checks.Uniqueleafnames
- Hledger.Read.Common
- Hledger.Read.CsvReader

View File

@ -17,7 +17,6 @@ import System.Console.CmdArgs.Explicit
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Check.Ordereddates (journalCheckOrdereddates)
checkmode :: Mode RawOpts
checkmode = hledgerCommandMode
@ -96,20 +95,12 @@ parseCheckArgument s =
-- | Run the named error check, possibly with some arguments,
-- on this journal with these options.
runCheck :: CliOpts -> Journal -> (Check,[String]) -> IO ()
runCheck copts@CliOpts{rawopts_} j (check,args) = do
runCheck CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts}} j (check,_) = do
let
-- XXX drop this ?
-- Hack: append the provided args to the raw opts, for checks
-- which can use them (just journalCheckOrdereddates rignt now
-- which has some flags from the old checkdates command).
-- Does not bother to regenerate the derived data (ReportOpts, ReportSpec..),
-- so those may be inconsistent.
copts' = copts{rawopts_=appendopts (map (,"") args) rawopts_}
results = case check of
Accounts -> journalCheckAccountsDeclared j
Commodities -> journalCheckCommoditiesDeclared j
Ordereddates -> journalCheckOrdereddates copts' j
Ordereddates -> journalCheckOrdereddates (whichDate ropts) j
Payees -> journalCheckPayeesDeclared j
Uniqueleafnames -> journalCheckUniqueleafnames j
-- the other checks have been done earlier during withJournalDo

View File

@ -110,7 +110,6 @@ library
Hledger.Cli.Commands.Balancesheetequity
Hledger.Cli.Commands.Cashflow
Hledger.Cli.Commands.Check
Hledger.Cli.Commands.Check.Ordereddates
Hledger.Cli.Commands.Close
Hledger.Cli.Commands.Codes
Hledger.Cli.Commands.Commodities

View File

@ -157,7 +157,6 @@ library:
- Hledger.Cli.Commands.Balancesheetequity
- Hledger.Cli.Commands.Cashflow
- Hledger.Cli.Commands.Check
- Hledger.Cli.Commands.Check.Ordereddates
- Hledger.Cli.Commands.Close
- Hledger.Cli.Commands.Codes
- Hledger.Cli.Commands.Commodities