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:
parent
810a868c88
commit
db26456e1c
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user