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