a more compatible balance report, not perfect yet

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
+- @liabilities@ is displayed only as a prefix because it has the same balance
-  of its own and only one subaccount.
+  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
+- zero-balance leaf accounts are removed
-  inline (a consequence of the above)
 
-- 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.
 
--}
+- the sum of the balances shown is displayed at the end, if it is non-zero
-{-
-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
 
 -}
 
@@ -133,119 +116,68 @@ import Utils
 printbalance :: [Opt] -> [String] -> Ledger -> IO ()
 printbalance opts args l = putStr $ balancereport opts args l
 
-balancereport = balancereport1
+-- | Generate balance report output for a ledger, based on options.
+balancereport :: [Opt] -> [String] -> Ledger -> String
+balancereport opts args l = acctsstr ++ totalstr
+    where 
+      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 = 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
+      nonredundantaccts = filter (not . hasparentshowing) acctstoshow
+      hasparentshowing a = (parentAccountName $ aname a) `elem` acctnamestoshow
 
--- | List the accounts for which we should show balances in the balance
+      -- select accounts for which we should show balances, based on the options
--- 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.
+      -- 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
 
-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
-    where 
-      showsubs = (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
-      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
-
       -- 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
+                | name `elem` acctnamestoshow = True
-                | any (name `isAccountNamePrefixOf`) acctnames = True
+                | any (name `isAccountNamePrefixOf`) acctnamestoshow = True
-                | showsubs && any (`isAccountNamePrefixOf` name) acctnames = 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.
+-- | Show a tree of accounts with balances, for the balance report,
--- The ledger from which the accounts come is required so that
+-- eliding boring parent accounts. Requires a list of the account names we
--- we can check for boring accounts.
+-- are interested in to help with that.
-showAccountTree :: Ledger -> Int -> Tree Account -> String
+showAccountTreeWithBalances :: [AccountName] -> Tree Account -> String
-showAccountTree l maxdepth = showAccountTree' l maxdepth 0 ""
+showAccountTreeWithBalances matchedacctnames = 
+    showAccountTreeWithBalances' matchedacctnames 0 ""
     where
-      showAccountTree' :: Ledger -> Int -> Int -> String -> Tree Account -> String
+      showAccountTreeWithBalances' :: [AccountName] -> Int -> String -> Tree Account -> String
-      showAccountTree' l maxdepth indentlevel prefix t
+      showAccountTreeWithBalances' matchedacctnames indentlevel prefix (Node (Account fullname _ bal) subs) =
-
+          if isboringparent then showsubswithprefix else showacct ++ showsubswithindent
-          | isBoringParentAccount (length subaccts) (length $ subAccounts l a) maxdepth a = nextwithprefix
-          | otherwise = thisline ++ nextwithindent
-
           where
-            a = root t
+            showsubswithprefix = showsubs indentlevel (fullname++":")
-            subaccts = subs t
+            showsubswithindent = showsubs (indentlevel+1) ""
-            nextwithprefix = showsubs 0 (fullname++":")
+            showsubs i p = concatMap (showAccountTreeWithBalances' matchedacctnames i p) subs
-            nextwithindent = showsubs 1 ""
+            showacct = showbal ++ "  " ++ indent ++ prefix ++ leafname ++ "\n"
-            showsubs i p = concatMap (showAccountTree' l maxdepth (indentlevel+i) p) subaccts
+            showbal = printf "%20s" $ show bal
-            thisline = bal ++ "  " ++ indent ++ prefix ++ leafname ++ "\n"
-
-            bal = printf "%20s" $ show $ abalance $ a
             indent = replicate (indentlevel * 2) ' '
             leafname = accountLeafName fullname
-            fullname = aname a
+            isboringparent = numsubs == 1 && (bal == subbal || not matched)
-            filtering = filteredaccountnames l /= (accountnames l)
+            numsubs = length subs
-            doesnotmatch = not (containsRegex (acctpat l) leafname)
+            subbal = abalance $ root $ head subs
-
+            matched = fullname `elem` matchedacctnames
-            -- 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