rename and unify the autofill stuff

This commit is contained in:
Simon Michael 2008-10-18 06:45:02 +00:00
parent a304ad3ca6
commit d31ba41703
4 changed files with 27 additions and 45 deletions

View File

@ -15,6 +15,12 @@ import Ledger.Amount
instance Show Entry where show = showEntry
instance Show ModifierEntry where
show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e))
instance Show PeriodicEntry where
show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e))
{-|
Show a ledger entry, formatted for the print command. ledger 2.x's
standard format looks like this:
@ -53,31 +59,27 @@ showEntry e =
showDate = printf "%-10s"
-- | Raise an error if this entry is not balanced.
assertBalancedEntry :: Entry -> Entry
assertBalancedEntry e
| isEntryBalanced e = e
| otherwise = error $ "transactions don't balance in:\n" ++ show e
isEntryBalanced :: Entry -> Bool
isEntryBalanced (Entry {etransactions=ts}) = isZeroMixedAmount sum
where
sum = sumRawTransactions realts
realts = filter isReal ts
-- | Fill in a missing balance in this entry, if there is one,
-- or raise an error if there is more than one.
autofillEntry :: Entry -> Entry
autofillEntry e@(Entry {etransactions=ts}) = e{etransactions=ts'}
where ts' = fromMaybe
(error $ "too many missing amounts in this entry, could not auto-balance:\n" ++ show e)
(autofillTransactions ts)
-- modifier & periodic entries
instance Show ModifierEntry where
show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e))
instance Show PeriodicEntry where
show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e))
-- | Fill in a missing balance in this entry, if we have enough
-- information to do that. Excluding virtual transactions, there should be
-- at most one missing balance. Otherwise, raise an error.
balanceEntry :: Entry -> Entry
balanceEntry e@(Entry{etransactions=ts}) = e{etransactions=ts'}
where
(withamounts, missingamounts) = partition hasAmount $ filter isReal ts
ts' = case (length missingamounts) of
0 -> ts
1 -> map balance ts
otherwise -> error $ "could not balance this entry, too many missing amounts:\n" ++ show e
otherstotal = sumRawTransactions withamounts
simpleotherstotal
| length otherstotal == 1 = head otherstotal
| otherwise = error $ "sorry, can't balance a mixed-commodity entry yet:\n" ++ show e
balance t
| isReal t && not (hasAmount t) = t{tamount = -simpleotherstotal}
| otherwise = t

View File

@ -231,7 +231,7 @@ ledgerentry = do
comment <- ledgercomment
restofline
transactions <- ledgertransactions
return $ assertBalancedEntry $ autofillEntry $ Entry date status code description comment transactions (unlines preceding)
return $ balanceEntry $ Entry date status code description comment transactions (unlines preceding)
ledgerdate :: Parser String
ledgerdate = do

View File

@ -21,26 +21,6 @@ showRawTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ ta
showaccountname = printf "%-22s" . elideAccountName 22
showamount = printf "%12s" . showAmountOrZero
-- | Fill in the missing balance in an entry's transactions. Excluding
-- virtual transactions, there should be at most one missing balance,
-- otherwise return Nothing.
autofillTransactions :: [RawTransaction] -> Maybe [RawTransaction]
autofillTransactions ts =
case (length withmissingamounts) of
0 -> Just ts
1 -> Just $ map balance ts
otherwise -> Nothing
where
(reals, _) = partition isReal ts
(withrealamounts, withmissingamounts) = partition hasAmount reals
balance t = if (isReal t) && (not $ hasAmount t)
then t{tamount = -otherssimpletotal}
else t
otherstotal = sumRawTransactions withrealamounts
otherssimpletotal
| length otherstotal == 1 = head otherstotal
| otherwise = error "sorry, can't balance a mixed-commodity entry yet"
isReal :: RawTransaction -> Bool
isReal t = rttype t == RegularTransaction

View File

@ -76,10 +76,10 @@ unittests = TestList [
"ledgerentry" ~: do
assertparseequal entry1 (parsewith ledgerentry entry1_str)
,
"autofillEntry" ~: do
"balanceEntry" ~: do
assertequal
(dollars (-47.18))
(tamount $ last $ etransactions $ autofillEntry entry1)
(tamount $ last $ etransactions $ balanceEntry entry1)
,
"punctuatethousands" ~: punctuatethousands "" @?= ""
,