{-|
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")
  [[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"no-new-accounts"]  (String -> RawOpts -> RawOpts
setboolopt String
"no-new-accounts") String
"don't allow creating new accounts"]
  [(String, [Flag RawOpts])
generalflagsgroup2]
  []
  ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ String -> Arg RawOpts
argsFlag String
"[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
(Int -> EntryState -> String -> String)
-> (EntryState -> String)
-> ([EntryState] -> String -> String)
-> Show EntryState
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> EntryState -> String -> String
showsPrec :: Int -> EntryState -> String -> String
$cshow :: EntryState -> String
show :: EntryState -> String
$cshowList :: [EntryState] -> String -> String
showList :: [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 = Maybe Transaction
forall a. Maybe a
Nothing
  ,esPostings :: [Posting]
esPostings           = []
}

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

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

-- | Read multiple transactions from the console, prompting for each
-- field, and append them to the journal file.  If the journal came
-- from stdin, this command has no effect.
add :: CliOpts -> Journal -> IO ()
add :: CliOpts -> Journal -> IO ()
add CliOpts
opts Journal
j
    | Journal -> String
journalFilePath Journal
j String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Adding transactions to journal file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Journal -> String
journalFilePath Journal
j
        IO ()
showHelp
        let today :: Day
today = CliOpts
optsCliOpts -> Getting Day CliOpts Day -> Day
forall s a. s -> Getting a s a -> a
^.Getting Day CliOpts Day
forall c. HasReportSpec c => Lens' c Day
Lens' CliOpts Day
rsDay
            es :: EntryState
es = EntryState
defEntryState{esOpts=opts
                              ,esArgs=listofstringopt "args" $ rawopts_ opts
                              ,esToday=today
                              ,esDefDate=today
                              ,esJournal=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) -> String -> IO ()
putStr String
"")

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

-- | Loop reading transactions from the console, prompting, validating
-- and appending each one to the journal file, until end of input or
-- ctrl-c (then raise an EOF exception).  If provided, command-line
-- arguments are used as defaults; otherwise defaults come from the
-- most similar recent transaction in the journal.
getAndAddTransactions :: EntryState -> IO ()
getAndAddTransactions :: EntryState -> IO ()
getAndAddTransactions es :: EntryState
es@EntryState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esOpts :: EntryState -> CliOpts
esArgs :: EntryState -> [String]
esToday :: EntryState -> Day
esDefDate :: EntryState -> Day
esJournal :: EntryState -> Journal
esSimilarTransaction :: EntryState -> Maybe Transaction
esPostings :: EntryState -> [Posting]
esOpts :: CliOpts
esArgs :: [String]
esToday :: Day
esDefDate :: Day
esJournal :: Journal
esSimilarTransaction :: Maybe Transaction
esPostings :: [Posting]
..} = (do
  let defaultPrevInput :: PrevInput
defaultPrevInput = PrevInput{prevDateAndCode :: Maybe String
prevDateAndCode=Maybe String
forall a. Maybe a
Nothing, prevDescAndCmnt :: Maybe String
prevDescAndCmnt=Maybe String
forall a. Maybe a
Nothing, prevAccount :: [String]
prevAccount=[], prevAmountAndCmnt :: [String]
prevAmountAndCmnt=[]}
  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 -> String -> IO ()
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
           then do Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Skipping journal add due to debug mode."
                   Journal -> IO Journal
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
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."
                   Journal -> IO Journal
forall a. a -> IO a
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=j, esDefDate=tdate t}
  )
  IO () -> (RestartTransactionException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(RestartTransactionException
_::RestartTransactionException) ->
                 Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Restarting this transaction." IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
(Int -> TxnParams -> String -> String)
-> (TxnParams -> String)
-> ([TxnParams] -> String -> String)
-> Show TxnParams
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TxnParams -> String -> String
showsPrec :: Int -> TxnParams -> String -> String
$cshow :: TxnParams -> String
show :: TxnParams -> String
$cshowList :: [TxnParams] -> String -> String
showList :: [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
(Int -> PrevInput -> String -> String)
-> (PrevInput -> String)
-> ([PrevInput] -> String -> String)
-> Show PrevInput
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PrevInput -> String -> String
showsPrec :: Int -> PrevInput -> String -> String
$cshow :: PrevInput -> String
show :: PrevInput -> String
$cshowList :: [PrevInput] -> String -> String
showList :: [PrevInput] -> String -> String
Show)

data 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
esOpts :: EntryState -> CliOpts
esArgs :: EntryState -> [String]
esToday :: EntryState -> Day
esDefDate :: EntryState -> Day
esJournal :: EntryState -> Journal
esSimilarTransaction :: EntryState -> Maybe Transaction
esPostings :: EntryState -> [Posting]
esOpts :: CliOpts
esArgs :: [String]
esToday :: Day
esDefDate :: Day
esJournal :: Journal
esSimilarTransaction :: Maybe Transaction
esPostings :: [Posting]
..} stack :: [AddingStage]
stack@(AddingStage
currentStage : [AddingStage]
_) = case AddingStage
currentStage of
  AddingStage
EnterDateAndCode -> PrevInput -> EntryState -> Wizard Haskeline (Maybe (EFDay, Text))
dateAndCodeWizard PrevInput
prevInput EntryState
es Wizard Haskeline (Maybe (EFDay, Text))
-> (Maybe (EFDay, Text) -> Wizard Haskeline Transaction)
-> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a
-> (a -> Wizard Haskeline b) -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (EFDay
efd, Text
code) -> do
      let 
        date :: Day
date = EFDay -> Day
fromEFDay EFDay
efd
        es' :: EntryState
es' = EntryState
es{ esArgs = drop 1 esArgs
                , esDefDate = date
                }
        dateAndCodeString :: String
dateAndCodeString = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
yyyymmddFormat Day
date
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (if Text -> Bool
T.null Text
code then Text
"" else Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
        yyyymmddFormat :: String
yyyymmddFormat = String
"%Y-%m-%d"
      PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput{prevDateAndCode=Just dateAndCodeString} EntryState
es' ((Day, Text) -> AddingStage
EnterDescAndComment (Day
date, Text
code) AddingStage -> [AddingStage] -> [AddingStage]
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 Wizard Haskeline (Maybe (Text, Text))
-> (Maybe (Text, Text) -> Wizard Haskeline Transaction)
-> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a
-> (a -> Wizard Haskeline b) -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Text
desc, Text
comment) -> do
      let mbaset :: Maybe Transaction
mbaset = CliOpts -> Journal -> Text -> Maybe Transaction
journalSimilarTransaction CliOpts
esOpts Journal
esJournal Text
desc
          es' :: EntryState
es' = EntryState
es
            { esArgs = drop 1 esArgs
            , esPostings = []
            , esSimilarTransaction = mbaset
            }
          descAndCommentString :: String
descAndCommentString = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Text -> Bool
T.null Text
comment then Text
"" else Text
"  ; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
comment)
          prevInput' :: PrevInput
prevInput' = PrevInput
prevInput{prevDescAndCmnt=Just descAndCommentString}
      Bool -> Wizard Haskeline () -> Wizard Haskeline ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Transaction -> Bool
forall a. Maybe a -> Bool
isJust Maybe Transaction
mbaset) (Wizard Haskeline () -> Wizard Haskeline ())
-> (IO () -> Wizard Haskeline ()) -> IO () -> Wizard Haskeline ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> Wizard Haskeline ()
forall a. IO a -> Wizard Haskeline a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Wizard Haskeline ()) -> IO () -> Wizard Haskeline ()
forall a b. (a -> b) -> a -> b
$ do
          Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Using this similar transaction for defaults:"
          Handle -> Text -> IO ()
T.hPutStr Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction (Maybe Transaction -> Transaction
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Transaction
mbaset)
      PrevInput
-> 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} 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
txnDate :: TxnParams -> Day
txnCode :: TxnParams -> Text
txnDesc :: TxnParams -> Text
txnCmnt :: TxnParams -> Text
txnDate :: Day
txnCode :: Text
txnDesc :: Text
txnCmnt :: Text
..} 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 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=txnDate
                             ,tstatus=Unmarked
                             ,tcode=txnCode
                             ,tdescription=txnDesc
                             ,tcomment=txnCmnt
                             ,tpostings=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' AddingStage -> [AddingStage] -> [AddingStage]
forall a. a -> [a] -> [a]
: [AddingStage]
stack)
        Left String
err -> do
          IO () -> Wizard Haskeline ()
forall a. IO a -> Wizard Haskeline a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
capitalize String
err) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"please re-enter.")
          let notFirstEnterPost :: 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=[]} ((AddingStage -> Bool) -> [AddingStage] -> [AddingStage]
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 Wizard Haskeline (Maybe String)
-> (Maybe String -> Wizard Haskeline Transaction)
-> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a
-> (a -> Wizard Haskeline b) -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just String
account
      | String
account String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".", String
""] ->
          case ([Posting]
esPostings, [Posting] -> Bool
postingsBalanced [Posting]
esPostings) of
            ([],Bool
_)    -> IO () -> Wizard Haskeline ()
forall a. IO a -> Wizard Haskeline a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Please enter some postings first.") Wizard Haskeline ()
-> Wizard Haskeline Transaction -> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a -> Wizard Haskeline b -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput EntryState
es [AddingStage]
stack
            ([Posting]
_,Bool
False) -> IO () -> Wizard Haskeline ()
forall a. IO a -> Wizard Haskeline a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Please enter more postings to balance the transaction.") Wizard Haskeline ()
-> Wizard Haskeline Transaction -> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a -> Wizard Haskeline b -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrevInput
-> 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' :: [String]
prevAccount' = Int -> String -> [String] -> [String]
forall {a}. Int -> a -> [a] -> [a]
replaceNthOrAppend ([Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
esPostings) String
account (PrevInput -> [String]
prevAccount PrevInput
prevInput)
          PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput{prevAccount=prevAccount'} EntryState
es{esArgs=drop 1 esArgs} (TxnParams -> String -> AddingStage
EnterAmountAndComment TxnParams
txnParams String
account AddingStage -> [AddingStage] -> [AddingStage]
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=init esPostings} ((AddingStage -> Bool) -> [AddingStage] -> [AddingStage]
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 Wizard Haskeline (Maybe (Amount, Text))
-> (Maybe (Amount, Text) -> Wizard Haskeline Transaction)
-> Wizard Haskeline Transaction
forall a b.
Wizard Haskeline a
-> (a -> Wizard Haskeline b) -> Wizard Haskeline b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Amount
amt, Text
comment) -> do
      let p :: Posting
p = Posting
nullposting{paccount=T.pack $ stripbrackets account
                          ,pamount=mixedAmount amt
                          ,pcomment=comment
                          ,ptype=accountNamePostingType $ T.pack account
                          }
          amountAndCommentString :: String
amountAndCommentString = Amount -> String
showAmount Amount
amt String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (if Text -> Bool
T.null Text
comment then Text
"" else Text
"  ;" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
comment)
          prevAmountAndCmnt' :: [String]
prevAmountAndCmnt' = Int -> String -> [String] -> [String]
forall {a}. Int -> a -> [a] -> [a]
replaceNthOrAppend ([Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
esPostings) String
amountAndCommentString (PrevInput -> [String]
prevAmountAndCmnt PrevInput
prevInput)
          es' :: EntryState
es' = EntryState
es{esPostings=esPostings++[p], esArgs=drop 2 esArgs}
      PrevInput
-> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard PrevInput
prevInput{prevAmountAndCmnt=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
    String -> Wizard Haskeline ()
forall (b :: * -> *). (Output :<: b) => String -> Wizard b ()
output (String -> Wizard Haskeline ())
-> (Text -> String) -> Text -> Wizard Haskeline ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Wizard Haskeline ()) -> Text -> Wizard Haskeline ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
t
    Maybe Char
y <- let def :: String
def = String
"y" in
         String
-> Wizard Haskeline (Maybe Char) -> Wizard Haskeline (Maybe Char)
forall (b :: * -> *) a.
(OutputLn :<: b) =>
String -> Wizard b a -> Wizard b a
retryMsg String
"Please enter y or n." (Wizard Haskeline (Maybe Char) -> Wizard Haskeline (Maybe Char))
-> Wizard Haskeline (Maybe Char) -> Wizard Haskeline (Maybe Char)
forall a b. (a -> b) -> a -> b
$
          (String -> Maybe (Maybe Char))
-> Wizard Haskeline String -> Wizard Haskeline (Maybe Char)
forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser (((Char -> Maybe Char) -> Maybe Char -> Maybe (Maybe Char)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<' then Maybe Char
forall a. Maybe a
Nothing else Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c)) (Maybe Char -> Maybe (Maybe Char))
-> (String -> Maybe Char) -> String -> Maybe (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Char
forall a. [a] -> Maybe a
headMay (String -> Maybe Char)
-> (String -> String) -> String -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strip) (Wizard Haskeline String -> Wizard Haskeline (Maybe Char))
-> Wizard Haskeline String -> Wizard Haskeline (Maybe Char)
forall a b. (a -> b) -> a -> b
$
          String -> Wizard Haskeline String -> Wizard Haskeline String
forall {b}. b -> Wizard Haskeline b -> Wizard Haskeline b
defaultTo' String
def (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$ Wizard Haskeline String -> Wizard Haskeline String
forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
nonEmpty (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
          String -> Wizard Haskeline String
forall (b :: * -> *). (Line :<: b) => String -> Wizard b String
line (String -> Wizard Haskeline String)
-> String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$ String -> String
green' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Save this transaction to the journal ?%s: " (String -> String
showDefault String
def)
    case Maybe Char
y of
      Just Char
'y' -> Transaction -> Wizard Haskeline Transaction
forall a. a -> Wizard Haskeline a
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
      Just Char
_   -> RestartTransactionException -> Wizard Haskeline Transaction
forall a e. 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 (EFDay, Text))
dateAndCodeWizard PrevInput{[String]
Maybe String
prevDateAndCode :: PrevInput -> Maybe String
prevDescAndCmnt :: PrevInput -> Maybe String
prevAccount :: PrevInput -> [String]
prevAmountAndCmnt :: PrevInput -> [String]
prevDateAndCode :: Maybe String
prevDescAndCmnt :: Maybe String
prevAccount :: [String]
prevAmountAndCmnt :: [String]
..} EntryState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esOpts :: EntryState -> CliOpts
esArgs :: EntryState -> [String]
esToday :: EntryState -> Day
esDefDate :: EntryState -> Day
esJournal :: EntryState -> Journal
esSimilarTransaction :: EntryState -> Maybe Transaction
esPostings :: EntryState -> [Posting]
esOpts :: CliOpts
esArgs :: [String]
esToday :: Day
esDefDate :: Day
esJournal :: Journal
esSimilarTransaction :: Maybe Transaction
esPostings :: [Posting]
..} = do
  let def :: String
def = String -> [String] -> String
forall a. a -> [a] -> a
headDef (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Day -> Text
showDate Day
esDefDate) [String]
esArgs
  String
-> Wizard Haskeline (Maybe (EFDay, Text))
-> Wizard Haskeline (Maybe (EFDay, Text))
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." (Wizard Haskeline (Maybe (EFDay, Text))
 -> Wizard Haskeline (Maybe (EFDay, Text)))
-> Wizard Haskeline (Maybe (EFDay, Text))
-> Wizard Haskeline (Maybe (EFDay, Text))
forall a b. (a -> b) -> a -> b
$
   (String -> Maybe (Maybe (EFDay, Text)))
-> Wizard Haskeline String
-> Wizard Haskeline (Maybe (EFDay, Text))
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) (Wizard Haskeline String -> Wizard Haskeline (Maybe (EFDay, Text)))
-> Wizard Haskeline String
-> Wizard Haskeline (Maybe (EFDay, Text))
forall a b. (a -> b) -> a -> b
$
   CompletionFunc IO
-> Wizard Haskeline String -> Wizard Haskeline String
forall {b :: * -> *} {a}.
(WithSettings :<: b) =>
CompletionFunc IO -> Wizard b a -> Wizard b a
withCompletion (String -> CompletionFunc IO
dateCompleter String
def) (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
   String -> Wizard Haskeline String -> Wizard Haskeline String
forall {b}. b -> Wizard Haskeline b -> Wizard Haskeline b
defaultTo' String
def (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$ Wizard Haskeline String -> Wizard Haskeline String
forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
nonEmpty (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
   Wizard Haskeline String -> Wizard Haskeline String
maybeExit (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
   -- maybeShowHelp $
   String -> String -> String -> Wizard Haskeline String
forall (b :: * -> *).
(LinePrewritten :<: b) =>
String -> String -> String -> Wizard b String
linePrewritten (String -> String
green' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Date%s: " (String -> String
showDefault String
def)) (String -> Maybe String -> String
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"<" then Maybe (EFDay, Text) -> Maybe (Maybe (EFDay, Text))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EFDay, Text)
forall a. Maybe a
Nothing else (ParseErrorBundle Text HledgerParseErrorData
 -> Maybe (Maybe (EFDay, Text)))
-> ((SmartDate, Text) -> Maybe (Maybe (EFDay, Text)))
-> Either
     (ParseErrorBundle Text HledgerParseErrorData) (SmartDate, Text)
-> Maybe (Maybe (EFDay, Text))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Maybe (EFDay, Text))
-> ParseErrorBundle Text HledgerParseErrorData
-> Maybe (Maybe (EFDay, Text))
forall a b. a -> b -> a
const Maybe (Maybe (EFDay, Text))
forall a. Maybe a
Nothing) (\(SmartDate
d,Text
c) -> Maybe (EFDay, Text) -> Maybe (Maybe (EFDay, Text))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EFDay, Text) -> Maybe (Maybe (EFDay, Text)))
-> Maybe (EFDay, Text) -> Maybe (Maybe (EFDay, Text))
forall a b. (a -> b) -> a -> b
$ (EFDay, Text) -> Maybe (EFDay, Text)
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 = Parsec HledgerParseErrorData Text (SmartDate, Text)
-> String
-> Text
-> Either
     (ParseErrorBundle Text HledgerParseErrorData) (SmartDate, Text)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec HledgerParseErrorData Text (SmartDate, Text)
dateandcodep Parsec HledgerParseErrorData Text (SmartDate, Text)
-> ParsecT HledgerParseErrorData Text Identity ()
-> Parsec HledgerParseErrorData Text (SmartDate, Text)
forall a b.
ParsecT HledgerParseErrorData Text Identity a
-> ParsecT HledgerParseErrorData Text Identity b
-> ParsecT HledgerParseErrorData Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT HledgerParseErrorData Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" (Text
 -> Either
      (ParseErrorBundle Text HledgerParseErrorData) (SmartDate, Text))
-> Text
-> Either
     (ParseErrorBundle Text HledgerParseErrorData) (SmartDate, Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
lowercase String
s
            dateandcodep :: SimpleTextParser (SmartDate, Text)
            dateandcodep :: Parsec HledgerParseErrorData Text (SmartDate, Text)
dateandcodep = do
                SmartDate
d <- TextParser Identity SmartDate
forall (m :: * -> *). TextParser m SmartDate
smartdate
                Maybe Text
c <- ParsecT HledgerParseErrorData Text Identity Text
-> ParsecT HledgerParseErrorData Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT HledgerParseErrorData Text Identity Text
forall (m :: * -> *). TextParser m Text
codep
                ParsecT HledgerParseErrorData Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
                ParsecT HledgerParseErrorData Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
                (SmartDate, Text)
-> Parsec HledgerParseErrorData Text (SmartDate, Text)
forall a. a -> ParsecT HledgerParseErrorData Text Identity a
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{[String]
Maybe String
prevDateAndCode :: PrevInput -> Maybe String
prevDescAndCmnt :: PrevInput -> Maybe String
prevAccount :: PrevInput -> [String]
prevAmountAndCmnt :: PrevInput -> [String]
prevDateAndCode :: Maybe String
prevDescAndCmnt :: Maybe String
prevAccount :: [String]
prevAmountAndCmnt :: [String]
..} EntryState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esOpts :: EntryState -> CliOpts
esArgs :: EntryState -> [String]
esToday :: EntryState -> Day
esDefDate :: EntryState -> Day
esJournal :: EntryState -> Journal
esSimilarTransaction :: EntryState -> Maybe Transaction
esPostings :: EntryState -> [Posting]
esOpts :: CliOpts
esArgs :: [String]
esToday :: Day
esDefDate :: Day
esJournal :: Journal
esSimilarTransaction :: Maybe Transaction
esPostings :: [Posting]
..} = do
  let def :: String
def = String -> [String] -> String
forall a. a -> [a] -> a
headDef String
"" [String]
esArgs
  String
s <- CompletionFunc IO
-> Wizard Haskeline String -> Wizard Haskeline String
forall {b :: * -> *} {a}.
(WithSettings :<: b) =>
CompletionFunc IO -> Wizard b a -> Wizard b a
withCompletion (Journal -> String -> CompletionFunc IO
descriptionCompleter Journal
esJournal String
def) (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
       String -> Wizard Haskeline String -> Wizard Haskeline String
forall {b}. b -> Wizard Haskeline b -> Wizard Haskeline b
defaultTo' String
def (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$ Wizard Haskeline String -> Wizard Haskeline String
forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
nonEmpty (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
       String -> String -> String -> Wizard Haskeline String
forall (b :: * -> *).
(LinePrewritten :<: b) =>
String -> String -> String -> Wizard b String
linePrewritten (String -> String
green' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Description%s: " (String -> String
showDefault String
def)) (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
prevDescAndCmnt) String
""
  if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"<"
    then Maybe (Text, Text) -> Wizard Haskeline (Maybe (Text, Text))
forall a. a -> Wizard Haskeline a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, Text)
forall a. Maybe a
Nothing
    else do
      let (Text
desc,Text
comment) = (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
strip String
a, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
strip (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';') String
b) where (String
a,String
b) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';') String
s
      Maybe (Text, Text) -> Wizard Haskeline (Maybe (Text, Text))
forall a. a -> Wizard Haskeline a
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 String Transaction -> Bool
forall a b. Either a b -> Bool
isRight (Either String Transaction -> Bool)
-> Either String Transaction -> Bool
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Transaction -> Either String Transaction
balanceTransaction BalancingOpts
defbalancingopts Transaction
nulltransaction{tpostings=ps}

accountWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe String)
accountWizard PrevInput{[String]
Maybe String
prevDateAndCode :: PrevInput -> Maybe String
prevDescAndCmnt :: PrevInput -> Maybe String
prevAccount :: PrevInput -> [String]
prevAmountAndCmnt :: PrevInput -> [String]
prevDateAndCode :: Maybe String
prevDescAndCmnt :: Maybe String
prevAccount :: [String]
prevAmountAndCmnt :: [String]
..} EntryState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esOpts :: EntryState -> CliOpts
esArgs :: EntryState -> [String]
esToday :: EntryState -> Day
esDefDate :: EntryState -> Day
esJournal :: EntryState -> Journal
esSimilarTransaction :: EntryState -> Maybe Transaction
esPostings :: EntryState -> [Posting]
esOpts :: CliOpts
esArgs :: [String]
esToday :: Day
esDefDate :: Day
esJournal :: Journal
esSimilarTransaction :: Maybe Transaction
esPostings :: [Posting]
..} = do
  let pnum :: Int
pnum = [Posting] -> Int
forall a. [a] -> 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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Posting] -> Int -> Posting
forall a. HasCallStack => [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 :: String
def = String -> [String] -> String
forall a. a -> [a] -> a
headDef (Text -> String
T.unpack Text
historicalacct) [String]
esArgs
      endmsg :: String
endmsg | Bool
canfinish Bool -> Bool -> Bool
&& String -> Bool
forall a. [a] -> 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
""
  String
-> Wizard Haskeline (Maybe String)
-> Wizard Haskeline (Maybe 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." (Wizard Haskeline (Maybe String)
 -> Wizard Haskeline (Maybe String))
-> Wizard Haskeline (Maybe String)
-> Wizard Haskeline (Maybe String)
forall a b. (a -> b) -> a -> b
$
   (String -> Maybe (Maybe String))
-> Wizard Haskeline String -> Wizard Haskeline (Maybe String)
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) (Wizard Haskeline String -> Wizard Haskeline (Maybe String))
-> Wizard Haskeline String -> Wizard Haskeline (Maybe String)
forall a b. (a -> b) -> a -> b
$
   CompletionFunc IO
-> Wizard Haskeline String -> Wizard Haskeline String
forall {b :: * -> *} {a}.
(WithSettings :<: b) =>
CompletionFunc IO -> Wizard b a -> Wizard b a
withCompletion (Journal -> String -> CompletionFunc IO
accountCompleter Journal
esJournal String
def) (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
   String -> Wizard Haskeline String -> Wizard Haskeline String
forall {b}. b -> Wizard Haskeline b -> Wizard Haskeline b
defaultTo' String
def (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$ -- nonEmpty $
   String -> String -> String -> Wizard Haskeline String
forall (b :: * -> *).
(LinePrewritten :<: b) =>
String -> String -> String -> Wizard b String
linePrewritten (String -> String
green' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> Int -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Account %d%s%s: " Int
pnum (String
endmsg::String) (String -> String
showDefault String
def)) (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [String]
prevAccount [String] -> Int -> Maybe String
forall a. [a] -> Int -> Maybe a
`atMay` [Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
esPostings) String
""
    where
      canfinish :: Bool
canfinish = Bool -> Bool
not ([Posting] -> Bool
forall a. [a] -> 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 :: String -> Bool -> String -> Maybe (Maybe String)
parseAccountOrDotOrNull String
_  Bool
_ String
"<"       = Maybe (Maybe String) -> Maybe (Maybe String)
forall {a}. a -> a
dbg' (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe String -> Maybe (Maybe String)
forall a. a -> Maybe a
Just Maybe String
forall a. Maybe a
Nothing
      parseAccountOrDotOrNull String
_  Bool
_ String
"."       = Maybe (Maybe String) -> Maybe (Maybe String)
forall {a}. a -> a
dbg' (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe String -> Maybe (Maybe String)
forall a. a -> Maybe a
Just (Maybe String -> Maybe (Maybe String))
-> Maybe String -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
"." -- . always signals end of txn
      parseAccountOrDotOrNull String
"" Bool
True String
""     = Maybe (Maybe String) -> Maybe (Maybe String)
forall {a}. a -> a
dbg' (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe String -> Maybe (Maybe String)
forall a. a -> Maybe a
Just (Maybe String -> Maybe (Maybe String))
-> Maybe String -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
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
"" = Maybe (Maybe String) -> Maybe (Maybe String)
forall {a}. a -> a
dbg' (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe String -> Maybe (Maybe String)
forall a. a -> Maybe a
Just (Maybe String -> Maybe (Maybe String))
-> Maybe String -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
def -- when there's a default, "" means use that
      parseAccountOrDotOrNull String
_ Bool
_ String
s          = Maybe (Maybe String) -> Maybe (Maybe String)
forall {a}. a -> a
dbg' (Maybe (Maybe String) -> Maybe (Maybe String))
-> Maybe (Maybe String) -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe String) -> Maybe Text -> Maybe (Maybe String)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Text -> String) -> Text -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (Maybe Text -> Maybe (Maybe String))
-> Maybe Text -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$
        (ParseErrorBundle Text HledgerParseErrorData -> Maybe Text)
-> (Text -> Maybe Text)
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text
-> ParseErrorBundle Text HledgerParseErrorData -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Text -> Maybe Text
validateAccount (Either (ParseErrorBundle Text HledgerParseErrorData) Text
 -> Maybe Text)
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
-> Maybe Text
forall a b. (a -> b) -> a -> b
$
          (State
   Journal (Either (ParseErrorBundle Text HledgerParseErrorData) Text)
 -> Journal
 -> Either (ParseErrorBundle Text HledgerParseErrorData) Text)
-> Journal
-> State
     Journal (Either (ParseErrorBundle Text HledgerParseErrorData) Text)
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip State
  Journal (Either (ParseErrorBundle Text HledgerParseErrorData) Text)
-> Journal
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
forall s a. State s a -> s -> a
evalState Journal
esJournal (State
   Journal (Either (ParseErrorBundle Text HledgerParseErrorData) Text)
 -> Either (ParseErrorBundle Text HledgerParseErrorData) Text)
-> State
     Journal (Either (ParseErrorBundle Text HledgerParseErrorData) Text)
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text (StateT Journal Identity) Text
-> String
-> Text
-> State
     Journal (Either (ParseErrorBundle Text HledgerParseErrorData) Text)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (ParsecT HledgerParseErrorData Text (StateT Journal Identity) Text
forall (m :: * -> *). TextParser m Text
accountnamep ParsecT HledgerParseErrorData Text (StateT Journal Identity) Text
-> ParsecT HledgerParseErrorData Text (StateT Journal Identity) ()
-> ParsecT
     HledgerParseErrorData Text (StateT Journal Identity) Text
forall a b.
ParsecT HledgerParseErrorData Text (StateT Journal Identity) a
-> ParsecT HledgerParseErrorData Text (StateT Journal Identity) b
-> ParsecT HledgerParseErrorData Text (StateT Journal Identity) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT HledgerParseErrorData Text (StateT Journal Identity) ()
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
&& 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
      dbg' :: a -> a
dbg' = a -> a
forall {a}. a -> a
id -- strace

amountAndCommentWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe (Amount, Text))
amountAndCommentWizard PrevInput{[String]
Maybe String
prevDateAndCode :: PrevInput -> Maybe String
prevDescAndCmnt :: PrevInput -> Maybe String
prevAccount :: PrevInput -> [String]
prevAmountAndCmnt :: PrevInput -> [String]
prevDateAndCode :: Maybe String
prevDescAndCmnt :: Maybe String
prevAccount :: [String]
prevAmountAndCmnt :: [String]
..} EntryState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
esOpts :: EntryState -> CliOpts
esArgs :: EntryState -> [String]
esToday :: EntryState -> Day
esDefDate :: EntryState -> Day
esJournal :: EntryState -> Journal
esSimilarTransaction :: EntryState -> Maybe Transaction
esPostings :: EntryState -> [Posting]
esOpts :: CliOpts
esArgs :: [String]
esToday :: Day
esDefDate :: Day
esJournal :: Journal
esSimilarTransaction :: Maybe Transaction
esPostings :: [Posting]
..} = do
  let pnum :: Int
pnum = [Posting] -> Int
forall a. [a] -> 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 a. [a] -> 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. HasCallStack => [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 :: String
def | (String
d:[String]
_) <- [String]
esArgs                                     = String
d
          | Just Posting
hp <- Maybe Posting
mhistoricalp, Bool
followedhistoricalsofar    = MixedAmount -> String
showamt (MixedAmount -> String) -> MixedAmount -> String
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 -> String
showamt MixedAmount
balancingamtfirstcommodity
          | Bool
otherwise                                           = String
""
  String
-> Wizard Haskeline (Maybe (Amount, Text))
-> Wizard Haskeline (Maybe (Amount, Text))
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\"." (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
$
   (String -> Maybe (Maybe (Amount, Text)))
-> Wizard Haskeline String
-> Wizard Haskeline (Maybe (Amount, Text))
forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser String -> Maybe (Maybe (Amount, Text))
parseAmountAndComment (Wizard Haskeline String
 -> Wizard Haskeline (Maybe (Amount, Text)))
-> Wizard Haskeline String
-> Wizard Haskeline (Maybe (Amount, Text))
forall a b. (a -> b) -> a -> b
$
   CompletionFunc IO
-> Wizard Haskeline String -> Wizard Haskeline String
forall {b :: * -> *} {a}.
(WithSettings :<: b) =>
CompletionFunc IO -> Wizard b a -> Wizard b a
withCompletion (String -> CompletionFunc IO
amountCompleter String
def) (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
   String -> Wizard Haskeline String -> Wizard Haskeline String
forall {b}. b -> Wizard Haskeline b -> Wizard Haskeline b
defaultTo' String
def (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
   Wizard Haskeline String -> Wizard Haskeline String
forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
nonEmpty (Wizard Haskeline String -> Wizard Haskeline String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall a b. (a -> b) -> a -> b
$
   String -> String -> String -> Wizard Haskeline String
forall (b :: * -> *).
(LinePrewritten :<: b) =>
String -> String -> String -> Wizard b String
linePrewritten (String -> String
green' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"Amount  %d%s: " Int
pnum (String -> String
showDefault String
def)) (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [String]
prevAmountAndCmnt [String] -> Int -> Maybe String
forall a. [a] -> Int -> Maybe a
`atMay` [Posting] -> Int
forall a. [a] -> Int
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"<" then Maybe (Amount, Text) -> Maybe (Maybe (Amount, Text))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Amount, Text)
forall a. Maybe a
Nothing else (ParseErrorBundle Text HledgerParseErrorData
 -> Maybe (Maybe (Amount, Text)))
-> ((Amount, Text) -> Maybe (Maybe (Amount, Text)))
-> Either
     (ParseErrorBundle Text HledgerParseErrorData) (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 HledgerParseErrorData
-> 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 a. a -> Maybe a
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 HledgerParseErrorData) (Amount, Text)
 -> Maybe (Maybe (Amount, Text)))
-> Either
     (ParseErrorBundle Text HledgerParseErrorData) (Amount, Text)
-> Maybe (Maybe (Amount, Text))
forall a b. (a -> b) -> a -> b
$
                                Parsec HledgerParseErrorData Text (Amount, Text)
-> String
-> Text
-> Either
     (ParseErrorBundle Text HledgerParseErrorData) (Amount, Text)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser
                                  (StateT
  Journal
  (ParsecT HledgerParseErrorData Text Identity)
  (Amount, Text)
-> Journal -> Parsec HledgerParseErrorData Text (Amount, Text)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT
  Journal
  (ParsecT HledgerParseErrorData Text Identity)
  (Amount, Text)
amountandcommentp StateT
  Journal
  (ParsecT HledgerParseErrorData Text Identity)
  (Amount, Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text Identity)
     (Amount, Text)
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) b
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
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=Nothing}
      amountandcommentp :: JournalParser Identity (Amount, Text)
      amountandcommentp :: StateT
  Journal
  (ParsecT HledgerParseErrorData Text Identity)
  (Amount, Text)
amountandcommentp = do
        Amount
a <- JournalParser Identity Amount
forall (m :: * -> *). JournalParser m Amount
amountp
        ParsecT HledgerParseErrorData Text Identity ()
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
        Text
c <- String -> Text
T.pack (String -> Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     Journal (ParsecT HledgerParseErrorData Text Identity) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe String)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text Identity) String
forall a b.
(a -> b)
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` StateT Journal (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData 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 HledgerParseErrorData Text Identity) Char
-> StateT
     Journal (ParsecT HledgerParseErrorData Text Identity) String
-> StateT
     Journal (ParsecT HledgerParseErrorData Text Identity) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) b
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT Journal (ParsecT HledgerParseErrorData Text Identity) Char
-> StateT
     Journal (ParsecT HledgerParseErrorData Text Identity) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many StateT Journal (ParsecT HledgerParseErrorData Text Identity) Char
StateT
  Journal (ParsecT HledgerParseErrorData Text Identity) (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle)
        -- eof
        (Amount, Text)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text Identity)
     (Amount, Text)
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
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 -> String
showamt = WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
defaultFmt (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 String -> Wizard Haskeline String
maybeExit = (String -> Maybe String)
-> Wizard Haskeline String -> Wizard Haskeline String
forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser (\String
s -> if String
sString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"." then UnexpectedEOF -> Maybe String
forall a e. Exception e => e -> a
throw UnexpectedEOF
UnexpectedEOF else String -> Maybe String
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 ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
journalPayeesDeclaredOrUsed Journal
j [Text] -> [Text] -> [Text]
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 ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> [Text] -> [String]
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 = Maybe Char
-> String -> (String -> IO [Completion]) -> CompletionFunc IO
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord Maybe Char
forall a. Maybe a
Nothing String
"" String -> IO [Completion]
forall {m :: * -> *}. Monad m => String -> m [Completion]
completionsFor
    where
      simpleCompletion' :: String -> Completion
simpleCompletion' String
s = (String -> Completion
simpleCompletion String
s){isFinished=False}
      completionsFor :: String -> m [Completion]
completionsFor String
"" = [Completion] -> m [Completion]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> Completion
simpleCompletion' String
def]
      completionsFor String
i  = [Completion] -> m [Completion]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> Completion) -> [String] -> [Completion]
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 String -> String -> Bool
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' = (Wizard Haskeline b -> b -> Wizard Haskeline b)
-> b -> Wizard Haskeline b -> Wizard Haskeline b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Wizard Haskeline b -> b -> Wizard Haskeline b
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)

showDefault :: String -> String
showDefault String
"" = String
""
showDefault String
s = String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
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 (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
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"\nAdded transaction to %s:" String
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j{jtxns=ts++[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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-"  = Text -> IO ()
T.putStr Text
s'
  | Bool
otherwise = String -> String -> IO ()
appendFile String
f (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
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 a. a -> IO a
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_=True}
        rspec :: ReportSpec
rspec = ReportSpec
defreportspec{_rsReportOpts=ropts}
        opts :: CliOpts
opts = CliOpts
defcliopts{reportspec_=rspec}

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