4cfd3cb590
(SourcePos, SourcePos). This has been marked for possible removal for a while. We are keeping strictly more information. Possible edge cases arise with Timeclock and CsvReader, but I think these are covered. The particular motivation for getting rid of this is that GenericSourcePos is creating some awkward import considerations for little gain. Removing this enables some flattening of the module dependency tree.
62 lines
2.4 KiB
Haskell
Executable File
62 lines
2.4 KiB
Haskell
Executable File
module Hledger.Cli.Commands.Check.Ordereddates (
|
|
journalCheckOrdereddates
|
|
)
|
|
where
|
|
|
|
import qualified Data.Text as T
|
|
import Hledger
|
|
import Hledger.Cli.CliOptions
|
|
import Control.Monad (forM)
|
|
import Data.List (groupBy)
|
|
|
|
journalCheckOrdereddates :: CliOpts -> Journal -> Either String ()
|
|
journalCheckOrdereddates CliOpts{reportspec_=rspec} 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
|
|
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 ()) $
|
|
forM filets $ \ts ->
|
|
case checkTransactions compare ts of
|
|
FoldAcc{fa_previous=Nothing} -> Right ()
|
|
FoldAcc{fa_error=Nothing} -> Right ()
|
|
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
|
|
let
|
|
datestr = if date2_ ropts then "2" else ""
|
|
uniquestr = if checkunique then " and/or not unique" else ""
|
|
positionstr = showSourcePosPair $ tsourcepos error
|
|
txn1str = T.unpack . linesPrepend (T.pack " ") $ showTransaction previous
|
|
txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error
|
|
Left $
|
|
"transaction date" <> datestr <> " is out of order"
|
|
<> uniquestr <> "\nat " <> positionstr <> ":\n\n"
|
|
<> txn1str <> txn2str
|
|
|
|
data FoldAcc a b = FoldAcc
|
|
{ fa_error :: Maybe a
|
|
, fa_previous :: Maybe b
|
|
}
|
|
|
|
checkTransactions :: (Transaction -> Transaction -> Bool)
|
|
-> [Transaction] -> FoldAcc Transaction Transaction
|
|
checkTransactions compare = foldWhile f FoldAcc{fa_error=Nothing, fa_previous=Nothing}
|
|
where
|
|
f current acc@FoldAcc{fa_previous=Nothing} = acc{fa_previous=Just current}
|
|
f current acc@FoldAcc{fa_previous=Just previous} =
|
|
if compare previous current
|
|
then acc{fa_previous=Just current}
|
|
else acc{fa_error=Just current}
|
|
|
|
foldWhile :: (a -> FoldAcc a b -> FoldAcc a b) -> FoldAcc a b -> [a] -> FoldAcc a b
|
|
foldWhile _ acc [] = acc
|
|
foldWhile fold acc (a:as) =
|
|
case fold a acc of
|
|
acc@FoldAcc{fa_error=Just _} -> acc
|
|
acc -> foldWhile fold acc as
|