diff --git a/Ledger/Entry.hs b/Ledger/Entry.hs index cbdd98edb..457ba4e2a 100644 --- a/Ledger/Entry.hs +++ b/Ledger/Entry.hs @@ -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 diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index 492c204b8..7fe6236f7 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -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 diff --git a/Ledger/RawTransaction.hs b/Ledger/RawTransaction.hs index 7dfcf0fb6..1e6eafbdc 100644 --- a/Ledger/RawTransaction.hs +++ b/Ledger/RawTransaction.hs @@ -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 diff --git a/Tests.hs b/Tests.hs index f850ccec4..42c84b636 100644 --- a/Tests.hs +++ b/Tests.hs @@ -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 "" @?= "" ,