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 -> Journal -> Either String ()
journalCheckOrdereddates CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j = do
  let 
    ropts :: ReportOpts
ropts = (ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec){accountlistmode_ :: AccountListMode
accountlistmode_=AccountListMode
ALFlat}
    -- check date ordering within each file, not across files
    filets :: [[Transaction]]
filets = 
      (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
$
      (Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter (ReportSpec -> Query
_rsQuery ReportSpec
rspec Query -> Transaction -> Bool
`matchesTransaction`) ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$
      Journal -> [Transaction]
jtxns (Journal -> [Transaction]) -> Journal -> [Transaction]
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> Journal
journalApplyValuationFromOpts ReportSpec
rspec Journal
j
    checkunique :: Bool
checkunique = Bool
False -- boolopt "unique" rawopts  XXX was supported by checkdates command
    compare :: Transaction -> Transaction -> Bool
compare Transaction
a Transaction
b = if Bool
checkunique then Transaction -> Day
getdate Transaction
a Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Transaction -> Day
getdate Transaction
b else Transaction -> Day
getdate Transaction
a Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Transaction -> Day
getdate Transaction
b
      where getdate :: Transaction -> Day
getdate = ReportOpts -> Transaction -> Day
transactionDateFn ReportOpts
ropts
  (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]]
filets (([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
error, fa_previous :: forall a b. FoldAcc a b -> Maybe b
fa_previous=Just Transaction
previous} -> do
        let
          datestr :: String
datestr = if ReportOpts -> Bool
date2_ ReportOpts
ropts then String
"2" else String
""
          uniquestr :: String
uniquestr = if Bool
checkunique then String
" and/or not unique" else String
""
          positionstr :: String
positionstr = (SourcePos, SourcePos) -> String
showSourcePosPair ((SourcePos, SourcePos) -> String)
-> (SourcePos, SourcePos) -> String
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
error
          txn1str :: String
txn1str = Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
linesPrepend  (String -> Text
T.pack String
"  ")               (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
previous
          txn2str :: String
txn2str = Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
linesPrepend2 (String -> Text
T.pack String
"> ") (String -> Text
T.pack String
"  ") (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
error
        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
"transaction date" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
datestr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is out of order"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
uniquestr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\nat " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
positionstr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":\n\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
txn1str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
txn2str

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