    module Hledger.Data.JournalChecks.Ordereddates (
      journalCheckOrdereddates
    )
    where

    import Control.Monad (forM)
    import Data.List (groupBy)
    import Text.Printf (printf)
    import Data.Text qualified 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 :: Journal -> Either String ()
    journalCheckOrdereddates 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 = (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
        compare' :: Transaction -> Transaction -> Bool
    compare' Transaction
    a Transaction
    b = Transaction -> Day
    tdate Transaction
    a Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Transaction -> Day
    tdate Transaction
    b
      (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 ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m 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 -> Text -> String -> String
    forall r. PrintfType r => String -> r
    printf
            (String
    "%s:%d:\n%s\nOrdered dates checking is enabled, and this transaction's\n"
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "date (%s) is out of order with the previous transaction.\n"
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Consider moving this entry into date order, or adjusting its date.")
            String
    f Int
    l Text
    ex (Day -> String
    forall a. Show a => a -> String
    show (Day -> String) -> Day -> String
    forall a b. (a -> b) -> a -> b
    $ Transaction -> Day
    tdate 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 (Maybe (Int, Maybe Int) -> Transaction -> Maybe (Int, Maybe Int)
    forall a b. a -> b -> a
    const Maybe (Int, Maybe Int)
    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 Transaction -> Maybe (Int, Maybe Int)
    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 = (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)
        )

    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' = (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{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=Just 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=Just current}
          else FoldAcc Transaction Transaction
    acc{fa_error=Just 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' -> (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