module Hledger.Data.JournalChecks.Ordereddates (
journalCheckOrdereddates
)
where
import Control.Monad (forM)
import Data.List (groupBy)
import Text.Printf (printf)
import Data.Maybe (fromMaybe)
import Hledger.Data.Errors (makeTransactionErrorExcerpt)
import Hledger.Data.Transaction (transactionFile, transactionDateOrDate2)
import Hledger.Data.Types
journalCheckOrdereddates :: WhichDate -> Journal -> Either String ()
journalCheckOrdereddates :: WhichDate -> Journal -> Either String ()
journalCheckOrdereddates WhichDate
whichdate Journal
j = do
let
txnsbyfile :: [[Transaction]]
txnsbyfile = (Transaction -> Transaction -> Bool)
-> [Transaction] -> [[Transaction]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Transaction
t1 Transaction
t2 -> Transaction -> String
transactionFile Transaction
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Transaction -> String
transactionFile Transaction
t2) ([Transaction] -> [[Transaction]])
-> [Transaction] -> [[Transaction]]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
getdate :: Transaction -> Day
getdate = WhichDate -> Transaction -> Day
transactionDateOrDate2 WhichDate
whichdate
compare :: Transaction -> Transaction -> Bool
compare Transaction
a Transaction
b = Transaction -> Day
getdate Transaction
a Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Transaction -> Day
getdate Transaction
b
(String -> Either String ())
-> ([()] -> Either String ())
-> Either String [()]
-> Either String ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String ()
forall a b. a -> Either a b
Left (Either String () -> [()] -> Either String ()
forall a b. a -> b -> a
const (Either String () -> [()] -> Either String ())
-> Either String () -> [()] -> Either String ()
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()) (Either String [()] -> Either String ())
-> Either String [()] -> Either String ()
forall a b. (a -> b) -> a -> b
$
[[Transaction]]
-> ([Transaction] -> Either String ()) -> Either String [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Transaction]]
txnsbyfile (([Transaction] -> Either String ()) -> Either String [()])
-> ([Transaction] -> Either String ()) -> Either String [()]
forall a b. (a -> b) -> a -> b
$ \[Transaction]
ts ->
case (Transaction -> Transaction -> Bool)
-> [Transaction] -> FoldAcc Transaction Transaction
checkTransactions Transaction -> Transaction -> Bool
compare [Transaction]
ts of
FoldAcc{fa_previous :: forall a b. FoldAcc a b -> Maybe b
fa_previous=Maybe Transaction
Nothing} -> () -> Either String ()
forall a b. b -> Either a b
Right ()
FoldAcc{fa_error :: forall a b. FoldAcc a b -> Maybe a
fa_error=Maybe Transaction
Nothing} -> () -> Either String ()
forall a b. b -> Either a b
Right ()
FoldAcc{fa_error :: forall a b. FoldAcc a b -> Maybe a
fa_error=Just Transaction
t, fa_previous :: forall a b. FoldAcc a b -> Maybe b
fa_previous=Just Transaction
tprev} -> String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
-> String
-> Int
-> Int
-> Int
-> Text
-> String
-> String
-> String
forall r. PrintfType r => String -> r
printf
String
"%s:%d:%d-%d:\n%stransaction date%s is out of order with previous transaction date %s"
String
f Int
l Int
col Int
col2 Text
ex String
datenum String
tprevdate
where
(String
f,Int
l,Maybe (Int, Maybe Int)
mcols,Text
ex) = Transaction
-> (Transaction -> Maybe (Int, Maybe Int))
-> (String, Int, Maybe (Int, Maybe Int), Text)
makeTransactionErrorExcerpt Transaction
t Transaction -> Maybe (Int, Maybe Int)
forall a a p. (Num a, Num a) => p -> Maybe (a, Maybe a)
finderrcols
col :: Int
col = Int -> ((Int, Maybe Int) -> Int) -> Maybe (Int, Maybe Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst Maybe (Int, Maybe Int)
mcols
col2 :: Int
col2 = Int -> ((Int, Maybe Int) -> Int) -> Maybe (Int, Maybe Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int)
-> ((Int, Maybe Int) -> Maybe Int) -> (Int, Maybe Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd) Maybe (Int, Maybe Int)
mcols
finderrcols :: p -> Maybe (a, Maybe a)
finderrcols p
_t = (a, Maybe a) -> Maybe (a, Maybe a)
forall a. a -> Maybe a
Just (a
1, a -> Maybe a
forall a. a -> Maybe a
Just a
10)
datenum :: String
datenum = if WhichDate
whichdateWhichDate -> WhichDate -> Bool
forall a. Eq a => a -> a -> Bool
==WhichDate
SecondaryDate then String
"2" else String
""
tprevdate :: String
tprevdate = Day -> String
forall a. Show a => a -> String
show (Day -> String) -> Day -> String
forall a b. (a -> b) -> a -> b
$ Transaction -> Day
getdate Transaction
tprev
data FoldAcc a b = FoldAcc
{ FoldAcc a b -> Maybe a
fa_error :: Maybe a
, FoldAcc a b -> Maybe b
fa_previous :: Maybe b
}
checkTransactions :: (Transaction -> Transaction -> Bool)
-> [Transaction] -> FoldAcc Transaction Transaction
checkTransactions :: (Transaction -> Transaction -> Bool)
-> [Transaction] -> FoldAcc Transaction Transaction
checkTransactions Transaction -> Transaction -> Bool
compare = (Transaction
-> FoldAcc Transaction Transaction
-> FoldAcc Transaction Transaction)
-> FoldAcc Transaction Transaction
-> [Transaction]
-> FoldAcc Transaction Transaction
forall a b.
(a -> FoldAcc a b -> FoldAcc a b)
-> FoldAcc a b -> [a] -> FoldAcc a b
foldWhile Transaction
-> FoldAcc Transaction Transaction
-> FoldAcc Transaction Transaction
f FoldAcc :: forall a b. Maybe a -> Maybe b -> FoldAcc a b
FoldAcc{fa_error :: Maybe Transaction
fa_error=Maybe Transaction
forall a. Maybe a
Nothing, fa_previous :: Maybe Transaction
fa_previous=Maybe Transaction
forall a. Maybe a
Nothing}
where
f :: Transaction
-> FoldAcc Transaction Transaction
-> FoldAcc Transaction Transaction
f Transaction
current acc :: FoldAcc Transaction Transaction
acc@FoldAcc{fa_previous :: forall a b. FoldAcc a b -> Maybe b
fa_previous=Maybe Transaction
Nothing} = FoldAcc Transaction Transaction
acc{fa_previous :: Maybe Transaction
fa_previous=Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
current}
f Transaction
current acc :: FoldAcc Transaction Transaction
acc@FoldAcc{fa_previous :: forall a b. FoldAcc a b -> Maybe b
fa_previous=Just Transaction
previous} =
if Transaction -> Transaction -> Bool
compare Transaction
previous Transaction
current
then FoldAcc Transaction Transaction
acc{fa_previous :: Maybe Transaction
fa_previous=Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
current}
else FoldAcc Transaction Transaction
acc{fa_error :: Maybe Transaction
fa_error=Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
current}
foldWhile :: (a -> FoldAcc a b -> FoldAcc a b) -> FoldAcc a b -> [a] -> FoldAcc a b
foldWhile :: (a -> FoldAcc a b -> FoldAcc a b)
-> FoldAcc a b -> [a] -> FoldAcc a b
foldWhile a -> FoldAcc a b -> FoldAcc a b
_ FoldAcc a b
acc [] = FoldAcc a b
acc
foldWhile a -> FoldAcc a b -> FoldAcc a b
fold FoldAcc a b
acc (a
a:[a]
as) =
case a -> FoldAcc a b -> FoldAcc a b
fold a
a FoldAcc a b
acc of
acc :: FoldAcc a b
acc@FoldAcc{fa_error :: forall a b. FoldAcc a b -> Maybe a
fa_error=Just a
_} -> FoldAcc a b
acc
FoldAcc a b
acc -> (a -> FoldAcc a b -> FoldAcc a b)
-> FoldAcc a b -> [a] -> FoldAcc a b
forall a b.
(a -> FoldAcc a b -> FoldAcc a b)
-> FoldAcc a b -> [a] -> FoldAcc a b
foldWhile a -> FoldAcc a b -> FoldAcc a b
fold FoldAcc a b
acc [a]
as