more code cleanups

BalanceCommand.hs

@@ -164,21 +164,22 @@ showBalanceReport opts args l = acctsstr ++ totalstr
 -- 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 matchednames = 
-    showAccountTreeWithBalances' matchedacctnames 0 ""
+    showAccountTreeWithBalances' matchednames 0 ""
     where
       showAccountTreeWithBalances' :: [AccountName] -> Int -> String -> Tree Account -> String
-      showAccountTreeWithBalances' matchedacctnames indentlevel prefix (Node (Account fullname _ bal) subs) =
+      showAccountTreeWithBalances' matchednames indent prefix (Node (Account fullname _ bal) subs)
-          if isboringparent then showsubswithprefix else showacct ++ showsubswithindent
+          | not isboringparent = this ++ subswithindent
+          | otherwise = subswithprefix
           where
-            showsubswithprefix = showsubs indentlevel (prefix++leafname++":")
+            subswithindent = showsubs (indent+1) ""
-            showsubswithindent = showsubs (indentlevel+1) ""
+            subswithprefix = showsubs indent (prefix++leafname++":")
-            showsubs i p = concatMap (showAccountTreeWithBalances' matchedacctnames i p) subs
+            showsubs i p = concatMap (showAccountTreeWithBalances' matchednames i p) subs
-            showacct = showbal ++ "  " ++ indent ++ prefix ++ leafname ++ "\n"
+            this = showbal ++ spaces ++ prefix ++ leafname ++ "\n"
             showbal = printf "%20s" $ show bal
-            indent = replicate (indentlevel * 2) ' '
+            spaces = "  " ++ replicate (indent * 2) ' '
             leafname = accountLeafName fullname
+            isboringparent = numsubs >= 1 && (bal == subbal || not matched)
             numsubs = length subs
             subbal = abalance $ root $ head subs
-            matched = fullname `elem` matchedacctnames
+            matched = fullname `elem` matchednames
-            isboringparent = numsubs >= 1 && (bal == subbal || not matched)

Ledger/Entry.hs

@@ -15,24 +15,6 @@ import Ledger.Amount
 
 instance Show Entry where show = showEntry
 
-{-
-Helpers for the register report. A register entry is displayed as two
-or more lines like this:
-
-@
-date       description          account                 amount       balance
-DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
-                                aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
-                                ...                     ...         ...
-
-datewidth = 10
-descwidth = 20
-acctwidth = 22
-amtwidth  = 11
-balwidth  = 12
-@
--}
-
 showEntryDescription e = 
     (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " "
 showDate d = printf "%-10s" d

RegisterCommand.hs

@@ -12,27 +12,36 @@ import Options
 
 -- | Print a register report.
 register :: [Opt] -> [String] -> Ledger -> IO ()
-register opts args l = putStr $ showTransactionsWithBalances opts args l
+register opts args l = putStr $ showRegisterReport opts args l
 
-showTransactionsWithBalances :: [Opt] -> [String] -> Ledger -> String
+{- |
-showTransactionsWithBalances opts args l =
+Generate the register report. Each ledger entry is displayed as two or
-    unlines $ showTransactionsWithBalances' ts nulltxn startingbalance
+more lines like this:
-        where
+
-          ts = filter matchtxn $ ledgerTransactions l
+@
-          matchtxn (Transaction _ _ desc acct _ _) = matchLedgerPatterns False apats acct
+date (10)  description (20)     account (22)            amount (11)  balance (12)
-          apats = fst $ parseAccountDescriptionArgs args
+DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
-          startingbalance = nullamt
+                                aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
-          showTransactionsWithBalances' :: [Transaction] -> Transaction -> Amount -> [String]
+                                ...                     ...         ...
-          showTransactionsWithBalances' [] _ _ = []
+@
-          showTransactionsWithBalances' (t@Transaction{amount=a}:ts) tprev b = 
+-}
-              (if isZeroAmount a then [] else this) ++ rest
+showRegisterReport :: [Opt] -> [String] -> Ledger -> String
-              where
+showRegisterReport opts args l = showtxns ts nulltxn nullamt
-                b' = b + (amount t)
+    where
-                sameentry (Transaction {entryno=e1}) (Transaction {entryno=e2}) = e1 == e2
+      ts = filter matchtxn $ ledgerTransactions l
-                this = if sameentry t tprev
+      matchtxn Transaction{account=a} = matchLedgerPatterns False apats a
-                       then [showTransactionWithoutDescription t b']
+      apats = fst $ parseAccountDescriptionArgs args
-                       else [showTransactionWithDescription t b']
+
-                rest = showTransactionsWithBalances' ts t b'
+      -- show transactions, one per line, keeping a running balance
+      showtxns [] _ _ = ""
+      showtxns (t@Transaction{amount=a}:ts) tprev bal =
+          (if isZeroAmount a then "" else this) ++ showtxns ts t bal'
+          where
+            this = if t `issame` tprev
+                   then showTransactionWithoutDescription t bal'
+                   else showTransactionWithDescription t bal'
+            issame t1 t2 = entryno t1 == entryno t2
+            bal' = bal + amount t
 
 showTransactionWithDescription :: Transaction -> Amount -> String
 showTransactionWithDescription t b =

Tests.hs

@@ -218,7 +218,7 @@ registercommandtests = TestList [
   "register does something" ~:
   do 
     l <- ledgerfromfile "sample.ledger"
-    assertnotequal "" $ showTransactionsWithBalances [] [] l
+    assertnotequal "" $ showRegisterReport [] [] l
   ]
   
 -- | Assert a parsed thing equals some expected thing, or print a parse error.