remove obsolete code, cleanups

AccountName.hs

@@ -79,12 +79,3 @@ accountNameTreeFrom accts =
           accountsFrom as = [Node a (accountsFrom $ subs a) | a <- as]
           subs = (subAccountNamesFrom accts)
 
-filterAccountNameTree :: [String] -> Bool -> Int -> Tree AccountName -> Tree AccountName
-filterAccountNameTree pats keepsubs maxdepth =
-    treefilter (\a -> matchany a || (keepsubs && issubofmatch a)) . treeprune maxdepth
-    where
-      regexes = map mkRegex pats
-      matchany a = any (match a) regexes
-      match a r = matchAccountName r $ accountLeafName a
-      issubofmatch a = any matchany $ parentAccountNames a
-

Ledger.hs

@@ -43,11 +43,11 @@ cacheLedger acctpats descpats l =
     let 
         (acctpats', descpats') = (wilddefault acctpats, wilddefault descpats)
         l' = filterLedgerEntries acctpats descpats l
-        ant = filterAccountNameTree acctpats' True 9999 $ rawLedgerAccountNameTree l'
+        ant = rawLedgerAccountNameTree l'
         ans = flatten ant
         filterTxnsByAcctpats ts = concat [filter (matchTransactionAccount $ mkRegex r) ts | r <- acctpats']
-        allts = rawLedgerTransactions l'
+        allts = rawLedgerTransactions l
-        ts = filterTxnsByAcctpats allts
+        ts = rawLedgerTransactions l'
         sortedts = sortBy (comparing account) ts
         groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
         tmap = Map.union 
@@ -64,8 +64,9 @@ cacheLedger acctpats descpats l =
     in
       Ledger l' ant amap lprecision
 
-filterLedgerEntries :: [String] -> [String] -> LedgerFile -> LedgerFile
+-- filter entries by descpats and by whether any transactions contain any acctpats
-filterLedgerEntries acctpats descpats (LedgerFile ms ps es) = 
+filterLedgerEntries1 :: [String] -> [String] -> LedgerFile -> LedgerFile
+filterLedgerEntries1 acctpats descpats (LedgerFile ms ps es) = 
     LedgerFile ms ps es'
     where
       es' = intersect
@@ -84,6 +85,29 @@ filterLedgerEntries acctpats descpats (LedgerFile ms ps es) =
                         Nothing -> False
                         otherwise -> True
 
+-- filter txns in each entry by acctpats, then filter the modified entries by descpats
+filterLedgerEntries :: [String] -> [String] -> LedgerFile -> LedgerFile
+filterLedgerEntries acctpats descpats (LedgerFile ms ps es) = 
+    LedgerFile ms ps es'
+    where
+      es' = filter matchanydesc $ map filtertxns es
+      acctregexps = map mkRegex $ wilddefault acctpats
+      descregexps = map mkRegex $ wilddefault descpats
+      filtertxns :: LedgerEntry -> LedgerEntry
+      filtertxns (LedgerEntry d s cod desc com ts) = LedgerEntry d s cod desc com $ filter matchanyacct ts
+      matchanyacct :: LedgerTransaction -> Bool
+      matchanyacct t = any (matchtxn t) acctregexps
+      matchtxn :: LedgerTransaction -> Regex -> Bool
+      matchtxn t r = case matchRegex r (taccount t) of
+                       Nothing -> False
+                       otherwise -> True
+      matchanydesc :: LedgerEntry -> Bool
+      matchanydesc e = any (matchdesc e) descregexps
+      matchdesc :: LedgerEntry -> Regex -> Bool
+      matchdesc e r = case matchRegex r (edescription e) of
+                        Nothing -> False
+                        otherwise -> True
+
 accountnames :: Ledger -> [AccountName]
 accountnames l = flatten $ accountnametree l
 
@@ -100,21 +124,9 @@ ledgerTransactions l =
     where
       setprecisions = map (transactionSetPrecision (lprecision l))
 
-ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [Transaction]
+ledgerAccountTree :: Ledger -> Int -> Tree Account
-ledgerTransactionsMatching (acctpats,descpats) l =
+ledgerAccountTree l depth = 
-    intersect 
+    addDataToAccountNameTree l $ treeprune depth $ accountnametree l
-    (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
-    (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
-    where 
-      ts = ledgerTransactions l
-      acctregexps = map mkRegex $ wilddefault acctpats
-      descregexps = map mkRegex $ wilddefault descpats
-
-ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account
-ledgerAccountTreeMatching l acctpats showsubs maxdepth = 
-    addDataToAccountNameTree l $ 
-    filterAccountNameTree (wilddefault acctpats) showsubs maxdepth $ 
-    accountnametree l
 
 addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
 addDataToAccountNameTree = treemap . ledgerAccount
@@ -181,11 +193,11 @@ addDataToAccountNameTree = treemap . ledgerAccount
 --   f
 --   g
 
-showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
+showLedgerAccounts :: Ledger -> Int -> String
-showLedgerAccounts l acctpats showsubs maxdepth = 
+showLedgerAccounts l maxdepth = 
     concatMap 
     (showAccountTree l) 
-    (branches $ ledgerAccountTreeMatching l acctpats showsubs maxdepth)
+    (branches $ ledgerAccountTree l maxdepth)
 
 showAccountTree :: Ledger -> Tree Account -> String
 showAccountTree l = showAccountTree' l 0 . pruneBoringBranches

Tests.hs

@@ -383,5 +383,5 @@ test_cacheLedger =
     assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger [] [] ledger7)
 
 test_showLedgerAccounts = 
-    assertEqual' 4 (length $ lines $ showLedgerAccounts l7 [] False 1)
+    assertEqual' 4 (length $ lines $ showLedgerAccounts l7 1)
 

hledger.hs

@@ -26,53 +26,14 @@ main = do
   run cmd opts acctpats descpats
   where run cmd opts acctpats descpats
             | Help `elem` opts            = putStr usage
-            | cmd `isPrefixOf` "register" = register opts acctpats descpats
+            | cmd `isPrefixOf` "test"     = test     opts acctpats descpats
-            | cmd `isPrefixOf` "balance"  = balance opts acctpats descpats
             | cmd `isPrefixOf` "print"    = printcmd opts acctpats descpats
-            | cmd `isPrefixOf` "test"     = test
+            | cmd `isPrefixOf` "register" = register opts acctpats descpats
+            | cmd `isPrefixOf` "balance"  = balance  opts acctpats descpats
             | otherwise                   = putStr usage
 
--- commands
+doWithFilteredLedger :: [Flag] -> [String] -> [String] -> (Ledger -> IO ()) -> IO ()
-
+doWithFilteredLedger opts acctpats descpats cmd = do
-test :: IO ()
-test = do
-  Tests.hunit
-  Tests.quickcheck
-  return ()
-
-printcmd :: [Flag] -> [String] -> [String] -> IO ()
-printcmd opts acctpats descpats = do 
-  doWithLedger opts acctpats descpats printentries
-    where
-      printentries l = putStr $ showEntries $ setprecision $ entries $ rawledger l
-          where
-            setprecision = map (entrySetPrecision (lprecision l))
-
-register :: [Flag] -> [String] -> [String] -> IO ()
-register opts acctpats descpats = do 
-  doWithLedger opts acctpats descpats printregister
-    where 
-      printregister l = 
-          putStr $ showTransactionsWithBalances 
-                     (sortBy (comparing date) (ledgerTransactionsMatching (acctpats, descpats) l))
-                     nullamt{precision=lprecision l}
-
-balance :: [Flag] -> [String] -> [String] -> IO ()
-balance opts acctpats descpats = do
-  doWithLedger opts acctpats descpats printbalance
-    where
-      printbalance l =
-          putStr $ showLedgerAccounts l acctpats showsubs maxdepth
-              where 
-                showsubs = (ShowSubs `elem` opts)
-                maxdepth = case (acctpats, showsubs) of
-                             ([],False) -> 1
-                             otherwise  -> 9999
-
--- utils
-
-doWithLedger :: [Flag] -> [String] -> [String] -> (Ledger -> IO ()) -> IO ()
-doWithLedger opts acctpats descpats cmd = do
     ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed acctpats descpats cmd
 
 doWithParsed :: [String] -> [String] -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO ()
@@ -80,6 +41,42 @@ doWithParsed acctpats descpats cmd parsed = do
   case parsed of Left e -> parseError e
                  Right l -> cmd $ cacheLedger acctpats descpats l 
 
+type Command = [Flag] -> [String] -> [String] -> IO ()
+
+test :: Command
+test opts acctpats descpats = do 
+  Tests.hunit
+  Tests.quickcheck
+  return ()
+
+printcmd :: Command
+printcmd opts acctpats descpats = do 
+  doWithFilteredLedger opts acctpats descpats printentries
+    where
+      printentries l = putStr $ showEntries $ setprecision $ entries $ rawledger l
+          where
+            setprecision = map (entrySetPrecision (lprecision l))
+
+register :: Command
+register opts acctpats descpats = do 
+  doWithFilteredLedger opts acctpats descpats printregister
+    where 
+      printregister l = 
+          putStr $ showTransactionsWithBalances 
+                     (sortBy (comparing date) $ ledgerTransactions l)
+                     nullamt{precision=lprecision l}
+
+balance :: Command
+balance opts acctpats descpats = do
+  doWithFilteredLedger opts acctpats descpats printbalance
+    where
+      printbalance l =
+          putStr $ showLedgerAccounts l depth
+              where 
+                showsubs = (ShowSubs `elem` opts)
+                depth = case (acctpats, showsubs) of
+                          ([],False) -> 1
+                          otherwise  -> 9999
 
 {-
 interactive testing: