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, transactionDateOrDate2)
import Hledger.Data.Types
import Hledger.Utils (textChomp)

journalCheckOrdereddates :: WhichDate -> Journal -> Either String ()
journalCheckOrdereddates :: WhichDate -> Journal -> Either String ()
journalCheckOrdereddates WhichDate
whichdate Journal
j = do
  let
    -- we check date ordering within each file, not across files
    -- note, relying on txns always being sorted by file here
    txnsbyfile :: [[Transaction]]
txnsbyfile = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Transaction
t1 Transaction
t2 -> Transaction -> String
transactionFile Transaction
t1 forall a. Eq a => a -> a -> Bool
== Transaction -> String
transactionFile Transaction
t2) 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 forall a. Ord a => a -> a -> Bool
<= Transaction -> Day
getdate Transaction
b
  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Transaction]]
txnsbyfile 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} -> forall a b. b -> Either a b
Right ()
      FoldAcc{fa_error :: forall a b. FoldAcc a b -> Maybe a
fa_error=Maybe Transaction
Nothing}    -> 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} -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf
        (String
"%s:%d:\n%s\nOrdered dates checking is enabled, and this transaction's\n"
          forall a. [a] -> [a] -> [a]
++ String
"date%s (%s) is out of order with the previous transaction.\n"
          forall a. [a] -> [a] -> [a]
++ String
"Consider moving this entry into date order, or adjusting its date.")
        String
f Int
l Text
ex String
datenum (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Transaction -> Day
getdate Transaction
t)
        where
          (String
_,Int
_,Maybe (Int, Maybe Int)
_,Text
ex1) = Transaction
-> (Transaction -> Maybe (Int, Maybe Int))
-> (String, Int, Maybe (Int, Maybe Int), Text)
makeTransactionErrorExcerpt Transaction
tprev (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
          (String
f,Int
l,Maybe (Int, Maybe Int)
_,Text
ex2) = Transaction
-> (Transaction -> Maybe (Int, Maybe Int))
-> (String, Int, Maybe (Int, Maybe Int), Text)
makeTransactionErrorExcerpt Transaction
t forall {a} {a} {p}. (Num a, Num a) => p -> Maybe (a, Maybe a)
finderrcols
          -- separate the two excerpts by a space-beginning line to help flycheck-hledger parse them
          ex :: Text
ex = [Text] -> Text
T.unlines [Text -> Text
textChomp Text
ex1, String -> Text
T.pack String
" ", Text -> Text
textChomp Text
ex2]
          finderrcols :: p -> Maybe (a, Maybe a)
finderrcols p
_t = forall a. a -> Maybe a
Just (a
1, forall a. a -> Maybe a
Just a
10)
          datenum :: String
datenum   = if WhichDate
whichdateforall a. Eq a => a -> a -> Bool
==WhichDate
SecondaryDate then String
"2" else String
"")

data FoldAcc a b = FoldAcc
 { forall a b. FoldAcc a b -> Maybe a
fa_error    :: Maybe a
 , forall a b. 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' = 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{fa_error :: Maybe Transaction
fa_error=forall a. Maybe a
Nothing, fa_previous :: Maybe Transaction
fa_previous=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=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=forall a. a -> Maybe a
Just Transaction
current}
      else FoldAcc Transaction Transaction
acc{fa_error :: Maybe Transaction
fa_error=forall a. a -> Maybe a
Just Transaction
current}

foldWhile :: (a -> FoldAcc a b -> FoldAcc a b) -> FoldAcc a b -> [a] -> FoldAcc a b
foldWhile :: 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
_ 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' -> 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