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

add: simplify code

Browse Source
This commit is contained in:
Simon Michael 2009-05-24 08:36:02 +00:00
parent 49e66477fb
commit 2373429b64
1 changed files with 70 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
Commands/Add.hs
View File

@ -1,6 +1,6 @@
{-| {-|
An add command to help with data entry. A history-aware add command to help with data entry.
-} -}
@ -26,125 +26,101 @@ add opts args l
| otherwise = do | otherwise = do
hPutStrLn stderr hPutStrLn stderr
"Enter one or more transactions, which will be added to your ledger file.\n\ "Enter one or more transactions, which will be added to your ledger file.\n\
\To complete a transaction, enter . as account name.\n\ \To complete a transaction, enter . as account name. To quit, enter control-d."
\To finish input, enter control-d (discards any transaction in progress)." getAndAddTransactions l args `catch` (\e -> if isEOFError e then return () else ioError e)
getAndAddTransactions l args
return ()
-- | Read a number of ledger transactions from the command line, -- | Read a number of ledger transactions from the command line,
-- prompting, validating, displaying and appending them to the ledger -- prompting, validating, displaying and appending them to the ledger
-- file, until end of input. Any command-line arguments are used as the -- file, until end of input (then raise an EOF exception). Any
-- first transaction's description. -- command-line arguments are used as the first transaction's description.
getAndAddTransactions :: Ledger -> [String] -> IO [LedgerTransaction] getAndAddTransactions :: Ledger -> [String] -> IO ()
getAndAddTransactions l args = do getAndAddTransactions l args = do
-- for now, thread the eoi flag throughout rather than muck about with monads l <- getTransaction l args >>= addTransaction l
(t, eoi) <- getTransaction l args getAndAddTransactions l []
l <- if isJust t then addTransaction l (fromJust t) else return l
if eoi then return $ maybe [] (:[]) t
else liftM (fromJust t:) (getAndAddTransactions l [])
-- | Get a transaction from the command line, if possible, and a flag -- | Read a transaction from the command line, with history-aware prompting.
-- indicating end of input. getTransaction :: Ledger -> [String] -> IO LedgerTransaction
getTransaction :: Ledger -> [String] -> IO (Maybe LedgerTransaction, Bool)
getTransaction l args = do getTransaction l args = do
today <- getCurrentDay today <- getCurrentDay
(datestr, eoi) <- askFor "date" datestr <- askFor "date"
(Just $ showDate today) (Just $ showDate today)
(Just $ \s -> null s || (Just $ \s -> null s ||
(isRight $ parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s)) (isRight $ parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))
if eoi description <- if null args
then return (Nothing, True)
else do
(description, eoi) <- if null args
then askFor "description" Nothing (Just $ not . null) then askFor "description" Nothing (Just $ not . null)
else (do else do
let description = unwords args let description = unwords args
hPutStrLn stderr $ "description: " ++ description hPutStrLn stderr $ "description: " ++ description
return (description, False)) return description
if eoi
then return (Nothing, True)
else do
let historymatches = transactionsSimilarTo l description let historymatches = transactionsSimilarTo l description
when (not $ null historymatches) (do bestmatch | null historymatches = Nothing
hPutStrLn stderr "Similar past transactions found:"
hPutStr stderr $ concatMap (\(n,t) -> printf "[%3d%%] %s" (round $ n*100 :: Int) (show t)) $ take 3 historymatches)
let bestmatch | null historymatches = Nothing
| otherwise = Just $ snd $ head $ historymatches | otherwise = Just $ snd $ head $ historymatches
bestmatchpostings = maybe Nothing (Just . ltpostings) bestmatch bestmatchpostings = maybe Nothing (Just . ltpostings) bestmatch
date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
getpostingsandvalidate = do getpostingsandvalidate = do
(ps, eoi) <- getPostings bestmatchpostings [] ps <- getPostings bestmatchpostings []
let t = nullledgertxn{ltdate=date let t = nullledgertxn{ltdate=date
,ltstatus=False ,ltstatus=False
,ltdescription=description ,ltdescription=description
,ltpostings=ps ,ltpostings=ps
} }
if eoi && null ps
then return (Nothing, eoi)
else either (const retry) (return . flip (,) eoi . Just) $ balanceLedgerTransaction t
retry = do retry = do
hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:" hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:"
getpostingsandvalidate getpostingsandvalidate
either (const retry) return $ balanceLedgerTransaction t
when (not $ null historymatches)
(do
hPutStrLn stderr "Similar transactions found, using the first for defaults:\n"
hPutStr stderr $ concatMap (\(n,t) -> printf "[%3d%%] %s" (round $ n*100 :: Int) (show t)) $ take 3 historymatches)
getpostingsandvalidate getpostingsandvalidate
-- | Get two or more postings from the command line, if possible, and a -- | Read postings from the command line until . is entered, using the
-- flag indicating end of input. -- provided historical postings, if any, to guess defaults.
getPostings :: Maybe [Posting] -> [Posting] -> IO ([Posting], Bool) getPostings :: Maybe [Posting] -> [Posting] -> IO [Posting]
getPostings bestmatchps enteredps = do getPostings historicalps enteredps = do
(account, eoi) <- askFor (printf "account %d" n) defaultaccount validateaccount account <- askFor (printf "account %d" n) defaultaccount (Just $ not . null)
if account=="." || eoi if account=="."
then return (enteredps, eoi) then return enteredps
else do else do
(amountstr, eoi) <- askFor (printf "amount %d" n) defaultamount validateamount amountstr <- askFor (printf "amount %d" n) defaultamount validateamount
let amount = fromparse $ parse (someamount <|> return missingamt) "" amountstr let amount = fromparse $ parse (someamount <|> return missingamt) "" amountstr
let p = nullrawposting{paccount=stripbrackets account,pamount=amount,ptype=postingaccounttype account} let p = nullrawposting{paccount=stripbrackets account,
if eoi pamount=amount,
then if null enteredps ptype=postingtype account}
then return ([], True) getPostings historicalps $ enteredps ++ [p]
else return (enteredps ++ [p], True)
else if amount == missingamt
then return $ (enteredps ++ [p], eoi)
else getPostings bestmatchps $ enteredps ++ [p]
where where
n = length enteredps + 1 n = length enteredps + 1
realn = length enteredrealps + 1 realn = length enteredrealps + 1
bestmatch | isNothing bestmatchps = Nothing enteredrealps = filter isReal enteredps
bestmatch | isNothing historicalps = Nothing
| n <= length ps = Just $ ps !! (n-1) | n <= length ps = Just $ ps !! (n-1)
| otherwise = Nothing | otherwise = Nothing
where Just ps = bestmatchps where Just ps = historicalps
defaultaccount = maybe Nothing (Just . showacctname) bestmatch defaultaccount = maybe Nothing (Just . showacctname) bestmatch
showacctname p = showAccountName Nothing (ptype p) $ paccount p showacctname p = showAccountName Nothing (ptype p) $ paccount p
validateaccount = Just $ \s -> not $ null s
defaultamount = maybe balancingamount (Just . show . pamount) bestmatch defaultamount = maybe balancingamount (Just . show . pamount) bestmatch
where balancingamount = Just $ show $ negate $ sum $ map pamount enteredrealps where balancingamount = Just $ show $ negate $ sum $ map pamount enteredrealps
enteredrealps = filter isReal enteredps postingtype ('[':_) = BalancedVirtualPosting
postingaccounttype ('[':_) = BalancedVirtualPosting postingtype ('(':_) = VirtualPosting
postingaccounttype ('(':_) = VirtualPosting postingtype _ = RegularPosting
postingaccounttype _ = RegularPosting
stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse
validateamount = Just $ \s -> validateamount = Just $ \s -> (null s && (not $ null enteredrealps))
(null s && (not $ null enteredps)) || || (isRight $ parse (someamount>>many spacenonewline>>eof) "" s)
(isRight $ parse (someamount>>many spacenonewline>>eof) "" s)
-- | Prompt for and read a string value, optionally with a default value
-- | Prompt for and read a string value and a flag indicating whether -- and a validator. A validator causes the prompt to repeat until the
-- input has ended (control-d was pressed), optionally with a default -- input is valid. May also raise an EOF exception if control-d is pressed.
-- value and a validator. A validator will cause the prompt to repeat askFor :: String -> Maybe String -> Maybe (String -> Bool) -> IO String
-- until the input is valid (unless the input is just ctrl-d).
askFor :: String -> Maybe String -> Maybe (String -> Bool) -> IO (String, Bool)
askFor prompt def validator = do askFor prompt def validator = do
hPutStr stderr $ prompt ++ (maybe "" showdef def) ++ ": " hPutStr stderr $ prompt ++ (maybe "" showdef def) ++ ": "
hFlush stderr hFlush stderr
-- ugly l <- getLine
l <- getLine `catch` (\e -> if isEOFError e then return "*EOF*" else ioError e) let input = if null l then fromMaybe l def else l
let (l', eoi) = case l of "*EOF*" -> ("", True)
_ -> (l, False)
let input = if null l' then fromMaybe l' def else l'
case validator of case validator of
Just valid -> if valid input || (null input && eoi) Just valid -> if valid input
then return (input, eoi) then return input
else askFor prompt def validator else askFor prompt def validator
Nothing -> return (input, eoi) Nothing -> return input
where showdef s = " [" ++ s ++ "]" where showdef s = " [" ++ s ++ "]"
-- | Append this transaction to the ledger's file. Also, to the ledger's -- | Append this transaction to the ledger's file. Also, to the ledger's