diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index 07bb95828..9324917d5 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -66,13 +66,10 @@ topAccounts :: Ledger -> [Account] topAccounts l = map root $ branches $ ledgerAccountTree 9999 l -- | Accounts in ledger whose name matches the pattern, in tree order. --- Like ledger (I think), if the pattern contains : we match the full --- name, otherwise just the leaf name. +-- We apply ledger's special rules for balance report account matching +-- (see 'matchLedgerPatterns'). accountsMatching :: [String] -> Ledger -> [Account] -accountsMatching pats l = filter (containsRegex (regexFor pats) . name) $ accounts l - where name = if any (elem ':') pats - then aname - else accountLeafName . aname +accountsMatching pats l = filter (matchLedgerPatterns True pats . aname) $ accounts l -- | List a ledger account's immediate subaccounts subAccounts :: Ledger -> Account -> [Account] diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 5cf8bee35..cd85d5d53 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -15,6 +15,8 @@ import Ledger.Entry import Ledger.Transaction +negativepatternchar = '-' + instance Show RawLedger where show l = printf "RawLedger with %d entries, %d accounts: %s" ((length $ entries l) + @@ -42,20 +44,18 @@ rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l -- | Remove ledger entries we are not interested in. -- Keep only those which fall between the begin and end dates, and match -- the description pattern. -filterRawLedger :: String -> String -> Regex -> RawLedger -> RawLedger -filterRawLedger begin end descpat = +filterRawLedger :: String -> String -> [String] -> RawLedger -> RawLedger +filterRawLedger begin end pats = filterRawLedgerEntriesByDate begin end . - filterRawLedgerEntriesByDescription descpat + filterRawLedgerEntriesByDescription pats -- | Keep only entries whose description matches the description pattern. -filterRawLedgerEntriesByDescription :: Regex -> RawLedger -> RawLedger -filterRawLedgerEntriesByDescription descpat (RawLedger ms ps es f) = +filterRawLedgerEntriesByDescription :: [String] -> RawLedger -> RawLedger +filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) = RawLedger ms ps (filter matchdesc es) f where matchdesc :: Entry -> Bool - matchdesc e = case matchRegex descpat (edescription e) of - Nothing -> False - otherwise -> True + matchdesc = matchLedgerPatterns False pats . edescription -- | Keep only entries which fall between begin and end dates. -- We include entries on the begin date and exclude entries on the end @@ -73,6 +73,28 @@ filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) = entrydate = parsedate $ edate e +-- | Check if a set of ledger account/description patterns matches the +-- given account name or entry description, applying ledger's special +-- cases. +-- +-- Patterns are regular expression strings, and those beginning with - are +-- negative patterns. The special case is that account patterns match the +-- full account name except in balance reports when the pattern does not +-- contain : and is a positive pattern, where it matches only the leaf +-- name. +matchLedgerPatterns :: Bool -> [String] -> String -> Bool +matchLedgerPatterns forbalancereport pats str = + (null positives || any ismatch positives) && (null negatives || (not $ any ismatch negatives)) + where + isnegative = (== negativepatternchar) . head + (negatives,positives) = partition isnegative pats + ismatch pat = containsRegex (mkRegex pat') matchee + where + pat' = if isnegative pat then drop 1 pat else pat + matchee = if forbalancereport && (not $ ':' `elem` pat) && (not $ isnegative pat) + then accountLeafName str + else str + -- | Give amounts the display settings of the first one detected in each commodity. normaliseRawLedgerAmounts :: RawLedger -> RawLedger normaliseRawLedgerAmounts l@(RawLedger ms ps es f) = RawLedger ms ps es' f diff --git a/Ledger/Utils.hs b/Ledger/Utils.hs index 9637a8714..6a7ab7855 100644 --- a/Ledger/Utils.hs +++ b/Ledger/Utils.hs @@ -44,20 +44,19 @@ import Text.ParserCombinators.Parsec (parse) instance Show Regex where show r = "a Regex" --- | 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 $ concat $ ["("] ++ (intersperse "|" ss) ++ [")"] - -wildcard :: Regex -wildcard = mkRegex ".*" - containsRegex :: Regex -> String -> Bool containsRegex r s = case matchRegex r s of Just _ -> True otherwise -> False +-- | Convert a list of strings (possibly with regular expression syntax) +-- to a regular expression matching any of them, or a wildcard if there +-- are none. +combinedRegex :: [String] -> Regex +combinedRegex [] = mkRegex ".*" +combinedRegex args = mkRegex $ concat $ ["("] ++ intersperse "|" args ++ [")"] + + -- time -- | Parse a date-time string to a time type, or raise an error. diff --git a/RegisterCommand.hs b/RegisterCommand.hs index 4cc93f019..9757edce5 100644 --- a/RegisterCommand.hs +++ b/RegisterCommand.hs @@ -19,7 +19,7 @@ showTransactionsWithBalances opts args l = unlines $ showTransactionsWithBalances' ts nulltxn startingbalance where ts = filter matchtxn $ ledgerTransactions l - matchtxn (Transaction _ _ desc acct _) = (containsRegex (regexFor apats) acct) + matchtxn (Transaction _ _ desc acct _) = matchLedgerPatterns False apats acct pats@(apats,dpats) = parseAccountDescriptionArgs args startingbalance = nullamt showTransactionsWithBalances' :: [Transaction] -> Transaction -> Amount -> [String] diff --git a/Tests.hs b/Tests.hs index 5077508cd..4fc0d480c 100644 --- a/Tests.hs +++ b/Tests.hs @@ -177,6 +177,11 @@ balancecommandtests = \ $1\n\ \" --" $ showBalanceReport [] ["expenses:food"] l + , + "balance report negative account pattern always matches full name" ~: + do + l <- ledgerfromfile "sample.ledger" + assertequal "" $ showBalanceReport [] ["-e"] l ] -- | Assert a parsed thing equals some expected thing, or print a parse error. diff --git a/Utils.hs b/Utils.hs index 13a9c9544..15264ab9d 100644 --- a/Utils.hs +++ b/Utils.hs @@ -21,7 +21,7 @@ rawledgerfromfile f = do ledgerfromfile :: FilePath -> IO Ledger ledgerfromfile f = do l <- rawledgerfromfile f - return $ cacheLedger $ filterRawLedger "" "" wildcard l + return $ cacheLedger $ filterRawLedger "" "" [] l -- | get a RawLedger from the file your LEDGER environment variable -- variable points to or (WARNING) an empty one if there was a problem. @@ -35,7 +35,7 @@ myrawledger = do myledger :: IO Ledger myledger = do l <- myrawledger - return $ cacheLedger $ filterRawLedger "" "" wildcard l + return $ cacheLedger $ filterRawLedger "" "" [] l -- | get a named account from your ledger file myaccount :: AccountName -> IO Account diff --git a/hledger.hs b/hledger.hs index ad946d24e..49c299ce1 100644 --- a/hledger.hs +++ b/hledger.hs @@ -70,10 +70,8 @@ parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) parseLedgerAndDo opts args cmd = ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand where - runthecommand = cmd opts args . cacheLedger . normaliseRawLedgerAmounts . filterRawLedger begin end descpat + runthecommand = cmd opts args . cacheLedger . normaliseRawLedgerAmounts . filterRawLedger begin end descpats begin = beginDateFromOpts opts end = endDateFromOpts opts - acctpat = regexFor acctpats - descpat = regexFor descpats - (acctpats,descpats) = parseAccountDescriptionArgs args + descpats = snd $ parseAccountDescriptionArgs args