diff --git a/BalanceCommand.hs b/BalanceCommand.hs index 2adde5206..758968ec5 100644 --- a/BalanceCommand.hs +++ b/BalanceCommand.hs @@ -122,16 +122,16 @@ showBalanceReport :: [Opt] -> [String] -> Ledger -> String showBalanceReport opts args l = acctsstr ++ totalstr where acctsstr = concatMap (showAccountTreeWithBalances acctnamestoshow) $ subs treetoshow - totalstr = if isZeroAmount total + totalstr = if isZeroMixedAmount total then "" - else printf "--------------------\n%20s\n" $ showAmount total + else printf "--------------------\n%20s\n" $ showMixedAmount total showingsubs = ShowSubs `elem` opts pats@(apats,dpats) = parseAccountDescriptionArgs args maxdepth = if null args && not showingsubs then 1 else 9999 acctstoshow = balancereportaccts showingsubs apats l acctnamestoshow = map aname acctstoshow treetoshow = pruneZeroBalanceLeaves $ pruneUnmatchedAccounts $ treeprune maxdepth $ ledgerAccountTree 9999 l - total = sumAmounts $ map abalance $ nonredundantaccts + total = sumMixedAmounts $ map abalance $ nonredundantaccts nonredundantaccts = filter (not . hasparentshowing) acctstoshow hasparentshowing a = (parentAccountName $ aname a) `elem` acctnamestoshow @@ -158,7 +158,7 @@ showBalanceReport opts args l = acctsstr ++ totalstr -- remove zero-balance leaf accounts (recursively) pruneZeroBalanceLeaves :: Tree Account -> Tree Account - pruneZeroBalanceLeaves = treefilter (not . isZeroAmount . abalance) + pruneZeroBalanceLeaves = treefilter (not . isZeroMixedAmount . abalance) -- | Show a tree of accounts with balances, for the balance report, -- eliding boring parent accounts. Requires a list of the account names we @@ -176,7 +176,7 @@ showAccountTreeWithBalances matchednames = subswithprefix = showsubs indent (prefix++leafname++":") showsubs i p = concatMap (showAccountTreeWithBalances' matchednames i p) subs this = showbal ++ spaces ++ prefix ++ leafname ++ "\n" - showbal = printf "%20s" $ show bal + showbal = printf "%20s" $ showMixedAmount bal spaces = " " ++ replicate (indent * 2) ' ' leafname = accountLeafName fullname isboringparent = numsubs >= 1 && (bal == subbal || not matched) diff --git a/Ledger/Account.hs b/Ledger/Account.hs index 113af60a7..3e78a49be 100644 --- a/Ledger/Account.hs +++ b/Ledger/Account.hs @@ -14,7 +14,7 @@ import Ledger.Amount instance Show Account where - show (Account a ts b) = printf "Account %s with %d txns and %s balance" a (length ts) (show b) + show (Account a ts b) = printf "Account %s with %d txns and %s balance" a (length ts) (showMixedAmount b) -nullacct = Account "" [] nullamt +nullacct = Account "" [] [] diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs index 8f47c4314..7997df838 100644 --- a/Ledger/Amount.hs +++ b/Ledger/Amount.hs @@ -38,13 +38,31 @@ examples: module Ledger.Amount where +import qualified Data.Map as Map import Ledger.Utils import Ledger.Types import Ledger.Commodity instance Show Amount where show = showAmount +-- instance Show MixedAmount where show = showMixedAmount +showMixedAmount :: MixedAmount -> String +showMixedAmount as = concat $ intersperse ", " $ map show $ normaliseMixedAmount as + +normaliseMixedAmount :: MixedAmount -> MixedAmount +normaliseMixedAmount as = map sumAmounts $ groupAmountsByCommodity as + +groupAmountsByCommodity :: [Amount] -> [[Amount]] +groupAmountsByCommodity as = grouped + where + grouped = [filter (hassymbol s) as | s <- symbols] + hassymbol s a = s == (symbol $ commodity a) + symbols = sort $ nub $ map (symbol . commodity) as + +-- samecommoditysymbol Amount{commodity=c1} Amount{commodity=c2} = samesymbol c1 c2 +-- samesymbol Commodity{symbol=s1} Commodity{symbol=s2} = s1==s2 + -- | Get the string representation of an amount, based on its commodity's -- display settings. showAmount :: Amount -> String @@ -78,6 +96,9 @@ isZeroAmount :: Amount -> Bool isZeroAmount a@(Amount c _ ) = nonzerodigits == "" where nonzerodigits = filter (`elem` "123456789") $ showAmount a +isZeroMixedAmount :: MixedAmount -> Bool +isZeroMixedAmount = all isZeroAmount . normaliseMixedAmount + instance Num Amount where abs (Amount c q) = Amount c (abs q) signum (Amount c q) = Amount c (signum q) @@ -104,6 +125,9 @@ convertAmountTo c2 (Amount c1 q) = Amount c2 (q * conversionRate c1 c2) sumAmounts :: [Amount] -> Amount sumAmounts = sum . filter (not . isZeroAmount) +sumMixedAmounts :: [MixedAmount] -> MixedAmount +sumMixedAmounts = concat + nullamt = Amount (comm "") 0 -- temporary value for partial entries diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index d73da71ad..2291c0b65 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -43,8 +43,8 @@ cacheLedger l = subacctsof a = filter (a `isAccountNamePrefixOf`) anames subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a] balmap = Map.union - (Map.fromList [(a, (sumTransactions $ subtxnsof a)) | a <- anames]) - (Map.fromList [(a,nullamt) | a <- anames]) + (Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames]) + (Map.fromList [(a,[]) | a <- anames]) amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames] in Ledger l ant amap diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs index 55bee7c08..2a2effb67 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -29,7 +29,8 @@ flattenEntry (Entry d _ _ desc _ ts _, e) = accountNamesFromTransactions :: [Transaction] -> [AccountName] accountNamesFromTransactions ts = nub $ map account ts -sumTransactions :: [Transaction] -> Amount -sumTransactions = sum . map amount +sumTransactions :: [Transaction] -> MixedAmount +-- sumTransactions = sum . map amount +sumTransactions = map amount nulltxn = Transaction 0 "" "" "" nullamt RegularTransaction diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 722441236..2ab131cb8 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -97,7 +97,7 @@ data Transaction = Transaction { data Account = Account { aname :: AccountName, atransactions :: [Transaction], - abalance :: Amount + abalance :: MixedAmount } data Ledger = Ledger {