combine patterns into single regexps, fix a bug with print & patterns

Ledger.hs

@@ -38,14 +38,15 @@ instance Show Ledger where
 -- 1. filter based on account/description patterns, if any
 -- 2. cache per-account info
 -- also, figure out the precision(s) to use
-cacheLedger :: ([Regex],[Regex]) -> LedgerFile -> Ledger
+cacheLedger :: FilterPatterns -> LedgerFile -> Ledger
 cacheLedger pats l = 
     let 
         lprecision = maximum $ map (precision . amount) $ rawLedgerTransactions l
         l' = filterLedgerEntries pats l
-        ant = rawLedgerAccountNameTree l'
+        l'' = filterLedgerTransactions pats l'
+        ant = rawLedgerAccountNameTree l''
         ans = flatten ant
-        ts = rawLedgerTransactions l'
+        ts = rawLedgerTransactions l''
         sortedts = sortBy (comparing account) ts
         groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
         tmap = Map.union 
@@ -61,46 +62,30 @@ cacheLedger pats l =
     in
       Ledger l' ant amap lprecision
 
--- filter entries by descpats and by whether any transactions contain any acctpats
-filterLedgerEntries1 :: ([Regex],[Regex]) -> LedgerFile -> LedgerFile
-filterLedgerEntries1 (acctpats,descpats) (LedgerFile ms ps es) = 
-    LedgerFile ms ps es'
+-- filter entries by description and whether any transactions match account patterns
+filterLedgerEntries :: FilterPatterns -> LedgerFile -> LedgerFile
+filterLedgerEntries (acctpat,descpat) (LedgerFile ms ps es) = 
+    LedgerFile ms ps (filter matchdesc $ filter (any matchtxn . etransactions) es)
     where
-      es' = intersect
-            (concat [filter (matchacct r) es | r <- acctpats])
-            (concat [filter (matchdesc r) es | r <- descpats])
-      matchacct :: Regex -> LedgerEntry -> Bool
-      matchacct r e = any (matchtxn r) (etransactions e)
-      matchtxn :: Regex -> LedgerTransaction -> Bool
-      matchtxn r t = case matchRegex r (taccount t) of
-                       Nothing -> False
-                       otherwise -> True
-      matchdesc :: Regex -> LedgerEntry -> Bool
-      matchdesc r e = case matchRegex r (edescription e) of
-                        Nothing -> False
-                        otherwise -> True
+      matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of
+                     Nothing -> False
+                     otherwise -> True
+      matchdesc e = case matchRegex (wilddefault descpat) (edescription e) of
+                      Nothing -> False
+                      otherwise -> True
 
--- filter txns in each entry by acctpats, then filter the modified entries by descpats
--- this seems aggressive, unbalancing entries, but so far so goo-
-filterLedgerEntries :: ([Regex],[Regex]) -> LedgerFile -> LedgerFile
-filterLedgerEntries (acctpats,descpats) (LedgerFile ms ps es) = 
-    LedgerFile ms ps es'
+-- filter transactions in each ledger entry by account patterns
+-- this may unbalance entries
+filterLedgerTransactions :: FilterPatterns -> LedgerFile -> LedgerFile
+filterLedgerTransactions (acctpat,descpat) (LedgerFile ms ps es) = 
+    LedgerFile ms ps (map filterentrytxns es)
     where
-      es' = filter matchanydesc $ map filtertxns es
-      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) acctpats
-      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) descpats
-      matchdesc :: LedgerEntry -> Regex -> Bool
-      matchdesc e r = case matchRegex r (edescription e) of
-                        Nothing -> False
-                        otherwise -> True
+      filterentrytxns l@(LedgerEntry _ _ _ _ _ ts) = l{etransactions=filter matchtxn ts}
+      matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of
+                     Nothing -> False
+                     otherwise -> True
+
+wilddefault = fromMaybe (mkRegex ".*")
 
 accountnames :: Ledger -> [AccountName]
 accountnames l = flatten $ accountnametree l

Options.hs

@@ -6,6 +6,7 @@ import System.Environment (getEnv)
 import Data.Maybe (fromMaybe)
     
 import Utils
+import Types
 
 
 usagehdr       = "Usage: hledger [OPTIONS] "++commands++" [ACCTPATTERNS] [-- DESCPATTERNS]\nOptions:"
@@ -73,14 +74,15 @@ tildeExpand xs           =  return xs
 
 -- ledger pattern args are 0 or more account patterns optionally followed
 -- by -- and 0 or more description patterns
-parsePatternArgs :: [String] -> ([Regex],[Regex])
-parsePatternArgs args = argregexes acctpats descpats
-    where (acctpats, _:descpats) = break (=="--") args
+parsePatternArgs :: [String] -> FilterPatterns
+parsePatternArgs args = argpats as ds' 
+    where (as, ds) = break (=="--") args
+          ds' = dropWhile (=="--") ds
 
-argregexes :: [String] -> [String] -> ([Regex],[Regex])
-argregexes as ds = (regexify as, regexify ds)
+argpats :: [String] -> [String] -> FilterPatterns
+argpats as ds = (regexify as, regexify ds)
     where
-      regexify = map mkRegex . wilddefault
-      wilddefault [] = [".*"]
-      wilddefault a = a
+      regexify :: [String] -> Maybe Regex
+      regexify [] = Nothing
+      regexify ss = Just $ mkRegex $ "(" ++ (unwords $ intersperse "|" ss) ++ ")"
 

Tests.hs

@@ -283,7 +283,7 @@ ledger7 = LedgerFile
                  }
           ]
 
-l7 = cacheLedger (argregexes [] []) ledger7
+l7 = cacheLedger (argpats [] []) ledger7
 
 timelogentry1_str  = "i 2007/03/11 16:19:00 hledger\n"
 timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger"
@@ -373,7 +373,7 @@ test_ledgerAccountNames =
     (rawLedgerAccountNames ledger7)
 
 test_cacheLedger =
-    assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger (argregexes [] []) ledger7)
+    assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger (argpats [] []) ledger7)
 
 test_showLedgerAccounts = 
     assertEqual' 4 (length $ lines $ showLedgerAccounts l7 1)

Types.hs

@@ -30,6 +30,9 @@ hledger
 
 -}
 
+-- account and description-matching patterns
+type FilterPatterns = (Maybe Regex, Maybe Regex)
+                       
 type Date = String
 
 type DateTime = String

Utils.hs

@@ -6,6 +6,7 @@ module Utils (
               module Data.Tree,
               module Data.Map,
               module Data.Ord,
+              module Data.Maybe,
               module Text.Printf,
               module Text.Regex,
               module Debug.Trace,
@@ -18,6 +19,7 @@ import Data.List
 import Data.Tree
 import qualified Data.Map
 import Data.Ord
+import Data.Maybe
 import Text.Printf
 import Text.Regex
 import Debug.Trace

hledger.hs

@@ -32,16 +32,16 @@ main = do
             | cmd `isPrefixOf` "balance"  = balance  opts pats
             | otherwise                   = putStr usage
 
-doWithFilteredLedger :: [Flag] -> ([Regex],[Regex]) -> (Ledger -> IO ()) -> IO ()
+doWithFilteredLedger :: [Flag] -> FilterPatterns -> (Ledger -> IO ()) -> IO ()
 doWithFilteredLedger opts pats cmd = do
     ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed pats cmd
 
-doWithParsed :: ([Regex],[Regex]) -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO ()
+doWithParsed :: FilterPatterns -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO ()
 doWithParsed pats cmd parsed = do
   case parsed of Left e -> parseError e
                  Right l -> cmd $ cacheLedger pats l 
 
-type Command = [Flag] -> ([Regex],[Regex]) -> IO ()
+type Command = [Flag] -> FilterPatterns -> IO ()
 
 test :: Command
 test opts pats = do 
@@ -74,9 +74,8 @@ balance opts pats = do
           putStr $ showLedgerAccounts l depth
               where 
                 showsubs = (ShowSubs `elem` opts)
-                (acctpats,_) = pats
-                depth = case (acctpats, showsubs) of
-                          ([],False) -> 1
+                depth = case (pats, showsubs) of
+                          ((Nothing,_), False) -> 1
                           otherwise  -> 9999
 
 {-