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

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

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

import Control.Exception as E
import Control.Monad (when)
import Control.Monad.Trans.Class
import Control.Monad.State.Strict (evalState, evalStateT)
import Control.Monad.Trans (liftIO)
import Data.Char (toUpper, toLower)
import Data.Either (isRight)
import Data.Functor.Identity (Identity(..))
import Data.List (isPrefixOf, nub)
import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.IO qualified as TL
import Data.Time.Calendar (Day, toGregorian)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Lens.Micro ((^.))
import Safe (headDef, headMay, atMay, lastMay)
import System.Console.CmdArgs.Explicit (flagNone)
import System.Console.Haskeline (runInputT, defaultSettings, setComplete)
import System.Console.Haskeline.Completion (CompletionFunc, completeWord, isFinished, noCompletion, simpleCompletion)
import System.Console.Wizard (Wizard, defaultTo, line, output, outputLn, retryMsg, linePrewritten, nonEmpty, parser, run)
import System.Console.Wizard.Haskeline
import System.IO ( stderr, hPutStr, hPutStrLn )
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Printf

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


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

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

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

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

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

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

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

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

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

-- | Read multiple transactions from the console, prompting for each
-- field, and append them to the journal file.  If the journal came
-- from stdin, this command has no effect.
add :: CliOpts -> Journal -> IO ()
add :: CliOpts -> Journal -> IO ()
add CliOpts
opts Journal
j
    | Journal -> String
journalFilePath Journal
j String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Adding transactions to journal file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Journal -> String
journalFilePath Journal
j
        IO ()
showHelp
        let today :: Day
today = CliOpts
optsCliOpts -> Getting Day CliOpts Day -> Day
forall s a. s -> Getting a s a -> a
^.Getting Day CliOpts Day
forall c. HasReportSpec c => Lens' c Day
Lens' CliOpts Day
rsDay
            state :: AddState
state = AddState
defAddState{asOpts=opts
                              ,asArgs=listofstringopt "args" $ rawopts_ opts
                              ,asToday=today
                              ,asDefDate=today
                              ,asJournal=j
                              }
        AddState -> IO ()
addTransactionsLoop AddState
state IO () -> (UnexpectedEOF -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(UnexpectedEOF
_::UnexpectedEOF) -> String -> IO ()
putStr String
"")

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

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

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

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

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

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

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

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

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

-- | Interact with the user to get a transaction date (accepting smart dates), maybe followed by a " (CODE)". 
-- Returns the date and the code, or nothing if the input was "<".
dateWizard :: PrevInput -> AddState -> Wizard Haskeline (Maybe (EFDay, Text))
dateWizard :: PrevInput -> AddState -> Wizard Haskeline (Maybe (EFDay, Text))
dateWizard 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]
..} AddState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
asOpts :: AddState -> CliOpts
asArgs :: AddState -> [String]
asToday :: AddState -> Day
asDefDate :: AddState -> Day
asJournal :: AddState -> Journal
asSimilarTransaction :: AddState -> Maybe Transaction
asPostings :: AddState -> [Posting]
asOpts :: CliOpts
asArgs :: [String]
asToday :: Day
asDefDate :: Day
asJournal :: Journal
asSimilarTransaction :: Maybe Transaction
asPostings :: [Posting]
..} = do
  let 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
asDefDate) [String]
asArgs
  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
asToday) (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
                d <- TextParser Identity SmartDate
forall (m :: * -> *). TextParser m SmartDate
smartdate
                c <- optional codep
                skipNonNewlineSpaces
                eof
                return (d, fromMaybe "" c)
      -- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate
      -- datestr = showDate $ fixSmartDate defday smtdate

-- | Interact with the user to get a transaction description, maybe followed by a "; COMMENT".
-- Returns the possibly empty description and comment, or nothing if the input is "<".
descriptionWizard :: PrevInput -> AddState -> Wizard Haskeline (Maybe (Text, Text))
descriptionWizard :: PrevInput -> AddState -> Wizard Haskeline (Maybe (Text, Text))
descriptionWizard 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]
..} AddState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
asOpts :: AddState -> CliOpts
asArgs :: AddState -> [String]
asToday :: AddState -> Day
asDefDate :: AddState -> Day
asJournal :: AddState -> Journal
asSimilarTransaction :: AddState -> Maybe Transaction
asPostings :: AddState -> [Posting]
asOpts :: CliOpts
asArgs :: [String]
asToday :: Day
asDefDate :: Day
asJournal :: Journal
asSimilarTransaction :: Maybe Transaction
asPostings :: [Posting]
..} = do
  let def :: String
def = String -> [String] -> String
forall a. a -> [a] -> a
headDef String
"" [String]
asArgs
  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
asJournal 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 s == "<"
    then return Nothing
    else do
      let (desc,comment) = (T.pack $ strip a, T.pack $ strip $ dropWhile (==';') b) where (a,b) = break (==';') s
      return $ Just (desc, comment)

-- | Interact with the user to get an account name, possibly enclosed in "()" or "[]".
-- Returns the account name, or nothing if the input is "<".
accountWizard :: PrevInput -> AddState -> Wizard Haskeline (Maybe String)
accountWizard :: PrevInput -> AddState -> 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]
..} AddState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
asOpts :: AddState -> CliOpts
asArgs :: AddState -> [String]
asToday :: AddState -> Day
asDefDate :: AddState -> Day
asJournal :: AddState -> Journal
asSimilarTransaction :: AddState -> Maybe Transaction
asPostings :: AddState -> [Posting]
asOpts :: CliOpts
asArgs :: [String]
asToday :: Day
asDefDate :: Day
asJournal :: Journal
asSimilarTransaction :: Maybe Transaction
asPostings :: [Posting]
..} = do
  let pnum :: Int
pnum = [Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
asPostings 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
asSimilarTransaction
      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]
asArgs
      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
asJournal 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]
asPostings) String
""
    where
      canfinish :: Bool
canfinish = Bool -> Bool
not ([Posting] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Posting]
asPostings) Bool -> Bool -> Bool
&& [Posting] -> Bool
postingsAreBalanced [Posting]
asPostings
      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
asJournal (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
asOpts Bool -> Bool -> Bool
&& Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Text
t (Journal -> [Text]
journalAccountNamesDeclaredOrImplied Journal
asJournal) = 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

-- | Interact with the user to get an amount and/or a balance assertion, maybe followed by a "; COMMENT".
-- Returns the amount, balance assertion, and/or comment, or nothing if the input is "<".
amountWizard :: PrevInput -> AddState -> Wizard Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
amountWizard :: PrevInput
-> AddState
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
amountWizard previnput :: PrevInput
previnput@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]
..} state :: AddState
state@AddState{[String]
[Posting]
Maybe Transaction
Journal
Day
CliOpts
asOpts :: AddState -> CliOpts
asArgs :: AddState -> [String]
asToday :: AddState -> Day
asDefDate :: AddState -> Day
asJournal :: AddState -> Journal
asSimilarTransaction :: AddState -> Maybe Transaction
asPostings :: AddState -> [Posting]
asOpts :: CliOpts
asArgs :: [String]
asToday :: Day
asDefDate :: Day
asJournal :: Journal
asSimilarTransaction :: Maybe Transaction
asPostings :: [Posting]
..} = do
  let pnum :: Int
pnum = [Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
asPostings Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      (Maybe Posting
mhistoricalp,Bool
followedhistoricalsofar) =
          case Maybe Transaction
asSimilarTransaction 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]
asPostings [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]
asArgs                                     = 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 (Maybe Amount, Maybe BalanceAssertion, Comment))
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
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 (Maybe Amount, Maybe BalanceAssertion, Comment))
 -> Wizard
      Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)))
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
forall a b. (a -> b) -> a -> b
$ 
   (String
 -> Either
      (ParseErrorBundle Text HledgerParseErrorData)
      (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)))
-> Wizard Haskeline String
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
forall {t}.
(t
 -> Either
      (ParseErrorBundle Text HledgerParseErrorData)
      (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)))
-> Wizard Haskeline t
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
parser' String
-> Either
     (ParseErrorBundle Text HledgerParseErrorData)
     (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
parseAmountAndComment (Wizard Haskeline String
 -> Wizard
      Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)))
-> Wizard Haskeline String
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
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]
asPostings) String
""
    where
      -- Custom parser that combines with Wizard to use IO via outputLn
      parser' :: (t
 -> Either
      (ParseErrorBundle Text HledgerParseErrorData)
      (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)))
-> Wizard Haskeline t
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
parser' t
-> Either
     (ParseErrorBundle Text HledgerParseErrorData)
     (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
f Wizard Haskeline t
a = Wizard Haskeline t
a Wizard Haskeline t
-> (t
    -> Wizard
         Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)))
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
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
>>= \t
input ->
        case t
-> Either
     (ParseErrorBundle Text HledgerParseErrorData)
     (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
f t
input of
          Left ParseErrorBundle Text HledgerParseErrorData
err -> do
            String -> Wizard Haskeline ()
forall (b :: * -> *). (OutputLn :<: b) => String -> Wizard b ()
outputLn (ParseErrorBundle Text HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle Text HledgerParseErrorData
err)
            PrevInput
-> AddState
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
amountWizard PrevInput
previnput AddState
state
          Right Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)
res -> Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)
-> Wizard
     Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
forall a. a -> Wizard Haskeline a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)
res
      parseAmountAndComment :: String
-> Either
     (ParseErrorBundle Text HledgerParseErrorData)
     (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
parseAmountAndComment String
s = 
        if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"<" then Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)
-> Either
     (ParseErrorBundle Text HledgerParseErrorData)
     (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
forall a b. b -> Either a b
Right Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)
forall a. Maybe a
Nothing else 
         (Maybe Amount, Maybe BalanceAssertion, Comment)
-> Maybe (Maybe Amount, Maybe BalanceAssertion, Comment)
forall a. a -> Maybe a
Just ((Maybe Amount, Maybe BalanceAssertion, Comment)
 -> Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
-> Either
     (ParseErrorBundle Text HledgerParseErrorData)
     (Maybe Amount, Maybe BalanceAssertion, Comment)
-> Either
     (ParseErrorBundle Text HledgerParseErrorData)
     (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec
  HledgerParseErrorData
  Text
  (Maybe Amount, Maybe BalanceAssertion, Comment)
-> String
-> Text
-> Either
     (ParseErrorBundle Text HledgerParseErrorData)
     (Maybe Amount, Maybe BalanceAssertion, Comment)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser 
            (StateT
  Journal
  (ParsecT HledgerParseErrorData Text Identity)
  (Maybe Amount, Maybe BalanceAssertion, Comment)
-> Journal
-> Parsec
     HledgerParseErrorData
     Text
     (Maybe Amount, Maybe BalanceAssertion, Comment)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT
  Journal
  (ParsecT HledgerParseErrorData Text Identity)
  (Maybe Amount, Maybe BalanceAssertion, Comment)
amountandcommentp StateT
  Journal
  (ParsecT HledgerParseErrorData Text Identity)
  (Maybe Amount, Maybe BalanceAssertion, Comment)
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe Amount, Maybe BalanceAssertion, Comment)
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
asJournal{jparsedefaultcommodity=Nothing}
      amountandcommentp :: JournalParser Identity (Maybe Amount, Maybe BalanceAssertion, Comment)
      amountandcommentp :: StateT
  Journal
  (ParsecT HledgerParseErrorData Text Identity)
  (Maybe Amount, Maybe BalanceAssertion, Comment)
amountandcommentp = do
        mamt <- StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe Amount)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
forall (m :: * -> *). JournalParser m Amount
amountp
        lift skipNonNewlineSpaces
        massertion <- optional balanceassertionp
        com <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle)
        case rtp (postingcommentp (let (y,_,_) = toGregorian asDefDate in Just y)) (T.cons ';' com) of
          Left ParseErrorBundle Text HledgerParseErrorData
err -> String
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe Amount, Maybe BalanceAssertion, Comment)
forall a.
String
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text Identity)
      (Maybe Amount, Maybe BalanceAssertion, Comment))
-> String
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe Amount, Maybe BalanceAssertion, Comment)
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text HledgerParseErrorData -> String
customErrorBundlePretty ParseErrorBundle Text HledgerParseErrorData
err
          -- Keep our original comment string from the user to add to the journal
          Right (Text
_, [(Text, Text)]
tags, Maybe Day
date1', Maybe Day
date2') -> (Maybe Amount, Maybe BalanceAssertion, Comment)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe Amount, Maybe BalanceAssertion, Comment)
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Amount, Maybe BalanceAssertion, Comment)
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text Identity)
      (Maybe Amount, Maybe BalanceAssertion, Comment))
-> (Maybe Amount, Maybe BalanceAssertion, Comment)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text Identity)
     (Maybe Amount, Maybe BalanceAssertion, Comment)
forall a b. (a -> b) -> a -> b
$ (Maybe Amount
mamt, Maybe BalanceAssertion
massertion, (Text
com, [(Text, Text)]
tags, Maybe Day
date1', Maybe Day
date2'))
      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]
asPostings
      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 asJournal) "" amt
  --     awithoutjps = fromparse $ runParser (amountp <|> return missingamt) mempty              "" amt
  --     defamtaccepted = Just (showAmount a) == mdefamt
  --     as2 = if defamtaccepted then as1 else as1{asHistoricalPostings=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)

-- 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

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
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"." then UnexpectedEOF -> Maybe String
forall a e. (HasCallStack, 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

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
"]"

-- | Balance and check a transaction with awareness of the whole journal it will be added to.
-- This means add it to the journal, balance it, calculate any balance assignments in it,
-- then maybe check all the journal's balance assertions,
-- then return the now fully balanced and checked transaction, or an error message.
balanceTransactionInJournal :: Transaction -> Journal -> BalancingOpts -> Either String Transaction
balanceTransactionInJournal :: Transaction
-> Journal -> BalancingOpts -> Either String Transaction
balanceTransactionInJournal Transaction
t Journal
j BalancingOpts
bopts = do
  -- Add the transaction at the end of the journal, as the add command will.
  let j' :: Journal
j' = Journal
j{jtxns = jtxns j ++ [t]}
  -- Try to balance and check the whole journal, and specifically the new transaction.
  Journal{jtxns=ts} <- BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
bopts Journal
j'
  -- Extract the balanced & checked transaction.
  maybe
    (Left "balanceTransactionInJournal: unexpected empty journal") -- should not happen
    Right
    (lastMay ts)

postingsAreBalanced :: [Posting] -> Bool
postingsAreBalanced :: [Posting] -> Bool
postingsAreBalanced [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
balanceSingleTransaction BalancingOpts
defbalancingopts Transaction
nulltransaction{tpostings = ps}

-- | 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 = do
      String -> IO ()
ensureJournalFileExists String
f
      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
  j <- Text -> IO Journal
readJournal'' Text
s
  return . postingsReportAsText opts $ postingsReport rspec 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