    {-|
    A history-aware add command to help with data entry.
    |-}

    {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-}
    {-# LANGUAGE ScopedTypeVariables, RecordWildCards, TypeOperators, FlexibleContexts, OverloadedStrings, PackageImports, LambdaCase #-}
    {-# LANGUAGE TemplateHaskell #-}

    module Hledger.Cli.Commands.Add (
       addmode
      ,add
      ,appendToJournalFileOrStdout
      ,journalAddTransaction
      ,transactionsSimilarTo
    )
    where

    import Prelude ()
    import "base-compat-batteries" Prelude.Compat hiding (fail)
    import Control.Exception as E
    import Control.Monad (when)
    import Control.Monad.Trans.Class
    import Control.Monad.State.Strict (evalState, evalStateT)
    import Control.Monad.Trans (liftIO)
    import Data.Char (toUpper, toLower)
    import Data.Either (isRight)
    import Data.Functor.Identity (Identity(..))
    import "base-compat-batteries" Data.List.Compat
    import qualified Data.Set as S
    import Data.Maybe
    import Data.Text (Text)
    import qualified Data.Text as T
    import Data.Time.Calendar (Day)
    import Data.Time.Format (formatTime, defaultTimeLocale, iso8601DateFormat)
    import Safe (headDef, headMay, atMay)
    import System.Console.CmdArgs.Explicit
    import System.Console.Haskeline (runInputT, defaultSettings, setComplete)
    import System.Console.Haskeline.Completion
    import System.Console.Wizard
    import System.Console.Wizard.Haskeline
    import System.IO ( stderr, hPutStr, hPutStrLn )
    import Text.Megaparsec
    import Text.Megaparsec.Char
    import Text.Printf

    import Hledger
    import Hledger.Cli.CliOptions
    import Hledger.Cli.Commands.Register (postingsReportAsText)

    addmode :: Mode RawOpts
    addmode = CommandDoc
    -> [Flag RawOpts]
    -> [(CommandDoc, [Flag RawOpts])]
    -> [Flag RawOpts]
    -> ([Arg RawOpts], Maybe (Arg RawOpts))
    -> Mode RawOpts
    hledgerCommandMode
      $(embedFileRelative "Hledger/Cli/Commands/Add.txt")
      [[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
    forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
    flagNone ["no-new-accounts"]  (CommandDoc -> RawOpts -> RawOpts
    setboolopt "no-new-accounts") "don't allow creating new accounts"]
      [(CommandDoc, [Flag RawOpts])
    generalflagsgroup2]
      []
      ([], 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 "[DATE [DESCRIPTION [ACCOUNT1 [AMOUNT1 [ACCOUNT2 [ETC...]]]]]]")

    -- | State used while entering transactions.
    data EntryState = EntryState {
       EntryState -> CliOpts
    esOpts               :: CliOpts           -- ^ command line options
      ,EntryState -> [CommandDoc]
    esArgs               :: [String]          -- ^ command line arguments remaining to be used as defaults
      ,EntryState -> Day
    esToday              :: Day               -- ^ today's date
      ,EntryState -> Day
    esDefDate            :: Day               -- ^ the default date for next transaction
      ,EntryState -> Journal
    esJournal            :: Journal           -- ^ the journal we are adding to
      ,EntryState -> Maybe Transaction
    esSimilarTransaction :: Maybe Transaction -- ^ the most similar historical txn
      ,EntryState -> [Posting]
    esPostings           :: [Posting]         -- ^ postings entered so far in the current txn
      } deriving (Int -> EntryState -> CommandDoc -> CommandDoc
    [EntryState] -> CommandDoc -> CommandDoc
    EntryState -> CommandDoc
    (Int -> EntryState -> CommandDoc -> CommandDoc)
    -> (EntryState -> CommandDoc)
    -> ([EntryState] -> CommandDoc -> CommandDoc)
    -> Show EntryState
    forall a.
    (Int -> a -> CommandDoc -> CommandDoc)
    -> (a -> CommandDoc) -> ([a] -> CommandDoc -> CommandDoc) -> Show a
    showList :: [EntryState] -> CommandDoc -> CommandDoc
    $cshowList :: [EntryState] -> CommandDoc -> CommandDoc
    show :: EntryState -> CommandDoc
    $cshow :: EntryState -> CommandDoc
    showsPrec :: Int -> EntryState -> CommandDoc -> CommandDoc
    $cshowsPrec :: Int -> EntryState -> CommandDoc -> CommandDoc
    Show)

    defEntryState :: EntryState
    defEntryState = EntryState :: CliOpts
    -> [CommandDoc]
    -> Day
    -> Day
    -> Journal
    -> Maybe Transaction
    -> [Posting]
    -> EntryState
    EntryState {
       esOpts :: CliOpts
    esOpts               = CliOpts
    defcliopts
      ,esArgs :: [CommandDoc]
    esArgs               = []
      ,esToday :: Day
    esToday              = Day
    nulldate
      ,esDefDate :: Day
    esDefDate            = Day
    nulldate
      ,esJournal :: Journal
    esJournal            = Journal
    nulljournal
      ,esSimilarTransaction :: Maybe Transaction
    esSimilarTransaction = Maybe Transaction
    forall a. Maybe a
    Nothing
      ,esPostings :: [Posting]
    esPostings           = []
    }

    data RestartTransactionException = RestartTransactionException deriving (Int -> RestartTransactionException -> CommandDoc -> CommandDoc
    [RestartTransactionException] -> CommandDoc -> CommandDoc
    RestartTransactionException -> CommandDoc
    (Int -> RestartTransactionException -> CommandDoc -> CommandDoc)
    -> (RestartTransactionException -> CommandDoc)
    -> ([RestartTransactionException] -> CommandDoc -> CommandDoc)
    -> Show RestartTransactionException
    forall a.
    (Int -> a -> CommandDoc -> CommandDoc)
    -> (a -> CommandDoc) -> ([a] -> CommandDoc -> CommandDoc) -> Show a
    showList :: [RestartTransactionException] -> CommandDoc -> CommandDoc
    $cshowList :: [RestartTransactionException] -> CommandDoc -> CommandDoc
    show :: RestartTransactionException -> CommandDoc
    $cshow :: RestartTransactionException -> CommandDoc
    showsPrec :: Int -> RestartTransactionException -> CommandDoc -> CommandDoc
    $cshowsPrec :: Int -> RestartTransactionException -> CommandDoc -> CommandDoc
    Show)
    instance Exception RestartTransactionException

    -- data ShowHelpException = ShowHelpException deriving (Show)
    -- instance Exception ShowHelpException

    -- | Read multiple transactions from the console, prompting for each
    -- field, and append them to the journal file.  If the journal came
    -- from stdin, this command has no effect.
    add :: CliOpts -> Journal -> IO ()
    add :: CliOpts -> Journal -> IO ()
    add opts :: CliOpts
    opts j :: Journal
    j
        | Journal -> CommandDoc
    journalFilePath Journal
    j CommandDoc -> CommandDoc -> Bool
    forall a. Eq a => a -> a -> Bool
    == "-" = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        | Bool
    otherwise = do
            Handle -> CommandDoc -> CommandDoc -> IO ()
    forall r. HPrintfType r => Handle -> CommandDoc -> r
    hPrintf Handle
    stderr "Adding transactions to journal file %s\n" (Journal -> CommandDoc
    journalFilePath Journal
    j)
            IO ()
    showHelp
            Day
    today <- IO Day
    getCurrentDay
            let es :: EntryState
    es = EntryState
    defEntryState{esOpts :: CliOpts
    esOpts=CliOpts
    opts
                                  ,esArgs :: [CommandDoc]
    esArgs=CommandDoc -> RawOpts -> [CommandDoc]
    listofstringopt "args" (RawOpts -> [CommandDoc]) -> RawOpts -> [CommandDoc]
    forall a b. (a -> b) -> a -> b
    $ CliOpts -> RawOpts
    rawopts_ CliOpts
    opts
                                  ,esToday :: Day
    esToday=Day
    today
                                  ,esDefDate :: Day
    esDefDate=Day
    today
                                  ,esJournal :: Journal
    esJournal=Journal
    j
                                  }
            EntryState -> IO ()
    getAndAddTransactions EntryState
    es IO () -> (UnexpectedEOF -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` (\(UnexpectedEOF
    _::UnexpectedEOF) -> CommandDoc -> IO ()
    putStr "")

    showHelp :: IO ()
    showHelp = Handle -> CommandDoc -> IO ()
    hPutStr Handle
    stderr (CommandDoc -> IO ()) -> CommandDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [CommandDoc] -> CommandDoc
    unlines [
         "Any command line arguments will be used as defaults."
        ,"Use tab key to complete, readline keys to edit, enter to accept defaults."
        ,"An optional (CODE) may follow transaction dates."
        ,"An optional ; COMMENT may follow descriptions or amounts."
        ,"If you make a mistake, enter < at any prompt to go one step backward."
        ,"To end a transaction, enter . when prompted."
        ,"To quit, enter . at a date prompt or press control-d or control-c."
        ]

    -- | Loop reading transactions from the console, prompting, validating
    -- and appending each one to the journal file, until end of input or
    -- ctrl-c (then raise an EOF exception).  If provided, command-line
    -- arguments are used as defaults; otherwise defaults come from the
    -- most similar recent transaction in the journal.
    getAndAddTransactions :: EntryState -> IO ()
    getAndAddTransactions :: EntryState -> IO ()
    getAndAddTransactions es :: EntryState
    es@EntryState{..} = (do
      let defaultPrevInput :: PrevInput
    defaultPrevInput = PrevInput :: Maybe CommandDoc
    -> Maybe CommandDoc -> [CommandDoc] -> [CommandDoc] -> PrevInput
    PrevInput{prevDateAndCode :: Maybe CommandDoc
    prevDateAndCode=Maybe CommandDoc
    forall a. Maybe a
    Nothing, prevDescAndCmnt :: Maybe CommandDoc
    prevDescAndCmnt=Maybe CommandDoc
    forall a. Maybe a
    Nothing, prevAccount :: [CommandDoc]
    prevAccount=[], prevAmountAndCmnt :: [CommandDoc]
    prevAmountAndCmnt=[]}
      Maybe Transaction
    mt <- Settings IO
    -> InputT IO (Maybe Transaction) -> IO (Maybe Transaction)
    forall (m :: * -> *) a.
    MonadException m =>
    Settings m -> InputT m a -> m a
    runInputT (CompletionFunc IO -> Settings IO -> Settings IO
    forall (m :: * -> *). CompletionFunc m -> Settings m -> Settings m
    setComplete CompletionFunc IO
    forall (m :: * -> *). Monad m => CompletionFunc m
    noCompletion Settings IO
    forall (m :: * -> *). MonadIO m => Settings m
    defaultSettings) (Wizard Haskeline Transaction -> InputT IO (Maybe Transaction)
    forall (f :: * -> *) (b :: * -> *) a.
    (Functor f, Monad b, Run b f) =>
    Wizard f a -> b (Maybe a)
    System.Console.Wizard.run (Wizard Haskeline Transaction -> InputT IO (Maybe Transaction))
    -> Wizard Haskeline Transaction -> InputT IO (Maybe Transaction)
    forall a b. (a -> b) -> a -> b
    $ Wizard Haskeline Transaction -> Wizard Haskeline Transaction
    forall a. Wizard Haskeline a -> Wizard Haskeline a
    haskeline (Wizard Haskeline Transaction -> Wizard Haskeline Transaction)
    -> Wizard Haskeline Transaction -> Wizard Haskeline Transaction
    forall a b. (a -> b) -> a -> b
    $ PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    defaultPrevInput EntryState
    es [])
      case Maybe Transaction
    mt of
        Nothing -> CommandDoc -> IO ()
    forall a. HasCallStack => CommandDoc -> a
    error "Could not interpret the input, restarting"  -- caught below causing a restart, I believe  -- PARTIAL:
        Just t :: Transaction
    t -> do
          Journal
    j <- if CliOpts -> Int
    debug_ CliOpts
    esOpts Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0
               then do Handle -> CommandDoc -> IO ()
    forall r. HPrintfType r => Handle -> CommandDoc -> r
    hPrintf Handle
    stderr "Skipping journal add due to debug mode.\n"
                       Journal -> IO Journal
    forall (m :: * -> *) a. Monad m => a -> m a
    return Journal
    esJournal
               else do Journal
    j' <- Journal -> CliOpts -> Transaction -> IO Journal
    journalAddTransaction Journal
    esJournal CliOpts
    esOpts Transaction
    t
                       Handle -> CommandDoc -> IO ()
    forall r. HPrintfType r => Handle -> CommandDoc -> r
    hPrintf Handle
    stderr "Saved.\n"
                       Journal -> IO Journal
    forall (m :: * -> *) a. Monad m => a -> m a
    return Journal
    j'
          Handle -> CommandDoc -> IO ()
    forall r. HPrintfType r => Handle -> CommandDoc -> r
    hPrintf Handle
    stderr "Starting the next transaction (. or ctrl-D/ctrl-C to quit)\n"
          EntryState -> IO ()
    getAndAddTransactions EntryState
    es{esJournal :: Journal
    esJournal=Journal
    j, esDefDate :: Day
    esDefDate=Transaction -> Day
    tdate Transaction
    t}
      )
      IO () -> (RestartTransactionException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` (\(RestartTransactionException
    _::RestartTransactionException) ->
                     Handle -> CommandDoc -> IO ()
    forall r. HPrintfType r => Handle -> CommandDoc -> r
    hPrintf Handle
    stderr "Restarting this transaction.\n" IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> EntryState -> IO ()
    getAndAddTransactions EntryState
    es)

    data TxnParams = TxnParams
      { TxnParams -> Day
    txnDate :: Day
      , TxnParams -> Text
    txnCode :: Text
      , TxnParams -> Text
    txnDesc :: Text
      , TxnParams -> Text
    txnCmnt :: Text
      } deriving (Int -> TxnParams -> CommandDoc -> CommandDoc
    [TxnParams] -> CommandDoc -> CommandDoc
    TxnParams -> CommandDoc
    (Int -> TxnParams -> CommandDoc -> CommandDoc)
    -> (TxnParams -> CommandDoc)
    -> ([TxnParams] -> CommandDoc -> CommandDoc)
    -> Show TxnParams
    forall a.
    (Int -> a -> CommandDoc -> CommandDoc)
    -> (a -> CommandDoc) -> ([a] -> CommandDoc -> CommandDoc) -> Show a
    showList :: [TxnParams] -> CommandDoc -> CommandDoc
    $cshowList :: [TxnParams] -> CommandDoc -> CommandDoc
    show :: TxnParams -> CommandDoc
    $cshow :: TxnParams -> CommandDoc
    showsPrec :: Int -> TxnParams -> CommandDoc -> CommandDoc
    $cshowsPrec :: Int -> TxnParams -> CommandDoc -> CommandDoc
    Show)

    data PrevInput = PrevInput
      { PrevInput -> Maybe CommandDoc
    prevDateAndCode   :: Maybe String
      , PrevInput -> Maybe CommandDoc
    prevDescAndCmnt   :: Maybe String
      , PrevInput -> [CommandDoc]
    prevAccount       :: [String]
      , PrevInput -> [CommandDoc]
    prevAmountAndCmnt :: [String]
      } deriving (Int -> PrevInput -> CommandDoc -> CommandDoc
    [PrevInput] -> CommandDoc -> CommandDoc
    PrevInput -> CommandDoc
    (Int -> PrevInput -> CommandDoc -> CommandDoc)
    -> (PrevInput -> CommandDoc)
    -> ([PrevInput] -> CommandDoc -> CommandDoc)
    -> Show PrevInput
    forall a.
    (Int -> a -> CommandDoc -> CommandDoc)
    -> (a -> CommandDoc) -> ([a] -> CommandDoc -> CommandDoc) -> Show a
    showList :: [PrevInput] -> CommandDoc -> CommandDoc
    $cshowList :: [PrevInput] -> CommandDoc -> CommandDoc
    show :: PrevInput -> CommandDoc
    $cshow :: PrevInput -> CommandDoc
    showsPrec :: Int -> PrevInput -> CommandDoc -> CommandDoc
    $cshowsPrec :: Int -> PrevInput -> CommandDoc -> CommandDoc
    Show)

    data AddingStage = EnterDateAndCode
                     | EnterDescAndComment (Day, Text)
                     | EnterAccount TxnParams
                     | EnterAmountAndComment TxnParams String
                     | EndStage Transaction
                     | EnterNewPosting TxnParams (Maybe Posting)

    confirmedTransactionWizard :: PrevInput -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard :: PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard prevInput :: PrevInput
    prevInput es :: EntryState
    es [] = PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es [AddingStage
    EnterDateAndCode]
    confirmedTransactionWizard prevInput :: PrevInput
    prevInput es :: EntryState
    es@EntryState{..} stack :: [AddingStage]
    stack@(currentStage :: AddingStage
    currentStage : _) = case AddingStage
    currentStage of
      EnterDateAndCode -> PrevInput -> EntryState -> Wizard Haskeline (Maybe (Day, Text))
    dateAndCodeWizard PrevInput
    prevInput EntryState
    es Wizard Haskeline (Maybe (Day, Text))
    -> (Maybe (Day, Text) -> Wizard Haskeline Transaction)
    -> Wizard Haskeline Transaction
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just (date :: Day
    date, code :: Text
    code) -> do
          let es' :: EntryState
    es' = EntryState
    es
                { esArgs :: [CommandDoc]
    esArgs = Int -> [CommandDoc] -> [CommandDoc]
    forall a. Int -> [a] -> [a]
    drop 1 [CommandDoc]
    esArgs
                , esDefDate :: Day
    esDefDate = Day
    date
                }
              dateAndCodeString :: CommandDoc
    dateAndCodeString = TimeLocale -> CommandDoc -> Day -> CommandDoc
    forall t.
    FormatTime t =>
    TimeLocale -> CommandDoc -> t -> CommandDoc
    formatTime TimeLocale
    defaultTimeLocale CommandDoc
    yyyymmddFormat Day
    date CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ (if Text -> Bool
    T.null Text
    code then "" else " (" CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ Text -> CommandDoc
    T.unpack Text
    code CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ ")")
              yyyymmddFormat :: CommandDoc
    yyyymmddFormat = Maybe CommandDoc -> CommandDoc
    iso8601DateFormat Maybe CommandDoc
    forall a. Maybe a
    Nothing
          PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput{prevDateAndCode :: Maybe CommandDoc
    prevDateAndCode=CommandDoc -> Maybe CommandDoc
    forall a. a -> Maybe a
    Just CommandDoc
    dateAndCodeString} EntryState
    es' ((Day, Text) -> AddingStage
    EnterDescAndComment (Day
    date, Text
    code) AddingStage -> [AddingStage] -> [AddingStage]
    forall a. a -> [a] -> [a]
    : [AddingStage]
    stack)
        Nothing ->
          PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es [AddingStage]
    stack

      EnterDescAndComment (date :: Day
    date, code :: Text
    code) -> PrevInput -> EntryState -> Wizard Haskeline (Maybe (Text, Text))
    descriptionAndCommentWizard PrevInput
    prevInput EntryState
    es Wizard Haskeline (Maybe (Text, Text))
    -> (Maybe (Text, Text) -> Wizard Haskeline Transaction)
    -> Wizard Haskeline Transaction
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just (desc :: Text
    desc, comment :: Text
    comment) -> do
          let mbaset :: Maybe Transaction
    mbaset = EntryState -> Text -> Maybe Transaction
    similarTransaction EntryState
    es Text
    desc
              es' :: EntryState
    es' = EntryState
    es
                { esArgs :: [CommandDoc]
    esArgs = Int -> [CommandDoc] -> [CommandDoc]
    forall a. Int -> [a] -> [a]
    drop 1 [CommandDoc]
    esArgs
                , esPostings :: [Posting]
    esPostings = []
                , esSimilarTransaction :: Maybe Transaction
    esSimilarTransaction = Maybe Transaction
    mbaset
                }
              descAndCommentString :: CommandDoc
    descAndCommentString = Text -> CommandDoc
    T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Text
    desc Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (if Text -> Bool
    T.null Text
    comment then "" else "  ; " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    comment)
              prevInput' :: PrevInput
    prevInput' = PrevInput
    prevInput{prevDescAndCmnt :: Maybe CommandDoc
    prevDescAndCmnt=CommandDoc -> Maybe CommandDoc
    forall a. a -> Maybe a
    Just CommandDoc
    descAndCommentString}
          Bool -> Wizard Haskeline () -> Wizard Haskeline ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe Transaction -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Transaction
    mbaset) (Wizard Haskeline () -> Wizard Haskeline ())
    -> Wizard Haskeline () -> Wizard Haskeline ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> Wizard Haskeline ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Wizard Haskeline ()) -> IO () -> Wizard Haskeline ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> CommandDoc -> CommandDoc -> IO ()
    forall r. HPrintfType r => Handle -> CommandDoc -> r
    hPrintf Handle
    stderr "Using this similar transaction for defaults:\n%s" (Transaction -> CommandDoc
    showTransaction (Transaction -> CommandDoc) -> Transaction -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Maybe Transaction -> Transaction
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe Transaction
    mbaset)
          PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput' EntryState
    es' ((TxnParams -> Maybe Posting -> AddingStage
    EnterNewPosting TxnParams :: Day -> Text -> Text -> Text -> TxnParams
    TxnParams{txnDate :: Day
    txnDate=Day
    date, txnCode :: Text
    txnCode=Text
    code, txnDesc :: Text
    txnDesc=Text
    desc, txnCmnt :: Text
    txnCmnt=Text
    comment} Maybe Posting
    forall a. Maybe a
    Nothing) AddingStage -> [AddingStage] -> [AddingStage]
    forall a. a -> [a] -> [a]
    : [AddingStage]
    stack)
        Nothing ->
          PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es (Int -> [AddingStage] -> [AddingStage]
    forall a. Int -> [a] -> [a]
    drop 1 [AddingStage]
    stack)

      EnterNewPosting txnParams :: TxnParams
    txnParams@TxnParams{..} posting :: Maybe Posting
    posting -> case ([Posting]
    esPostings, Maybe Posting
    posting) of
        ([], Nothing) ->
          PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es (TxnParams -> AddingStage
    EnterAccount TxnParams
    txnParams AddingStage -> [AddingStage] -> [AddingStage]
    forall a. a -> [a] -> [a]
    : [AddingStage]
    stack)
        (_, Just _) ->
          PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es (TxnParams -> AddingStage
    EnterAccount TxnParams
    txnParams AddingStage -> [AddingStage] -> [AddingStage]
    forall a. a -> [a] -> [a]
    : [AddingStage]
    stack)
        (_, Nothing) -> do
          let t :: Transaction
    t = Transaction
    nulltransaction{tdate :: Day
    tdate=Day
    txnDate
                                 ,tstatus :: Status
    tstatus=Status
    Unmarked
                                 ,tcode :: Text
    tcode=Text
    txnCode
                                 ,tdescription :: Text
    tdescription=Text
    txnDesc
                                 ,tcomment :: Text
    tcomment=Text
    txnCmnt
                                 ,tpostings :: [Posting]
    tpostings=[Posting]
    esPostings
                                 }
          case Maybe (Map Text AmountStyle)
    -> Transaction -> Either CommandDoc Transaction
    balanceTransaction Maybe (Map Text AmountStyle)
    forall a. Maybe a
    Nothing Transaction
    t of -- imprecise balancing (?)
            Right t' :: Transaction
    t' ->
              PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es (Transaction -> AddingStage
    EndStage Transaction
    t' AddingStage -> [AddingStage] -> [AddingStage]
    forall a. a -> [a] -> [a]
    : [AddingStage]
    stack)
            Left err :: CommandDoc
    err -> do
              IO () -> Wizard Haskeline ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Handle -> CommandDoc -> IO ()
    hPutStrLn Handle
    stderr (CommandDoc -> IO ()) -> CommandDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "\n" CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ (CommandDoc -> CommandDoc
    capitalize CommandDoc
    err) CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ "please re-enter.")
              let notFirstEnterPost :: AddingStage -> Bool
    notFirstEnterPost stage :: AddingStage
    stage = case AddingStage
    stage of
                    EnterNewPosting _ Nothing -> Bool
    False
                    _ -> Bool
    True
              PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es{esPostings :: [Posting]
    esPostings=[]} ((AddingStage -> Bool) -> [AddingStage] -> [AddingStage]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile AddingStage -> Bool
    notFirstEnterPost [AddingStage]
    stack)

      EnterAccount txnParams :: TxnParams
    txnParams -> PrevInput -> EntryState -> Wizard Haskeline (Maybe CommandDoc)
    accountWizard PrevInput
    prevInput EntryState
    es Wizard Haskeline (Maybe CommandDoc)
    -> (Maybe CommandDoc -> Wizard Haskeline Transaction)
    -> Wizard Haskeline Transaction
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just account :: CommandDoc
    account
          | CommandDoc
    account CommandDoc -> [CommandDoc] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [".", ""] ->
              case ([Posting]
    esPostings, [Posting] -> Bool
    postingsBalanced [Posting]
    esPostings) of
                ([],_)    -> IO () -> Wizard Haskeline ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Handle -> CommandDoc -> IO ()
    hPutStrLn Handle
    stderr "Please enter some postings first.") Wizard Haskeline ()
    -> Wizard Haskeline Transaction -> Wizard Haskeline Transaction
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es [AddingStage]
    stack
                (_,False) -> IO () -> Wizard Haskeline ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Handle -> CommandDoc -> IO ()
    hPutStrLn Handle
    stderr "Please enter more postings to balance the transaction.") Wizard Haskeline ()
    -> Wizard Haskeline Transaction -> Wizard Haskeline Transaction
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es [AddingStage]
    stack
                (_,True)  -> PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es (TxnParams -> Maybe Posting -> AddingStage
    EnterNewPosting TxnParams
    txnParams Maybe Posting
    forall a. Maybe a
    Nothing AddingStage -> [AddingStage] -> [AddingStage]
    forall a. a -> [a] -> [a]
    : [AddingStage]
    stack)
          | Bool
    otherwise -> do
              let prevAccount' :: [CommandDoc]
    prevAccount' = Int -> CommandDoc -> [CommandDoc] -> [CommandDoc]
    forall a. Int -> a -> [a] -> [a]
    replaceNthOrAppend ([Posting] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Posting]
    esPostings) CommandDoc
    account (PrevInput -> [CommandDoc]
    prevAccount PrevInput
    prevInput)
              PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput{prevAccount :: [CommandDoc]
    prevAccount=[CommandDoc]
    prevAccount'} EntryState
    es{esArgs :: [CommandDoc]
    esArgs=Int -> [CommandDoc] -> [CommandDoc]
    forall a. Int -> [a] -> [a]
    drop 1 [CommandDoc]
    esArgs} (TxnParams -> CommandDoc -> AddingStage
    EnterAmountAndComment TxnParams
    txnParams CommandDoc
    account AddingStage -> [AddingStage] -> [AddingStage]
    forall a. a -> [a] -> [a]
    : [AddingStage]
    stack)
        Nothing -> do
          let notPrevAmountAndNotEnterDesc :: AddingStage -> Bool
    notPrevAmountAndNotEnterDesc stage :: AddingStage
    stage = case AddingStage
    stage of
                EnterAmountAndComment _ _ -> Bool
    False
                EnterDescAndComment _ -> Bool
    False
                _ -> Bool
    True
          PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es{esPostings :: [Posting]
    esPostings=[Posting] -> [Posting]
    forall a. [a] -> [a]
    init [Posting]
    esPostings} ((AddingStage -> Bool) -> [AddingStage] -> [AddingStage]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile AddingStage -> Bool
    notPrevAmountAndNotEnterDesc [AddingStage]
    stack)

      EnterAmountAndComment txnParams :: TxnParams
    txnParams account :: CommandDoc
    account -> PrevInput -> EntryState -> Wizard Haskeline (Maybe (Amount, Text))
    amountAndCommentWizard PrevInput
    prevInput EntryState
    es Wizard Haskeline (Maybe (Amount, Text))
    -> (Maybe (Amount, Text) -> Wizard Haskeline Transaction)
    -> Wizard Haskeline Transaction
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just (amount :: Amount
    amount, comment :: Text
    comment) -> do
          let posting :: Posting
    posting = Posting
    nullposting{paccount :: Text
    paccount=CommandDoc -> Text
    T.pack (CommandDoc -> Text) -> CommandDoc -> Text
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc
    stripbrackets CommandDoc
    account
                                   ,pamount :: MixedAmount
    pamount=[Amount] -> MixedAmount
    Mixed [Amount
    amount]
                                   ,pcomment :: Text
    pcomment=Text
    comment
                                   ,ptype :: PostingType
    ptype=Text -> PostingType
    accountNamePostingType (Text -> PostingType) -> Text -> PostingType
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> Text
    T.pack CommandDoc
    account
                                   }
              amountAndCommentString :: CommandDoc
    amountAndCommentString = Amount -> CommandDoc
    showAmount Amount
    amount CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ (if Text -> Bool
    T.null Text
    comment then "" else "  ;" CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ Text -> CommandDoc
    T.unpack Text
    comment)
              prevAmountAndCmnt' :: [CommandDoc]
    prevAmountAndCmnt' = Int -> CommandDoc -> [CommandDoc] -> [CommandDoc]
    forall a. Int -> a -> [a] -> [a]
    replaceNthOrAppend ([Posting] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Posting]
    esPostings) CommandDoc
    amountAndCommentString (PrevInput -> [CommandDoc]
    prevAmountAndCmnt PrevInput
    prevInput)
              es' :: EntryState
    es' = EntryState
    es{esPostings :: [Posting]
    esPostings=[Posting]
    esPostings[Posting] -> [Posting] -> [Posting]
    forall a. [a] -> [a] -> [a]
    ++[Posting
    posting], esArgs :: [CommandDoc]
    esArgs=Int -> [CommandDoc] -> [CommandDoc]
    forall a. Int -> [a] -> [a]
    drop 2 [CommandDoc]
    esArgs}
          PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput{prevAmountAndCmnt :: [CommandDoc]
    prevAmountAndCmnt=[CommandDoc]
    prevAmountAndCmnt'} EntryState
    es' (TxnParams -> Maybe Posting -> AddingStage
    EnterNewPosting TxnParams
    txnParams (Posting -> Maybe Posting
    forall a. a -> Maybe a
    Just Posting
    posting) AddingStage -> [AddingStage] -> [AddingStage]
    forall a. a -> [a] -> [a]
    : [AddingStage]
    stack)
        Nothing -> PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es (Int -> [AddingStage] -> [AddingStage]
    forall a. Int -> [a] -> [a]
    drop 1 [AddingStage]
    stack)

      EndStage t :: Transaction
    t -> do
        CommandDoc -> Wizard Haskeline ()
    forall (b :: * -> *). (Output :<: b) => CommandDoc -> Wizard b ()
    output (CommandDoc -> Wizard Haskeline ())
    -> CommandDoc -> Wizard Haskeline ()
    forall a b. (a -> b) -> a -> b
    $ Transaction -> CommandDoc
    showTransaction Transaction
    t
        Maybe Char
    y <- let def :: CommandDoc
    def = "y" in
             CommandDoc
    -> Wizard Haskeline (Maybe Char) -> Wizard Haskeline (Maybe Char)
    forall (b :: * -> *) a.
    (OutputLn :<: b) =>
    CommandDoc -> Wizard b a -> Wizard b a
    retryMsg "Please enter y or n." (Wizard Haskeline (Maybe Char) -> Wizard Haskeline (Maybe Char))
    -> Wizard Haskeline (Maybe Char) -> Wizard Haskeline (Maybe Char)
    forall a b. (a -> b) -> a -> b
    $
              (CommandDoc -> Maybe (Maybe Char))
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline (Maybe Char)
    forall (b :: * -> *) a c.
    Functor b =>
    (a -> Maybe c) -> Wizard b a -> Wizard b c
    parser (((Char -> Maybe Char) -> Maybe Char -> Maybe (Maybe Char)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\c :: Char
    c -> if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '<' then Maybe Char
    forall a. Maybe a
    Nothing else Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c)) (Maybe Char -> Maybe (Maybe Char))
    -> (CommandDoc -> Maybe Char) -> CommandDoc -> Maybe (Maybe Char)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommandDoc -> Maybe Char
    forall a. [a] -> Maybe a
    headMay (CommandDoc -> Maybe Char)
    -> (CommandDoc -> CommandDoc) -> CommandDoc -> Maybe Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> CommandDoc -> CommandDoc
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (CommandDoc -> CommandDoc)
    -> (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommandDoc -> CommandDoc
    strip) (Wizard Haskeline CommandDoc -> Wizard Haskeline (Maybe Char))
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline (Maybe Char)
    forall a b. (a -> b) -> a -> b
    $
              CommandDoc
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a. a -> Wizard Haskeline a -> Wizard Haskeline a
    defaultTo' CommandDoc
    def (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
    nonEmpty (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $
              CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *).
    (Line :<: b) =>
    CommandDoc -> Wizard b CommandDoc
    line (CommandDoc -> Wizard Haskeline CommandDoc)
    -> CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc
    green (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "Save this transaction to the journal ?%s: " (CommandDoc -> CommandDoc
    showDefault CommandDoc
    def)
        case Maybe Char
    y of
          Just 'y' -> Transaction -> Wizard Haskeline Transaction
    forall (m :: * -> *) a. Monad m => a -> m a
    return Transaction
    t
          Just _   -> RestartTransactionException -> Wizard Haskeline Transaction
    forall a e. Exception e => e -> a
    throw RestartTransactionException
    RestartTransactionException
          Nothing  -> PrevInput
    -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
    confirmedTransactionWizard PrevInput
    prevInput EntryState
    es (Int -> [AddingStage] -> [AddingStage]
    forall a. Int -> [a] -> [a]
    drop 2 [AddingStage]
    stack)
      where
        replaceNthOrAppend :: Int -> a -> [a] -> [a]
    replaceNthOrAppend n :: Int
    n newElem :: a
    newElem xs :: [a]
    xs = Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take Int
    n [a]
    xs [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a
    newElem] [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) [a]
    xs

    -- Identify the closest recent match for this description in past transactions.
    similarTransaction :: EntryState -> Text -> Maybe Transaction
    similarTransaction :: EntryState -> Text -> Maybe Transaction
    similarTransaction EntryState{..} desc :: Text
    desc =
      let q :: Query
    q = Day -> ReportOpts -> Query
    queryFromOptsOnly Day
    esToday (ReportOpts -> Query) -> ReportOpts -> Query
    forall a b. (a -> b) -> a -> b
    $ CliOpts -> ReportOpts
    reportopts_ CliOpts
    esOpts
          historymatches :: [(Double, Transaction)]
    historymatches = Journal -> Query -> Text -> [(Double, Transaction)]
    transactionsSimilarTo Journal
    esJournal Query
    q Text
    desc
          bestmatch :: Maybe Transaction
    bestmatch | [(Double, Transaction)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Double, Transaction)]
    historymatches = Maybe Transaction
    forall a. Maybe a
    Nothing
                    | Bool
    otherwise           = Transaction -> Maybe Transaction
    forall a. a -> Maybe a
    Just (Transaction -> Maybe Transaction)
    -> Transaction -> Maybe Transaction
    forall a b. (a -> b) -> a -> b
    $ (Double, Transaction) -> Transaction
    forall a b. (a, b) -> b
    snd ((Double, Transaction) -> Transaction)
    -> (Double, Transaction) -> Transaction
    forall a b. (a -> b) -> a -> b
    $ [(Double, Transaction)] -> (Double, Transaction)
    forall a. [a] -> a
    head [(Double, Transaction)]
    historymatches
      in Maybe Transaction
    bestmatch

    dateAndCodeWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe (Day, Text))
    dateAndCodeWizard PrevInput{..} EntryState{..} = do
      let def :: CommandDoc
    def = CommandDoc -> [CommandDoc] -> CommandDoc
    forall a. a -> [a] -> a
    headDef (Day -> CommandDoc
    showDate Day
    esDefDate) [CommandDoc]
    esArgs
      CommandDoc
    -> Wizard Haskeline (Maybe (Day, Text))
    -> Wizard Haskeline (Maybe (Day, Text))
    forall (b :: * -> *) a.
    (OutputLn :<: b) =>
    CommandDoc -> Wizard b a -> Wizard b a
    retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." (Wizard Haskeline (Maybe (Day, Text))
     -> Wizard Haskeline (Maybe (Day, Text)))
    -> Wizard Haskeline (Maybe (Day, Text))
    -> Wizard Haskeline (Maybe (Day, Text))
    forall a b. (a -> b) -> a -> b
    $
       (CommandDoc -> Maybe (Maybe (Day, Text)))
    -> Wizard Haskeline CommandDoc
    -> Wizard Haskeline (Maybe (Day, Text))
    forall (b :: * -> *) a c.
    Functor b =>
    (a -> Maybe c) -> Wizard b a -> Wizard b c
    parser (Day -> CommandDoc -> Maybe (Maybe (Day, Text))
    parseSmartDateAndCode Day
    esToday) (Wizard Haskeline CommandDoc
     -> Wizard Haskeline (Maybe (Day, Text)))
    -> Wizard Haskeline CommandDoc
    -> Wizard Haskeline (Maybe (Day, Text))
    forall a b. (a -> b) -> a -> b
    $
       CompletionFunc IO
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *) a.
    (WithSettings :<: b) =>
    CompletionFunc IO -> Wizard b a -> Wizard b a
    withCompletion (CommandDoc -> CompletionFunc IO
    dateCompleter CommandDoc
    def) (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $
       CommandDoc
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a. a -> Wizard Haskeline a -> Wizard Haskeline a
    defaultTo' CommandDoc
    def (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
    nonEmpty (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $
       Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    maybeExit (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $
       -- maybeShowHelp $
       CommandDoc
    -> CommandDoc -> CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *).
    (LinePrewritten :<: b) =>
    CommandDoc -> CommandDoc -> CommandDoc -> Wizard b CommandDoc
    linePrewritten (CommandDoc -> CommandDoc
    green (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "Date%s: " (CommandDoc -> CommandDoc
    showDefault CommandDoc
    def)) (CommandDoc -> Maybe CommandDoc -> CommandDoc
    forall a. a -> Maybe a -> a
    fromMaybe "" Maybe CommandDoc
    prevDateAndCode) ""
        where
          parseSmartDateAndCode :: Day -> CommandDoc -> Maybe (Maybe (Day, Text))
    parseSmartDateAndCode refdate :: Day
    refdate s :: CommandDoc
    s = if CommandDoc
    s CommandDoc -> CommandDoc -> Bool
    forall a. Eq a => a -> a -> Bool
    == "<" then Maybe (Day, Text) -> Maybe (Maybe (Day, Text))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Day, Text)
    forall a. Maybe a
    Nothing else (ParseErrorBundle Text CustomErr -> Maybe (Maybe (Day, Text)))
    -> ((SmartDate, Text) -> Maybe (Maybe (Day, Text)))
    -> Either (ParseErrorBundle Text CustomErr) (SmartDate, Text)
    -> Maybe (Maybe (Day, Text))
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe (Maybe (Day, Text))
    -> ParseErrorBundle Text CustomErr -> Maybe (Maybe (Day, Text))
    forall a b. a -> b -> a
    const Maybe (Maybe (Day, Text))
    forall a. Maybe a
    Nothing) (\(d :: SmartDate
    d,c :: Text
    c) -> Maybe (Day, Text) -> Maybe (Maybe (Day, Text))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Day, Text) -> Maybe (Maybe (Day, Text)))
    -> Maybe (Day, Text) -> Maybe (Maybe (Day, Text))
    forall a b. (a -> b) -> a -> b
    $ (Day, Text) -> Maybe (Day, Text)
    forall a. a -> Maybe a
    Just (Day -> SmartDate -> Day
    fixSmartDate Day
    refdate SmartDate
    d, Text
    c)) Either (ParseErrorBundle Text CustomErr) (SmartDate, Text)
    edc
              where
                edc :: Either (ParseErrorBundle Text CustomErr) (SmartDate, Text)
    edc = Parsec CustomErr Text (SmartDate, Text)
    -> CommandDoc
    -> Text
    -> Either (ParseErrorBundle Text CustomErr) (SmartDate, Text)
    forall e s a.
    Parsec e s a -> CommandDoc -> s -> Either (ParseErrorBundle s e) a
    runParser (Parsec CustomErr Text (SmartDate, Text)
    dateandcodep Parsec CustomErr Text (SmartDate, Text)
    -> ParsecT CustomErr Text Identity ()
    -> Parsec CustomErr Text (SmartDate, Text)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT CustomErr Text Identity ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof) "" (Text
     -> Either (ParseErrorBundle Text CustomErr) (SmartDate, Text))
    -> Text
    -> Either (ParseErrorBundle Text CustomErr) (SmartDate, Text)
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> Text
    T.pack (CommandDoc -> Text) -> CommandDoc -> Text
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc
    lowercase CommandDoc
    s
                dateandcodep :: SimpleTextParser (SmartDate, Text)
                dateandcodep :: Parsec CustomErr Text (SmartDate, Text)
    dateandcodep = do
                    SmartDate
    d <- TextParser Identity SmartDate
    forall (m :: * -> *). TextParser m SmartDate
    smartdate
                    Maybe Text
    c <- ParsecT CustomErr Text Identity Text
    -> ParsecT CustomErr Text Identity (Maybe Text)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional ParsecT CustomErr Text Identity Text
    forall (m :: * -> *). TextParser m Text
    codep
                    ParsecT CustomErr Text Identity ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces
                    ParsecT CustomErr Text Identity ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof
                    (SmartDate, Text) -> Parsec CustomErr Text (SmartDate, Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SmartDate
    d, Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe "" Maybe Text
    c)
          -- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate
          -- datestr = showDate $ fixSmartDate defday smtdate

    descriptionAndCommentWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe (Text, Text))
    descriptionAndCommentWizard PrevInput{..} EntryState{..} = do
      let def :: CommandDoc
    def = CommandDoc -> [CommandDoc] -> CommandDoc
    forall a. a -> [a] -> a
    headDef "" [CommandDoc]
    esArgs
      CommandDoc
    s <- CompletionFunc IO
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *) a.
    (WithSettings :<: b) =>
    CompletionFunc IO -> Wizard b a -> Wizard b a
    withCompletion (Journal -> CommandDoc -> CompletionFunc IO
    descriptionCompleter Journal
    esJournal CommandDoc
    def) (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $
           CommandDoc
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a. a -> Wizard Haskeline a -> Wizard Haskeline a
    defaultTo' CommandDoc
    def (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
    nonEmpty (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $
           CommandDoc
    -> CommandDoc -> CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *).
    (LinePrewritten :<: b) =>
    CommandDoc -> CommandDoc -> CommandDoc -> Wizard b CommandDoc
    linePrewritten (CommandDoc -> CommandDoc
    green (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "Description%s: " (CommandDoc -> CommandDoc
    showDefault CommandDoc
    def)) (CommandDoc -> Maybe CommandDoc -> CommandDoc
    forall a. a -> Maybe a -> a
    fromMaybe "" Maybe CommandDoc
    prevDescAndCmnt) ""
      if CommandDoc
    s CommandDoc -> CommandDoc -> Bool
    forall a. Eq a => a -> a -> Bool
    == "<"
        then Maybe (Text, Text) -> Wizard Haskeline (Maybe (Text, Text))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Text, Text)
    forall a. Maybe a
    Nothing
        else do
          let (desc :: Text
    desc,comment :: Text
    comment) = (CommandDoc -> Text
    T.pack (CommandDoc -> Text) -> CommandDoc -> Text
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc
    strip CommandDoc
    a, CommandDoc -> Text
    T.pack (CommandDoc -> Text) -> CommandDoc -> Text
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc
    strip (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> CommandDoc -> CommandDoc
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==';') CommandDoc
    b) where (a :: CommandDoc
    a,b :: CommandDoc
    b) = (Char -> Bool) -> CommandDoc -> (CommandDoc, CommandDoc)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==';') CommandDoc
    s
          Maybe (Text, Text) -> Wizard Haskeline (Maybe (Text, Text))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Text, Text) -> Wizard Haskeline (Maybe (Text, Text)))
    -> Maybe (Text, Text) -> Wizard Haskeline (Maybe (Text, Text))
    forall a b. (a -> b) -> a -> b
    $ (Text, Text) -> Maybe (Text, Text)
    forall a. a -> Maybe a
    Just (Text
    desc, Text
    comment)

    postingsBalanced :: [Posting] -> Bool
    postingsBalanced :: [Posting] -> Bool
    postingsBalanced ps :: [Posting]
    ps = Either CommandDoc Transaction -> Bool
    forall a b. Either a b -> Bool
    isRight (Either CommandDoc Transaction -> Bool)
    -> Either CommandDoc Transaction -> Bool
    forall a b. (a -> b) -> a -> b
    $ Maybe (Map Text AmountStyle)
    -> Transaction -> Either CommandDoc Transaction
    balanceTransaction Maybe (Map Text AmountStyle)
    forall a. Maybe a
    Nothing Transaction
    nulltransaction{tpostings :: [Posting]
    tpostings=[Posting]
    ps}

    accountWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe CommandDoc)
    accountWizard PrevInput{..} EntryState{..} = do
      let pnum :: Int
    pnum = [Posting] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Posting]
    esPostings Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1
          historicalp :: Maybe Posting
    historicalp = (Transaction -> Posting) -> Maybe Transaction -> Maybe Posting
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([Posting] -> Int -> Posting
    forall a. [a] -> Int -> a
    !! (Int
    pnum Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1)) ([Posting] -> Posting)
    -> (Transaction -> [Posting]) -> Transaction -> Posting
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Posting] -> [Posting] -> [Posting]
    forall a. [a] -> [a] -> [a]
    ++ (Posting -> [Posting]
    forall a. a -> [a]
    repeat Posting
    nullposting)) ([Posting] -> [Posting])
    -> (Transaction -> [Posting]) -> Transaction -> [Posting]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transaction -> [Posting]
    tpostings) Maybe Transaction
    esSimilarTransaction
          historicalacct :: CommandDoc
    historicalacct = case Maybe Posting
    historicalp of Just p :: Posting
    p  -> Maybe Int -> PostingType -> Text -> CommandDoc
    showAccountName Maybe Int
    forall a. Maybe a
    Nothing (Posting -> PostingType
    ptype Posting
    p) (Posting -> Text
    paccount Posting
    p)
                                               Nothing -> ""
          def :: CommandDoc
    def = CommandDoc -> [CommandDoc] -> CommandDoc
    forall a. a -> [a] -> a
    headDef CommandDoc
    historicalacct [CommandDoc]
    esArgs
          endmsg :: CommandDoc
    endmsg | Bool
    canfinish Bool -> Bool -> Bool
    && CommandDoc -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null CommandDoc
    def = " (or . or enter to finish this transaction)"
                 | Bool
    canfinish             = " (or . to finish this transaction)"
                 | Bool
    otherwise             = ""
      CommandDoc
    -> Wizard Haskeline (Maybe CommandDoc)
    -> Wizard Haskeline (Maybe CommandDoc)
    forall (b :: * -> *) a.
    (OutputLn :<: b) =>
    CommandDoc -> Wizard b a -> Wizard b a
    retryMsg "A valid hledger account name is required. Eg: assets:cash, expenses:food:eating out." (Wizard Haskeline (Maybe CommandDoc)
     -> Wizard Haskeline (Maybe CommandDoc))
    -> Wizard Haskeline (Maybe CommandDoc)
    -> Wizard Haskeline (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $
       (CommandDoc -> Maybe (Maybe CommandDoc))
    -> Wizard Haskeline CommandDoc
    -> Wizard Haskeline (Maybe CommandDoc)
    forall (b :: * -> *) a c.
    Functor b =>
    (a -> Maybe c) -> Wizard b a -> Wizard b c
    parser (CommandDoc -> Bool -> CommandDoc -> Maybe (Maybe CommandDoc)
    parseAccountOrDotOrNull CommandDoc
    def Bool
    canfinish) (Wizard Haskeline CommandDoc
     -> Wizard Haskeline (Maybe CommandDoc))
    -> Wizard Haskeline CommandDoc
    -> Wizard Haskeline (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $
       CompletionFunc IO
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *) a.
    (WithSettings :<: b) =>
    CompletionFunc IO -> Wizard b a -> Wizard b a
    withCompletion (Journal -> CommandDoc -> CompletionFunc IO
    accountCompleter Journal
    esJournal CommandDoc
    def) (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $
       CommandDoc
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a. a -> Wizard Haskeline a -> Wizard Haskeline a
    defaultTo' CommandDoc
    def (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $ -- nonEmpty $
       CommandDoc
    -> CommandDoc -> CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *).
    (LinePrewritten :<: b) =>
    CommandDoc -> CommandDoc -> CommandDoc -> Wizard b CommandDoc
    linePrewritten (CommandDoc -> CommandDoc
    green (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> Int -> CommandDoc -> CommandDoc -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "Account %d%s%s: " Int
    pnum (CommandDoc
    endmsg::String) (CommandDoc -> CommandDoc
    showDefault CommandDoc
    def)) (CommandDoc -> Maybe CommandDoc -> CommandDoc
    forall a. a -> Maybe a -> a
    fromMaybe "" (Maybe CommandDoc -> CommandDoc) -> Maybe CommandDoc -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ [CommandDoc]
    prevAccount [CommandDoc] -> Int -> Maybe CommandDoc
    forall a. [a] -> Int -> Maybe a
    `atMay` [Posting] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Posting]
    esPostings) ""
        where
          canfinish :: Bool
    canfinish = Bool -> Bool
    not ([Posting] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Posting]
    esPostings) Bool -> Bool -> Bool
    && [Posting] -> Bool
    postingsBalanced [Posting]
    esPostings
          parseAccountOrDotOrNull :: String -> Bool -> String -> Maybe (Maybe String)
          parseAccountOrDotOrNull :: CommandDoc -> Bool -> CommandDoc -> Maybe (Maybe CommandDoc)
    parseAccountOrDotOrNull _  _ "<"       = Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc)
    forall a. a -> a
    dbg1 (Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc))
    -> Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $ Maybe CommandDoc -> Maybe (Maybe CommandDoc)
    forall a. a -> Maybe a
    Just Maybe CommandDoc
    forall a. Maybe a
    Nothing
          parseAccountOrDotOrNull _  _ "."       = Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc)
    forall a. a -> a
    dbg1 (Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc))
    -> Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $ Maybe CommandDoc -> Maybe (Maybe CommandDoc)
    forall a. a -> Maybe a
    Just (Maybe CommandDoc -> Maybe (Maybe CommandDoc))
    -> Maybe CommandDoc -> Maybe (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> Maybe CommandDoc
    forall a. a -> Maybe a
    Just "." -- . always signals end of txn
          parseAccountOrDotOrNull "" True ""     = Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc)
    forall a. a -> a
    dbg1 (Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc))
    -> Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $ Maybe CommandDoc -> Maybe (Maybe CommandDoc)
    forall a. a -> Maybe a
    Just (Maybe CommandDoc -> Maybe (Maybe CommandDoc))
    -> Maybe CommandDoc -> Maybe (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> Maybe CommandDoc
    forall a. a -> Maybe a
    Just ""  -- when there's no default and txn is balanced, "" also signals end of txn
          parseAccountOrDotOrNull def :: CommandDoc
    def@(_:_) _ "" = Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc)
    forall a. a -> a
    dbg1 (Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc))
    -> Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $ Maybe CommandDoc -> Maybe (Maybe CommandDoc)
    forall a. a -> Maybe a
    Just (Maybe CommandDoc -> Maybe (Maybe CommandDoc))
    -> Maybe CommandDoc -> Maybe (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> Maybe CommandDoc
    forall a. a -> Maybe a
    Just CommandDoc
    def -- when there's a default, "" means use that
          parseAccountOrDotOrNull _ _ s :: CommandDoc
    s          = Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc)
    forall a. a -> a
    dbg1 (Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc))
    -> Maybe (Maybe CommandDoc) -> Maybe (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $ (Text -> Maybe CommandDoc)
    -> Maybe Text -> Maybe (Maybe CommandDoc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (CommandDoc -> Maybe CommandDoc
    forall a. a -> Maybe a
    Just (CommandDoc -> Maybe CommandDoc)
    -> (Text -> CommandDoc) -> Text -> Maybe CommandDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> CommandDoc
    T.unpack) (Maybe Text -> Maybe (Maybe CommandDoc))
    -> Maybe Text -> Maybe (Maybe CommandDoc)
    forall a b. (a -> b) -> a -> b
    $
            (ParseErrorBundle Text CustomErr -> Maybe Text)
    -> (Text -> Maybe Text)
    -> Either (ParseErrorBundle Text CustomErr) Text
    -> Maybe Text
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe Text -> ParseErrorBundle Text CustomErr -> Maybe Text
    forall a b. a -> b -> a
    const Maybe Text
    forall a. Maybe a
    Nothing) Text -> Maybe Text
    validateAccount (Either (ParseErrorBundle Text CustomErr) Text -> Maybe Text)
    -> Either (ParseErrorBundle Text CustomErr) Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $
              (State Journal (Either (ParseErrorBundle Text CustomErr) Text)
     -> Journal -> Either (ParseErrorBundle Text CustomErr) Text)
    -> Journal
    -> State Journal (Either (ParseErrorBundle Text CustomErr) Text)
    -> Either (ParseErrorBundle Text CustomErr) Text
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip State Journal (Either (ParseErrorBundle Text CustomErr) Text)
    -> Journal -> Either (ParseErrorBundle Text CustomErr) Text
    forall s a. State s a -> s -> a
    evalState Journal
    esJournal (State Journal (Either (ParseErrorBundle Text CustomErr) Text)
     -> Either (ParseErrorBundle Text CustomErr) Text)
    -> State Journal (Either (ParseErrorBundle Text CustomErr) Text)
    -> Either (ParseErrorBundle Text CustomErr) Text
    forall a b. (a -> b) -> a -> b
    $ ParsecT CustomErr Text (StateT Journal Identity) Text
    -> CommandDoc
    -> Text
    -> State Journal (Either (ParseErrorBundle Text CustomErr) Text)
    forall (m :: * -> *) e s a.
    Monad m =>
    ParsecT e s m a
    -> CommandDoc -> s -> m (Either (ParseErrorBundle s e) a)
    runParserT (ParsecT CustomErr Text (StateT Journal Identity) Text
    forall (m :: * -> *). TextParser m Text
    accountnamep ParsecT CustomErr Text (StateT Journal Identity) Text
    -> ParsecT CustomErr Text (StateT Journal Identity) ()
    -> ParsecT CustomErr Text (StateT Journal Identity) Text
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT CustomErr Text (StateT Journal Identity) ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof) "" (CommandDoc -> Text
    T.pack CommandDoc
    s) -- otherwise, try to parse the input as an accountname
            where
              validateAccount :: Text -> Maybe Text
              validateAccount :: Text -> Maybe Text
    validateAccount t :: Text
    t | CliOpts -> Bool
    no_new_accounts_ CliOpts
    esOpts Bool -> Bool -> Bool
    && Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    notElem Text
    t (Journal -> [Text]
    journalAccountNamesDeclaredOrImplied Journal
    esJournal) = Maybe Text
    forall a. Maybe a
    Nothing
                                | Bool
    otherwise = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    t
          dbg1 :: a -> a
    dbg1 = a -> a
    forall a. a -> a
    id -- strace

    amountAndCommentWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe (Amount, Text))
    amountAndCommentWizard PrevInput{..} EntryState{..} = do
      let pnum :: Int
    pnum = [Posting] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Posting]
    esPostings Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1
          (mhistoricalp :: Maybe Posting
    mhistoricalp,followedhistoricalsofar :: Bool
    followedhistoricalsofar) =
              case Maybe Transaction
    esSimilarTransaction of
                Nothing                        -> (Maybe Posting
    forall a. Maybe a
    Nothing,Bool
    False)
                Just Transaction{tpostings :: Transaction -> [Posting]
    tpostings=[Posting]
    ps} -> (if [Posting] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Posting]
    ps Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    pnum then Posting -> Maybe Posting
    forall a. a -> Maybe a
    Just ([Posting]
    ps [Posting] -> Int -> Posting
    forall a. [a] -> Int -> a
    !! (Int
    pnumInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1)) else Maybe Posting
    forall a. Maybe a
    Nothing
                                                  ,((Posting, Posting) -> Bool) -> [(Posting, Posting)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\(a :: Posting
    a,b :: Posting
    b) -> Posting -> MixedAmount
    pamount Posting
    a MixedAmount -> MixedAmount -> Bool
    forall a. Eq a => a -> a -> Bool
    == Posting -> MixedAmount
    pamount Posting
    b) ([(Posting, Posting)] -> Bool) -> [(Posting, Posting)] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Posting] -> [Posting] -> [(Posting, Posting)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Posting]
    esPostings [Posting]
    ps)
          def :: CommandDoc
    def = case ([CommandDoc]
    esArgs, Maybe Posting
    mhistoricalp, Bool
    followedhistoricalsofar) of
                  (d :: CommandDoc
    d:_,_,_)                                             -> CommandDoc
    d
                  (_,Just hp :: Posting
    hp,True)                                      -> MixedAmount -> CommandDoc
    showamt (MixedAmount -> CommandDoc) -> MixedAmount -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Posting -> MixedAmount
    pamount Posting
    hp
                  _  | Int
    pnum Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 1 Bool -> Bool -> Bool
    && Bool -> Bool
    not (MixedAmount -> Bool
    mixedAmountLooksZero MixedAmount
    balancingamt) -> MixedAmount -> CommandDoc
    showamt MixedAmount
    balancingamtfirstcommodity
                  _                                                     -> ""
      CommandDoc
    -> Wizard Haskeline (Maybe (Amount, Text))
    -> Wizard Haskeline (Maybe (Amount, Text))
    forall (b :: * -> *) a.
    (OutputLn :<: b) =>
    CommandDoc -> Wizard b a -> Wizard b a
    retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." (Wizard Haskeline (Maybe (Amount, Text))
     -> Wizard Haskeline (Maybe (Amount, Text)))
    -> Wizard Haskeline (Maybe (Amount, Text))
    -> Wizard Haskeline (Maybe (Amount, Text))
    forall a b. (a -> b) -> a -> b
    $
       (CommandDoc -> Maybe (Maybe (Amount, Text)))
    -> Wizard Haskeline CommandDoc
    -> Wizard Haskeline (Maybe (Amount, Text))
    forall (b :: * -> *) a c.
    Functor b =>
    (a -> Maybe c) -> Wizard b a -> Wizard b c
    parser CommandDoc -> Maybe (Maybe (Amount, Text))
    parseAmountAndComment (Wizard Haskeline CommandDoc
     -> Wizard Haskeline (Maybe (Amount, Text)))
    -> Wizard Haskeline CommandDoc
    -> Wizard Haskeline (Maybe (Amount, Text))
    forall a b. (a -> b) -> a -> b
    $
       CompletionFunc IO
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *) a.
    (WithSettings :<: b) =>
    CompletionFunc IO -> Wizard b a -> Wizard b a
    withCompletion (CommandDoc -> CompletionFunc IO
    amountCompleter CommandDoc
    def) (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $
       CommandDoc
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a. a -> Wizard Haskeline a -> Wizard Haskeline a
    defaultTo' CommandDoc
    def (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
    nonEmpty (Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall a b. (a -> b) -> a -> b
    $
       CommandDoc
    -> CommandDoc -> CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *).
    (LinePrewritten :<: b) =>
    CommandDoc -> CommandDoc -> CommandDoc -> Wizard b CommandDoc
    linePrewritten (CommandDoc -> CommandDoc
    green (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> Int -> CommandDoc -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "Amount  %d%s: " Int
    pnum (CommandDoc -> CommandDoc
    showDefault CommandDoc
    def)) (CommandDoc -> Maybe CommandDoc -> CommandDoc
    forall a. a -> Maybe a -> a
    fromMaybe "" (Maybe CommandDoc -> CommandDoc) -> Maybe CommandDoc -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ [CommandDoc]
    prevAmountAndCmnt [CommandDoc] -> Int -> Maybe CommandDoc
    forall a. [a] -> Int -> Maybe a
    `atMay` [Posting] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Posting]
    esPostings) ""
        where
          parseAmountAndComment :: CommandDoc -> Maybe (Maybe (Amount, Text))
    parseAmountAndComment s :: CommandDoc
    s = if CommandDoc
    s CommandDoc -> CommandDoc -> Bool
    forall a. Eq a => a -> a -> Bool
    == "<" then Maybe (Amount, Text) -> Maybe (Maybe (Amount, Text))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Amount, Text)
    forall a. Maybe a
    Nothing else (ParseErrorBundle Text CustomErr -> Maybe (Maybe (Amount, Text)))
    -> ((Amount, Text) -> Maybe (Maybe (Amount, Text)))
    -> Either (ParseErrorBundle Text CustomErr) (Amount, Text)
    -> Maybe (Maybe (Amount, Text))
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe (Maybe (Amount, Text))
    -> ParseErrorBundle Text CustomErr -> Maybe (Maybe (Amount, Text))
    forall a b. a -> b -> a
    const Maybe (Maybe (Amount, Text))
    forall a. Maybe a
    Nothing) (Maybe (Amount, Text) -> Maybe (Maybe (Amount, Text))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Amount, Text) -> Maybe (Maybe (Amount, Text)))
    -> ((Amount, Text) -> Maybe (Amount, Text))
    -> (Amount, Text)
    -> Maybe (Maybe (Amount, Text))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Amount, Text) -> Maybe (Amount, Text)
    forall a. a -> Maybe a
    Just) (Either (ParseErrorBundle Text CustomErr) (Amount, Text)
     -> Maybe (Maybe (Amount, Text)))
    -> Either (ParseErrorBundle Text CustomErr) (Amount, Text)
    -> Maybe (Maybe (Amount, Text))
    forall a b. (a -> b) -> a -> b
    $
                                    Parsec CustomErr Text (Amount, Text)
    -> CommandDoc
    -> Text
    -> Either (ParseErrorBundle Text CustomErr) (Amount, Text)
    forall e s a.
    Parsec e s a -> CommandDoc -> s -> Either (ParseErrorBundle s e) a
    runParser
                                      (StateT Journal (ParsecT CustomErr Text Identity) (Amount, Text)
    -> Journal -> Parsec CustomErr Text (Amount, Text)
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT (StateT Journal (ParsecT CustomErr Text Identity) (Amount, Text)
    amountandcommentp StateT Journal (ParsecT CustomErr Text Identity) (Amount, Text)
    -> StateT Journal (ParsecT CustomErr Text Identity) ()
    -> StateT Journal (ParsecT CustomErr Text Identity) (Amount, Text)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* StateT Journal (ParsecT CustomErr Text Identity) ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof) Journal
    nodefcommodityj)
                                      ""
                                      (CommandDoc -> Text
    T.pack CommandDoc
    s)
          nodefcommodityj :: Journal
    nodefcommodityj = Journal
    esJournal{jparsedefaultcommodity :: Maybe (Text, AmountStyle)
    jparsedefaultcommodity=Maybe (Text, AmountStyle)
    forall a. Maybe a
    Nothing}
          amountandcommentp :: JournalParser Identity (Amount, Text)
          amountandcommentp :: StateT Journal (ParsecT CustomErr Text Identity) (Amount, Text)
    amountandcommentp = do
            Amount
    a <- JournalParser Identity Amount
    forall (m :: * -> *). JournalParser m Amount
    amountp
            ParsecT CustomErr Text Identity ()
    -> StateT Journal (ParsecT CustomErr Text Identity) ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift ParsecT CustomErr Text Identity ()
    forall s (m :: * -> *).
    (Stream s, Token s ~ Char) =>
    ParsecT CustomErr s m ()
    skipNonNewlineSpaces
            Text
    c <- CommandDoc -> Text
    T.pack (CommandDoc -> Text)
    -> StateT Journal (ParsecT CustomErr Text Identity) CommandDoc
    -> StateT Journal (ParsecT CustomErr Text Identity) Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CommandDoc -> Maybe CommandDoc -> CommandDoc
    forall a. a -> Maybe a -> a
    fromMaybe "" (Maybe CommandDoc -> CommandDoc)
    -> StateT
         Journal (ParsecT CustomErr Text Identity) (Maybe CommandDoc)
    -> StateT Journal (ParsecT CustomErr Text Identity) CommandDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` StateT Journal (ParsecT CustomErr Text Identity) CommandDoc
    -> StateT
         Journal (ParsecT CustomErr Text Identity) (Maybe CommandDoc)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Token Text
    -> StateT Journal (ParsecT CustomErr Text Identity) (Token Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Token Text
    ';' StateT Journal (ParsecT CustomErr Text Identity) Char
    -> StateT Journal (ParsecT CustomErr Text Identity) CommandDoc
    -> StateT Journal (ParsecT CustomErr Text Identity) CommandDoc
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> StateT Journal (ParsecT CustomErr Text Identity) Char
    -> StateT Journal (ParsecT CustomErr Text Identity) CommandDoc
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    many StateT Journal (ParsecT CustomErr Text Identity) Char
    forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
    anySingle)
            -- eof
            (Amount, Text)
    -> StateT Journal (ParsecT CustomErr Text Identity) (Amount, Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Amount
    a,Text
    c)
          balancingamt :: MixedAmount
    balancingamt = MixedAmount -> MixedAmount
    forall a. Num a => a -> a
    negate (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
    forall a b. (a -> b) -> a -> b
    $ [MixedAmount] -> MixedAmount
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
    forall a b. (a -> b) -> a -> b
    $ (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
    forall a b. (a -> b) -> [a] -> [b]
    map Posting -> MixedAmount
    pamount [Posting]
    realps where realps :: [Posting]
    realps = (Posting -> Bool) -> [Posting] -> [Posting]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Posting -> Bool
    isReal [Posting]
    esPostings
          balancingamtfirstcommodity :: MixedAmount
    balancingamtfirstcommodity = [Amount] -> MixedAmount
    Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
    forall a b. (a -> b) -> a -> b
    $ Int -> [Amount] -> [Amount]
    forall a. Int -> [a] -> [a]
    take 1 ([Amount] -> [Amount]) -> [Amount] -> [Amount]
    forall a b. (a -> b) -> a -> b
    $ MixedAmount -> [Amount]
    amounts MixedAmount
    balancingamt
          showamt :: MixedAmount -> CommandDoc
    showamt =
            AmountPrecision -> MixedAmount -> CommandDoc
    showMixedAmountWithPrecision
                      -- what should this be ?
                      -- 1 maxprecision (show all decimal places or none) ?
                      -- 2 maxprecisionwithpoint (show all decimal places or .0 - avoids some but not all confusion with thousands separators) ?
                      -- 3 canonical precision for this commodity in the journal ?
                      -- 4 maximum precision entered so far in this transaction ?
                      -- 5 3 or 4, whichever would show the most decimal places ?
                      -- I think 1 or 4, whichever would show the most decimal places
                      AmountPrecision
    NaturalPrecision
      --
      -- let -- (amt,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amtcmt
          -- a           = fromparse $ runParser (amountp <|> return missingamt) (jparsestate esJournal) "" amt
      --     awithoutjps = fromparse $ runParser (amountp <|> return missingamt) mempty              "" amt
      --     defamtaccepted = Just (showAmount a) == mdefamt
      --     es2 = if defamtaccepted then es1 else es1{esHistoricalPostings=Nothing}
      --     mdefaultcommodityapplied = if acommodity a == acommodity awithoutjps then Nothing else Just $ acommodity a
      -- when (isJust mdefaultcommodityapplied) $
      --      liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust mdefaultcommodityapplied)

    maybeExit :: Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    maybeExit = (CommandDoc -> Maybe CommandDoc)
    -> Wizard Haskeline CommandDoc -> Wizard Haskeline CommandDoc
    forall (b :: * -> *) a c.
    Functor b =>
    (a -> Maybe c) -> Wizard b a -> Wizard b c
    parser (\s :: CommandDoc
    s -> if CommandDoc
    sCommandDoc -> CommandDoc -> Bool
    forall a. Eq a => a -> a -> Bool
    =="." then UnexpectedEOF -> Maybe CommandDoc
    forall a e. Exception e => e -> a
    throw UnexpectedEOF
    UnexpectedEOF else CommandDoc -> Maybe CommandDoc
    forall a. a -> Maybe a
    Just CommandDoc
    s)

    -- maybeShowHelp :: Wizard Haskeline String -> Wizard Haskeline String
    -- maybeShowHelp wizard = maybe (liftIO showHelp >> wizard) return $
    --                        parser (\s -> if s=="?" then Nothing else Just s) wizard

    -- Completion helpers

    dateCompleter :: String -> CompletionFunc IO
    dateCompleter :: CommandDoc -> CompletionFunc IO
    dateCompleter = [CommandDoc] -> CommandDoc -> CompletionFunc IO
    completer ["today","tomorrow","yesterday"]

    descriptionCompleter :: Journal -> String -> CompletionFunc IO
    descriptionCompleter :: Journal -> CommandDoc -> CompletionFunc IO
    descriptionCompleter j :: Journal
    j = [CommandDoc] -> CommandDoc -> CompletionFunc IO
    completer ((Text -> CommandDoc) -> [Text] -> [CommandDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> CommandDoc
    T.unpack ([Text] -> [CommandDoc]) -> [Text] -> [CommandDoc]
    forall a b. (a -> b) -> a -> b
    $ Journal -> [Text]
    journalDescriptions Journal
    j)

    accountCompleter :: Journal -> String -> CompletionFunc IO
    accountCompleter :: Journal -> CommandDoc -> CompletionFunc IO
    accountCompleter j :: Journal
    j = [CommandDoc] -> CommandDoc -> CompletionFunc IO
    completer ((Text -> CommandDoc) -> [Text] -> [CommandDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> CommandDoc
    T.unpack ([Text] -> [CommandDoc]) -> [Text] -> [CommandDoc]
    forall a b. (a -> b) -> a -> b
    $ Journal -> [Text]
    journalAccountNamesDeclaredOrImplied Journal
    j)

    amountCompleter :: String -> CompletionFunc IO
    amountCompleter :: CommandDoc -> CompletionFunc IO
    amountCompleter = [CommandDoc] -> CommandDoc -> CompletionFunc IO
    completer []

    -- | Generate a haskeline completion function from the given
    -- completions and default, that case insensitively completes with
    -- prefix matches, or infix matches above a minimum length, or
    -- completes the null string with the default.
    completer :: [String] -> String -> CompletionFunc IO
    completer :: [CommandDoc] -> CommandDoc -> CompletionFunc IO
    completer completions :: [CommandDoc]
    completions def :: CommandDoc
    def = Maybe Char
    -> CommandDoc
    -> (CommandDoc -> IO [Completion])
    -> CompletionFunc IO
    forall (m :: * -> *).
    Monad m =>
    Maybe Char
    -> CommandDoc -> (CommandDoc -> m [Completion]) -> CompletionFunc m
    completeWord Maybe Char
    forall a. Maybe a
    Nothing "" CommandDoc -> IO [Completion]
    forall (m :: * -> *). Monad m => CommandDoc -> m [Completion]
    completionsFor
        where
          simpleCompletion' :: CommandDoc -> Completion
    simpleCompletion' s :: CommandDoc
    s = (CommandDoc -> Completion
    simpleCompletion CommandDoc
    s){isFinished :: Bool
    isFinished=Bool
    False}
          completionsFor :: CommandDoc -> m [Completion]
    completionsFor "" = [Completion] -> m [Completion]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [CommandDoc -> Completion
    simpleCompletion' CommandDoc
    def]
          completionsFor i :: CommandDoc
    i  = [Completion] -> m [Completion]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CommandDoc -> Completion) -> [CommandDoc] -> [Completion]
    forall a b. (a -> b) -> [a] -> [b]
    map CommandDoc -> Completion
    simpleCompletion' [CommandDoc]
    ciprefixmatches)
              where
                ciprefixmatches :: [CommandDoc]
    ciprefixmatches = [CommandDoc
    c | CommandDoc
    c <- [CommandDoc]
    completions, CommandDoc
    i CommandDoc -> CommandDoc -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` CommandDoc
    c]
                -- mixed-case completions require haskeline > 0.7.1.2
                -- ciprefixmatches = [c | c <- completions, lowercase i `isPrefixOf` lowercase c]

    --------------------------------------------------------------------------------

    -- utilities

    defaultTo' :: a -> Wizard Haskeline a -> Wizard Haskeline a
    defaultTo' = (Wizard Haskeline a -> a -> Wizard Haskeline a)
    -> a -> Wizard Haskeline a -> Wizard Haskeline a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Wizard Haskeline a -> a -> Wizard Haskeline a
    forall (b :: * -> *) a. Functor b => Wizard b a -> a -> Wizard b a
    defaultTo

    withCompletion :: CompletionFunc IO -> Wizard b a -> Wizard b a
    withCompletion f :: CompletionFunc IO
    f = Settings IO -> Wizard b a -> Wizard b a
    forall (b :: * -> *) a.
    (WithSettings :<: b) =>
    Settings IO -> Wizard b a -> Wizard b a
    withSettings (CompletionFunc IO -> Settings IO -> Settings IO
    forall (m :: * -> *). CompletionFunc m -> Settings m -> Settings m
    setComplete CompletionFunc IO
    f Settings IO
    forall (m :: * -> *). MonadIO m => Settings m
    defaultSettings)

    green :: CommandDoc -> CommandDoc
    green s :: CommandDoc
    s = "\ESC[1;32m\STX"CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++CommandDoc
    sCommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++"\ESC[0m\STX"

    showDefault :: CommandDoc -> CommandDoc
    showDefault "" = ""
    showDefault s :: CommandDoc
    s = " [" CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ CommandDoc
    s CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ "]"

    -- | Append this transaction to the journal's file and transaction list.
    journalAddTransaction :: Journal -> CliOpts -> Transaction -> IO Journal
    journalAddTransaction :: Journal -> CliOpts -> Transaction -> IO Journal
    journalAddTransaction j :: Journal
    j@Journal{jtxns :: Journal -> [Transaction]
    jtxns=[Transaction]
    ts} opts :: CliOpts
    opts t :: Transaction
    t = do
      let f :: CommandDoc
    f = Journal -> CommandDoc
    journalFilePath Journal
    j
      CommandDoc -> CommandDoc -> IO ()
    appendToJournalFileOrStdout CommandDoc
    f (CommandDoc -> IO ()) -> CommandDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Transaction -> CommandDoc
    showTransaction Transaction
    t
        -- unelided shows all amounts explicitly, in case there's a price, cf #283
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CliOpts -> Int
    debug_ CliOpts
    opts Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        CommandDoc -> IO ()
    putStrLn (CommandDoc -> IO ()) -> CommandDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "\nAdded transaction to %s:" CommandDoc
    f
        CommandDoc -> IO ()
    putStrLn (CommandDoc -> IO ()) -> IO CommandDoc -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< CommandDoc -> IO CommandDoc
    registerFromString (Transaction -> CommandDoc
    showTransaction Transaction
    t)
      Journal -> IO Journal
    forall (m :: * -> *) a. Monad m => a -> m a
    return Journal
    j{jtxns :: [Transaction]
    jtxns=[Transaction]
    ts[Transaction] -> [Transaction] -> [Transaction]
    forall a. [a] -> [a] -> [a]
    ++[Transaction
    t]}

    -- | Append a string, typically one or more transactions, to a journal
    -- file, or if the file is "-", dump it to stdout.  Tries to avoid
    -- excess whitespace.
    --
    -- XXX This writes unix line endings (\n), some at least,
    -- even if the file uses dos line endings (\r\n), which could leave
    -- mixed line endings in the file. See also writeFileWithBackupIfChanged.
    --
    appendToJournalFileOrStdout :: FilePath -> String -> IO ()
    appendToJournalFileOrStdout :: CommandDoc -> CommandDoc -> IO ()
    appendToJournalFileOrStdout f :: CommandDoc
    f s :: CommandDoc
    s
      | CommandDoc
    f CommandDoc -> CommandDoc -> Bool
    forall a. Eq a => a -> a -> Bool
    == "-"  = CommandDoc -> IO ()
    putStr CommandDoc
    s'
      | Bool
    otherwise = CommandDoc -> CommandDoc -> IO ()
    appendFile CommandDoc
    f CommandDoc
    s'
      where s' :: CommandDoc
    s' = "\n" CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ CommandDoc -> CommandDoc
    ensureOneNewlineTerminated CommandDoc
    s

    -- | Replace a string's 0 or more terminating newlines with exactly one.
    ensureOneNewlineTerminated :: String -> String
    ensureOneNewlineTerminated :: CommandDoc -> CommandDoc
    ensureOneNewlineTerminated = (CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++"\n") (CommandDoc -> CommandDoc)
    -> (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommandDoc -> CommandDoc
    forall a. [a] -> [a]
    reverse (CommandDoc -> CommandDoc)
    -> (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> CommandDoc -> CommandDoc
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    =='\n') (CommandDoc -> CommandDoc)
    -> (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommandDoc -> CommandDoc
    forall a. [a] -> [a]
    reverse

    -- | Convert a string of journal data into a register report.
    registerFromString :: String -> IO String
    registerFromString :: CommandDoc -> IO CommandDoc
    registerFromString s :: CommandDoc
    s = do
      Day
    d <- IO Day
    getCurrentDay
      Journal
    j <- Text -> IO Journal
    readJournal' (Text -> IO Journal) -> Text -> IO Journal
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> Text
    T.pack CommandDoc
    s
      CommandDoc -> IO CommandDoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CommandDoc -> IO CommandDoc) -> CommandDoc -> IO CommandDoc
    forall a b. (a -> b) -> a -> b
    $ CliOpts -> PostingsReport -> CommandDoc
    postingsReportAsText CliOpts
    opts (PostingsReport -> CommandDoc) -> PostingsReport -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ ReportOpts -> Query -> Journal -> PostingsReport
    postingsReport ReportOpts
    ropts (Day -> ReportOpts -> Query
    queryFromOpts Day
    d ReportOpts
    ropts) Journal
    j
          where
            ropts :: ReportOpts
    ropts = ReportOpts
    defreportopts{empty_ :: Bool
    empty_=Bool
    True}
            opts :: CliOpts
    opts = CliOpts
    defcliopts{reportopts_ :: ReportOpts
    reportopts_=ReportOpts
    ropts}

    capitalize :: String -> String
    capitalize :: CommandDoc -> CommandDoc
    capitalize "" = ""
    capitalize (c :: Char
    c:cs :: CommandDoc
    cs) = Char -> Char
    toUpper Char
    c Char -> CommandDoc -> CommandDoc
    forall a. a -> [a] -> [a]
    : CommandDoc
    cs

    -- | Find the most similar and recent transactions matching the given
    -- transaction description and report query.  Transactions are listed
    -- with their "relevancy" score, most relevant first.
    transactionsSimilarTo :: Journal -> Query -> Text -> [(Double,Transaction)]
    transactionsSimilarTo :: Journal -> Query -> Text -> [(Double, Transaction)]
    transactionsSimilarTo j :: Journal
    j q :: Query
    q desc :: Text
    desc =
        ((Double, Transaction) -> (Double, Transaction) -> Ordering)
    -> [(Double, Transaction)] -> [(Double, Transaction)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Double, Transaction) -> (Double, Transaction) -> Ordering
    forall a. Ord a => (a, Transaction) -> (a, Transaction) -> Ordering
    compareRelevanceAndRecency
                   ([(Double, Transaction)] -> [(Double, Transaction)])
    -> [(Double, Transaction)] -> [(Double, Transaction)]
    forall a b. (a -> b) -> a -> b
    $ ((Double, Transaction) -> Bool)
    -> [(Double, Transaction)] -> [(Double, Transaction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    threshold)(Double -> Bool)
    -> ((Double, Transaction) -> Double)
    -> (Double, Transaction)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Double, Transaction) -> Double
    forall a b. (a, b) -> a
    fst)
                   [(Text -> Text -> Double
    compareDescriptions Text
    desc (Text -> Double) -> Text -> Double
    forall a b. (a -> b) -> a -> b
    $ Transaction -> Text
    tdescription Transaction
    t, Transaction
    t) | Transaction
    t <- [Transaction]
    ts]
        where
          compareRelevanceAndRecency :: (a, Transaction) -> (a, Transaction) -> Ordering
    compareRelevanceAndRecency (n1 :: a
    n1,t1 :: Transaction
    t1) (n2 :: a
    n2,t2 :: Transaction
    t2) = (a, Day) -> (a, Day) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (a
    n2,Transaction -> Day
    tdate Transaction
    t2) (a
    n1,Transaction -> Day
    tdate Transaction
    t1)
          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
    j
          threshold :: Double
    threshold = 0

    -- | Return a similarity measure, from 0 to 1, for two transaction
    -- descriptions.  This is like compareStrings, but first strips out
    -- any numbers, to improve accuracy eg when there are bank transaction
    -- ids from imported data.
    compareDescriptions :: Text -> Text -> Double
    compareDescriptions :: Text -> Text -> Double
    compareDescriptions s :: Text
    s t :: Text
    t = CommandDoc -> CommandDoc -> Double
    compareStrings CommandDoc
    s' CommandDoc
    t'
        where s' :: CommandDoc
    s' = CommandDoc -> CommandDoc
    simplify (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Text -> CommandDoc
    T.unpack Text
    s
              t' :: CommandDoc
    t' = CommandDoc -> CommandDoc
    simplify (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Text -> CommandDoc
    T.unpack Text
    t
              simplify :: CommandDoc -> CommandDoc
    simplify = (Char -> Bool) -> CommandDoc -> CommandDoc
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> CommandDoc -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ("0123456789" :: String)))

    -- | Return a similarity measure, from 0 to 1, for two strings.  This
    -- was based on Simon White's string similarity algorithm
    -- (http://www.catalysoft.com/articles/StrikeAMatch.html), later found
    -- to be https://en.wikipedia.org/wiki/S%C3%B8rensen%E2%80%93Dice_coefficient,
    -- modified to handle short strings better.
    -- Todo: check out http://nlp.fi.muni.cz/raslan/2008/raslan08.pdf#page=14 .
    compareStrings :: String -> String -> Double
    compareStrings :: CommandDoc -> CommandDoc -> Double
    compareStrings "" "" = 1
    compareStrings [_] "" = 0
    compareStrings "" [_] = 0
    compareStrings [a :: Char
    a] [b :: Char
    b] = if Char -> Char
    toUpper Char
    a Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Char
    toUpper Char
    b then 1 else 0
    compareStrings s1 :: CommandDoc
    s1 s2 :: CommandDoc
    s2 = 2 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    commonpairs Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    totalpairs
        where
          pairs1 :: Set CommandDoc
    pairs1      = [CommandDoc] -> Set CommandDoc
    forall a. Ord a => [a] -> Set a
    S.fromList ([CommandDoc] -> Set CommandDoc) -> [CommandDoc] -> Set CommandDoc
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> [CommandDoc]
    wordLetterPairs (CommandDoc -> [CommandDoc]) -> CommandDoc -> [CommandDoc]
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc
    uppercase CommandDoc
    s1
          pairs2 :: Set CommandDoc
    pairs2      = [CommandDoc] -> Set CommandDoc
    forall a. Ord a => [a] -> Set a
    S.fromList ([CommandDoc] -> Set CommandDoc) -> [CommandDoc] -> Set CommandDoc
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> [CommandDoc]
    wordLetterPairs (CommandDoc -> [CommandDoc]) -> CommandDoc -> [CommandDoc]
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc
    uppercase CommandDoc
    s2
          commonpairs :: Double
    commonpairs = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Double) -> Int -> Double
    forall a b. (a -> b) -> a -> b
    $ Set CommandDoc -> Int
    forall a. Set a -> Int
    S.size (Set CommandDoc -> Int) -> Set CommandDoc -> Int
    forall a b. (a -> b) -> a -> b
    $ Set CommandDoc -> Set CommandDoc -> Set CommandDoc
    forall a. Ord a => Set a -> Set a -> Set a
    S.intersection Set CommandDoc
    pairs1 Set CommandDoc
    pairs2
          totalpairs :: Double
    totalpairs  = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Double) -> Int -> Double
    forall a b. (a -> b) -> a -> b
    $ Set CommandDoc -> Int
    forall a. Set a -> Int
    S.size Set CommandDoc
    pairs1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Set CommandDoc -> Int
    forall a. Set a -> Int
    S.size Set CommandDoc
    pairs2

    wordLetterPairs :: CommandDoc -> [CommandDoc]
    wordLetterPairs = (CommandDoc -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap CommandDoc -> [CommandDoc]
    forall a. [a] -> [[a]]
    letterPairs ([CommandDoc] -> [CommandDoc])
    -> (CommandDoc -> [CommandDoc]) -> CommandDoc -> [CommandDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommandDoc -> [CommandDoc]
    words

    letterPairs :: [a] -> [[a]]
    letterPairs (a :: a
    a:b :: a
    b:rest :: [a]
    rest) = [a
    a,a
    b] [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [a] -> [[a]]
    letterPairs (a
    ba -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    rest)
    letterPairs _ = []