diff --git a/hledger-lib/Hledger/Read/Checks.hs b/hledger-lib/Hledger/Read/Checks.hs index 6daddc112..986781910 100644 --- a/hledger-lib/Hledger/Read/Checks.hs +++ b/hledger-lib/Hledger/Read/Checks.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs b/hledger-lib/Hledger/Read/Checks/Ordereddates.hs similarity index 53% rename from hledger/Hledger/Cli/Commands/Check/Ordereddates.hs rename to hledger-lib/Hledger/Read/Checks/Ordereddates.hs index e14d71ebd..96d918d75 100755 --- a/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs +++ b/hledger-lib/Hledger/Read/Checks/Ordereddates.hs @@ -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 diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 80ebaa3b0..e5e7b2fc7 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -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 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 5292a4bfb..1fc71370d 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Check.hs b/hledger/Hledger/Cli/Commands/Check.hs index 7257984bd..666705166 100644 --- a/hledger/Hledger/Cli/Commands/Check.hs +++ b/hledger/Hledger/Cli/Commands/Check.hs @@ -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 diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 6ff9bc8c0..88230da54 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -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 diff --git a/hledger/package.yaml b/hledger/package.yaml index bed0dd404..ccac45d76 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -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