From d52b365fa0326fe08ba790283cf75c11a85ba8d5 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 11 Jul 2007 06:58:47 +0000 Subject: [PATCH] combine patterns into single regexps, fix a bug with print & patterns --- Ledger.hs | 65 +++++++++++++++++++++--------------------------------- Options.hs | 18 ++++++++------- Tests.hs | 4 ++-- Types.hs | 5 ++++- Utils.hs | 2 ++ hledger.hs | 11 +++++---- 6 files changed, 48 insertions(+), 57 deletions(-) diff --git a/Ledger.hs b/Ledger.hs index deaa80a2b..b98326c37 100644 --- a/Ledger.hs +++ b/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 diff --git a/Options.hs b/Options.hs index 46b27414f..cfda25840 100644 --- a/Options.hs +++ b/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) ++ ")" diff --git a/Tests.hs b/Tests.hs index f98cab954..3b9c1e781 100644 --- a/Tests.hs +++ b/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) diff --git a/Types.hs b/Types.hs index 42522d6cf..3bccb68db 100644 --- a/Types.hs +++ b/Types.hs @@ -30,6 +30,9 @@ hledger -} +-- account and description-matching patterns +type FilterPatterns = (Maybe Regex, Maybe Regex) + type Date = String type DateTime = String @@ -116,7 +119,7 @@ data Account = Account { -- a ledger with account information cached for faster queries data Ledger = Ledger { - rawledger :: LedgerFile, + rawledger :: LedgerFile, accountnametree :: Tree AccountName, accounts :: Map.Map AccountName Account, lprecision :: Int diff --git a/Utils.hs b/Utils.hs index 145131501..254e4330f 100644 --- a/Utils.hs +++ b/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 diff --git a/hledger.hs b/hledger.hs index 9b153a7dd..311287c39 100644 --- a/hledger.hs +++ b/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 {-