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

add: hack apart getPostingsLoop into smaller pieces

Browse Source
This commit is contained in:
Simon Michael 2014-02-23 07:52:26 -08:00
parent 56abdb2c8c
commit 6bf08cdd7c
1 changed files with 83 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,4 +1,4 @@
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, RecordWildCards #-}
{-| {-|
A history-aware add command to help with data entry. A history-aware add command to help with data entry.
@ -124,8 +124,7 @@ data EntryState = EntryState {
esJournal :: Journal -- ^ the journal we are adding to esJournal :: Journal -- ^ the journal we are adding to
,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 ,esValidateAccount :: AccountName -> Bool -- ^ validator for entered account names
,esSuggestHistoricalAmount :: Bool -- ^ should the amount from a similar past txn be suggested ,esHistoricalPostings :: Maybe [Posting] -- ^ postings of the most similar past txn, if applicable
,esHistoricalPostings :: Maybe [Posting] -- ^ the postings of the most similar past txn
,esEnteredPostings :: [Posting] -- ^ postings entered so far ,esEnteredPostings :: [Posting] -- ^ postings entered so far
} }
@ -133,7 +132,6 @@ defEntryState = EntryState {
esJournal = nulljournal esJournal = nulljournal
,esDefaultsRemaining = [] ,esDefaultsRemaining = []
,esValidateAccount = const True ,esValidateAccount = const True
,esSuggestHistoricalAmount = True
,esHistoricalPostings = Nothing ,esHistoricalPostings = Nothing
,esEnteredPostings = [] ,esEnteredPostings = []
} }
@ -178,85 +176,91 @@ getPostingsForTransactionWithHistory j opts datestr code description comment def
-- useful defaults based on historical context and postings entered so far. -- useful defaults based on historical context and postings entered so far.
getPostingsLoop :: EntryState -> IO [Posting] getPostingsLoop :: EntryState -> IO [Posting]
getPostingsLoop st = do getPostingsLoop st = do
let bestmatch | isNothing historicalps = Nothing (st1,account) <- getAccount st
| n <= length ps = Just $ ps !! (n-1)
| otherwise = Nothing
where Just ps = historicalps
bestmatchacct = maybe Nothing (Just . showacctname) bestmatch
defs = esDefaultsRemaining st
(defacct, defs') = (maybe bestmatchacct Just $ headMay defs, tailDef [] defs)
ordot | null enteredps || length enteredrealps == 1 = "" :: String
| otherwise = " (or . to complete this transaction)"
account <- runInteractionWithAccountCompletion j $ askFor (printf "account %d%s" n ordot) defacct (Just validateaccount)
when (account=="<") $ throwIO RestartEntryException
if account=="." if account=="."
then then case esEnteredPostings st of
if null enteredps [] -> hPutStrLn stderr "\nPlease enter some postings first." >> getPostingsLoop st
then do hPutStrLn stderr $ "\nPlease enter some postings first." ps -> return ps
getPostingsLoop st
else return enteredps
else do else do
let defacctaccepted = Just account == defacct (st2,amt,comment) <- getAmountAndComment st1
historicalps' = if defacctaccepted then historicalps else Nothing let p = nullposting{paccount=stripbrackets account
bestmatch' | isNothing historicalps' = Nothing ,pamount=mixed amt
| n <= length ps = Just $ ps !! (n-1)
| otherwise = Nothing
where Just ps = historicalps'
(amtfromdefs, defs'') = (headMay defs', tailDef [] defs')
defamountstr | isJust amtfromdefs = amtfromdefs
| isJust bestmatch' && suggesthistorical = Just historicalamountstr
| n > 1 = Just balancingamountstr
| otherwise = Nothing
where
historicalamountstr = showMixedAmountWithPrecision p $ pamount $ fromJust bestmatch'
balancingamountstr = showMixedAmountWithPrecision p $ negate $ sum $ map pamount enteredrealps
-- 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
p = maxprecisionwithpoint
amt <- runInteraction $ askFor (printf "amount %d" n) defamountstr validateamount
when (amt=="<") $ throwIO RestartEntryException
let (amountstr,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amt
let a = fromparse $ runParser (amountp <|> return missingamt) ctx "" amountstr
a' = fromparse $ runParser (amountp <|> return missingamt) nullctx "" amountstr
defamtaccepted = Just (showAmount a) == defamountstr
defcommodityadded | acommodity a == acommodity a' = Nothing
| otherwise = Just $ acommodity a
p = nullposting{paccount=stripbrackets account
,pamount=mixed a
,pcomment=comment ,pcomment=comment
,ptype=postingtype account ,ptype=accountNamePostingType account
} }
st' = st{esEnteredPostings=esEnteredPostings st ++ [p] getPostingsLoop st2{esEnteredPostings=esEnteredPostings st2 ++ [p]}
,esDefaultsRemaining=defs''
} getAccount :: EntryState -> IO (EntryState,AccountName)
st'' = if defamtaccepted getAccount st@EntryState{..} = do
then st' let pnum = length esEnteredPostings + 1
else st'{esHistoricalPostings=historicalps', esSuggestHistoricalAmount=False} mhistoricalacct = maybe Nothing (Just . showacctname) mhistoricalp
when (isJust defcommodityadded) $ where
liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust defcommodityadded) mhistoricalp | isNothing esHistoricalPostings = Nothing
getPostingsLoop st'' | pnum <= length historicalps = Just $ historicalps !! (pnum-1)
where | otherwise = Nothing
j = esJournal st where Just historicalps = esHistoricalPostings
historicalps = esHistoricalPostings st showacctname p = showAccountName Nothing (ptype p) $ paccount p
ctx = jContext j (mdefacct, st1) = case esDefaultsRemaining of
validateaccount = esValidateAccount st d:ds -> (Just d, st{esDefaultsRemaining=ds})
suggesthistorical = esSuggestHistoricalAmount st [] -> (mhistoricalacct, st)
enteredps = esEnteredPostings st endmsg | null esEnteredPostings || numenteredrealps == 1 = "" :: String
n = length enteredps + 1 | otherwise = " (or . to complete this transaction)"
enteredrealps = filter isReal enteredps where numenteredrealps = length $ filter isReal esEnteredPostings
showacctname p = showAccountName Nothing (ptype p) $ paccount p account <- runInteractionWithAccountCompletion esJournal $
postingtype ('[':_) = BalancedVirtualPosting askFor (printf "account %d%s" pnum endmsg) mdefacct (Just esValidateAccount)
postingtype ('(':_) = VirtualPosting if (account=="<")
postingtype _ = RegularPosting then throwIO RestartEntryException
validateamount = Just $ \s -> (null s && not (null enteredrealps)) else let defacctaccepted = Just account == mdefacct
|| s == "<" st2 = if defacctaccepted then st1 else st1{esHistoricalPostings=Nothing}
|| (isRight (runParser (amountp >> many spacenonewline >> optional (char ';' >> many anyChar) >> eof) ctx "" s) in return (st2, account)
&& s /= ".")
getAmountAndComment :: EntryState -> IO (EntryState,Amount,String)
getAmountAndComment st@EntryState{..} = do
let pnum = length esEnteredPostings + 1
showamt = showMixedAmountWithPrecision
-- 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
maxprecisionwithpoint
mhistoricalamt = maybe Nothing (Just . showamt . pamount) mhistoricalp
where
mhistoricalp | isNothing esHistoricalPostings = Nothing
| pnum <= length historicalps = Just $ historicalps !! (pnum-1)
| otherwise = Nothing
where Just historicalps = esHistoricalPostings
enteredrealps = filter isReal esEnteredPostings
(mdefamt, st1) = case esDefaultsRemaining of
d:ds -> (Just d, st{esDefaultsRemaining=ds})
_ | isJust mhistoricalamt -> (mhistoricalamt, st)
_ | pnum > 1 -> (Just balancingamt, st)
_ -> (Nothing, st)
where
balancingamt = showamt $ negate $ sum $ map pamount enteredrealps
validateamount = Just $ \s ->
(null s && not (null enteredrealps))
|| s == "<"
|| (s /= "." && isRight (runParser amountandoptionalcommentp (jContext esJournal) "" s))
where
amountandoptionalcommentp = do
amountp
many spacenonewline
optional (char ';' >> many anyChar)
eof
amtcmt <- runInteraction $ askFor (printf "amount %d" pnum) mdefamt validateamount
when (amtcmt=="<") $ throwIO RestartEntryException
let (amt,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amtcmt
a = fromparse $ runParser (amountp <|> return missingamt) (jContext esJournal) "" amt
awithoutctx = fromparse $ runParser (amountp <|> return missingamt) nullctx "" amt
defamtaccepted = Just (showAmount a) == mdefamt
st2 = if defamtaccepted then st1 else st1{esHistoricalPostings=Nothing}
mdefaultcommodityapplied = if acommodity a == acommodity awithoutctx then Nothing else Just $ acommodity a
when (isJust mdefaultcommodityapplied) $
liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust mdefaultcommodityapplied)
return (st2, a, comment)
-- | 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