support negative patterns and ledger's special balance report account matching rule

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]

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

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.

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]

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.

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

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