consolidate register command code, make it do filtering

Ledger/Transaction.hs

@@ -37,33 +37,4 @@ accountNamesFromTransactions ts = nub $ map account ts
 sumTransactions :: [Transaction] -> Amount
 sumTransactions = sum . map amount
 
--- | for register command 
+nulltxn = Transaction 0 "" "" "" nullamt
-
-showTransactionsWithBalances :: [Transaction] -> Amount -> String
-showTransactionsWithBalances [] _ = []
-showTransactionsWithBalances ts b =
-    unlines $ showTransactionsWithBalances' ts dummyt b
-        where
-          dummyt = Transaction 0 "" "" "" nullamt
-          showTransactionsWithBalances' [] _ _ = []
-          showTransactionsWithBalances' (t:ts) tprev b =
-              (if sameentry t tprev
-               then [showTransactionAndBalance t b']
-               else [showTransactionDescriptionAndBalance t b'])
-              ++ (showTransactionsWithBalances' ts t b')
-                  where 
-                    b' = b + (amount t)
-                    sameentry (Transaction e1 _ _ _ _) (Transaction e2 _ _ _ _) = e1 == e2
-
-showTransactionDescriptionAndBalance :: Transaction -> Amount -> String
-showTransactionDescriptionAndBalance t b =
-    (showEntryDescription $ Entry (date t) False "" (description t) "" [] "") 
-    ++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)
-
-showTransactionAndBalance :: Transaction -> Amount -> String
-showTransactionAndBalance t b =
-    (replicate 32 ' ') ++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)
-
-showBalance :: Amount -> String
-showBalance b = printf " %12s" (showAmountRoundedOrZero b)
-

RegisterCommand.hs

@@ -15,7 +15,36 @@ registercommandtests = TestList [
 
 -- | Print a register report.
 printregister :: [Opt] -> [String] -> Ledger -> IO ()
-printregister opts args l = putStr $ showTransactionsWithBalances txns startingbalance
+printregister opts args l = putStr $ showTransactionsWithBalances opts args l
-    where
+
-      txns = sortBy (comparing date) $ ledgerTransactions l
+showTransactionsWithBalances :: [Opt] -> [String] -> Ledger -> String
-      startingbalance = nullamt{precision=lprecision l}
+showTransactionsWithBalances opts args l =
+    unlines $ showTransactionsWithBalances' ts nulltxn startingbalance
+        where
+          ts = filter matchtxn $ ledgerTransactions l
+          matchtxn (Transaction _ _ desc acct _) = (containsRegex (regexFor apats) acct)
+          pats@(apats,dpats) = parseAccountDescriptionArgs args
+          startingbalance = nullamt{precision=lprecision l}
+          showTransactionsWithBalances' :: [Transaction] -> Transaction -> Amount -> [String]
+          showTransactionsWithBalances' [] _ _ = []
+          showTransactionsWithBalances' (t:ts) tprev b =
+              (if sameentry t tprev
+               then [showTransactionAndBalance t b']
+               else [showTransactionDescriptionAndBalance t b'])
+              ++ (showTransactionsWithBalances' ts t b')
+                  where 
+                    b' = b + (amount t)
+                    sameentry (Transaction e1 _ _ _ _) (Transaction e2 _ _ _ _) = e1 == e2
+
+showTransactionDescriptionAndBalance :: Transaction -> Amount -> String
+showTransactionDescriptionAndBalance t b =
+    (showEntryDescription $ Entry (date t) False "" (description t) "" [] "") 
+    ++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)
+
+showTransactionAndBalance :: Transaction -> Amount -> String
+showTransactionAndBalance t b =
+    (replicate 32 ' ') ++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)
+
+showBalance :: Amount -> String
+showBalance b = printf " %12s" (showAmountRoundedOrZero b)
+