try to simplify FilterPatterns a bit

This commit is contained in:
Simon Michael 2008-10-01 11:08:30 +00:00
parent 66050fd248
commit 8c6d93701b
5 changed files with 38 additions and 26 deletions

View File

@ -62,31 +62,37 @@ cacheLedger pats l =
in
Ledger l' ant amap lprecision
-- | filter entries by description and whether any transactions match account patterns
-- | keep only entries whose description matches one of the
-- | description patterns, if any, and which have at least one
-- | transaction matching one of the account patterns, if any.
-- | No description or account patterns implies match all.
filterLedgerEntries :: FilterPatterns -> LedgerFile -> LedgerFile
filterLedgerEntries (acctpat,descpat) (LedgerFile ms ps es f) =
LedgerFile ms ps (filter matchdesc $ filter (any matchtxn . etransactions) es) f
LedgerFile ms ps filteredentries f
where
matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of
filteredentries :: [LedgerEntry]
filteredentries = (filter matchdesc $ filter (any matchtxn . etransactions) es)
matchtxn :: LedgerTransaction -> Bool
matchtxn t = case matchRegex acctpat (taccount t) of
Nothing -> False
otherwise -> True
matchdesc e = case matchRegex (wilddefault descpat) (edescription e) of
matchdesc :: LedgerEntry -> Bool
matchdesc e = case matchRegex descpat (edescription e) of
Nothing -> False
otherwise -> True
-- | filter transactions in each ledger entry by account patterns
-- this may unbalance entries
-- | in each ledger entry, filter out transactions which do not match
-- | the account patterns, if any. (Entries are no longer balanced
-- | after this.)
filterLedgerTransactions :: FilterPatterns -> LedgerFile -> LedgerFile
filterLedgerTransactions (acctpat,descpat) (LedgerFile ms ps es f) =
LedgerFile ms ps (map filterentrytxns es) f
where
filterentrytxns l@(LedgerEntry _ _ _ _ _ ts _) = l{etransactions=filter matchtxn ts}
matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of
matchtxn t = case matchRegex acctpat (taccount t) of
Nothing -> False
otherwise -> True
wilddefault = fromMaybe (mkRegex ".*")
accountnames :: Ledger -> [AccountName]
accountnames l = flatten $ accountnametree l

View File

@ -72,17 +72,20 @@ tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
tildeExpand xs = return xs
-- -- courtesy of allberry_b
-- | ledger pattern args are 0 or more account patterns optionally followed
-- by -- and 0 or more description patterns
-- | ledger pattern arguments are: 0 or more account patterns
-- | optionally followed by -- and 0 or more description patterns.
-- | Here we convert the arguments, if any, to FilterPatterns,
-- | which is a pair of maybe regexps.
parsePatternArgs :: [String] -> FilterPatterns
parsePatternArgs args = argpats as ds'
parsePatternArgs args = (regexFor as, regexFor ds')
where (as, ds) = break (=="--") args
ds' = dropWhile (=="--") ds
argpats :: [String] -> [String] -> FilterPatterns
argpats as ds = (regexify as, regexify ds)
where
regexify :: [String] -> Maybe Regex
regexify [] = Nothing
regexify ss = Just $ mkRegex $ "(" ++ (unwords $ intersperse "|" ss) ++ ")"
-- | convert a list of strings to a regular expression matching any of them,
-- | or a wildcard if there are none.
regexFor :: [String] -> Regex
regexFor [] = wildcard
regexFor ss = mkRegex $ "(" ++ (unwords $ intersperse "|" ss) ++ ")"
wildcard :: Regex
wildcard = mkRegex ".*"

View File

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

View File

@ -6,8 +6,8 @@ where
import Utils
import qualified Data.Map as Map
-- | account and description-matching patterns
type FilterPatterns = (Maybe Regex, Maybe Regex)
-- | account and description-matching patterns, see 'Options.parsePatternArgs'.
type FilterPatterns = (Regex, Regex)
type Date = String

View File

@ -98,25 +98,28 @@ balance opts pats = do
where
showsubs = (ShowSubs `elem` opts)
depth = case (pats, showsubs) of
((Nothing,_), False) -> 1
-- when there are no account patterns and no -s,
-- show only to depth 1. (This was clearer and more
-- correct when FilterPatterns used maybe.)
((wildcard,_), False) -> 1
otherwise -> 9999
-- helpers for interacting in ghci
-- | return a Ledger parsed from the file your LEDGER environment variable
-- points to or (WARNING:) an empty one if there was a problem.
-- points to or (WARNING) an empty one if there was a problem.
myledger :: IO Ledger
myledger = do
parsed <- ledgerFilePath [] >>= parseLedgerFile
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
return $ cacheLedger (argpats [] []) ledgerfile
return $ cacheLedger (parsePatternArgs []) ledgerfile
-- | return a Ledger parsed from the given file path
ledgerfromfile :: String -> IO Ledger
ledgerfromfile f = do
parsed <- ledgerFilePath [File f] >>= parseLedgerFile
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
return $ cacheLedger (argpats [] []) ledgerfile
return $ cacheLedger (parsePatternArgs []) ledgerfile
accountnamed :: AccountName -> IO Account
accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts)