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

add: cleanup, cleanup

Browse Source
This commit is contained in:
Simon Michael 2014-02-23 15:04:28 -08:00
parent 6bf08cdd7c
commit 8d3161f6d6
1 changed files with 35 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
hledger/Hledger/Cli/Add.hs
View File

@ -67,7 +67,7 @@ add opts j
getAndAddTransactionsLoop :: Journal -> CliOpts -> String -> [String] -> IO () getAndAddTransactionsLoop :: Journal -> CliOpts -> String -> [String] -> IO ()
getAndAddTransactionsLoop j opts defdate defs = do getAndAddTransactionsLoop j opts defdate defs = do
hPrintf stderr "\nStarting a new transaction.\n" hPrintf stderr "\nStarting a new transaction.\n"
t <- getTransaction j opts defdate defs t <- getTransactionAndConfirm j opts defdate defs
j' <- journalAddTransaction j opts t j' <- journalAddTransaction j opts t
hPrintf stderr "Added to the journal.\n" hPrintf stderr "Added to the journal.\n"
let defdate' = showDate $ tdate t let defdate' = showDate $ tdate t
@ -76,12 +76,12 @@ getAndAddTransactionsLoop j opts defdate defs = do
-- | Read a single transaction from the console, with history-aware prompting, -- | Read a single transaction from the console, with history-aware prompting,
-- allowing the user to restart and confirm at the end. -- allowing the user to restart and confirm at the end.
-- A default date, and zero or more defaults for subsequent fields, are provided. -- A default date, and zero or more defaults for subsequent fields, are provided.
getTransaction :: Journal -> CliOpts -> String -> [String] -> IO Transaction getTransactionAndConfirm :: Journal -> CliOpts -> String -> [String] -> IO Transaction
getTransaction j opts defdate defs = do getTransactionAndConfirm j opts defdate defs = do
mt <- getTransactionOrRestart j opts defdate defs mt <- getTransaction j opts defdate defs
let restart = do let restart = do
hPrintf stderr "\nRestarting this transaction.\n" hPrintf stderr "\nRestarting this transaction.\n"
getTransaction j opts defdate defs getTransactionAndConfirm j opts defdate defs
case mt of case mt of
Nothing -> restart Nothing -> restart
Just t -> do Just t -> do
@ -94,27 +94,30 @@ getTransaction j opts defdate defs = do
-- | Read a single transaction from the console, with history-aware prompting, -- | Read a single transaction from the console, with history-aware prompting,
-- or return nothing indicating that the user wants to restart entering this transaction. -- or return nothing indicating that the user wants to restart entering this transaction.
-- A default date, and zero or more defaults for subsequent fields, are provided. -- A default date, and zero or more defaults for subsequent fields, are provided.
getTransactionOrRestart :: Journal -> CliOpts -> String -> [String] -> IO (Maybe Transaction) getTransaction :: Journal -> CliOpts -> String -> [String] -> IO (Maybe Transaction)
getTransactionOrRestart j opts defdate defs = do getTransaction j opts defdate defs = do
let dateandcodep = do {d <- smartdate; c <- optionMaybe codep; many spacenonewline; eof; return (d, fromMaybe "" c)} let dateandcodep = do
datecodestr <- runInteraction $ askFor "date" d <- smartdate
(Just defdate) c <- optionMaybe codep
(Just $ \s -> null s many spacenonewline
eof
return (d, fromMaybe "" c)
validate s = null s
|| s == "." || s == "."
|| isRight (parseWithCtx nullctx dateandcodep $ lowercase s)) || isRight (parseWithCtx nullctx dateandcodep $ lowercase s)
when (datecodestr == ".") $ ioError $ mkIOError eofErrorType "" Nothing Nothing dateandcode <- runInteraction $ askFor "date" (Just defdate) (Just validate)
when (dateandcode == ".") $ ioError $ mkIOError eofErrorType "" Nothing Nothing
today <- getCurrentDay today <- getCurrentDay
let (sdate,code) = fromparse $ parseWithCtx nullctx dateandcodep datecodestr let (smtdate,code) = fromparse $ parseWithCtx nullctx dateandcodep dateandcode
defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate
datestr = showDate $ fixSmartDate defday sdate datestr = showDate $ fixSmartDate defday smtdate
let (defdesc, defs') = headTailDef "" defs let (defdesc, defs') = headTailDef "" defs
desc <- runInteraction $ askFor "description" (Just defdesc) Nothing desc <- runInteraction $ askFor "description" (Just defdesc) Nothing
if desc == "<" if desc == "<"
then return Nothing then return Nothing
else do else do
let (description,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') desc let (description,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') desc
getPostingsForTransactionWithHistory j opts datestr code description comment defs' getPostingsForTransaction j opts datestr code description comment defs'
data RestartEntryException = RestartEntryException deriving (Typeable,Show) data RestartEntryException = RestartEntryException deriving (Typeable,Show)
instance Exception RestartEntryException instance Exception RestartEntryException
@ -122,16 +125,16 @@ instance Exception RestartEntryException
-- | State used while entering a single transaction. -- | State used while entering a single transaction.
data EntryState = EntryState { data EntryState = EntryState {
esJournal :: Journal -- ^ the journal we are adding to esJournal :: Journal -- ^ the journal we are adding to
,esOpts :: CliOpts -- ^ command line options
,esDefaultsRemaining :: [String] -- ^ command line arguments not yet used as defaults ,esDefaultsRemaining :: [String] -- ^ command line arguments not yet used as defaults
,esValidateAccount :: AccountName -> Bool -- ^ validator for entered account names
,esHistoricalPostings :: Maybe [Posting] -- ^ postings of the most similar past txn, if applicable ,esHistoricalPostings :: Maybe [Posting] -- ^ postings of the most similar past txn, if applicable
,esEnteredPostings :: [Posting] -- ^ postings entered so far ,esEnteredPostings :: [Posting] -- ^ postings entered so far
} }
defEntryState = EntryState { defEntryState = EntryState {
esJournal = nulljournal esJournal = nulljournal
,esOpts = defcliopts
,esDefaultsRemaining = [] ,esDefaultsRemaining = []
,esValidateAccount = const True
,esHistoricalPostings = Nothing ,esHistoricalPostings = Nothing
,esEnteredPostings = [] ,esEnteredPostings = []
} }
@ -139,22 +142,18 @@ defEntryState = EntryState {
-- | Loop reading postings from the console, until a valid balanced -- | Loop reading postings from the console, until a valid balanced
-- set of postings has been entered, then return the final transaction, -- set of postings has been entered, then return the final transaction,
-- or nothing indicating that the user wants to restart entering this transaction. -- or nothing indicating that the user wants to restart entering this transaction.
getPostingsForTransactionWithHistory :: Journal -> CliOpts -> String -> String -> String -> String -> [String] -> IO (Maybe Transaction) getPostingsForTransaction :: Journal -> CliOpts -> String -> String -> String -> String -> [String] -> IO (Maybe Transaction)
getPostingsForTransactionWithHistory j opts datestr code description comment defs = do getPostingsForTransaction j opts datestr code description comment defs = do
today <- getCurrentDay today <- getCurrentDay
let historymatches = transactionsSimilarTo j (queryFromOpts today $ reportopts_ opts) description let historymatches = transactionsSimilarTo j (queryFromOpts today $ reportopts_ opts) description
bestmatch | not (null defs) || null historymatches = Nothing bestmatch | not (null defs) || null historymatches = Nothing
| otherwise = Just $ snd $ head historymatches | otherwise = Just $ snd $ head historymatches
bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch
date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
validateaccount x = x == "." || (not . null) x &&
if no_new_accounts_ opts
then x `elem` journalAccountNames j
else True
getvalidpostings = do getvalidpostings = do
let st = defEntryState{esJournal=j let st = defEntryState{esJournal=j
,esOpts=opts
,esDefaultsRemaining=defs ,esDefaultsRemaining=defs
,esValidateAccount=validateaccount
,esHistoricalPostings=bestmatchpostings ,esHistoricalPostings=bestmatchpostings
} }
ps <- getPostingsLoop st ps <- getPostingsLoop st
@ -206,8 +205,11 @@ getAccount st@EntryState{..} = do
endmsg | null esEnteredPostings || numenteredrealps == 1 = "" :: String endmsg | null esEnteredPostings || numenteredrealps == 1 = "" :: String
| otherwise = " (or . to complete this transaction)" | otherwise = " (or . to complete this transaction)"
where numenteredrealps = length $ filter isReal esEnteredPostings where numenteredrealps = length $ filter isReal esEnteredPostings
validate s = s == "."
|| (not . null) s
&& (not (no_new_accounts_ esOpts) || s `elem` journalAccountNames esJournal)
account <- runInteractionWithAccountCompletion esJournal $ account <- runInteractionWithAccountCompletion esJournal $
askFor (printf "account %d%s" pnum endmsg) mdefacct (Just esValidateAccount) askFor (printf "account %d%s" pnum endmsg) mdefacct (Just validate)
if (account=="<") if (account=="<")
then throwIO RestartEntryException then throwIO RestartEntryException
else let defacctaccepted = Just account == mdefacct else let defacctaccepted = Just account == mdefacct
@ -262,6 +264,8 @@ getAmountAndComment st@EntryState{..} = do
liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust mdefaultcommodityapplied) liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust mdefaultcommodityapplied)
return (st2, a, comment) return (st2, a, comment)
-- utilities
-- | Prompt for and read a string value, optionally with a default value -- | Prompt for and read a string value, optionally with a default value
-- and a validator. A validator causes the prompt to repeat until the -- and a validator. A validator causes the prompt to repeat until the
-- input is valid. May also raise an EOF exception if control-d or control-c is pressed. -- input is valid. May also raise an EOF exception if control-d or control-c is pressed.