slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Show the previous input in the input area after the back command

Browse Source
This commit is contained in:
Gaith Hallak 2019-12-18 19:53:45 +03:00
parent 6f26eef832
commit ee18227a12
1 changed files with 54 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
hledger/Hledger/Cli/Commands/Add.hs
View File

@ -30,8 +30,9 @@ import Data.Maybe
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Safe (headDef, headMay) import Safe (headDef, headMay, atMay)
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
import System.Console.Haskeline (runInputT, defaultSettings, setComplete) import System.Console.Haskeline (runInputT, defaultSettings, setComplete)
import System.Console.Haskeline.Completion import System.Console.Haskeline.Completion
@ -116,7 +117,8 @@ showHelp = hPutStr stderr $ unlines [
-- most similar recent transaction in the journal. -- most similar recent transaction in the journal.
getAndAddTransactions :: EntryState -> IO () getAndAddTransactions :: EntryState -> IO ()
getAndAddTransactions es@EntryState{..} = (do getAndAddTransactions es@EntryState{..} = (do
mt <- runInputT (setComplete noCompletion defaultSettings) (System.Console.Wizard.run $ haskeline $ confirmedTransactionWizard es []) let defaultPrevInput = PrevInput{prevDateAndCode=Nothing, prevDescAndCmnt=Nothing, prevAccount=[], prevAmountAndCmnt=[]}
mt <- runInputT (setComplete noCompletion defaultSettings) (System.Console.Wizard.run $ haskeline $ confirmedTransactionWizard defaultPrevInput es [])
case mt of case mt of
Nothing -> error "Could not interpret the input, restarting" -- caught below causing a restart, I believe Nothing -> error "Could not interpret the input, restarting" -- caught below causing a restart, I believe
Just t -> do Just t -> do
@ -139,6 +141,13 @@ data TxnParams = TxnParams
, txnCmnt :: Text , txnCmnt :: Text
} deriving (Show) } deriving (Show)
data PrevInput = PrevInput
{ prevDateAndCode :: Maybe String
, prevDescAndCmnt :: Maybe String
, prevAccount :: [String]
, prevAmountAndCmnt :: [String]
} deriving (Show)
data AddingStage = EnterDateAndCode data AddingStage = EnterDateAndCode
| EnterDescAndComment (Day, Text) | EnterDescAndComment (Day, Text)
| EnterAccount TxnParams | EnterAccount TxnParams
@ -146,20 +155,21 @@ data AddingStage = EnterDateAndCode
| EndStage Transaction | EndStage Transaction
| EnterNewPosting TxnParams (Maybe Posting) | EnterNewPosting TxnParams (Maybe Posting)
confirmedTransactionWizard :: EntryState -> [AddingStage] -> Wizard Haskeline Transaction confirmedTransactionWizard :: PrevInput -> EntryState -> [AddingStage] -> Wizard Haskeline Transaction
confirmedTransactionWizard es [] = confirmedTransactionWizard es [EnterDateAndCode] confirmedTransactionWizard prevInput es [] = confirmedTransactionWizard prevInput es [EnterDateAndCode]
confirmedTransactionWizard es@EntryState{..} stack@(currentStage : _) = case currentStage of confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) = case currentStage of
EnterDateAndCode -> dateAndCodeWizard es >>= \case EnterDateAndCode -> dateAndCodeWizard prevInput es >>= \case
Just (date, code) -> do Just (date, code) -> do
let es' = es let es' = es
{ esArgs = drop 1 esArgs { esArgs = drop 1 esArgs
, esDefDate = date , esDefDate = date
} }
confirmedTransactionWizard es' (EnterDescAndComment (date, code) : stack) dateAndCodeString = formatTime defaultTimeLocale "%Y/%m/%d" date ++ (if T.null code then "" else " (" ++ T.unpack code ++ ")")
confirmedTransactionWizard prevInput{prevDateAndCode=Just dateAndCodeString} es' (EnterDescAndComment (date, code) : stack)
Nothing -> Nothing ->
confirmedTransactionWizard es stack confirmedTransactionWizard prevInput es stack
EnterDescAndComment (date, code) -> descriptionAndCommentWizard es >>= \case EnterDescAndComment (date, code) -> descriptionAndCommentWizard prevInput es >>= \case
Just (desc, comment) -> do Just (desc, comment) -> do
let mbaset = similarTransaction es desc let mbaset = similarTransaction es desc
es' = es es' = es
@ -167,16 +177,18 @@ confirmedTransactionWizard es@EntryState{..} stack@(currentStage : _) = case cur
, esPostings = [] , esPostings = []
, esSimilarTransaction = mbaset , esSimilarTransaction = mbaset
} }
descAndCommentString = T.unpack $ desc <> (if T.null comment then "" else " ; " <> comment)
prevInput' = prevInput{prevDescAndCmnt=Just descAndCommentString}
when (isJust mbaset) $ liftIO $ hPrintf stderr "Using this similar transaction for defaults:\n%s" (showTransaction $ fromJust mbaset) when (isJust mbaset) $ liftIO $ hPrintf stderr "Using this similar transaction for defaults:\n%s" (showTransaction $ fromJust mbaset)
confirmedTransactionWizard es' ((EnterNewPosting TxnParams{txnDate=date, txnCode=code, txnDesc=desc, txnCmnt=comment} Nothing) : stack) confirmedTransactionWizard prevInput' es' ((EnterNewPosting TxnParams{txnDate=date, txnCode=code, txnDesc=desc, txnCmnt=comment} Nothing) : stack)
Nothing -> Nothing ->
confirmedTransactionWizard es (drop 1 stack) confirmedTransactionWizard prevInput es (drop 1 stack)
EnterNewPosting txnParams@TxnParams{..} posting -> case (esPostings, posting) of EnterNewPosting txnParams@TxnParams{..} posting -> case (esPostings, posting) of
([], Nothing) -> ([], Nothing) ->
confirmedTransactionWizard es (EnterAccount txnParams : stack) confirmedTransactionWizard prevInput es (EnterAccount txnParams : stack)
(_, Just p) -> (_, Just _) ->
confirmedTransactionWizard es (EnterAccount txnParams : stack) confirmedTransactionWizard prevInput es (EnterAccount txnParams : stack)
(_, Nothing) -> do (_, Nothing) -> do
let t = nulltransaction{tdate=txnDate let t = nulltransaction{tdate=txnDate
,tstatus=Unmarked ,tstatus=Unmarked
@ -187,38 +199,44 @@ confirmedTransactionWizard es@EntryState{..} stack@(currentStage : _) = case cur
} }
case balanceTransaction Nothing t of -- imprecise balancing (?) case balanceTransaction Nothing t of -- imprecise balancing (?)
Right t' -> Right t' ->
confirmedTransactionWizard es (EndStage t' : stack) confirmedTransactionWizard prevInput es (EndStage t' : stack)
Left err -> do Left err -> do
liftIO (hPutStrLn stderr $ "\n" ++ (capitalize err) ++ "please re-enter.") liftIO (hPutStrLn stderr $ "\n" ++ (capitalize err) ++ "please re-enter.")
let notFirstEnterPost stage = case stage of let notFirstEnterPost stage = case stage of
EnterNewPosting _ Nothing -> False EnterNewPosting _ Nothing -> False
_ -> True _ -> True
confirmedTransactionWizard es{esPostings=[]} (dropWhile notFirstEnterPost stack) confirmedTransactionWizard prevInput es{esPostings=[]} (dropWhile notFirstEnterPost stack)
EnterAccount txnParams -> accountWizard es >>= \case EnterAccount txnParams -> accountWizard prevInput es >>= \case
Just account Just account
| account `elem` [".", ""] -> | account `elem` [".", ""] ->
case (esPostings, postingsBalanced esPostings) of case (esPostings, postingsBalanced esPostings) of
([],_) -> liftIO (hPutStrLn stderr "Please enter some postings first.") >> confirmedTransactionWizard es stack ([],_) -> liftIO (hPutStrLn stderr "Please enter some postings first.") >> confirmedTransactionWizard prevInput es stack
(_,False) -> liftIO (hPutStrLn stderr "Please enter more postings to balance the transaction.") >> confirmedTransactionWizard es stack (_,False) -> liftIO (hPutStrLn stderr "Please enter more postings to balance the transaction.") >> confirmedTransactionWizard prevInput es stack
(_,True) -> confirmedTransactionWizard es (EnterNewPosting (traceShowId txnParams) Nothing : stack) (_,True) -> confirmedTransactionWizard prevInput es (EnterNewPosting txnParams Nothing : stack)
| otherwise -> confirmedTransactionWizard es{esArgs=drop 1 esArgs} (EnterAmountAndComment txnParams account : stack) | otherwise -> do
let prevAccount' = replaceNthOrAppend (length esPostings) account (prevAccount prevInput)
confirmedTransactionWizard prevInput{prevAccount=prevAccount'} es{esArgs=drop 1 esArgs} (EnterAmountAndComment txnParams account : stack)
Nothing -> do Nothing -> do
let notPrevAmountAndNotEnterDesc stage = case stage of let notPrevAmountAndNotEnterDesc stage = case stage of
EnterAmountAndComment _ _ -> False EnterAmountAndComment _ _ -> False
EnterDescAndComment _ -> False EnterDescAndComment _ -> False
_ -> True _ -> True
confirmedTransactionWizard es{esPostings=init esPostings} (dropWhile notPrevAmountAndNotEnterDesc stack) prevAccount' = take (length esPostings) (prevAccount prevInput)
confirmedTransactionWizard prevInput{prevAccount=prevAccount'} es{esPostings=init esPostings} (dropWhile notPrevAmountAndNotEnterDesc stack)
EnterAmountAndComment txnParams account -> amountAndCommentWizard es >>= \case EnterAmountAndComment txnParams account -> amountAndCommentWizard prevInput es >>= \case
Just (amount, comment) -> do Just (amount, comment) -> do
let posting = nullposting{paccount=T.pack $ stripbrackets account let posting = nullposting{paccount=T.pack $ stripbrackets account
,pamount=Mixed [amount] ,pamount=Mixed [amount]
,pcomment=comment ,pcomment=comment
,ptype=accountNamePostingType $ T.pack account ,ptype=accountNamePostingType $ T.pack account
} }
confirmedTransactionWizard es{esPostings=esPostings++[posting], esArgs=drop 2 esArgs} (EnterNewPosting txnParams (Just posting) : stack) amountAndCommentString = showAmount amount ++ (if T.null comment then "" else " ;" ++ T.unpack comment)
Nothing -> confirmedTransactionWizard es (drop 1 stack) prevAmountAndCmnt' = replaceNthOrAppend (length esPostings) amountAndCommentString (prevAmountAndCmnt prevInput)
es' = es{esPostings=esPostings++[posting], esArgs=drop 2 esArgs}
confirmedTransactionWizard prevInput{prevAmountAndCmnt=prevAmountAndCmnt'} es' (EnterNewPosting txnParams (Just posting) : stack)
Nothing -> confirmedTransactionWizard prevInput{prevAmountAndCmnt=take (length esPostings) (prevAmountAndCmnt prevInput)} es (drop 1 stack)
EndStage t -> do EndStage t -> do
output $ showTransaction t output $ showTransaction t
@ -230,7 +248,9 @@ confirmedTransactionWizard es@EntryState{..} stack@(currentStage : _) = case cur
case y of case y of
Just 'y' -> return t Just 'y' -> return t
Just _ -> throw RestartTransactionException Just _ -> throw RestartTransactionException
Nothing -> confirmedTransactionWizard es (drop 2 stack) Nothing -> confirmedTransactionWizard prevInput es (drop 2 stack)
where
replaceNthOrAppend n newElem xs = take n xs ++ [newElem] ++ drop (n + 1) xs
-- Identify the closest recent match for this description in past transactions. -- Identify the closest recent match for this description in past transactions.
similarTransaction :: EntryState -> Text -> Maybe Transaction similarTransaction :: EntryState -> Text -> Maybe Transaction
@ -241,7 +261,7 @@ similarTransaction EntryState{..} desc =
| otherwise = Just $ snd $ head historymatches | otherwise = Just $ snd $ head historymatches
in bestmatch in bestmatch
dateAndCodeWizard EntryState{..} = do dateAndCodeWizard PrevInput{..} EntryState{..} = do
let def = headDef (showDate esDefDate) esArgs let def = headDef (showDate esDefDate) esArgs
retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $ retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $
parser (parseSmartDateAndCode esToday) $ parser (parseSmartDateAndCode esToday) $
@ -249,7 +269,7 @@ dateAndCodeWizard EntryState{..} = do
defaultTo' def $ nonEmpty $ defaultTo' def $ nonEmpty $
maybeExit $ maybeExit $
-- maybeShowHelp $ -- maybeShowHelp $
line $ green $ printf "Date%s: " (showDefault def) linePrewritten (green $ printf "Date%s: " (showDefault def)) (fromMaybe "" prevDateAndCode) ""
where where
parseSmartDateAndCode refdate s = if s == "<" then return Nothing else either (const Nothing) (\(d,c) -> return $ Just (fixSmartDate refdate d, c)) edc parseSmartDateAndCode refdate s = if s == "<" then return Nothing else either (const Nothing) (\(d,c) -> return $ Just (fixSmartDate refdate d, c)) edc
where where
@ -264,11 +284,11 @@ dateAndCodeWizard EntryState{..} = do
-- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate -- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate
-- datestr = showDate $ fixSmartDate defday smtdate -- datestr = showDate $ fixSmartDate defday smtdate
descriptionAndCommentWizard EntryState{..} = do descriptionAndCommentWizard PrevInput{..} EntryState{..} = do
let def = headDef "" esArgs let def = headDef "" esArgs
s <- withCompletion (descriptionCompleter esJournal def) $ s <- withCompletion (descriptionCompleter esJournal def) $
defaultTo' def $ nonEmpty $ defaultTo' def $ nonEmpty $
line $ green $ printf "Description%s: " (showDefault def) linePrewritten (green $ printf "Description%s: " (showDefault def)) (fromMaybe "" prevDescAndCmnt) ""
if s == "<" if s == "<"
then return Nothing then return Nothing
else do else do
@ -278,7 +298,7 @@ descriptionAndCommentWizard EntryState{..} = do
postingsBalanced :: [Posting] -> Bool postingsBalanced :: [Posting] -> Bool
postingsBalanced ps = isRight $ balanceTransaction Nothing nulltransaction{tpostings=ps} postingsBalanced ps = isRight $ balanceTransaction Nothing nulltransaction{tpostings=ps}
accountWizard EntryState{..} = do accountWizard PrevInput{..} EntryState{..} = do
let pnum = length esPostings + 1 let pnum = length esPostings + 1
historicalp = fmap ((!! (pnum - 1)) . (++ (repeat nullposting)) . tpostings) esSimilarTransaction historicalp = fmap ((!! (pnum - 1)) . (++ (repeat nullposting)) . tpostings) esSimilarTransaction
historicalacct = case historicalp of Just p -> showAccountName Nothing (ptype p) (paccount p) historicalacct = case historicalp of Just p -> showAccountName Nothing (ptype p) (paccount p)
@ -291,7 +311,7 @@ accountWizard EntryState{..} = do
parser (parseAccountOrDotOrNull def canfinish) $ parser (parseAccountOrDotOrNull def canfinish) $
withCompletion (accountCompleter esJournal def) $ withCompletion (accountCompleter esJournal def) $
defaultTo' def $ -- nonEmpty $ defaultTo' def $ -- nonEmpty $
line $ green $ printf "Account %d%s%s: " pnum (endmsg::String) (showDefault def) linePrewritten (green $ printf "Account %d%s%s: " pnum (endmsg::String) (showDefault def)) (fromMaybe "" $ prevAccount `atMay` length esPostings) ""
where where
canfinish = not (null esPostings) && postingsBalanced esPostings canfinish = not (null esPostings) && postingsBalanced esPostings
parseAccountOrDotOrNull :: String -> Bool -> String -> Maybe (Maybe String) parseAccountOrDotOrNull :: String -> Bool -> String -> Maybe (Maybe String)
@ -308,7 +328,7 @@ accountWizard EntryState{..} = do
| otherwise = Just t | otherwise = Just t
dbg1 = id -- strace dbg1 = id -- strace
amountAndCommentWizard EntryState{..} = do amountAndCommentWizard PrevInput{..} EntryState{..} = do
let pnum = length esPostings + 1 let pnum = length esPostings + 1
(mhistoricalp,followedhistoricalsofar) = (mhistoricalp,followedhistoricalsofar) =
case esSimilarTransaction of case esSimilarTransaction of
@ -324,7 +344,7 @@ amountAndCommentWizard EntryState{..} = do
parser parseAmountAndComment $ parser parseAmountAndComment $
withCompletion (amountCompleter def) $ withCompletion (amountCompleter def) $
defaultTo' def $ nonEmpty $ defaultTo' def $ nonEmpty $
line $ green $ printf "Amount %d%s: " pnum (showDefault def) linePrewritten (green $ printf "Amount %d%s: " pnum (showDefault def)) (fromMaybe "" $ prevAmountAndCmnt `atMay` length esPostings) ""
where where
parseAmountAndComment s = if s == "<" then return Nothing else either (const Nothing) (return . Just) $ parseAmountAndComment s = if s == "<" then return Nothing else either (const Nothing) (return . Just) $
runParser runParser