{-|
A history-aware, tab-completing interactive add command to help with data entry.
-}

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

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

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 Data.List (isPrefixOf, nub)
import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.IO qualified as TL
import Data.Time.Calendar (Day, toGregorian)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Lens.Micro ((^.))
import Safe (headDef, headMay, atMay, lastMay)
import System.Console.CmdArgs.Explicit (flagNone)
import System.Console.Haskeline (runInputT, defaultSettings, setComplete)
import System.Console.Haskeline.Completion (CompletionFunc, completeWord, isFinished, noCompletion, simpleCompletion)
import System.Console.Wizard (Wizard, defaultTo, line, output, outputLn, retryMsg, linePrewritten, nonEmpty, parser, run)
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)
import Hledger.Cli.Utils (journalSimilarTransaction)


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

data AddState = AddState {
   AddState -> CliOpts
asOpts               :: CliOpts           -- ^ command line options
  ,AddState -> [String]
asArgs               :: [String]          -- ^ command line arguments remaining to be used as defaults
  ,AddState -> Day
asToday              :: Day               -- ^ today's date
  ,AddState -> Day
asDefDate            :: Day               -- ^ the default date to use for the next transaction
  ,AddState -> Journal
asJournal            :: Journal           -- ^ the journal we are adding to
  ,AddState -> Maybe Transaction
asSimilarTransaction :: Maybe Transaction -- ^ the old transaction most similar to the new one being entered
  ,AddState -> [Posting]
asPostings           :: [Posting]         -- ^ the new postings entered so far
} deriving (Int -> AddState -> String -> String
[AddState] -> String -> String
AddState -> String
(Int -> AddState -> String -> String)
-> (AddState -> String)
-> ([AddState] -> String -> String)
-> Show AddState
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> AddState -> String -> String
showsPrec :: Int -> AddState -> String -> String
$cshow :: AddState -> String
show :: AddState -> String
$cshowList :: [AddState] -> String -> String
showList :: [AddState] -> String -> String
Show)

defAddState :: AddState
defAddState = AddState {
   asOpts :: CliOpts
asOpts               = CliOpts
defcliopts
  ,asArgs :: [String]
asArgs               = []
  ,asToday :: Day
asToday              = Day
nulldate
  ,asDefDate :: Day
asDefDate            = Day
nulldate
  ,asJournal :: Journal
asJournal            = Journal
nulljournal
  ,asSimilarTransaction :: Maybe Transaction
asSimilarTransaction = Maybe Transaction
forall a. Maybe a
Nothing
  ,asPostings :: [Posting]
asPostings           = []
}

data AddStep =
    GetDate
  | GetDescription (Day, Text)
  | GetPosting TxnData (Maybe Posting)
  | GetAccount TxnData
  | GetAmount TxnData String
  | Confirm Transaction

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

type Comment = (Text, [Tag], Maybe Day, Maybe Day)

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

data RestartTransactionException = RestartTransactionException deriving (Int -> RestartTransactionException -> String -> String
[RestartTransactionException] -> String -> String
RestartTransactionException -> String
(Int -> RestartTransactionException -> String -> String)
-> (RestartTransactionException -> String)
-> ([RestartTransactionException] -> String -> String)
-> Show RestartTransactionException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> RestartTransactionException -> String -> String
showsPrec :: Int -> RestartTransactionException -> String -> String
$cshow :: RestartTransactionException -> String
show :: RestartTransactionException -> String
$cshowList :: [RestartTransactionException] -> String -> String
showList :: [RestartTransactionException] -> String -> String
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 CliOpts
opts Journal
j
    | Journal -> String
journalFilePath Journal
j String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Adding transactions to journal file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Journal -> String
journalFilePath Journal
j
        IO ()
showHelp
        let today :: Day
today = CliOpts
optsCliOpts -> Getting Day CliOpts Day -> Day
forall s a. s -> Getting a s a -> a
^.Getting Day CliOpts Day
forall c. HasReportSpec c => Lens' c Day
Lens' CliOpts Day
rsDay
            state :: AddState
state = AddState
defAddState{asOpts=opts
                              ,asArgs=listofstringopt "args" $ rawopts_ opts
                              ,asToday=today
                              ,asDefDate=today
                              ,asJournal=j
                              }
        AddState -> IO ()
addTransactionsLoop AddState
state IO () -> (UnexpectedEOF -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(UnexpectedEOF
_::UnexpectedEOF) -> String -> IO ()
putStr String
"")

showHelp :: IO ()
showHelp = Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
     String
"Any command line arguments will be used as defaults."
    ,String
"Use tab key to complete, readline keys to edit, enter to accept defaults."
    ,String
"An optional (CODE) may follow transaction dates."
    ,String
"An optional ; COMMENT may follow descriptions or amounts."
    ,String
"If you make a mistake, enter < at any prompt to go one step backward."
    ,String
"To end a transaction, enter . when prompted."
    ,String
"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.
addTransactionsLoop :: AddState -> IO ()
addTransactionsLoop :: AddState -> IO ()
addTransactionsLoop state :: AddState
state@AddState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
asOpts :: AddState -> CliOpts
asArgs :: AddState -> [String]
asToday :: AddState -> Day
asDefDate :: AddState -> Day
asJournal :: AddState -> Journal
asSimilarTransaction :: AddState -> Maybe Transaction
asPostings :: AddState -> [Posting]
asOpts :: CliOpts
asArgs :: [String]
asToday :: Day
asDefDate :: Day
asJournal :: Journal
asSimilarTransaction :: Maybe Transaction
asPostings :: [Posting]
..} = (do
  let defaultPrevInput :: PrevInput
defaultPrevInput = PrevInput{prevDateAndCode :: Maybe String
prevDateAndCode=Maybe String
forall a. Maybe a
Nothing, prevDescAndCmnt :: Maybe String
prevDescAndCmnt=Maybe String
forall a. Maybe a
Nothing, prevAccount :: [String]
prevAccount=[], prevAmountAndCmnt :: [String]
prevAmountAndCmnt=[]}
  mt <- Settings IO
-> InputT IO (Maybe Transaction) -> IO (Maybe Transaction)
forall (m :: * -> *) a.
(MonadIO m, MonadMask 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 -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
defaultPrevInput AddState
state [])
  case mt of
    Maybe Transaction
Nothing -> String -> IO ()
forall a. String -> a
error' String
"Could not interpret the input, restarting"  -- caught below causing a restart, I believe  -- PARTIAL:
    Just Transaction
t -> do
      j <- if CliOpts -> Int
debug_ CliOpts
asOpts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
           then do Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Skipping journal add due to debug mode."
                   Journal -> IO Journal
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
asJournal
           else do j' <- Journal -> CliOpts -> Transaction -> IO Journal
journalAddTransaction Journal
asJournal CliOpts
asOpts Transaction
t
                   hPutStrLn stderr "Saved."
                   return j'
      hPutStrLn stderr "Starting the next transaction (. or ctrl-D/ctrl-C to quit)"
      addTransactionsLoop state{asJournal=j, asDefDate=tdate t}
  )
  IO () -> (RestartTransactionException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(RestartTransactionException
_::RestartTransactionException) ->
                 Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Restarting this transaction." IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AddState -> IO ()
addTransactionsLoop AddState
state)

-- | Interact with the user to get a Transaction.
transactionWizard :: PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard :: PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state [] = PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state [AddStep
GetDate]
transactionWizard PrevInput
previnput state :: AddState
state@AddState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
asOpts :: AddState -> CliOpts
asArgs :: AddState -> [String]
asToday :: AddState -> Day
asDefDate :: AddState -> Day
asJournal :: AddState -> Journal
asSimilarTransaction :: AddState -> Maybe Transaction
asPostings :: AddState -> [Posting]
asOpts :: CliOpts
asArgs :: [String]
asToday :: Day
asDefDate :: Day
asJournal :: Journal
asSimilarTransaction :: Maybe Transaction
asPostings :: [Posting]
..} stack :: [AddStep]
stack@(AddStep
currentStage : [AddStep]
_) = case AddStep
currentStage of
  AddStep
GetDate -> PrevInput -> AddState -> Wizard Haskeline (Maybe (EFDay, Text))
dateWizard PrevInput
previnput AddState
state Wizard Haskeline (Maybe (EFDay, Text))
-> (Maybe (EFDay, Text) -> Wizard Haskeline Transaction)
-> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a
-> (a -> Wizard Haskeline b) -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (EFDay
efd, Text
code) -> do
      let
        date :: Day
date = EFDay -> Day
fromEFDay EFDay
efd
        state' :: AddState
state' = AddState
state{ asArgs = drop 1 asArgs
                , asDefDate = date
                }
        dateAndCodeString :: String
dateAndCodeString = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
yyyymmddFormat Day
date
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (if Text -> Bool
T.null Text
code then Text
"" else Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
        yyyymmddFormat :: String
yyyymmddFormat = String
"%Y-%m-%d"
      PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput{prevDateAndCode=Just dateAndCodeString} AddState
state' ((Day, Text) -> AddStep
GetDescription (Day
date, Text
code) AddStep -> [AddStep] -> [AddStep]
forall a. a -> [a] -> [a]
: [AddStep]
stack)
    Maybe (EFDay, Text)
Nothing ->
      PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state [AddStep]
stack

  GetDescription (Day
date, Text
code) -> PrevInput -> AddState -> Wizard Haskeline (Maybe (Text, Text))
descriptionWizard PrevInput
previnput AddState
state Wizard Haskeline (Maybe (Text, Text))
-> (Maybe (Text, Text) -> Wizard Haskeline Transaction)
-> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a
-> (a -> Wizard Haskeline b) -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Text
desc, Text
comment) -> do
      let mbaset :: Maybe Transaction
mbaset = CliOpts -> Journal -> Text -> Maybe Transaction
journalSimilarTransaction CliOpts
asOpts Journal
asJournal Text
desc
          state' :: AddState
state' = AddState
state
            { asArgs = drop 1 asArgs
            , asPostings = []
            , asSimilarTransaction = mbaset
            }
          descAndCommentString :: String
descAndCommentString = Text -> String
T.unpack (Text -> String) -> Text -> String
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 Text
"" else Text
"  ; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
comment)
          previnput' :: PrevInput
previnput' = PrevInput
previnput{prevDescAndCmnt=Just 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 ())
-> (IO () -> Wizard Haskeline ()) -> IO () -> Wizard Haskeline ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> Wizard Haskeline ()
forall a. IO a -> Wizard Haskeline a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Wizard Haskeline ()) -> IO () -> Wizard Haskeline ()
forall a b. (a -> b) -> a -> b
$ do
          Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Using this similar transaction for defaults:"
          Handle -> Text -> IO ()
T.hPutStr Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction (Maybe Transaction -> Transaction
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Transaction
mbaset)
      PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput' AddState
state' ((TxnData -> Maybe Posting -> AddStep
GetPosting TxnData{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) AddStep -> [AddStep] -> [AddStep]
forall a. a -> [a] -> [a]
: [AddStep]
stack)
    Maybe (Text, Text)
Nothing ->
      PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state (Int -> [AddStep] -> [AddStep]
forall a. Int -> [a] -> [a]
drop Int
1 [AddStep]
stack)

  GetPosting txndata :: TxnData
txndata@TxnData{Text
Day
txnDate :: TxnData -> Day
txnCode :: TxnData -> Text
txnDesc :: TxnData -> Text
txnCmnt :: TxnData -> Text
txnDate :: Day
txnCode :: Text
txnDesc :: Text
txnCmnt :: Text
..} Maybe Posting
p -> case ([Posting]
asPostings, Maybe Posting
p) of
    ([], Maybe Posting
Nothing) ->
      PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state (TxnData -> AddStep
GetAccount TxnData
txndata AddStep -> [AddStep] -> [AddStep]
forall a. a -> [a] -> [a]
: [AddStep]
stack)
    ([Posting]
_, Just Posting
_) ->
      PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state (TxnData -> AddStep
GetAccount TxnData
txndata AddStep -> [AddStep] -> [AddStep]
forall a. a -> [a] -> [a]
: [AddStep]
stack)
    ([Posting]
_, Maybe Posting
Nothing) -> do
      let t :: Transaction
t = Transaction
nulltransaction{tdate=txnDate
                             ,tstatus=Unmarked
                             ,tcode=txnCode
                             ,tdescription=txnDesc
                             ,tcomment=txnCmnt
                             ,tpostings=asPostings
                             }
          bopts :: BalancingOpts
bopts = InputOpts -> BalancingOpts
balancingopts_ (CliOpts -> InputOpts
inputopts_ CliOpts
asOpts)
      case Transaction
-> Journal -> BalancingOpts -> Either String Transaction
balanceTransactionInJournal Transaction
t Journal
asJournal BalancingOpts
bopts of
        Right Transaction
t' ->
          PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state (Transaction -> AddStep
Confirm Transaction
t' AddStep -> [AddStep] -> [AddStep]
forall a. a -> [a] -> [a]
: [AddStep]
stack)
        Left String
err -> do
          IO () -> Wizard Haskeline ()
forall a. IO a -> Wizard Haskeline a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
capitalize String
err) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", please re-enter.")
          let notFirstEnterPost :: AddStep -> Bool
notFirstEnterPost AddStep
stage = case AddStep
stage of
                GetPosting TxnData
_ Maybe Posting
Nothing -> Bool
False
                AddStep
_ -> Bool
True
          PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state{asPostings=[]} ((AddStep -> Bool) -> [AddStep] -> [AddStep]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile AddStep -> Bool
notFirstEnterPost [AddStep]
stack)

  GetAccount TxnData
txndata -> PrevInput -> AddState -> Wizard Haskeline (Maybe String)
accountWizard PrevInput
previnput AddState
state Wizard Haskeline (Maybe String)
-> (Maybe String -> Wizard Haskeline Transaction)
-> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a
-> (a -> Wizard Haskeline b) -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just String
account
      | String
account String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".", String
""] ->
          case ([Posting]
asPostings, [Posting] -> Bool
postingsAreBalanced [Posting]
asPostings) of
            ([],Bool
_)    -> IO () -> Wizard Haskeline ()
forall a. IO a -> Wizard Haskeline a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Please enter some postings first.") Wizard Haskeline ()
-> Wizard Haskeline Transaction -> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a -> Wizard Haskeline b -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state [AddStep]
stack
            ([Posting]
_,Bool
False) -> IO () -> Wizard Haskeline ()
forall a. IO a -> Wizard Haskeline a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Please enter more postings to balance the transaction.") Wizard Haskeline ()
-> Wizard Haskeline Transaction -> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a -> Wizard Haskeline b -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state [AddStep]
stack
            ([Posting]
_,Bool
True)  -> PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state (TxnData -> Maybe Posting -> AddStep
GetPosting TxnData
txndata Maybe Posting
forall a. Maybe a
Nothing AddStep -> [AddStep] -> [AddStep]
forall a. a -> [a] -> [a]
: [AddStep]
stack)
      | Bool
otherwise -> do
          let prevAccount' :: [String]
prevAccount' = Int -> String -> [String] -> [String]
forall {a}. Int -> a -> [a] -> [a]
replaceNthOrAppend ([Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
asPostings) String
account (PrevInput -> [String]
prevAccount PrevInput
previnput)
          PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput{prevAccount=prevAccount'} AddState
state{asArgs=drop 1 asArgs} (TxnData -> String -> AddStep
GetAmount TxnData
txndata String
account AddStep -> [AddStep] -> [AddStep]
forall a. a -> [a] -> [a]
: [AddStep]
stack)
    Maybe String
Nothing -> do
      let notPrevAmountAndNotGetDesc :: AddStep -> Bool
notPrevAmountAndNotGetDesc AddStep
stage = case AddStep
stage of
            GetAmount TxnData
_ String
_ -> Bool
False
            GetDescription (Day, Text)
_ -> Bool
False
            AddStep
_ -> Bool
True
      PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state{asPostings=init asPostings} ((AddStep -> Bool) -> [AddStep] -> [AddStep]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile AddStep -> Bool
notPrevAmountAndNotGetDesc [AddStep]
stack)

  GetAmount TxnData
txndata String
account -> PrevInput
-> AddState
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
amountWizard PrevInput
previnput AddState
state Wizard
  Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
-> (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)
    -> Wizard Haskeline Transaction)
-> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a
-> (a -> Wizard Haskeline b) -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Maybe Amount
mamt, Maybe BalanceAssertion
assertion, (Text
comment, [(Text, Text)]
tags, Maybe Day
pdate1, Maybe Day
pdate2)) -> do
      let mixedamt :: MixedAmount
mixedamt = MixedAmount
-> (Amount -> MixedAmount) -> Maybe Amount -> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount
missingmixedamt Amount -> MixedAmount
mixedAmount Maybe Amount
mamt
          p :: Posting
p = Posting
nullposting{paccount=T.pack $ stripbrackets account
                          ,pamount=mixedamt
                          ,pcomment=T.dropAround isNewline comment
                          ,ptype=accountNamePostingType $ T.pack account
                          ,pbalanceassertion = assertion
                          ,pdate=pdate1
                          ,pdate2=pdate2
                          ,ptags=tags
                          }
          amountAndCommentString :: String
amountAndCommentString = MixedAmount -> String
showMixedAmountOneLine MixedAmount
mixedamt String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (if Text -> Bool
T.null Text
comment then Text
"" else Text
"  ;" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
comment)
          prevAmountAndCmnt' :: [String]
prevAmountAndCmnt' = Int -> String -> [String] -> [String]
forall {a}. Int -> a -> [a] -> [a]
replaceNthOrAppend ([Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
asPostings) String
amountAndCommentString (PrevInput -> [String]
prevAmountAndCmnt PrevInput
previnput)
          state' :: AddState
state' = AddState
state{asPostings=asPostings++[p], asArgs=drop 1 asArgs}
          -- Include a dummy posting to balance the unfinished transation in assertion checking
          dummytxn :: Transaction
dummytxn = Transaction
nulltransaction{tpostings = asPostings ++ [p, post "" missingamt]
                                     ,tdate = txnDate txndata
                                     ,tdescription = txnDesc txndata }
          bopts :: BalancingOpts
bopts = InputOpts -> BalancingOpts
balancingopts_ (CliOpts -> InputOpts
inputopts_ CliOpts
asOpts)
          balanceassignment :: Bool
balanceassignment = MixedAmount
mixedamtMixedAmount -> MixedAmount -> Bool
forall a. Eq a => a -> a -> Bool
==MixedAmount
missingmixedamt Bool -> Bool -> Bool
&& Maybe BalanceAssertion -> Bool
forall a. Maybe a -> Bool
isJust Maybe BalanceAssertion
assertion
          etxn :: Either String Transaction
etxn
            -- If the new posting is doing a balance assignment,
            -- don't attempt to balance the transaction or check assertions yet
            | Bool
balanceassignment = Transaction -> Either String Transaction
forall a b. b -> Either a b
Right Transaction
dummytxn
            -- Otherwise, balance the transaction in context of the whole journal,
            -- maybe filling its balance assignments if any,
            -- and maybe checking all the journal's balance assertions.
            | Bool
otherwise = Transaction
-> Journal -> BalancingOpts -> Either String Transaction
balanceTransactionInJournal Transaction
dummytxn Journal
asJournal BalancingOpts
bopts

      case Either String Transaction
etxn of
        Left String
err -> do
          IO () -> Wizard Haskeline ()
forall a. IO a -> Wizard Haskeline a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err)
          PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state (TxnData -> String -> AddStep
GetAmount TxnData
txndata String
account AddStep -> [AddStep] -> [AddStep]
forall a. a -> [a] -> [a]
: [AddStep]
stack)
        Right Transaction
_ -> 
          PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput{prevAmountAndCmnt=prevAmountAndCmnt'} AddState
state' (TxnData -> Maybe Posting -> AddStep
GetPosting TxnData
txndata (Posting -> Maybe Posting
forall a. a -> Maybe a
Just Posting
posting) AddStep -> [AddStep] -> [AddStep]
forall a. a -> [a] -> [a]
: [AddStep]
stack)
    Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)
Nothing -> PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction
transactionWizard PrevInput
previnput AddState
state (Int -> [AddStep] -> [AddStep]
forall a. Int -> [a] -> [a]
drop Int
1 [AddStep]
stack)

  Confirm Transaction
t -> do
    String -> Wizard Haskeline ()
forall (b :: * -> *). (Output :<: b) => String -> Wizard b ()
output (String -> Wizard Haskeline ())
-> (Text -> String) -> Text -> Wizard Haskeline ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Wizard Haskeline ()) -> Text -> Wizard Haskeline ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
t
    y <- let def :: String
def = String
"y" in
         String
-> Wizard Haskeline (Maybe Char) -> Wizard Haskeline (Maybe Char)
forall (b :: * -> *) a.
(OutputLn :<: b) =>
String -> Wizard b a -> Wizard b a
retryMsg String
"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
$
          (String -> Maybe (Maybe Char))
-> Wizard Haskeline String -> 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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<' 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))
-> (String -> Maybe Char) -> String -> Maybe (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Char
forall a. [a] -> Maybe a
headMay (String -> Maybe Char)
-> (String -> String) -> String -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strip) (Wizard Haskeline String -> Wizard Haskeline (Maybe Char))
-> Wizard Haskeline String -> Wizard Haskeline (Maybe Char)
forall a b. (a -> b) -> a -> b
$
          String -> Wizard Haskeline String -> Wizard Haskeline String
forall {b}. b -> Wizard Haskeline b -> Wizard Haskeline b
defaultTo' String
def (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$ Wizard Haskeline String -> Wizard Haskeline String
forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
nonEmpty (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
          String -> Wizard Haskeline String
forall (b :: * -> *). (Line :<: b) => String -> Wizard b String
line (String -> Wizard Haskeline String)
-> String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$ String -> String
green' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Save this transaction to the journal ?%s: " (String -> String
showDefault String
def)
    case y of
      Just Char
'y' -> Transaction -> Wizard Haskeline Transaction
forall a. a -> Wizard Haskeline a
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
      Just Char
_   -> RestartTransactionException -> Wizard Haskeline Transaction
forall a e. (HasCallStack, Exception e) => e -> a
throw RestartTransactionException
RestartTransactionException
      Maybe Char
Nothing  -> PrevInput -> AddState -> [AddStep] -> Wizard Haskeline Transaction