try to simplify FilterPatterns a bit
This commit is contained in:
parent
66050fd248
commit
8c6d93701b
24
Ledger.hs
24
Ledger.hs
@ -62,31 +62,37 @@ cacheLedger pats l =
|
|||||||
in
|
in
|
||||||
Ledger l' ant amap lprecision
|
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 :: FilterPatterns -> LedgerFile -> LedgerFile
|
||||||
filterLedgerEntries (acctpat,descpat) (LedgerFile ms ps es f) =
|
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
|
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
|
Nothing -> False
|
||||||
otherwise -> True
|
otherwise -> True
|
||||||
matchdesc e = case matchRegex (wilddefault descpat) (edescription e) of
|
matchdesc :: LedgerEntry -> Bool
|
||||||
|
matchdesc e = case matchRegex descpat (edescription e) of
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
otherwise -> True
|
otherwise -> True
|
||||||
|
|
||||||
-- | filter transactions in each ledger entry by account patterns
|
-- | in each ledger entry, filter out transactions which do not match
|
||||||
-- this may unbalance entries
|
-- | the account patterns, if any. (Entries are no longer balanced
|
||||||
|
-- | after this.)
|
||||||
filterLedgerTransactions :: FilterPatterns -> LedgerFile -> LedgerFile
|
filterLedgerTransactions :: FilterPatterns -> LedgerFile -> LedgerFile
|
||||||
filterLedgerTransactions (acctpat,descpat) (LedgerFile ms ps es f) =
|
filterLedgerTransactions (acctpat,descpat) (LedgerFile ms ps es f) =
|
||||||
LedgerFile ms ps (map filterentrytxns es) f
|
LedgerFile ms ps (map filterentrytxns es) f
|
||||||
where
|
where
|
||||||
filterentrytxns l@(LedgerEntry _ _ _ _ _ ts _) = l{etransactions=filter matchtxn ts}
|
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
|
Nothing -> False
|
||||||
otherwise -> True
|
otherwise -> True
|
||||||
|
|
||||||
wilddefault = fromMaybe (mkRegex ".*")
|
|
||||||
|
|
||||||
accountnames :: Ledger -> [AccountName]
|
accountnames :: Ledger -> [AccountName]
|
||||||
accountnames l = flatten $ accountnametree l
|
accountnames l = flatten $ accountnametree l
|
||||||
|
|
||||||
|
|||||||
21
Options.hs
21
Options.hs
@ -72,17 +72,20 @@ tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
|
|||||||
tildeExpand xs = return xs
|
tildeExpand xs = return xs
|
||||||
-- -- courtesy of allberry_b
|
-- -- courtesy of allberry_b
|
||||||
|
|
||||||
-- | ledger pattern args are 0 or more account patterns optionally followed
|
-- | ledger pattern arguments are: 0 or more account patterns
|
||||||
-- by -- and 0 or more description 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 :: [String] -> FilterPatterns
|
||||||
parsePatternArgs args = argpats as ds'
|
parsePatternArgs args = (regexFor as, regexFor ds')
|
||||||
where (as, ds) = break (=="--") args
|
where (as, ds) = break (=="--") args
|
||||||
ds' = dropWhile (=="--") ds
|
ds' = dropWhile (=="--") ds
|
||||||
|
|
||||||
argpats :: [String] -> [String] -> FilterPatterns
|
-- | convert a list of strings to a regular expression matching any of them,
|
||||||
argpats as ds = (regexify as, regexify ds)
|
-- | or a wildcard if there are none.
|
||||||
where
|
regexFor :: [String] -> Regex
|
||||||
regexify :: [String] -> Maybe Regex
|
regexFor [] = wildcard
|
||||||
regexify [] = Nothing
|
regexFor ss = mkRegex $ "(" ++ (unwords $ intersperse "|" ss) ++ ")"
|
||||||
regexify ss = Just $ mkRegex $ "(" ++ (unwords $ intersperse "|" ss) ++ ")"
|
|
||||||
|
|
||||||
|
wildcard :: Regex
|
||||||
|
wildcard = mkRegex ".*"
|
||||||
4
Tests.hs
4
Tests.hs
@ -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_str = "i 2007/03/11 16:19:00 hledger\n"
|
||||||
timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger"
|
timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger"
|
||||||
@ -375,7 +375,7 @@ test_ledgerAccountNames =
|
|||||||
(rawLedgerAccountNames ledger7)
|
(rawLedgerAccountNames ledger7)
|
||||||
|
|
||||||
test_cacheLedger =
|
test_cacheLedger =
|
||||||
assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger (argpats [] []) ledger7)
|
assertEqual' 15 (length $ Map.keys $ accounts $ cacheLedger (parsePatternArgs []) ledger7)
|
||||||
|
|
||||||
test_showLedgerAccounts =
|
test_showLedgerAccounts =
|
||||||
assertEqual' 4 (length $ lines $ showLedgerAccounts l7 1)
|
assertEqual' 4 (length $ lines $ showLedgerAccounts l7 1)
|
||||||
|
|||||||
4
Types.hs
4
Types.hs
@ -6,8 +6,8 @@ where
|
|||||||
import Utils
|
import Utils
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
-- | account and description-matching patterns
|
-- | account and description-matching patterns, see 'Options.parsePatternArgs'.
|
||||||
type FilterPatterns = (Maybe Regex, Maybe Regex)
|
type FilterPatterns = (Regex, Regex)
|
||||||
|
|
||||||
type Date = String
|
type Date = String
|
||||||
|
|
||||||
|
|||||||
11
hledger.hs
11
hledger.hs
@ -98,25 +98,28 @@ balance opts pats = do
|
|||||||
where
|
where
|
||||||
showsubs = (ShowSubs `elem` opts)
|
showsubs = (ShowSubs `elem` opts)
|
||||||
depth = case (pats, showsubs) of
|
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
|
otherwise -> 9999
|
||||||
|
|
||||||
-- helpers for interacting in ghci
|
-- helpers for interacting in ghci
|
||||||
|
|
||||||
-- | return a Ledger parsed from the file your LEDGER environment variable
|
-- | 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 :: IO Ledger
|
||||||
myledger = do
|
myledger = do
|
||||||
parsed <- ledgerFilePath [] >>= parseLedgerFile
|
parsed <- ledgerFilePath [] >>= parseLedgerFile
|
||||||
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
|
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
|
||||||
return $ cacheLedger (argpats [] []) ledgerfile
|
return $ cacheLedger (parsePatternArgs []) ledgerfile
|
||||||
|
|
||||||
-- | return a Ledger parsed from the given file path
|
-- | return a Ledger parsed from the given file path
|
||||||
ledgerfromfile :: String -> IO Ledger
|
ledgerfromfile :: String -> IO Ledger
|
||||||
ledgerfromfile f = do
|
ledgerfromfile f = do
|
||||||
parsed <- ledgerFilePath [File f] >>= parseLedgerFile
|
parsed <- ledgerFilePath [File f] >>= parseLedgerFile
|
||||||
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
|
let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed
|
||||||
return $ cacheLedger (argpats [] []) ledgerfile
|
return $ cacheLedger (parsePatternArgs []) ledgerfile
|
||||||
|
|
||||||
accountnamed :: AccountName -> IO Account
|
accountnamed :: AccountName -> IO Account
|
||||||
accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts)
|
accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user