clean up account/description pattern handling

Ledger.hs

@@ -38,15 +38,13 @@ 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 :: [String] -> [String] -> LedgerFile -> Ledger
+cacheLedger :: ([Regex],[Regex]) -> LedgerFile -> Ledger
-cacheLedger acctpats descpats l = 
+cacheLedger pats l = 
     let 
-        (acctpats', descpats') = (wilddefault acctpats, wilddefault descpats)
+        lprecision = maximum $ map (precision . amount) $ rawLedgerTransactions l
-        l' = filterLedgerEntries acctpats descpats l
+        l' = filterLedgerEntries pats l
         ant = rawLedgerAccountNameTree l'
         ans = flatten ant
-        filterTxnsByAcctpats ts = concat [filter (matchTransactionAccount $ mkRegex r) ts | r <- acctpats']
-        allts = rawLedgerTransactions l
         ts = rawLedgerTransactions l'
         sortedts = sortBy (comparing account) ts
         groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
@@ -56,7 +54,6 @@ cacheLedger acctpats descpats l =
         txns = (tmap !)
         subaccts a = filter (isAccountNamePrefixOf a) ans
         subtxns a = concat [txns a | a <- [a] ++ subaccts a]
-        lprecision = maximum $ map (precision . amount) allts
         bmap = Map.union 
                (Map.fromList [(a, (sumTransactions $ subtxns a){precision=lprecision}) | a <- ans])
                (Map.fromList [(a,nullamt) | a <- ans])
@@ -65,15 +62,13 @@ cacheLedger acctpats descpats l =
       Ledger l' ant amap lprecision
 
 -- filter entries by descpats and by whether any transactions contain any acctpats
-filterLedgerEntries1 :: [String] -> [String] -> LedgerFile -> LedgerFile
+filterLedgerEntries1 :: ([Regex],[Regex]) -> LedgerFile -> LedgerFile
-filterLedgerEntries1 acctpats descpats (LedgerFile ms ps es) = 
+filterLedgerEntries1 (acctpats,descpats) (LedgerFile ms ps es) = 
     LedgerFile ms ps es'
     where
       es' = intersect
-            (concat [filter (matchacct r) es | r <- acctregexps])
+            (concat [filter (matchacct r) es | r <- acctpats])
-            (concat [filter (matchdesc r) es | r <- descregexps])
+            (concat [filter (matchdesc r) es | r <- descpats])
-      acctregexps = map mkRegex $ wilddefault acctpats
-      descregexps = map mkRegex $ wilddefault descpats
       matchacct :: Regex -> LedgerEntry -> Bool
       matchacct r e = any (matchtxn r) (etransactions e)
       matchtxn :: Regex -> LedgerTransaction -> Bool
@@ -86,23 +81,22 @@ filterLedgerEntries1 acctpats descpats (LedgerFile ms ps es) =
                         otherwise -> True
 
 -- filter txns in each entry by acctpats, then filter the modified entries by descpats
-filterLedgerEntries :: [String] -> [String] -> LedgerFile -> LedgerFile
+-- this seems aggressive, unbalancing entries, but so far so goo-
-filterLedgerEntries acctpats descpats (LedgerFile ms ps es) = 
+filterLedgerEntries :: ([Regex],[Regex]) -> 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
+      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) descregexps
+      matchanydesc e = any (matchdesc e) descpats
       matchdesc :: LedgerEntry -> Regex -> Bool
       matchdesc e r = case matchRegex r (edescription e) of
                         Nothing -> False

Options.hs

@@ -73,8 +73,14 @@ tildeExpand xs           =  return xs
 
 -- ledger pattern args are 0 or more account patterns optionally followed
 -- by -- and 0 or more description patterns
-parseLedgerPatternArgs :: [String] -> ([String],[String])
+parsePatternArgs :: [String] -> ([Regex],[Regex])
-parseLedgerPatternArgs args = 
+parsePatternArgs args = argregexes acctpats descpats
-    case "--" `elem` args of
+    where (acctpats, _:descpats) = break (=="--") args
-      True -> ((takeWhile (/= "--") args), tail $ (dropWhile (/= "--") args))
+
-      False -> (args,[])
+argregexes :: [String] -> [String] -> ([Regex],[Regex])
+argregexes as ds = (regexify as, regexify ds)
+    where
+      regexify = map mkRegex . wilddefault
+      wilddefault [] = [".*"]
+      wilddefault a = a
+

Tests.hs

@@ -283,7 +283,7 @@ ledger7 = LedgerFile
                  }
           ]
 
-l7 = cacheLedger [] [] ledger7
+l7 = cacheLedger (argregexes [] []) ledger7
 
 timelogentry1_str  = "i 2007/03/11 16:19:00 hledger\n"
 timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger"
@@ -306,14 +306,7 @@ quickcheck = mapM quickCheck ([
         ] :: [Bool])
 
 hunit = runTestTT $ "hunit" ~: test ([
-         "" ~: parseLedgerPatternArgs []                     @?= ([],[])
+        "" ~: punctuatethousands "" @?= ""
-        ,"" ~: parseLedgerPatternArgs ["a"]                  @?= (["a"],[])
-        ,"" ~: parseLedgerPatternArgs ["a","b"]              @?= (["a","b"],[])
-        ,"" ~: parseLedgerPatternArgs ["a","b","--"]         @?= (["a","b"],[])
-        ,"" ~: parseLedgerPatternArgs ["a","b","--","c","b"] @?= (["a","b"],["c","b"])
-        ,"" ~: parseLedgerPatternArgs ["--","c"]             @?= ([],["c"])
-        ,"" ~: parseLedgerPatternArgs ["--"]                 @?= ([],[])
-        ,"" ~: punctuatethousands "" @?= ""
         ,"" ~: punctuatethousands "1234567.8901" @?= "1,234,567.8901"
         ,"" ~: punctuatethousands "-100" @?= "-100"
         ,"" ~: test_ledgertransaction
@@ -380,7 +373,7 @@ test_ledgerAccountNames =
     (rawLedgerAccountNames ledger7)
 
 test_cacheLedger =
-    assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger [] [] ledger7)
+    assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger (argregexes [] []) ledger7)
 
 test_showLedgerAccounts = 
     assertEqual' 4 (length $ lines $ showLedgerAccounts l7 1)

Utils.hs

@@ -25,9 +25,6 @@ import Test.QuickCheck hiding (test, Testable)
 import Test.HUnit
 
 
-wilddefault [] = [".*"]
-wilddefault a = a
-
 -- lists
 
 splitAtElement :: Eq a => a -> [a] -> [[a]]

hledger.hs

@@ -22,44 +22,44 @@ import Utils hiding (test)
 main :: IO ()
 main = do
   (opts, (cmd:args)) <- getArgs >>= parseOptions
-  let (acctpats, descpats) = parseLedgerPatternArgs args
+  let pats = parsePatternArgs args
-  run cmd opts acctpats descpats
+  run cmd opts pats
-  where run cmd opts acctpats descpats
+  where run cmd opts pats
             | Help `elem` opts            = putStr usage
-            | cmd `isPrefixOf` "test"     = test     opts acctpats descpats
+            | cmd `isPrefixOf` "test"     = test     opts pats
-            | cmd `isPrefixOf` "print"    = printcmd opts acctpats descpats
+            | cmd `isPrefixOf` "print"    = printcmd opts pats
-            | cmd `isPrefixOf` "register" = register opts acctpats descpats
+            | cmd `isPrefixOf` "register" = register opts pats
-            | cmd `isPrefixOf` "balance"  = balance  opts acctpats descpats
+            | cmd `isPrefixOf` "balance"  = balance  opts pats
             | otherwise                   = putStr usage
 
-doWithFilteredLedger :: [Flag] -> [String] -> [String] -> (Ledger -> IO ()) -> IO ()
+doWithFilteredLedger :: [Flag] -> ([Regex],[Regex]) -> (Ledger -> IO ()) -> IO ()
-doWithFilteredLedger opts acctpats descpats cmd = do
+doWithFilteredLedger opts pats cmd = do
-    ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed acctpats descpats cmd
+    ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed pats cmd
 
-doWithParsed :: [String] -> [String] -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO ()
+doWithParsed :: ([Regex],[Regex]) -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO ()
-doWithParsed acctpats descpats cmd parsed = do
+doWithParsed pats cmd parsed = do
   case parsed of Left e -> parseError e
-                 Right l -> cmd $ cacheLedger acctpats descpats l 
+                 Right l -> cmd $ cacheLedger pats l 
 
-type Command = [Flag] -> [String] -> [String] -> IO ()
+type Command = [Flag] -> ([Regex],[Regex]) -> IO ()
 
 test :: Command
-test opts acctpats descpats = do 
+test opts pats = do 
   Tests.hunit
   Tests.quickcheck
   return ()
 
 printcmd :: Command
-printcmd opts acctpats descpats = do 
+printcmd opts pats = do 
-  doWithFilteredLedger opts acctpats descpats printentries
+  doWithFilteredLedger opts pats printentries
     where
       printentries l = putStr $ showEntries $ setprecision $ entries $ rawledger l
           where
             setprecision = map (entrySetPrecision (lprecision l))
 
 register :: Command
-register opts acctpats descpats = do 
+register opts pats = do 
-  doWithFilteredLedger opts acctpats descpats printregister
+  doWithFilteredLedger opts pats printregister
     where 
       printregister l = 
           putStr $ showTransactionsWithBalances 
@@ -67,13 +67,14 @@ register opts acctpats descpats = do
                      nullamt{precision=lprecision l}
 
 balance :: Command
-balance opts acctpats descpats = do
+balance opts pats = do
-  doWithFilteredLedger opts acctpats descpats printbalance
+  doWithFilteredLedger opts pats printbalance
     where
       printbalance l =
           putStr $ showLedgerAccounts l depth
               where 
                 showsubs = (ShowSubs `elem` opts)
+                (acctpats,_) = pats
                 depth = case (acctpats, showsubs) of
                           ([],False) -> 1
                           otherwise  -> 9999