    {-# LANGUAGE NoOverloadedStrings #-} -- prevent trouble if turned on in ghci
    {-# LANGUAGE TemplateHaskell #-}

    module Hledger.Cli.Commands.Checkdates (
      checkdatesmode
     ,checkdates
    ) where

    import Hledger
    import Hledger.Cli.CliOptions
    import System.Console.CmdArgs.Explicit
    import System.Exit
    import Text.Printf

    checkdatesmode :: Mode RawOpts
    checkdatesmode :: Mode RawOpts
    checkdatesmode = CommandDoc
    -> [Flag RawOpts]
    -> [(CommandDoc, [Flag RawOpts])]
    -> [Flag RawOpts]
    -> ([Arg RawOpts], Maybe (Arg RawOpts))
    -> Mode RawOpts
    hledgerCommandMode
      $(embedFileRelative "Hledger/Cli/Commands/Checkdates.txt")
      [[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
    forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
    flagNone ["strict"] (CommandDoc -> RawOpts -> RawOpts
    setboolopt "strict") "makes date comparing strict"]
      [(CommandDoc, [Flag RawOpts])
    generalflagsgroup1]
      [Flag RawOpts]
    hiddenflags
      ([], Arg RawOpts -> Maybe (Arg RawOpts)
    forall a. a -> Maybe a
    Just (Arg RawOpts -> Maybe (Arg RawOpts))
    -> Arg RawOpts -> Maybe (Arg RawOpts)
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> Arg RawOpts
    argsFlag "[QUERY]")

    checkdates :: CliOpts -> Journal -> IO ()
    checkdates :: CliOpts -> Journal -> IO ()
    checkdates CliOpts{rawopts_ :: CliOpts -> RawOpts
    rawopts_=RawOpts
    rawopts,reportopts_ :: CliOpts -> ReportOpts
    reportopts_=ReportOpts
    ropts} j :: Journal
    j = do
      Day
    d <- IO Day
    getCurrentDay
      let ropts_ :: ReportOpts
    ropts_ = ReportOpts
    ropts{accountlistmode_ :: AccountListMode
    accountlistmode_=AccountListMode
    ALFlat}
      let q :: Query
    q = Day -> ReportOpts -> Query
    queryFromOpts Day
    d ReportOpts
    ropts_
      let ts :: [Transaction]
    ts = (Transaction -> Bool) -> [Transaction] -> [Transaction]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Query
    q 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
    $ ReportOpts -> Journal -> Journal
    journalSelectingAmountFromOpts ReportOpts
    ropts Journal
    j
      let strict :: Bool
    strict = CommandDoc -> RawOpts -> Bool
    boolopt "strict" RawOpts
    rawopts
      let date :: Transaction -> Day
    date = ReportOpts -> Transaction -> Day
    transactionDateFn ReportOpts
    ropts
      let compare :: Transaction -> Transaction -> Bool
    compare a :: Transaction
    a b :: Transaction
    b =
            if Bool
    strict
            then Transaction -> Day
    date Transaction
    a Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    <  Transaction -> Day
    date Transaction
    b
            else Transaction -> Day
    date Transaction
    a Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Transaction -> Day
    date Transaction
    b
      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} -> CommandDoc -> IO ()
    putStrLn "ok (empty journal)" IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    forall a. IO a
    exitSuccess
       FoldAcc{fa_error :: forall a b. FoldAcc a b -> Maybe a
    fa_error=Maybe Transaction
    Nothing}    -> CommandDoc -> IO ()
    putStrLn "ok" IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    forall a. IO a
    exitSuccess
       FoldAcc{fa_error :: forall a b. FoldAcc a b -> Maybe a
    fa_error=Just error :: Transaction
    error, fa_previous :: forall a b. FoldAcc a b -> Maybe b
    fa_previous=Just previous :: Transaction
    previous} ->
        (CommandDoc -> IO ()
    putStrLn (CommandDoc -> IO ()) -> CommandDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CommandDoc
    -> CommandDoc
    -> CommandDoc
    -> CommandDoc
    -> CommandDoc
    -> CommandDoc
    -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf ("ERROR: transaction out of%s date order"
         CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ "\nPrevious date: %s"
         CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ "\nDate: %s"
         CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ "\nLocation: %s"
         CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ "\nTransaction:\n\n%s")
         (if Bool
    strict then " STRICT" else "")
         (Day -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show (Day -> CommandDoc) -> Day -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Transaction -> Day
    date Transaction
    previous)
         (Day -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show (Day -> CommandDoc) -> Day -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Transaction -> Day
    date Transaction
    error)
         (GenericSourcePos -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show (GenericSourcePos -> CommandDoc) -> GenericSourcePos -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Transaction -> GenericSourcePos
    tsourcepos Transaction
    error)
         (Transaction -> CommandDoc
    showTransaction Transaction
    error)) IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    forall a. IO a
    exitFailure

    data FoldAcc a b = FoldAcc
     { FoldAcc a b -> Maybe a
    fa_error    :: Maybe a
     , FoldAcc a b -> Maybe b
    fa_previous :: Maybe 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 -> [a] -> FoldAcc a b
    foldWhile _ acc :: FoldAcc a b
    acc [] = FoldAcc a b
    acc
    foldWhile fold :: a -> FoldAcc a b -> FoldAcc a b
    fold acc :: FoldAcc a b
    acc (a :: a
    a:as :: [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 _} -> FoldAcc a b
    acc
       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

    checkTransactions :: (Transaction -> Transaction -> Bool)
     -> [Transaction] -> FoldAcc Transaction Transaction
    checkTransactions :: (Transaction -> Transaction -> Bool)
    -> [Transaction] -> FoldAcc Transaction Transaction
    checkTransactions compare :: 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 current :: 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 current :: Transaction
    current acc :: FoldAcc Transaction Transaction
    acc@FoldAcc{fa_previous :: forall a b. FoldAcc a b -> Maybe b
    fa_previous=Just previous :: 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}