rename and unify the autofill stuff
This commit is contained in:
parent
a304ad3ca6
commit
d31ba41703
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
4
Tests.hs
4
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 "" @?= ""
|
||||
,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user