filter by account patterns when caching a ledger, fix balance report totals

Ledger/Ledger.hs

@@ -1,8 +1,8 @@
 {-|
 
 A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of account
-names, and a map from account names to 'Account's. Typically it also has
+names, and a map from account names to 'Account's. It may also have had
-had uninteresting 'Entry's filtered out.
+uninteresting 'Entry's and 'Transaction's filtered out.
 
 -}
 
@@ -29,12 +29,12 @@ instance Show Ledger where
              (showtree $ accountnametree l)
 
 -- | Convert a raw ledger to a more efficient cached type, described above.  
-cacheLedger :: RawLedger -> Ledger
+cacheLedger :: [String] -> RawLedger -> Ledger
-cacheLedger l = Ledger l ant amap
+cacheLedger apats l = Ledger l ant amap
     where
       ant = rawLedgerAccountNameTree l
       anames = flatten ant
-      ts = rawLedgerTransactions l
+      ts = filtertxns apats $ rawLedgerTransactions l
       sortedts = sortBy (comparing account) ts
       groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
       txnmap = Map.union 
@@ -48,6 +48,9 @@ cacheLedger l = Ledger l ant amap
                (Map.fromList [(a,Mixed []) | a <- anames])
       amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
 
+filtertxns :: [String] -> [Transaction] -> [Transaction]
+filtertxns apats ts = filter (matchpats apats . account) ts
+
 -- | List a ledger's account names.
 accountnames :: Ledger -> [AccountName]
 accountnames l = drop 1 $ flatten $ accountnametree l

Tests.hs

@@ -81,7 +81,7 @@ misc_tests = TestList [
       (accountnames ledger7)
   ,
   "cacheLedger"        ~: do
-    assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger rawledger7)
+    assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger [] rawledger7)
   ,
   "transactionamount"       ~: do
     assertparseequal (Mixed [dollars 47.18]) (parsewith transactionamount " $47.18")
@@ -115,13 +115,13 @@ balancereportacctnames_tests = TestList
   ,"balancereportacctnames8" ~: ("-s",["-e"])          `gives` []
   ] where
     gives (opt,pats) e = do 
-      l <- ledgerfromfile "sample.ledger"
+      l <- ledgerfromfile pats "sample.ledger"
       let t = pruneZeroBalanceLeaves $ ledgerAccountTree 999 l
       assertequal e (balancereportacctnames l (opt=="-s") pats t)
 
 balancecommand_tests = TestList [
   "simple balance report" ~: do
-    l <- ledgerfromfile "sample.ledger"
+    l <- ledgerfromfile [] "sample.ledger"
     assertequal
      "                 $-1  assets\n\
      \                  $2  expenses\n\
@@ -131,7 +131,7 @@ balancecommand_tests = TestList [
      (showBalanceReport [] [] l)
  ,
   "balance report with --subtotal" ~: do
-    l <- ledgerfromfile "sample.ledger"
+    l <- ledgerfromfile [] "sample.ledger"
     assertequal
      "                 $-1  assets\n\
      \                 $-2    cash\n\
@@ -147,7 +147,7 @@ balancecommand_tests = TestList [
      (showBalanceReport [SubTotal] [] l)
  ,
   "balance report with account pattern o" ~: do
-    l <- ledgerfromfile "sample.ledger"
+    l <- ledgerfromfile ["o"] "sample.ledger"
     assertequal
      "                  $1  expenses:food\n\
      \                 $-2  income\n\
@@ -157,7 +157,7 @@ balancecommand_tests = TestList [
      (showBalanceReport [] ["o"] l)
  ,
   "balance report with account pattern o and --subtotal" ~: do
-    l <- ledgerfromfile "sample.ledger"
+    l <- ledgerfromfile ["o"] "sample.ledger"
     assertequal
      "                  $1  expenses:food\n\
      \                 $-2  income\n\
@@ -169,7 +169,7 @@ balancecommand_tests = TestList [
      (showBalanceReport [SubTotal] ["o"] l)
  ,
   "balance report with account pattern a" ~: do
-    l <- ledgerfromfile "sample.ledger"
+    l <- ledgerfromfile ["a"] "sample.ledger"
     assertequal
      "                 $-1  assets\n\
      \                 $-2    cash\n\
@@ -182,7 +182,7 @@ balancecommand_tests = TestList [
      (showBalanceReport [] ["a"] l)
  ,
   "balance report with account pattern e" ~: do
-    l <- ledgerfromfile "sample.ledger"
+    l <- ledgerfromfile ["e"] "sample.ledger"
     assertequal
      "                 $-1  assets\n\
      \                  $2  expenses\n\
@@ -194,7 +194,7 @@ balancecommand_tests = TestList [
  ,
   "balance report with unmatched parent of two matched subaccounts" ~: 
   do
-    l <- ledgerfromfile "sample.ledger"
+    l <- ledgerfromfile ["cash","saving"] "sample.ledger"
     assertequal
      "                 $-2  assets:cash\n\
      \                  $1  assets:saving\n\
@@ -205,16 +205,17 @@ balancecommand_tests = TestList [
  ,
   "balance report with multi-part account name" ~: 
   do 
-    l <- ledgerfromfile "sample.ledger"
+    let pats = ["expenses:food"]
+    l <- ledgerfromfile pats "sample.ledger"
     assertequal
      "                  $1  expenses:food\n\
      \--------------------\n\
      \                  $1\n\
      \" --"
-     $ showBalanceReport [] ["expenses:food"] l
+     $ showBalanceReport [] pats l
  ,
   "balance report with negative account pattern" ~: do
-    l <- ledgerfromfile "sample.ledger"
+    l <- ledgerfromfile ["-assets"] "sample.ledger"
     assertequal (
      "                  $2  expenses\n" ++
      "                 $-2  income\n" ++
@@ -226,24 +227,25 @@ balancecommand_tests = TestList [
  ,
   "balance report negative account pattern always matches full name" ~: 
   do 
-    l <- ledgerfromfile "sample.ledger"
+    l <- ledgerfromfile ["-e"] "sample.ledger"
     assertequal "" $ showBalanceReport [] ["-e"] l
  ,
   "balance report negative patterns affect totals" ~: 
   do 
-    l <- ledgerfromfile "sample.ledger"
+    let pats = ["expenses","-food"]
+    l <- ledgerfromfile pats "sample.ledger"
     assertequal (
      "                  $1  expenses\n" ++
      "--------------------\n" ++
      "                  $1\n" ++
      "")
-     $ showBalanceReport [] ["expenses","-food"] l
+     $ showBalanceReport [] pats l
  ]
 
 registercommand_tests = TestList [
   "register report" ~:
   do 
-    l <- ledgerfromfile "sample.ledger"
+    l <- ledgerfromfile [] "sample.ledger"
     assertequal (
      "2007/01/01 income               assets:checking                  $1           $1\n" ++
      "                                income:salary                   $-1            0\n" ++
@@ -551,7 +553,7 @@ rawledger7 = RawLedger
           ]
           ""
 
-ledger7 = cacheLedger rawledger7 
+ledger7 = cacheLedger [] rawledger7 
 
 timelogentry1_str  = "i 2007/03/11 16:19:00 hledger\n"
 timelogentry1 = TimeLogEntry 'i' (parsedatetime "2007/03/11 16:19:00") "hledger"

Utils.hs

@@ -17,12 +17,14 @@ rawledgerfromfile f = do
   parsed <- parseLedgerFile f
   return $ either (\_ -> RawLedger [] [] [] "") id parsed
 
--- | get a cached Ledger from the given file path
+-- | get a cached Ledger from the given file path, filtered by the patterns.
-ledgerfromfile :: FilePath -> IO Ledger
+ledgerfromfile :: [String] -> FilePath -> IO Ledger
-ledgerfromfile f = do
+ledgerfromfile args f = do
   l  <- rawledgerfromfile f
-  return $ cacheLedger $ filterRawLedger Nothing Nothing [] False False l
+  return $ cacheLedger apats $ filterRawLedger Nothing Nothing dpats False False l
-
+      where
+        (apats,dpats) = parseAccountDescriptionArgs args
+           
 -- | get a RawLedger from the file your LEDGER environment variable
 -- variable points to or (WARNING) an empty one if there was a problem.
 myrawledger :: IO RawLedger
@@ -35,7 +37,7 @@ myrawledger = do
 myledger :: IO Ledger
 myledger = do
   l <- myrawledger
-  return $ cacheLedger $ filterRawLedger Nothing Nothing [] False False l
+  return $ cacheLedger [] $ filterRawLedger Nothing Nothing [] False False l
 
 -- | get a named account from your ledger file
 myaccount :: AccountName -> IO Account

hledger.hs

@@ -17,7 +17,7 @@ You can use the command line:
 or ghci:
 
 > $ ghci hledger
-> > l <- ledgerfromfile "sample.ledger"
+> > l <- ledgerfromfile [] "sample.ledger"
 > > balance [] [] l
 >                  $-1  assets
 >                   $2  expenses
@@ -73,10 +73,10 @@ parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ())
 parseLedgerAndDo opts args cmd = 
     ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runcmd
     where
-      runcmd = cmd opts args . cacheLedger . canonicaliseAmounts . filterRawLedger b e dpats c r
+      runcmd = cmd opts args . cacheLedger apats . canonicaliseAmounts . filterRawLedger b e dpats c r
       b = parsemaybedate (beginDateFromOpts opts)
       e = parsemaybedate (endDateFromOpts opts)
-      dpats = snd $ parseAccountDescriptionArgs args
+      (apats,dpats) = parseAccountDescriptionArgs args
       c = Cleared `elem` opts
       r = Real `elem` opts