{-|
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, nub)
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)
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 = String
-> [Flag RawOpts]
-> [(String, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Add.txt")
  [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]
  []
  ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Arg RawOpts
argsFlag String
"[DATE [DESCRIPTION [ACCOUNT1 [AMOUNT1 [ACCOUNT2 [ETC...]]]]]]")

-- | State used while entering transactions.
data EntryState = EntryState {
   EntryState -> CliOpts
esOpts               :: CliOpts           -- ^ command line options
  ,EntryState -> [String]
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 -> String -> String
[EntryState] -> String -> String
EntryState -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EntryState] -> String -> String
$cshowList :: [EntryState] -> String -> String
show :: EntryState -> String
$cshow :: EntryState -> String
showsPrec :: Int -> EntryState -> String -> String
$cshowsPrec :: Int -> EntryState -> String -> String
Show)

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

data RestartTransactionException = RestartTransactionException deriving (Int -> RestartTransactionException -> String -> String
[RestartTransactionException] -> String -> String
RestartTransactionException -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RestartTransactionException] -> String -> String
$cshowList :: [RestartTransactionException] -> String -> String
show :: RestartTransactionException -> String
$cshow :: RestartTransactionException -> String
showsPrec :: Int -> RestartTransactionException -> String -> String
$cshowsPrec :: Int -> 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 forall a. Eq a => a -> a -> Bool
== String
"-" = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Adding transactions to journal file " forall a. Semigroup a => a -> a -> a
<> Journal -> String
journalFilePath Journal
j
        IO ()
showHelp
        let today :: Day
today = CliOpts
optsforall s a. s -> Getting a s a -> a
^.forall c. HasReportSpec c => Lens' c Day
rsDay
            es :: EntryState
es = EntryState
defEntryState{esOpts :: CliOpts
esOpts=CliOpts
opts
                              ,esArgs :: [String]
esArgs=String -> RawOpts -> [String]
listofstringopt String
"args" 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 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 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.
getAndAddTransactions :: EntryState -> IO ()
getAndAddTransactions :: EntryState -> IO ()
getAndAddTransactions es :: EntryState
es@EntryState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [String]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [String]
esOpts :: EntryState -> CliOpts
..} = (do
  let defaultPrevInput :: PrevInput
defaultPrevInput = PrevInput{prevDateAndCode :: Maybe String
prevDateAndCode=forall a. Maybe a
Nothing, prevDescAndCmnt :: Maybe String
prevDescAndCmnt=forall a. Maybe a
Nothing, prevAccount :: [String]
prevAccount=[], prevAmountAndCmnt :: [String]
prevAmountAndCmnt=[]}
  Maybe Transaction
mt <- forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT (forall (m :: * -> *). CompletionFunc m -> Settings m -> Settings m
setComplete forall (m :: * -> *). Monad m => CompletionFunc m
noCompletion forall (m :: * -> *). MonadIO m => Settings m
defaultSettings) (forall (f :: * -> *) (b :: * -> *) a.
(Functor f, Monad b, Run b f) =>
Wizard f a -> b (Maybe a)
System.Console.Wizard.run forall a b. (a -> b) -> a -> b
$ forall a. Wizard Haskeline a -> Wizard Haskeline a
haskeline 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 -> forall a. HasCallStack => String -> a
error String
"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 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."
                   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 -> String -> IO ()
hPutStrLn Handle
stderr String
"Saved."
                   forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j'
      Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"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}
  )
  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." 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 -> String -> String
[TxnParams] -> String -> String
TxnParams -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TxnParams] -> String -> String
$cshowList :: [TxnParams] -> String -> String
show :: TxnParams -> String
$cshow :: TxnParams -> String
showsPrec :: Int -> TxnParams -> String -> String
$cshowsPrec :: Int -> TxnParams -> String -> String
Show)

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
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PrevInput] -> String -> String
$cshowList :: [PrevInput] -> String -> String
show :: PrevInput -> String
$cshow :: PrevInput -> String
showsPrec :: Int -> PrevInput -> String -> String
$cshowsPrec :: Int -> PrevInput -> String -> String
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{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [String]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [String]
esOpts :: EntryState -> CliOpts
..} stack :: [AddingStage]
stack@(AddingStage
currentStage : [AddingStage]
_) = case AddingStage
currentStage of
  AddingStage
EnterDateAndCode -> PrevInput -> EntryState -> Wizard Haskeline (Maybe (EFDay, Text))
dateAndCodeWizard PrevInput
prevInput EntryState
es 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
        es' :: EntryState
es' = EntryState
es{ esArgs :: [String]
esArgs = forall a. Int -> [a] -> [a]
drop Int
1 [String]
esArgs
                , esDefDate :: Day
esDefDate = Day
date
                }
        dateAndCodeString :: String
dateAndCodeString = forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
yyyymmddFormat Day
date
                            forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (if Text -> Bool
T.null Text
code then Text
"" else Text
" (" forall a. Semigroup a => a -> a -> a
<> Text
code forall a. Semigroup a => a -> a -> a
<> Text
")")
        yyyymmddFormat :: String
yyyymmddFormat = String
"%Y-%m-%d"
      PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput{prevDateAndCode :: Maybe String
prevDateAndCode=forall a. a -> Maybe a
Just String
dateAndCodeString} EntryState
es' ((Day, Text) -> AddingStage
EnterDescAndComment (Day
date, Text
code) forall a. a -> [a] -> [a]
: [AddingStage]
stack)
    Maybe (EFDay, 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 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 :: [String]
esArgs = forall a. Int -> [a] -> [a]
drop Int
1 [String]
esArgs
            , esPostings :: [Posting]
esPostings = []
            , esSimilarTransaction :: Maybe Transaction
esSimilarTransaction = Maybe Transaction
mbaset
            }
          descAndCommentString :: String
descAndCommentString = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
desc forall a. Semigroup a => a -> a -> a
<> (if Text -> Bool
T.null Text
comment then Text
"" else Text
"  ; " forall a. Semigroup a => a -> a -> a
<> Text
comment)
          prevInput' :: PrevInput
prevInput' = PrevInput
prevInput{prevDescAndCmnt :: Maybe String
prevDescAndCmnt=forall a. a -> Maybe a
Just String
descAndCommentString}
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Transaction
mbaset) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction (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{txnDate :: Day
txnDate=Day
date, txnCode :: Text
txnCode=Text
code, txnDesc :: Text
txnDesc=Text
desc, txnCmnt :: Text
txnCmnt=Text
comment} forall a. Maybe a
Nothing) forall a. a -> [a] -> [a]
: [AddingStage]
stack)
    Maybe (Text, Text)
Nothing ->
      PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput EntryState
es (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
p -> case ([Posting]
esPostings, Maybe Posting
p) of
    ([], Maybe Posting
Nothing) ->
      PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput EntryState
es (TxnParams -> AddingStage
EnterAccount TxnParams
txnParams 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 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 String 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' forall a. a -> [a] -> [a]
: [AddingStage]
stack)
        Left String
err -> do
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"\n" forall a. [a] -> [a] -> [a]
++ (String -> String
capitalize String
err) forall a. [a] -> [a] -> [a]
++ String
"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=[]} (forall a. (a -> Bool) -> [a] -> [a]
dropWhile AddingStage -> Bool
notFirstEnterPost [AddingStage]
stack)

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

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

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

dateAndCodeWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe (EFDay, Text))
dateAndCodeWizard PrevInput{[String]
Maybe String
prevAmountAndCmnt :: [String]
prevAccount :: [String]
prevDescAndCmnt :: Maybe String
prevDateAndCode :: Maybe String
prevAmountAndCmnt :: PrevInput -> [String]
prevAccount :: PrevInput -> [String]
prevDescAndCmnt :: PrevInput -> Maybe String
prevDateAndCode :: PrevInput -> Maybe String
..} EntryState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [String]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [String]
esOpts :: EntryState -> CliOpts
..} = do
  let def :: String
def = forall a. a -> [a] -> a
headDef (Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Day -> Text
showDate Day
esDefDate) [String]
esArgs
  forall (b :: * -> *) a.
(OutputLn :<: b) =>
String -> Wizard b a -> Wizard b a
retryMsg String
"A valid hledger smart date is required. Eg: 2022-08-30, 8/30, 30, yesterday." forall a b. (a -> b) -> a -> b
$
   forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser (Day -> String -> Maybe (Maybe (EFDay, Text))
parseSmartDateAndCode Day
esToday) forall a b. (a -> b) -> a -> b
$
   forall {b :: * -> *} {a}.
(WithSettings :<: b) =>
CompletionFunc IO -> Wizard b a -> Wizard b a
withCompletion (String -> CompletionFunc IO
dateCompleter String
def) forall a b. (a -> b) -> a -> b
$
   forall {b}. b -> Wizard Haskeline b -> Wizard Haskeline b
defaultTo' String
def forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
nonEmpty forall a b. (a -> b) -> a -> b
$
   Wizard Haskeline String -> Wizard Haskeline String
maybeExit forall a b. (a -> b) -> a -> b
$
   -- maybeShowHelp $
   forall (b :: * -> *).
(LinePrewritten :<: b) =>
String -> String -> String -> Wizard b String
linePrewritten (String -> String
green forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"Date%s: " (String -> String
showDefault String
def)) (forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
prevDateAndCode) String
""
    where
      parseSmartDateAndCode :: Day -> String -> Maybe (Maybe (EFDay, Text))
parseSmartDateAndCode Day
refdate String
s = if String
s forall a. Eq a => a -> a -> Bool
== String
"<" then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (\(SmartDate
d,Text
c) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Day -> SmartDate -> EFDay
fixSmartDate Day
refdate SmartDate
d, Text
c)) Either
  (ParseErrorBundle Text HledgerParseErrorData) (SmartDate, Text)
edc
          where
            edc :: Either
  (ParseErrorBundle Text HledgerParseErrorData) (SmartDate, Text)
edc = forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (ParsecT HledgerParseErrorData Text Identity (SmartDate, Text)
dateandcodep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String -> String
lowercase String
s
            dateandcodep :: SimpleTextParser (SmartDate, Text)
            dateandcodep :: ParsecT HledgerParseErrorData Text Identity (SmartDate, Text)
dateandcodep = do
                SmartDate
d <- forall (m :: * -> *). TextParser m SmartDate
smartdate
                Maybe Text
c <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall (m :: * -> *). TextParser m Text
codep
                forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
                forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
                forall (m :: * -> *) a. Monad m => a -> m a
return (SmartDate
d, 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{[String]
Maybe String
prevAmountAndCmnt :: [String]
prevAccount :: [String]
prevDescAndCmnt :: Maybe String
prevDateAndCode :: Maybe String
prevAmountAndCmnt :: PrevInput -> [String]
prevAccount :: PrevInput -> [String]
prevDescAndCmnt :: PrevInput -> Maybe String
prevDateAndCode :: PrevInput -> Maybe String
..} EntryState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [String]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [String]
esOpts :: EntryState -> CliOpts
..} = do
  let def :: String
def = forall a. a -> [a] -> a
headDef String
"" [String]
esArgs
  String
s <- forall {b :: * -> *} {a}.
(WithSettings :<: b) =>
CompletionFunc IO -> Wizard b a -> Wizard b a
withCompletion (Journal -> String -> CompletionFunc IO
descriptionCompleter Journal
esJournal String
def) forall a b. (a -> b) -> a -> b
$
       forall {b}. b -> Wizard Haskeline b -> Wizard Haskeline b
defaultTo' String
def forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
nonEmpty forall a b. (a -> b) -> a -> b
$
       forall (b :: * -> *).
(LinePrewritten :<: b) =>
String -> String -> String -> Wizard b String
linePrewritten (String -> String
green forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"Description%s: " (String -> String
showDefault String
def)) (forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
prevDescAndCmnt) String
""
  if String
s forall a. Eq a => a -> a -> Bool
== String
"<"
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else do
      let (Text
desc,Text
comment) = (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String -> String
strip String
a, String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String -> String
strip forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
';') String
b) where (String
a,String
b) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
';') String
s
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Text
desc, Text
comment)

postingsBalanced :: [Posting] -> Bool
postingsBalanced :: [Posting] -> Bool
postingsBalanced [Posting]
ps = forall a b. Either a b -> Bool
isRight forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Transaction -> Either String Transaction
balanceTransaction BalancingOpts
defbalancingopts Transaction
nulltransaction{tpostings :: [Posting]
tpostings=[Posting]
ps}

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

amountAndCommentWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe (Amount, Text))
amountAndCommentWizard PrevInput{[String]
Maybe String
prevAmountAndCmnt :: [String]
prevAccount :: [String]
prevDescAndCmnt :: Maybe String
prevDateAndCode :: Maybe String
prevAmountAndCmnt :: PrevInput -> [String]
prevAccount :: PrevInput -> [String]
prevDescAndCmnt :: PrevInput -> Maybe String
prevDateAndCode :: PrevInput -> Maybe String
..} EntryState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esPostings :: [Posting]
esSimilarTransaction :: Maybe Transaction
esJournal :: Journal
esDefDate :: Day
esToday :: Day
esArgs :: [String]
esOpts :: CliOpts
esPostings :: EntryState -> [Posting]
esSimilarTransaction :: EntryState -> Maybe Transaction
esJournal :: EntryState -> Journal
esDefDate :: EntryState -> Day
esToday :: EntryState -> Day
esArgs :: EntryState -> [String]
esOpts :: EntryState -> CliOpts
..} = do
  let pnum :: Int
pnum = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
esPostings forall a. Num a => a -> a -> a
+ Int
1
      (Maybe Posting
mhistoricalp,Bool
followedhistoricalsofar) =
          case Maybe Transaction
esSimilarTransaction of
            Maybe Transaction
Nothing                        -> (forall a. Maybe a
Nothing,Bool
False)
            Just Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} ->
              ( if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
ps forall a. Ord a => a -> a -> Bool
>= Int
pnum then forall a. a -> Maybe a
Just ([Posting]
ps forall a. [a] -> Int -> a
!! (Int
pnumforall a. Num a => a -> a -> a
-Int
1)) else forall a. Maybe a
Nothing
              , forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Posting, Posting) -> Bool
sameamount forall a b. (a -> b) -> a -> b
$ 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) forall a. Eq a => a -> a -> Bool
== MixedAmount -> MixedAmount
mixedAmountUnstyled (Posting -> MixedAmount
pamount Posting
p2)
      def :: String
def | (String
d:[String]
_) <- [String]
esArgs                                     = String
d
          | Just Posting
hp <- Maybe Posting
mhistoricalp, Bool
followedhistoricalsofar    = MixedAmount -> String
showamt forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
hp
          | Int
pnum forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not (MixedAmount -> Bool
mixedAmountLooksZero MixedAmount
balancingamt) = MixedAmount -> String
showamt MixedAmount
balancingamtfirstcommodity
          | Bool
otherwise                                           = String
""
  forall (b :: * -> *) a.
(OutputLn :<: b) =>
String -> Wizard b a -> Wizard b a
retryMsg String
"A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." forall a b. (a -> b) -> a -> b
$
   forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser String -> Maybe (Maybe (Amount, Text))
parseAmountAndComment forall a b. (a -> b) -> a -> b
$
   forall {b :: * -> *} {a}.
(WithSettings :<: b) =>
CompletionFunc IO -> Wizard b a -> Wizard b a
withCompletion (String -> CompletionFunc IO
amountCompleter String
def) forall a b. (a -> b) -> a -> b
$
   forall {b}. b -> Wizard Haskeline b -> Wizard Haskeline b
defaultTo' String
def forall a b. (a -> b) -> a -> b
$
   forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
nonEmpty forall a b. (a -> b) -> a -> b
$
   forall (b :: * -> *).
(LinePrewritten :<: b) =>
String -> String -> String -> Wizard b String
linePrewritten (String -> String
green forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"Amount  %d%s: " Int
pnum (String -> String
showDefault String
def)) (forall a. a -> Maybe a -> a
fromMaybe String
"" forall a b. (a -> b) -> a -> b
$ [String]
prevAmountAndCmnt forall a. [a] -> Int -> Maybe a
`atMay` forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
esPostings) String
""
    where
      parseAmountAndComment :: String -> Maybe (Maybe (Amount, Text))
parseAmountAndComment String
s = if String
s forall a. Eq a => a -> a -> Bool
== String
"<" then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall a b. (a -> b) -> a -> b
$
                                forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser
                                  (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT
  Journal
  (ParsecT HledgerParseErrorData Text Identity)
  (Amount, Text)
amountandcommentp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
nodefcommodityj)
                                  String
""
                                  (String -> Text
T.pack String
s)
      nodefcommodityj :: Journal
nodefcommodityj = Journal
esJournal{jparsedefaultcommodity :: Maybe (Text, AmountStyle)
jparsedefaultcommodity=forall a. Maybe a
Nothing}
      amountandcommentp :: JournalParser Identity (Amount, Text)
      amountandcommentp :: StateT
  Journal
  (ParsecT HledgerParseErrorData Text Identity)
  (Amount, Text)
amountandcommentp = do
        Amount
a <- forall (m :: * -> *). JournalParser m Amount
amountp
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
        Text
c <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a -> a
fromMaybe String
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
';' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle)
        -- eof
        forall (m :: * -> *) a. Monad m => a -> m a
return (Amount
a,Text
c)
      balancingamt :: MixedAmount
balancingamt = MixedAmount -> MixedAmount
maNegate forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Posting] -> MixedAmount
sumPostings forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Posting -> Bool
isReal [Posting]
esPostings
      balancingamtfirstcommodity :: MixedAmount
balancingamtfirstcommodity = forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amounts MixedAmount
balancingamt
      showamt :: MixedAmount -> String
showamt = WideBuilder -> String
wbUnpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour 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 String -> Wizard Haskeline String
maybeExit = forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser (\String
s -> if String
sforall a. Eq a => a -> a -> Bool
==String
"." then forall a e. Exception e => e -> a
throw UnexpectedEOF
UnexpectedEOF else forall a. a -> Maybe a
Just String
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 :: String -> CompletionFunc IO
dateCompleter = [String] -> String -> CompletionFunc IO
completer [String
"today",String
"tomorrow",String
"yesterday"]

-- Offer payees declared, payees used, or full descriptions used.
descriptionCompleter :: Journal -> String -> CompletionFunc IO
descriptionCompleter :: Journal -> String -> CompletionFunc IO
descriptionCompleter Journal
j = [String] -> String -> CompletionFunc IO
completer (forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
journalPayeesDeclaredOrUsed Journal
j forall a. [a] -> [a] -> [a]
++ Journal -> [Text]
journalDescriptions Journal
j)

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

amountCompleter :: String -> CompletionFunc IO
amountCompleter :: String -> CompletionFunc IO
amountCompleter = [String] -> String -> 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 :: [String] -> String -> CompletionFunc IO
completer [String]
completions String
def = forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord forall a. Maybe a
Nothing String
"" forall {m :: * -> *}. Monad m => String -> m [Completion]
completionsFor
    where
      simpleCompletion' :: String -> Completion
simpleCompletion' String
s = (String -> Completion
simpleCompletion String
s){isFinished :: Bool
isFinished=Bool
False}
      completionsFor :: String -> m [Completion]
completionsFor String
"" = forall (m :: * -> *) a. Monad m => a -> m a
return [String -> Completion
simpleCompletion' String
def]
      completionsFor String
i  = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map String -> Completion
simpleCompletion' [String]
ciprefixmatches)
          where
            ciprefixmatches :: [String]
ciprefixmatches = [String
c | String
c <- [String]
completions, String
i forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
c]
            -- mixed-case completions require haskeline > 0.7.1.2
            -- ciprefixmatches = [c | c <- completions, lowercase i `isPrefixOf` lowercase c]

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

-- utilities

defaultTo' :: b -> Wizard Haskeline b -> Wizard Haskeline b
defaultTo' = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall (b :: * -> *) a.
(WithSettings :<: b) =>
Settings IO -> Wizard b a -> Wizard b a
withSettings (forall (m :: * -> *). CompletionFunc m -> Settings m -> Settings m
setComplete CompletionFunc IO
f forall (m :: * -> *). MonadIO m => Settings m
defaultSettings)

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

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

-- | 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 :: String
f = Journal -> String
journalFilePath Journal
j
  String -> Text -> IO ()
appendToJournalFileOrStdout String
f 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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CliOpts -> Int
debug_ CliOpts
opts forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"\nAdded transaction to %s:" String
f
    Text -> IO ()
TL.putStrLn forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> IO Text
registerFromString (Transaction -> Text
showTransaction Transaction
t)
  forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j{jtxns :: [Transaction]
jtxns=[Transaction]
tsforall 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 :: String -> Text -> IO ()
appendToJournalFileOrStdout String
f Text
s
  | String
f forall a. Eq a => a -> a -> Bool
== String
"-"  = Text -> IO ()
T.putStr Text
s'
  | Bool
otherwise = String -> String -> IO ()
appendFile String
f forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s'
  where s' :: Text
s' = Text
"\n" 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 = (forall a. Semigroup a => a -> a -> a
<>Text
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> PostingsReport -> Text
postingsReportAsText CliOpts
opts 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 :: String -> String
capitalize String
"" = String
""
capitalize (Char
c:String
cs) = Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: String
cs