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

View File

@ -21,26 +21,6 @@ showRawTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ ta
showaccountname = printf "%-22s" . elideAccountName 22 showaccountname = printf "%-22s" . elideAccountName 22
showamount = printf "%12s" . showAmountOrZero 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 :: RawTransaction -> Bool
isReal t = rttype t == RegularTransaction isReal t = rttype t == RegularTransaction

View File

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