mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-26 20:02:27 +03:00
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
|
||||
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
|
||||
|
||||
|
21
Options.hs
21
Options.hs
@ -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 ".*"
|
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 = 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)
|
||||
|
4
Types.hs
4
Types.hs
@ -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
|
||||
|
||||
|
11
hledger.hs
11
hledger.hs
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user