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

View File

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

View File

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

View File

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

View File

@ -17,7 +17,6 @@ import System.Console.CmdArgs.Explicit
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Check.Ordereddates (journalCheckOrdereddates)
checkmode :: Mode RawOpts checkmode :: Mode RawOpts
checkmode = hledgerCommandMode checkmode = hledgerCommandMode
@ -96,20 +95,12 @@ parseCheckArgument s =
-- | Run the named error check, possibly with some arguments, -- | Run the named error check, possibly with some arguments,
-- on this journal with these options. -- on this journal with these options.
runCheck :: CliOpts -> Journal -> (Check,[String]) -> IO () runCheck :: CliOpts -> Journal -> (Check,[String]) -> IO ()
runCheck copts@CliOpts{rawopts_} j (check,args) = do runCheck CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts}} j (check,_) = do
let 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 results = case check of
Accounts -> journalCheckAccountsDeclared j Accounts -> journalCheckAccountsDeclared j
Commodities -> journalCheckCommoditiesDeclared j Commodities -> journalCheckCommoditiesDeclared j
Ordereddates -> journalCheckOrdereddates copts' j Ordereddates -> journalCheckOrdereddates (whichDate ropts) j
Payees -> journalCheckPayeesDeclared j Payees -> journalCheckPayeesDeclared j
Uniqueleafnames -> journalCheckUniqueleafnames j Uniqueleafnames -> journalCheckUniqueleafnames j
-- the other checks have been done earlier during withJournalDo -- the other checks have been done earlier during withJournalDo

View File

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

View File

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