4cbf72ab1f
date2 is a deprecated feature and was getting in the way, so has been dropped from the ordereddates check, simplifying it.
61 lines
2.4 KiB
Haskell
Executable File
61 lines
2.4 KiB
Haskell
Executable File
module Hledger.Data.JournalChecks.Ordereddates (
|
|
journalCheckOrdereddates
|
|
)
|
|
where
|
|
|
|
import Control.Monad (forM)
|
|
import Data.List (groupBy)
|
|
import Text.Printf (printf)
|
|
import qualified Data.Text as T (pack, unlines)
|
|
|
|
import Hledger.Data.Errors (makeTransactionErrorExcerpt)
|
|
import Hledger.Data.Transaction (transactionFile)
|
|
import Hledger.Data.Types
|
|
import Hledger.Utils (textChomp)
|
|
|
|
journalCheckOrdereddates :: Journal -> Either String ()
|
|
journalCheckOrdereddates j = do
|
|
let
|
|
-- 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
|
|
compare' a b = tdate a <= tdate b
|
|
(const $ Right ()) =<< (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:\n%s\nOrdered dates checking is enabled, and this transaction's\n"
|
|
++ "date (%s) is out of order with the previous transaction.\n"
|
|
++ "Consider moving this entry into date order, or adjusting its date.")
|
|
f l ex (show $ tdate t)
|
|
where
|
|
(_,_,_,ex1) = makeTransactionErrorExcerpt tprev (const Nothing)
|
|
(f,l,_,ex2) = makeTransactionErrorExcerpt t finderrcols
|
|
-- separate the two excerpts by a space-beginning line to help flycheck-hledger parse them
|
|
ex = T.unlines [textChomp ex1, T.pack " ", textChomp ex2]
|
|
finderrcols _t = Just (1, Just 10)
|
|
)
|
|
|
|
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
|