{-|
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
)
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)
import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import Data.Time.Calendar (Day)
import Data.Time.Format (formatTime, defaultTimeLocale, iso8601DateFormat)
import Lens.Micro ((^.))
import Safe (headDef, headMay, atMay)
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, 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 = 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 [CommandDoc
"no-new-accounts"]  (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"no-new-accounts") CommandDoc
"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 CommandDoc
"[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 CliOpts
opts Journal
j
    | Journal -> CommandDoc
journalFilePath Journal
j CommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
== CommandDoc
"-" = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = do
        Handle -> CommandDoc -> IO ()
hPutStrLn Handle
stderr (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ CommandDoc
"Adding transactions to journal file " CommandDoc -> CommandDoc -> CommandDoc
forall a. Semigroup a => a -> a -> a
<> Journal -> CommandDoc
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
rsDay
            es :: EntryState
es = EntryState
defEntryState{esOpts :: CliOpts
esOpts=CliOpts
opts
                              ,esArgs :: [CommandDoc]
esArgs=CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt CommandDoc
"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 CommandDoc
"")

showHelp :: IO ()
showHelp = Handle -> CommandDoc -> IO ()
hPutStr Handle
stderr (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> CommandDoc
unlines [
     CommandDoc
"Any command line arguments will be used as defaults."
    ,CommandDoc
"Use tab key to complete, readline keys to edit, enter to accept defaults."
    ,CommandDoc
"An optional (CODE) may follow transaction dates."
    ,CommandDoc
"An optional ; COMMENT may follow descriptions or amounts."
    ,CommandDoc
"If you make a mistake, enter < at any prompt to go one step backward."
    ,CommandDoc
"To end a transaction, enter . when prompted."
    ,CommandDoc
"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{[CommandDoc]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [CommandDoc]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [CommandDoc]
esOpts :: EntryState -> CliOpts
..} = (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.
(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
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
defaultPrevInput EntryState
es [])
  case Maybe Transaction
mt of
    Maybe Transaction
Nothing -> CommandDoc -> IO ()
forall a. HasCallStack => CommandDoc -> a
error CommandDoc
"Could not interpret the input, restarting"  -- caught below causing a restart, I believe  -- PARTIAL:
    Just Transaction
t -> do
      Journal
j <- if CliOpts -> Int
debug_ CliOpts
esOpts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
           then do Handle -> CommandDoc -> IO ()
hPutStrLn Handle
stderr CommandDoc
"Skipping journal add due to debug mode."
                   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 ()
hPutStrLn Handle
stderr CommandDoc
"Saved."
                   Journal -> IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j'
      Handle -> CommandDoc -> IO ()
hPutStrLn Handle
stderr CommandDoc
"Starting the next transaction (. or ctrl-D/ctrl-C to quit)"
      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 ()
hPutStrLn Handle
stderr CommandDoc
"Restarting this transaction." 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 EntryState
es [] = PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput EntryState
es [AddingStage
EnterDateAndCode]
confirmedTransactionWizard PrevInput
prevInput es :: EntryState
es@EntryState{[CommandDoc]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [CommandDoc]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [CommandDoc]
esOpts :: EntryState -> CliOpts
..} stack :: [AddingStage]
stack@(AddingStage
currentStage : [AddingStage]
_) = case AddingStage
currentStage of
  AddingStage
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 (Day
date, Text
code) -> do
      let es' :: EntryState
es' = EntryState
es
            { esArgs :: [CommandDoc]
esArgs = Int -> [CommandDoc] -> [CommandDoc]
forall a. Int -> [a] -> [a]
drop Int
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]
++ Text -> CommandDoc
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 :: 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)
    Maybe (Day, Text)
Nothing ->
      PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput EntryState
es [AddingStage]
stack

  EnterDescAndComment (Day
date, 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 (Text
desc, Text
comment) -> do
      let mbaset :: Maybe Transaction
mbaset = CliOpts -> Journal -> Text -> Maybe Transaction
journalSimilarTransaction CliOpts
esOpts Journal
esJournal Text
desc
          es' :: EntryState
es' = EntryState
es
            { esArgs :: [CommandDoc]
esArgs = Int -> [CommandDoc] -> [CommandDoc]
forall a. Int -> [a] -> [a]
drop Int
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 Text
"" else Text
"  ; " 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 ())
-> (IO () -> Wizard Haskeline ()) -> IO () -> Wizard Haskeline ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
$ do
          Handle -> CommandDoc -> IO ()
hPutStrLn Handle
stderr CommandDoc
"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
-> 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)
    Maybe (Text, Text)
Nothing ->
      PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput EntryState
es (Int -> [AddingStage] -> [AddingStage]
forall a. Int -> [a] -> [a]
drop Int
1 [AddingStage]
stack)

  EnterNewPosting txnParams :: TxnParams
txnParams@TxnParams{Text
Day
txnCmnt :: Text
txnDesc :: Text
txnCode :: Text
txnDate :: Day
txnCmnt :: TxnParams -> Text
txnDesc :: TxnParams -> Text
txnCode :: TxnParams -> Text
txnDate :: TxnParams -> Day
..} Maybe Posting
posting -> case ([Posting]
esPostings, Maybe Posting
posting) of
    ([], Maybe Posting
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)
    ([Posting]
_, Just Posting
_) ->
      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)
    ([Posting]
_, Maybe Posting
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 BalancingOpts -> Transaction -> Either CommandDoc Transaction
balanceTransaction BalancingOpts
defbalancingopts Transaction
t of -- imprecise balancing (?)
        Right 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 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
$ CommandDoc
"\n" CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ (CommandDoc -> CommandDoc
capitalize CommandDoc
err) CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
"please re-enter.")
          let notFirstEnterPost :: AddingStage -> Bool
notFirstEnterPost AddingStage
stage = case AddingStage
stage of
                EnterNewPosting TxnParams
_ Maybe Posting
Nothing -> Bool
False
                AddingStage
_ -> 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 -> 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 CommandDoc
account
      | CommandDoc
account CommandDoc -> [CommandDoc] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandDoc
".", CommandDoc
""] ->
          case ([Posting]
esPostings, [Posting] -> Bool
postingsBalanced [Posting]
esPostings) of
            ([],Bool
_)    -> IO () -> Wizard Haskeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> CommandDoc -> IO ()
hPutStrLn Handle
stderr CommandDoc
"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
            ([Posting]
_,Bool
False) -> IO () -> Wizard Haskeline ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> CommandDoc -> IO ()
hPutStrLn Handle
stderr CommandDoc
"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
            ([Posting]
_,Bool
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 Int
1 [CommandDoc]
esArgs} (TxnParams -> CommandDoc -> AddingStage
EnterAmountAndComment TxnParams
txnParams CommandDoc
account AddingStage -> [AddingStage] -> [AddingStage]
forall a. a -> [a] -> [a]
: [AddingStage]
stack)
    Maybe CommandDoc
Nothing -> do
      let notPrevAmountAndNotEnterDesc :: AddingStage -> Bool
notPrevAmountAndNotEnterDesc AddingStage
stage = case AddingStage
stage of
            EnterAmountAndComment TxnParams
_ CommandDoc
_ -> Bool
False
            EnterDescAndComment (Day, Text)
_ -> Bool
False
            AddingStage
_ -> 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 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, 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
mixedAmount 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]
++ Text -> CommandDoc
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' :: [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 Int
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)
    Maybe (Amount, Text)
Nothing -> PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput EntryState
es (Int -> [AddingStage] -> [AddingStage]
forall a. Int -> [a] -> [a]
drop Int
1 [AddingStage]
stack)

  EndStage Transaction
t -> do
    CommandDoc -> Wizard Haskeline ()
forall (b :: * -> *). (Output :<: b) => CommandDoc -> Wizard b ()
output (CommandDoc -> Wizard Haskeline ())
-> (Text -> CommandDoc) -> Text -> Wizard Haskeline ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CommandDoc
T.unpack (Text -> Wizard Haskeline ()) -> Text -> Wizard Haskeline ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
t
    Maybe Char
y <- let def :: CommandDoc
def = CommandDoc
"y" in
         CommandDoc
-> Wizard Haskeline (Maybe Char) -> Wizard Haskeline (Maybe Char)
forall (b :: * -> *) a.
(OutputLn :<: b) =>
CommandDoc -> Wizard b a -> Wizard b a
retryMsg CommandDoc
"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 (\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))
-> (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 CommandDoc
"Save this transaction to the journal ?%s: " (CommandDoc -> CommandDoc
showDefault CommandDoc
def)
    case Maybe Char
y of
      Just Char
'y' -> Transaction -> Wizard Haskeline Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
      Just Char
_   -> RestartTransactionException -> Wizard Haskeline Transaction
forall a e. Exception e => e -> a
throw RestartTransactionException
RestartTransactionException
      Maybe Char
Nothing  -> PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput EntryState
es (Int -> [AddingStage] -> [AddingStage]
forall a. Int -> [a] -> [a]
drop Int
2 [AddingStage]
stack)
  where
    replaceNthOrAppend :: Int -> a -> [a] -> [a]
replaceNthOrAppend Int
n a
newElem [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
+ Int
1) [a]
xs

dateAndCodeWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe (Day, Text))
dateAndCodeWizard PrevInput{[CommandDoc]
Maybe CommandDoc
prevAmountAndCmnt :: [CommandDoc]
prevAccount :: [CommandDoc]
prevDescAndCmnt :: Maybe CommandDoc
prevDateAndCode :: Maybe CommandDoc
prevAmountAndCmnt :: PrevInput -> [CommandDoc]
prevAccount :: PrevInput -> [CommandDoc]
prevDescAndCmnt :: PrevInput -> Maybe CommandDoc
prevDateAndCode :: PrevInput -> Maybe CommandDoc
..} EntryState{[CommandDoc]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [CommandDoc]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [CommandDoc]
esOpts :: EntryState -> CliOpts
..} = do
  let def :: CommandDoc
def = CommandDoc -> [CommandDoc] -> CommandDoc
forall a. a -> [a] -> a
headDef (Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Day -> Text
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 CommandDoc
"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 CommandDoc
"Date%s: " (CommandDoc -> CommandDoc
showDefault CommandDoc
def)) (CommandDoc -> Maybe CommandDoc -> CommandDoc
forall a. a -> Maybe a -> a
fromMaybe CommandDoc
"" Maybe CommandDoc
prevDateAndCode) CommandDoc
""
    where
      parseSmartDateAndCode :: Day -> CommandDoc -> Maybe (Maybe (Day, Text))
parseSmartDateAndCode Day
refdate CommandDoc
s = if CommandDoc
s CommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
== CommandDoc
"<" 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) (\(SmartDate
d,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) CommandDoc
"" (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 Text
"" 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{[CommandDoc]
Maybe CommandDoc
prevAmountAndCmnt :: [CommandDoc]
prevAccount :: [CommandDoc]
prevDescAndCmnt :: Maybe CommandDoc
prevDateAndCode :: Maybe CommandDoc
prevAmountAndCmnt :: PrevInput -> [CommandDoc]
prevAccount :: PrevInput -> [CommandDoc]
prevDescAndCmnt :: PrevInput -> Maybe CommandDoc
prevDateAndCode :: PrevInput -> Maybe CommandDoc
..} EntryState{[CommandDoc]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [CommandDoc]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [CommandDoc]
esOpts :: EntryState -> CliOpts
..} = do
  let def :: CommandDoc
def = CommandDoc -> [CommandDoc] -> CommandDoc
forall a. a -> [a] -> a
headDef CommandDoc
"" [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 CommandDoc
"Description%s: " (CommandDoc -> CommandDoc
showDefault CommandDoc
def)) (CommandDoc -> Maybe CommandDoc -> CommandDoc
forall a. a -> Maybe a -> a
fromMaybe CommandDoc
"" Maybe CommandDoc
prevDescAndCmnt) CommandDoc
""
  if CommandDoc
s CommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
== CommandDoc
"<"
    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 (Text
desc,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
==Char
';') CommandDoc
b) where (CommandDoc
a,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
==Char
';') 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 [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
$ BalancingOpts -> Transaction -> Either CommandDoc Transaction
balanceTransaction BalancingOpts
defbalancingopts Transaction
nulltransaction{tpostings :: [Posting]
tpostings=[Posting]
ps}

accountWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe CommandDoc)
accountWizard PrevInput{[CommandDoc]
Maybe CommandDoc
prevAmountAndCmnt :: [CommandDoc]
prevAccount :: [CommandDoc]
prevDescAndCmnt :: Maybe CommandDoc
prevDateAndCode :: Maybe CommandDoc
prevAmountAndCmnt :: PrevInput -> [CommandDoc]
prevAccount :: PrevInput -> [CommandDoc]
prevDescAndCmnt :: PrevInput -> Maybe CommandDoc
prevDateAndCode :: PrevInput -> Maybe CommandDoc
..} EntryState{[CommandDoc]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [CommandDoc]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [CommandDoc]
esOpts :: EntryState -> CliOpts
..} = 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
+ Int
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
- Int
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 :: Text
historicalacct = case Maybe Posting
historicalp of Just Posting
p  -> Maybe Int -> PostingType -> Text -> Text
showAccountName Maybe Int
forall a. Maybe a
Nothing (Posting -> PostingType
ptype Posting
p) (Posting -> Text
paccount Posting
p)
                                           Maybe Posting
Nothing -> Text
""
      def :: CommandDoc
def = CommandDoc -> [CommandDoc] -> CommandDoc
forall a. a -> [a] -> a
headDef (Text -> CommandDoc
T.unpack Text
historicalacct) [CommandDoc]
esArgs
      endmsg :: CommandDoc
endmsg | Bool
canfinish Bool -> Bool -> Bool
&& CommandDoc -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null CommandDoc
def = CommandDoc
" (or . or enter to finish this transaction)"
             | Bool
canfinish             = CommandDoc
" (or . to finish this transaction)"
             | Bool
otherwise             = CommandDoc
""
  CommandDoc
-> Wizard Haskeline (Maybe CommandDoc)
-> Wizard Haskeline (Maybe CommandDoc)
forall (b :: * -> *) a.
(OutputLn :<: b) =>
CommandDoc -> Wizard b a -> Wizard b a
retryMsg CommandDoc
"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 CommandDoc
"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 CommandDoc
"" (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) CommandDoc
""
    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 CommandDoc
_  Bool
_ CommandDoc
"<"       = 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 CommandDoc
_  Bool
_ CommandDoc
"."       = 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
"." -- . always signals end of txn
      parseAccountOrDotOrNull CommandDoc
"" Bool
True CommandDoc
""     = 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
""  -- when there's no default and txn is balanced, "" also signals end of txn
      parseAccountOrDotOrNull def :: CommandDoc
def@(Char
_:CommandDoc
_) Bool
_ CommandDoc
"" = 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 CommandDoc
_ Bool
_ 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
"" (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 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{[CommandDoc]
Maybe CommandDoc
prevAmountAndCmnt :: [CommandDoc]
prevAccount :: [CommandDoc]
prevDescAndCmnt :: Maybe CommandDoc
prevDateAndCode :: Maybe CommandDoc
prevAmountAndCmnt :: PrevInput -> [CommandDoc]
prevAccount :: PrevInput -> [CommandDoc]
prevDescAndCmnt :: PrevInput -> Maybe CommandDoc
prevDateAndCode :: PrevInput -> Maybe CommandDoc
..} EntryState{[CommandDoc]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [CommandDoc]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [CommandDoc]
esOpts :: EntryState -> CliOpts
..} = 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
+ Int
1
      (Maybe Posting
mhistoricalp,Bool
followedhistoricalsofar) =
          case Maybe Transaction
esSimilarTransaction of
            Maybe Transaction
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
-Int
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 (Posting, Posting) -> Bool
sameamount ([(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
              )
              where
                sameamount :: (Posting, Posting) -> Bool
sameamount (Posting
p1,Posting
p2) = MixedAmount -> MixedAmount
mixedAmountUnstyled (Posting -> MixedAmount
pamount Posting
p1) MixedAmount -> MixedAmount -> Bool
forall a. Eq a => a -> a -> Bool
== MixedAmount -> MixedAmount
mixedAmountUnstyled (Posting -> MixedAmount
pamount Posting
p2)
      def :: CommandDoc
def | (CommandDoc
d:[CommandDoc]
_) <- [CommandDoc]
esArgs                                     = CommandDoc
d
          | Just Posting
hp <- Maybe Posting
mhistoricalp, Bool
followedhistoricalsofar    = 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
> Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not (MixedAmount -> Bool
mixedAmountLooksZero MixedAmount
balancingamt) = MixedAmount -> CommandDoc
showamt MixedAmount
balancingamtfirstcommodity
          | Bool
otherwise                                           = CommandDoc
""
  CommandDoc
-> Wizard Haskeline (Maybe (Amount, Text))
-> Wizard Haskeline (Maybe (Amount, Text))
forall (b :: * -> *) a.
(OutputLn :<: b) =>
CommandDoc -> Wizard b a -> Wizard b a
retryMsg CommandDoc
"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 CommandDoc
"Amount  %d%s: " Int
pnum (CommandDoc -> CommandDoc
showDefault CommandDoc
def)) (CommandDoc -> Maybe CommandDoc -> CommandDoc
forall a. a -> Maybe a -> a
fromMaybe CommandDoc
"" (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) CommandDoc
""
    where
      parseAmountAndComment :: CommandDoc -> Maybe (Maybe (Amount, Text))
parseAmountAndComment CommandDoc
s = if CommandDoc
s CommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
== CommandDoc
"<" 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
""
                                  (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 CommandDoc
"" (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 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
maNegate (MixedAmount -> MixedAmount)
-> ([Posting] -> MixedAmount) -> [Posting] -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Posting] -> MixedAmount
sumPostings ([Posting] -> MixedAmount) -> [Posting] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter Posting -> Bool
isReal [Posting]
esPostings
      balancingamtfirstcommodity :: MixedAmount
balancingamtfirstcommodity = [Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed ([Amount] -> MixedAmount)
-> ([Amount] -> [Amount]) -> [Amount] -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Amount] -> [Amount]
forall a. Int -> [a] -> [a]
take Int
1 ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amounts MixedAmount
balancingamt
      showamt :: MixedAmount -> CommandDoc
showamt = WideBuilder -> CommandDoc
wbUnpack (WideBuilder -> CommandDoc)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour (MixedAmount -> WideBuilder)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountPrecision -> MixedAmount -> MixedAmount
mixedAmountSetPrecision
                  -- 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 (\CommandDoc
s -> if CommandDoc
sCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
==CommandDoc
"." 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 [CommandDoc
"today",CommandDoc
"tomorrow",CommandDoc
"yesterday"]

descriptionCompleter :: Journal -> String -> CompletionFunc IO
descriptionCompleter :: Journal -> CommandDoc -> CompletionFunc IO
descriptionCompleter 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 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 [CommandDoc]
completions 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
"" CommandDoc -> IO [Completion]
forall (m :: * -> *). Monad m => CommandDoc -> m [Completion]
completionsFor
    where
      simpleCompletion' :: CommandDoc -> Completion
simpleCompletion' CommandDoc
s = (CommandDoc -> Completion
simpleCompletion CommandDoc
s){isFinished :: Bool
isFinished=Bool
False}
      completionsFor :: CommandDoc -> m [Completion]
completionsFor CommandDoc
"" = [Completion] -> m [Completion]
forall (m :: * -> *) a. Monad m => a -> m a
return [CommandDoc -> Completion
simpleCompletion' CommandDoc
def]
      completionsFor 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 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 CommandDoc
s = CommandDoc
"\ESC[1;32m\STX"CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
sCommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
"\ESC[0m\STX"

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

-- | 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} CliOpts
opts Transaction
t = do
  let f :: CommandDoc
f = Journal -> CommandDoc
journalFilePath Journal
j
  CommandDoc -> Text -> IO ()
appendToJournalFileOrStdout CommandDoc
f (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
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
> Int
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 CommandDoc
"\nAdded transaction to %s:" CommandDoc
f
    Text -> IO ()
TL.putStrLn (Text -> IO ()) -> IO Text -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> IO Text
registerFromString (Transaction -> Text
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 -> Text -> IO ()
appendToJournalFileOrStdout :: CommandDoc -> Text -> IO ()
appendToJournalFileOrStdout CommandDoc
f Text
s
  | CommandDoc
f CommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
== CommandDoc
"-"  = Text -> IO ()
T.putStr Text
s'
  | Bool
otherwise = CommandDoc -> CommandDoc -> IO ()
appendFile CommandDoc
f (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CommandDoc
T.unpack Text
s'
  where s' :: Text
s' = Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
ensureOneNewlineTerminated Text
s

-- | Replace a string's 0 or more terminating newlines with exactly one.
ensureOneNewlineTerminated :: Text -> Text
ensureOneNewlineTerminated :: Text -> Text
ensureOneNewlineTerminated = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n')

-- | Convert a string of journal data into a register report.
registerFromString :: T.Text -> IO TL.Text
registerFromString :: Text -> IO Text
registerFromString Text
s = do
  Journal
j <- Text -> IO Journal
readJournal' Text
s
  Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text)
-> (PostingsReport -> Text) -> PostingsReport -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts (PostingsReport -> IO Text) -> PostingsReport -> IO Text
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
rspec Journal
j
      where
        ropts :: ReportOpts
ropts = ReportOpts
defreportopts{empty_ :: Bool
empty_=Bool
True}
        rspec :: ReportSpec
rspec = ReportSpec
defreportspec{_rsReportOpts :: ReportOpts
_rsReportOpts=ReportOpts
ropts}
        opts :: CliOpts
opts = CliOpts
defcliopts{reportspec_ :: ReportSpec
reportspec_=ReportSpec
rspec}

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