From c46189a75b24a2f9cd8719e90e223e943c1b06d7 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 22 Nov 2008 05:51:48 +0000 Subject: [PATCH] filter by account patterns when caching a ledger, fix balance report totals --- Ledger/Ledger.hs | 13 ++++++++----- Tests.hs | 36 +++++++++++++++++++----------------- Utils.hs | 14 ++++++++------ hledger.hs | 6 +++--- 4 files changed, 38 insertions(+), 31 deletions(-) diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index 76b3220a8..8e49b07e4 100644 --- a/Ledger/Ledger.hs +++ b/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 -had uninteresting 'Entry's filtered out. +names, and a map from account names to 'Account's. It may also have had +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 l = Ledger l ant amap +cacheLedger :: [String] -> RawLedger -> Ledger +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 diff --git a/Tests.hs b/Tests.hs index eeaf5ff92..ac4795678 100644 --- a/Tests.hs +++ b/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" diff --git a/Utils.hs b/Utils.hs index dd1de7fe2..30caab3b6 100644 --- a/Utils.hs +++ b/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 -ledgerfromfile :: FilePath -> IO Ledger -ledgerfromfile f = do +-- | get a cached Ledger from the given file path, filtered by the patterns. +ledgerfromfile :: [String] -> FilePath -> IO Ledger +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 diff --git a/hledger.hs b/hledger.hs index 58cd0a88d..020b249f5 100644 --- a/hledger.hs +++ b/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