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, |   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 | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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 | ||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user