add: < at any prompt restarts the current transaction (#47)
This commit is contained in:
Simon Michael
parent
7fcd45614b
commit
c8e2751aa5
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}
|
||||
{-|
|
||||
|
||||
A history-aware add command to help with data entry.
|
||||
@ -17,6 +18,7 @@ import Data.Char (toUpper)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Time.Calendar
|
||||
import Data.Typeable (Typeable)
|
||||
import System.Console.Haskeline (InputT, runInputT, defaultSettings, setComplete, getInputLine)
|
||||
import System.Console.Haskeline.Completion
|
||||
import System.IO ( stderr, hPutStrLn, hPutStr )
|
||||
@ -52,7 +54,7 @@ add opts j
|
||||
"Adding transactions to journal file "++f
|
||||
,"Provide field values at the prompts, or press enter to accept defaults."
|
||||
,"Use readline keys to edit, use tab key to complete account names."
|
||||
-- ,"If you make a mistake, enter < at any prompt to restart the transaction."
|
||||
,"If you make a mistake, enter < at any prompt to restart the transaction."
|
||||
,"To record a transaction, enter . when prompted."
|
||||
,"To quit, press control-d or control-c."
|
||||
]
|
||||
@ -73,10 +75,8 @@ getAndAddTransactions j opts defaultDate = do
|
||||
getAndAddTransactions j opts d
|
||||
|
||||
-- | Read a transaction from the command line, with history-aware prompting.
|
||||
getTransaction :: Journal -> CliOpts -> Day
|
||||
-> IO (Transaction,Day)
|
||||
getTransaction :: Journal -> CliOpts -> Day -> IO (Transaction,Day)
|
||||
getTransaction j opts defaultDate = do
|
||||
today <- getCurrentDay
|
||||
datestr <- runInteractionDefault $ askFor "date"
|
||||
(Just $ showDate defaultDate)
|
||||
(Just $ \s -> null s
|
||||
@ -84,6 +84,19 @@ getTransaction j opts defaultDate = do
|
||||
|| isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))
|
||||
when (datestr == ".") $ ioError $ mkIOError eofErrorType "" Nothing Nothing
|
||||
description <- runInteractionDefault $ askFor "description" (Just "") Nothing
|
||||
let restart = do hPrintf stderr "\nRestarting this transaction..\n\n"
|
||||
getTransaction j opts defaultDate
|
||||
if description == "<"
|
||||
then restart
|
||||
else do
|
||||
mr <- getPostingsAndValidateTransaction j opts datestr description
|
||||
case mr of
|
||||
Nothing -> restart
|
||||
Just r -> return r
|
||||
|
||||
getPostingsAndValidateTransaction :: Journal -> CliOpts -> String -> String -> IO (Maybe (Transaction,Day))
|
||||
getPostingsAndValidateTransaction j opts datestr description = do
|
||||
today <- getCurrentDay
|
||||
let historymatches = transactionsSimilarTo j (queryFromOpts today $ reportopts_ opts) description
|
||||
bestmatch | null historymatches = Nothing
|
||||
| otherwise = Just $ snd $ head historymatches
|
||||
@ -95,7 +108,7 @@ getTransaction j opts defaultDate = do
|
||||
else True
|
||||
existingaccts = journalAccountNames j
|
||||
getpostingsandvalidate = do
|
||||
ps <- getPostings (PostingState j accept True bestmatchpostings) []
|
||||
ps <- getPostingsWithState (PostingState j accept True bestmatchpostings) []
|
||||
let t = nulltransaction{tdate=date
|
||||
,tstatus=False
|
||||
,tdescription=description
|
||||
@ -105,22 +118,20 @@ getTransaction j opts defaultDate = do
|
||||
let msg' = capitalize msg
|
||||
liftIO $ hPutStrLn stderr $ "\n" ++ msg' ++ "please re-enter."
|
||||
getpostingsandvalidate
|
||||
either retry (return . flip (,) date) $ balanceTransaction Nothing t -- imprecise balancing
|
||||
unless (null historymatches) $
|
||||
liftIO $ hPutStr stderr $
|
||||
"\nSimilar transactions found, using the first for defaults:\n"
|
||||
++ concatMap (\(n,t) -> printf "[%3d%%] %s" (round $ n*100 :: Int) (show t)) (take 3 historymatches)
|
||||
getpostingsandvalidate
|
||||
either retry (return . Just . flip (,) date) $ balanceTransaction Nothing t -- imprecise balancing
|
||||
unless (null historymatches) $ liftIO $ hPutStr stderr $
|
||||
"\nSimilar transactions found, using the first for defaults:\n"
|
||||
++ concatMap (\(n,t) -> printf "[%3d%%] %s" (round $ n*100 :: Int) (show t)) (take 3 historymatches)
|
||||
getpostingsandvalidate `catch` \(_::RestartEntryException) -> return Nothing
|
||||
|
||||
capitalize :: String -> String
|
||||
capitalize "" = ""
|
||||
capitalize (c:cs) = toUpper c : cs
|
||||
data RestartEntryException = RestartEntryException deriving (Typeable,Show)
|
||||
instance Exception RestartEntryException
|
||||
|
||||
-- fragile
|
||||
-- | Read postings from the command line until . is entered, using any
|
||||
-- provided historical postings and the journal context to guess defaults.
|
||||
getPostings :: PostingState -> [Posting] -> IO [Posting]
|
||||
getPostings st enteredps = do
|
||||
getPostingsWithState :: PostingState -> [Posting] -> IO [Posting]
|
||||
getPostingsWithState st enteredps = do
|
||||
let bestmatch | isNothing historicalps = Nothing
|
||||
| n <= length ps = Just $ ps !! (n-1)
|
||||
| otherwise = Nothing
|
||||
@ -129,11 +140,12 @@ getPostings st enteredps = do
|
||||
ordot | null enteredps || length enteredrealps == 1 = "" :: String
|
||||
| otherwise = " (or . to record)"
|
||||
account <- runInteraction j $ askFor (printf "account %d%s" n ordot) defaultaccount (Just accept)
|
||||
when (account=="<") $ throwIO RestartEntryException
|
||||
if account=="."
|
||||
then
|
||||
if null enteredps
|
||||
then do hPutStrLn stderr $ "\nPlease enter some postings first."
|
||||
getPostings st enteredps
|
||||
getPostingsWithState st enteredps
|
||||
else return enteredps
|
||||
else do
|
||||
let defaultacctused = Just account == defaultaccount
|
||||
@ -157,6 +169,7 @@ getPostings st enteredps = do
|
||||
-- I think 1 or 4, whichever would show the most decimal places
|
||||
p = maxprecisionwithpoint
|
||||
amountstr <- runInteractionDefault $ askFor (printf "amount %d" n) defaultamountstr validateamount
|
||||
when (amountstr=="<") $ throwIO RestartEntryException
|
||||
let a = fromparse $ runParser (amountp <|> return missingamt) ctx "" amountstr
|
||||
a' = fromparse $ runParser (amountp <|> return missingamt) nullctx "" amountstr
|
||||
wasdefaultamtused = Just (showAmount a) == defaultamountstr
|
||||
@ -171,7 +184,7 @@ getPostings st enteredps = do
|
||||
else st{psHistory=historicalps', psSuggestHistoricalAmount=False}
|
||||
when (isJust defaultcommodityadded) $
|
||||
liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust defaultcommodityadded)
|
||||
getPostings st' (enteredps ++ [p])
|
||||
getPostingsWithState st' (enteredps ++ [p])
|
||||
where
|
||||
j = psJournal st
|
||||
historicalps = psHistory st
|
||||
@ -185,8 +198,9 @@ getPostings st enteredps = do
|
||||
postingtype ('(':_) = VirtualPosting
|
||||
postingtype _ = RegularPosting
|
||||
validateamount = Just $ \s -> (null s && not (null enteredrealps))
|
||||
|| (s /= "."
|
||||
&& isRight (runParser (amountp >> many spacenonewline >> eof) ctx "" s))
|
||||
|| s == "<"
|
||||
|| (isRight (runParser (amountp >> many spacenonewline >> eof) ctx "" s)
|
||||
&& s /= ".")
|
||||
|
||||
-- | Prompt for and read a string value, optionally with a default value
|
||||
-- and a validator. A validator causes the prompt to repeat until the
|
||||
@ -298,3 +312,7 @@ accountCompletion cc = completeWord Nothing
|
||||
-- can contain spaces.
|
||||
$ \s -> return $ map simpleCompletion
|
||||
$ filter (s `isPrefixOf`) cc
|
||||
|
||||
capitalize :: String -> String
|
||||
capitalize "" = ""
|
||||
capitalize (c:cs) = toUpper c : cs
|
||||
|
||||
Loading…
Reference in New Issue
Block a user