From a64d320c84a86fbcd9dc513b2b22ff9bcbf3f320 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 12 Oct 2008 06:23:55 +0000 Subject: [PATCH] a more compatible balance report, not perfect yet --- BalanceCommand.hs | 182 +++++++++++++++------------------------------- 1 file changed, 57 insertions(+), 125 deletions(-) diff --git a/BalanceCommand.hs b/BalanceCommand.hs index 8620693d4..464ea0123 100644 --- a/BalanceCommand.hs +++ b/BalanceCommand.hs @@ -47,8 +47,8 @@ With -s (--showsubs), also show the subaccounts: - @checking@ is not shown because it has a zero balance and no interesting subaccounts. -- @liabilities@ is displayed only as a prefix because it has no transactions - of its own and only one subaccount. +- @liabilities@ is displayed only as a prefix because it has the same balance + as its single subaccount. With an account pattern, show only the accounts with matching names: @@ -82,39 +82,22 @@ Again, -s adds the subaccounts: - We do not add the subaccounts of parents included for context (@expenses@). -Here are some rules for account balance display, as seen above: +Some notes for the implementation: -- grand total is omitted if it is 0 +- a simple balance report shows top-level accounts -- leaf accounts and branches with 0 balance or 0 transactions are omitted +- with an account pattern, it shows accounts whose leafname matches, plus their parents -- inner accounts with 0 transactions and 1 subaccount are displayed inline +- with the showsubs option, it also shows all subaccounts of the above -- in a filtered report, matched accounts are displayed with their parents - inline (a consequence of the above) +- zero-balance leaf accounts are removed -- in a showsubs report, all subaccounts of matched accounts are displayed +- the resulting account tree is displayed with each account's aggregated + balance, with boring parents prefixed to the next line. A boring parent + has the same balance as its single child and is not explicitly matched + by the display options. --} -{- -let's start over: - -a simple balance report lists top-level non-boring accounts, with their aggregated balances, followed by the total - -a balance report with showsubs lists all non-boring accounts, with their aggregated balances, followed by the total - -a filtered balance report lists non-boring accounts whose leafname matches the filter, with their aggregated balances, followed by the total - -a filtered balance report with showsubs lists non-boring accounts whose leafname matches the filter, plus their subaccounts, with their aggregated balances, followed by the total - -the total is the sum of the aggregated balances shown, excluding subaccounts whose parent's balance is shown. If the total is zero it is not shown. - -boring accounts are -- leaf accounts with zero balance; these are never shown -- non-matched parent accounts of matched accounts, when filtering; these are shown inline -- parent accounts with no transactions of their own and a single subaccount; these are shown inline - -maxdepth may affect this further +- the sum of the balances shown is displayed at the end, if it is non-zero -} @@ -133,119 +116,68 @@ import Utils printbalance :: [Opt] -> [String] -> Ledger -> IO () printbalance opts args l = putStr $ balancereport opts args l -balancereport = balancereport1 - --- | List the accounts for which we should show balances in the balance --- report, based on the options. -balancereportaccts :: Bool -> [String] -> Ledger -> [Account] -balancereportaccts False [] l = topAccounts l -balancereportaccts False pats l = accountsMatching (regexFor pats) l -balancereportaccts True pats l = addsubaccts l $ balancereportaccts False pats l - --- | Add (in tree order) any missing subacccounts to a list of accounts. -addsubaccts l as = concatMap addsubs as where addsubs = maybe [] flatten . ledgerAccountTreeAt l - -balancereport2 :: [Opt] -> [String] -> Ledger -> String -balancereport2 opts args l = acctsstr ++ totalstr - where - accts = balancereportaccts (ShowSubs `elem` opts) args l - showacct a = - bal ++ " " ++ indent ++ prefix ++ fullname ++ "\n" - where - bal = printf "%20s" $ show $ abalance a - indentlevel = 0 - prefix = "" - indent = replicate (indentlevel * 2) ' ' - fullname = aname a - leafname = accountLeafName fullname - acctsstr = concatMap showacct accts - total = sumAmounts $ map abalance $ removeduplicatebalances accts - removeduplicatebalances as = filter (not . hasparentshowing) as - where - hasparentshowing a = (parentAccountName $ aname a) `elem` names - names = map aname as - totalstr - | isZeroAmount total = "" - | otherwise = printf "--------------------\n%20s\n" $ showAmountRounded total - --- | Generate balance report output for a ledger. -balancereport1 :: [Opt] -> [String] -> Ledger -> String -balancereport1 opts args l = acctsstr ++ totalstr +-- | Generate balance report output for a ledger, based on options. +balancereport :: [Opt] -> [String] -> Ledger -> String +balancereport opts args l = acctsstr ++ totalstr where - showsubs = (ShowSubs `elem` opts) + acctsstr = concatMap (showAccountTreeWithBalances acctnamestoshow) $ subs treetoshow + totalstr = if isZeroAmount total + then "" + else printf "--------------------\n%20s\n" $ showAmountRounded total + showingsubs = ShowSubs `elem` opts pats@(apats,dpats) = parseAccountDescriptionArgs args - maxdepth = case (pats, showsubs) of - (([],[]), False) -> 1 -- with no -s or pattern, show with depth 1 - otherwise -> 9999 - - acctstoshow = balancereportaccts showsubs apats l - acctnames = map aname acctstoshow + 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 - acctforest = subs treetoshow - - acctsstr = concatMap (showAccountTree l maxdepth) acctforest - - totalstr - | isZeroAmount total = "" - | otherwise = printf "--------------------\n%20s\n" $ showAmountRounded total total = sumAmounts $ map abalance $ nonredundantaccts nonredundantaccts = filter (not . hasparentshowing) acctstoshow - hasparentshowing a = (parentAccountName $ aname a) `elem` acctnames + hasparentshowing a = (parentAccountName $ aname a) `elem` acctnamestoshow + + -- select accounts for which we should show balances, based on the options + balancereportaccts :: Bool -> [String] -> Ledger -> [Account] + balancereportaccts False [] l = topAccounts l + balancereportaccts False pats l = accountsMatching (regexFor pats) l + balancereportaccts True pats l = addsubaccts l $ balancereportaccts False pats l + + -- add (in tree order) any missing subacccounts to a list of accounts + addsubaccts :: Ledger -> [Account] -> [Account] + addsubaccts l as = concatMap addsubs as where addsubs = maybe [] flatten . ledgerAccountTreeAt l -- remove any accounts from the tree which are not one of the acctstoshow, - -- or one of their parents, or one of their subaccounts when doing showsubs + -- or one of their parents, or one of their subaccounts when doing --showsubs pruneUnmatchedAccounts :: Tree Account -> Tree Account pruneUnmatchedAccounts = treefilter matched where - matched :: Account -> Bool matched (Account name _ _) - | name `elem` acctnames = True - | any (name `isAccountNamePrefixOf`) acctnames = True - | showsubs && any (`isAccountNamePrefixOf` name) acctnames = True + | name `elem` acctnamestoshow = True + | any (name `isAccountNamePrefixOf`) acctnamestoshow = True + | showingsubs && any (`isAccountNamePrefixOf` name) acctnamestoshow = True | otherwise = False - -- remove all zero-balance leaf accounts (recursively) + -- remove zero-balance leaf accounts (recursively) pruneZeroBalanceLeaves :: Tree Account -> Tree Account pruneZeroBalanceLeaves = treefilter (not . isZeroAmount . abalance) --- | Get the string representation of a tree of accounts. --- The ledger from which the accounts come is required so that --- we can check for boring accounts. -showAccountTree :: Ledger -> Int -> Tree Account -> String -showAccountTree l maxdepth = showAccountTree' l maxdepth 0 "" +-- | Show a tree of accounts with balances, for the balance report, +-- eliding boring parent accounts. Requires a list of the account names we +-- are interested in to help with that. +showAccountTreeWithBalances :: [AccountName] -> Tree Account -> String +showAccountTreeWithBalances matchedacctnames = + showAccountTreeWithBalances' matchedacctnames 0 "" where - showAccountTree' :: Ledger -> Int -> Int -> String -> Tree Account -> String - showAccountTree' l maxdepth indentlevel prefix t - - | isBoringParentAccount (length subaccts) (length $ subAccounts l a) maxdepth a = nextwithprefix - | otherwise = thisline ++ nextwithindent - + showAccountTreeWithBalances' :: [AccountName] -> Int -> String -> Tree Account -> String + showAccountTreeWithBalances' matchedacctnames indentlevel prefix (Node (Account fullname _ bal) subs) = + if isboringparent then showsubswithprefix else showacct ++ showsubswithindent where - a = root t - subaccts = subs t - nextwithprefix = showsubs 0 (fullname++":") - nextwithindent = showsubs 1 "" - showsubs i p = concatMap (showAccountTree' l maxdepth (indentlevel+i) p) subaccts - thisline = bal ++ " " ++ indent ++ prefix ++ leafname ++ "\n" - - bal = printf "%20s" $ show $ abalance $ a + showsubswithprefix = showsubs indentlevel (fullname++":") + showsubswithindent = showsubs (indentlevel+1) "" + showsubs i p = concatMap (showAccountTreeWithBalances' matchedacctnames i p) subs + showacct = showbal ++ " " ++ indent ++ prefix ++ leafname ++ "\n" + showbal = printf "%20s" $ show bal indent = replicate (indentlevel * 2) ' ' leafname = accountLeafName fullname - fullname = aname a - filtering = filteredaccountnames l /= (accountnames l) - doesnotmatch = not (containsRegex (acctpat l) leafname) - - -- Boring parent accounts have the same balance as their - -- single child. In other words they have exactly one child - -- (which we may not be showing) and no transactions. Also - -- their depth is less than the maximum display depth. - -- ..or some such thing.. - --isBoringParentAccount :: Int -> Int -> Account -> Bool - isBoringParentAccount numsubs realnumsubs maxdepth a - | name == "top" = False - | depth < maxdepth && numtxns == 0 && numsubs == 1 = True - | otherwise = False - where - name = aname a - depth = accountNameLevel name - numtxns = length $ atransactions a + isboringparent = numsubs == 1 && (bal == subbal || not matched) + numsubs = length subs + subbal = abalance $ root $ head subs + matched = fullname `elem` matchedacctnames