balance: combine boring account names properly when matching account patterns

Ledger.hs

@@ -34,14 +34,19 @@ instance Show Ledger where
               (length $ periodic_entries $ rawledger l))
              (length $ accountnames l)
 
--- at startup, we augment the parsed ledger entries with an account map
+-- at startup, to improve performance, we refine the parsed ledger entries:
--- and other things useful for performance
+-- 1. filter based on account/description patterns, if any
-cacheLedger :: LedgerFile -> Ledger
+-- 2. cache per-account info
-cacheLedger l = 
+-- also, figure out the precision(s) to use
+cacheLedger :: [String] -> [String] -> LedgerFile -> Ledger
+cacheLedger acctpats descpats l = 
     let 
-        ant = rawLedgerAccountNameTree l
+        (acctpats', descpats') = (wilddefault acctpats, wilddefault descpats)
+        ant = filterAccountNameTree acctpats' True 9999 $ rawLedgerAccountNameTree l
         ans = flatten ant
-        ts = rawLedgerTransactions l
+        filterTxnsByAcctpats ts = concat [filter (matchTransactionAccount $ mkRegex r) ts | r <- acctpats']
+        allts = rawLedgerTransactions l
+        ts = filterTxnsByAcctpats allts
         sortedts = sortBy (comparing account) ts
         groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
         tmap = Map.union 
@@ -50,7 +55,7 @@ cacheLedger l =
         txns = (tmap !)
         subaccts a = filter (isAccountNamePrefixOf a) ans
         subtxns a = concat [txns a | a <- [a] ++ subaccts a]
-        lprecision = maximum $ map (precision . amount) ts
+        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])
@@ -75,17 +80,14 @@ ledgerTransactions l =
       setprecisions = map (transactionSetPrecision (lprecision l))
 
 ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [Transaction]
-ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l
-ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l
-ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l
 ledgerTransactionsMatching (acctpats,descpats) l =
     intersect 
     (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
     (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
     where 
       ts = ledgerTransactions l
-      acctregexps = map mkRegex acctpats
+      acctregexps = map mkRegex $ wilddefault acctpats
-      descregexps = map mkRegex descpats
+      descregexps = map mkRegex $ wilddefault descpats
 
 ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account
 ledgerAccountTreeMatching l [] showsubs maxdepth = 
@@ -164,7 +166,7 @@ showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
 showLedgerAccounts l acctpats showsubs maxdepth = 
     concatMap 
     (showAccountTree l) 
-    (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth))
+    (branches $ ledgerAccountTreeMatching l acctpats showsubs maxdepth)
 
 showAccountTree :: Ledger -> Tree Account -> String
 showAccountTree l = showAccountTree' l 0 . pruneBoringBranches
@@ -183,7 +185,7 @@ showAccountTree' l indentlevel t
       subsindented i = concatMap (showAccountTree' l (indentlevel+i)) subs
       bal = printf "%20s" $ show $ abalance $ acct
       indent = replicate (indentlevel * 2) ' '
-      prefix = concatMap (++ ":") $ map accountLeafName boringparents
+      prefix = concatMap (++ ":") $ map accountLeafName $ reverse boringparents
       boringparents = takeWhile (isBoringAccountName l) $ parentAccountNames $ aname acct
       leafname = accountLeafName $ aname acct
 

Tests.hs

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

Transaction.hs

@@ -9,6 +9,10 @@ import Amount
 import Currency
 
 
+instance Show Transaction where 
+    show (Transaction eno d desc a amt) = 
+        unwords [d,desc,a,show amt]
+
 -- we use the entry number e to remember the grouping of txns
 flattenEntry :: (LedgerEntry, Int) -> [Transaction]
 flattenEntry (LedgerEntry d _ _ desc _ ts, e) = 

Utils.hs

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

hledger.hs

@@ -42,24 +42,24 @@ test = do
 
 register :: [Flag] -> [String] -> [String] -> IO ()
 register opts acctpats descpats = do 
-  doWithLedger opts printregister
+  doWithLedger opts acctpats descpats printregister
     where 
       printregister l = 
           putStr $ showTransactionsWithBalances 
-                     (sortBy (comparing date) (ledgerTransactionsMatching (acctpats,descpats) l))
+                     (sortBy (comparing date) (ledgerTransactionsMatching (acctpats, descpats) l))
                      nullamt{precision=lprecision l}
 
-printcmd :: [Flag] -> IO ()
+printcmd :: [Flag] -> IO () -- XXX acctpats descpats ?
 printcmd opts = do 
-  doWithLedger opts printentries
+  doWithLedger opts [] [] printentries
     where
       printentries l = putStr $ showEntries $ setprecision $ entries $ rawledger l
           where
             setprecision = map (entrySetPrecision (lprecision l))
 
 balance :: [Flag] -> [String] -> [String] -> IO ()
-balance opts acctpats _ = do 
+balance opts acctpats _ = do  -- XXX descpats
-  doWithLedger opts printbalance
+  doWithLedger opts acctpats [] printbalance
     where
       printbalance l =
           putStr $ showLedgerAccounts l acctpats showsubs maxdepth
@@ -71,14 +71,14 @@ balance opts acctpats _ = do
 
 -- utils
 
-doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO ()
+doWithLedger :: [Flag] -> [String] -> [String] -> (Ledger -> IO ()) -> IO ()
-doWithLedger opts cmd = do
+doWithLedger opts acctpats descpats cmd = do
-    ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd
+    ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed acctpats descpats cmd
 
-doWithParsed :: (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO ()
+doWithParsed :: [String] -> [String] -> (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO ()
-doWithParsed cmd parsed = do
+doWithParsed acctpats descpats cmd parsed = do
   case parsed of Left e -> parseError e
-                 Right l -> cmd $ cacheLedger l
+                 Right l -> cmd $ cacheLedger acctpats descpats l 
 
 
 {-