From 96aa9bfc76d0b6fef34da800ccf8277542647f00 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Sat, 11 Jun 2011 18:35:20 +0000
Subject: [PATCH] matcher improvements, tests

---
 hledger-lib/Hledger/Data.hs             |  1 +
 hledger-lib/Hledger/Data/AccountName.hs | 19 +++++++++++++
 hledger-lib/Hledger/Data/Matching.hs    | 37 ++++++++++++++++++++-----
 hledger-web/Handlers.hs                 | 10 -------
 hledger/Hledger/Cli.hs                  |  3 +-
 5 files changed, 52 insertions(+), 18 deletions(-)

diff --git a/hledger-lib/Hledger/Data.hs b/hledger-lib/Hledger/Data.hs
index 32abb505f..85b2a092a 100644
--- a/hledger-lib/Hledger/Data.hs
+++ b/hledger-lib/Hledger/Data.hs
@@ -47,6 +47,7 @@ tests_Hledger_Data = TestList
     ,tests_Hledger_Data_Dates
     ,tests_Hledger_Data_Journal
     ,tests_Hledger_Data_Ledger
+    ,tests_Hledger_Data_Matching
     ,tests_Hledger_Data_Posting
     ,tests_Hledger_Data_TimeLog
     ,tests_Hledger_Data_Transaction
diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs
index d55643cba..0292b183a 100644
--- a/hledger-lib/Hledger/Data/AccountName.hs
+++ b/hledger-lib/Hledger/Data/AccountName.hs
@@ -13,6 +13,7 @@ import Data.List
 import Data.Map (Map)
 import Data.Tree
 import Test.HUnit
+import Text.Printf
 import qualified Data.Map as M
 
 import Hledger.Data.Types
@@ -177,6 +178,24 @@ elideAccountName width s =
 clipAccountName :: Int -> AccountName -> AccountName
 clipAccountName n = accountNameFromComponents . take n . accountNameComponents
 
+-- | Convert an account name to a regular expression matching it and its subaccounts.
+accountNameToAccountRegex :: String -> String
+accountNameToAccountRegex "" = ""
+accountNameToAccountRegex a = printf "^%s(:|$)" a
+
+-- | Convert an account name to a regular expression matching it and its subaccounts.
+accountNameToAccountOnlyRegex :: String -> String
+accountNameToAccountOnlyRegex "" = ""
+accountNameToAccountOnlyRegex a = printf "^%s$" a
+
+-- | Convert an exact account-matching regular expression to a plain account name.
+accountRegexToAccountName :: String -> String
+accountRegexToAccountName = regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1"
+
+-- | Does this string look like an exact account-matching regular expression ?
+isAccountRegex  :: String -> Bool
+isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:("
+
 tests_Hledger_Data_AccountName = TestList
  [
   "accountNameTreeFrom" ~: do
diff --git a/hledger-lib/Hledger/Data/Matching.hs b/hledger-lib/Hledger/Data/Matching.hs
index 89d7e69ea..5ddd90805 100644
--- a/hledger-lib/Hledger/Data/Matching.hs
+++ b/hledger-lib/Hledger/Data/Matching.hs
@@ -48,12 +48,12 @@ data Matcher = MatchAny                   -- ^ always match
              | MatchDepth Bool Int        -- ^ match if account depth is less than or equal to this value
              -- XXX not sure if this belongs here
              | MatchInAcct Bool String    -- ^ match postings whose transaction contains a posting to an account matching this regexp
-    deriving (Show)
+    deriving (Show, Eq)
 
 -- | Parse a query expression string as a list of match patterns OR'd together.
 -- The current date is required to interpret relative dates.
 parseMatcher :: Day -> String -> Matcher
-parseMatcher refdate s = MatchAnd $ map parseword $ words'' ["not:","acct:","desc:"] s
+parseMatcher refdate s = MatchAnd $ map parseword $ words'' matcherprefixes s
   where
     parseword :: String -> Matcher
     parseword ('n':'o':'t':':':s) = negateMatch $ parseMatcher refdate s
@@ -70,6 +70,9 @@ parseMatcher refdate s = MatchAnd $ map parseword $ words'' ["not:","acct:","des
     parseword "" = MatchAny
     parseword s = parseword $ "acct:"++s
 
+    -- keep synced with patterns above
+    matcherprefixes = map (++":") ["not","desc","acct","inacct","in","date","edate","status","real","empty","depth"]
+
     parseStatus "*" = True
     parseStatus _ = False
 
@@ -144,6 +147,17 @@ matchesTransaction (MatchAcct False r) t = not $ (MatchAcct True r) `matchesTran
 matchesTransaction (MatchInAcct sense r) t = (MatchAcct sense r) `matchesTransaction` t
 matchesTransaction _ _ = False
 
+-- | Does the match expression match this account ?
+-- A matching in: clause is also considered a match.
+matchesAccount :: Matcher -> AccountName -> Bool
+matchesAccount (MatchAny) _ = True
+matchesAccount (MatchOr ms) a = any (`matchesAccount` a) ms
+matchesAccount (MatchAnd ms) a = all (`matchesAccount` a) ms
+matchesAccount (MatchAcct True r) a = regexMatchesCI r a
+matchesAccount (MatchAcct False r) a = not $ (MatchAcct True r) `matchesAccount` a
+matchesAccount (MatchInAcct True r) a = (MatchAcct True r) `matchesAccount` a
+matchesAccount _ _ = False
+
 -- | Does the match expression include an "in:" clause specifying this account ?
 -- For now, does a case-insensitive exact string match on the full account name.
 -- XXX perhaps in: should be handled separately.
@@ -155,14 +169,14 @@ matchesInAccount (MatchInAcct True s) a = lowercase s == lowercase a -- regexMat
 matchesInAccount (MatchInAcct False s) a = not $ (MatchInAcct True s) `matchesInAccount` a
 matchesInAccount _ _ = True
 
--- | Which account does the match expression specify as the one we are in, if any ?
+-- | Which account is specified by an in:ACCT in the match expression, if any ?
 matcherInAccount :: Matcher -> Maybe AccountName
 matcherInAccount (MatchOr ms) = case catMaybes $ map matcherInAccount ms of
                                   [a] -> Just a
                                   (a:as@(_:_)) -> if all (==a) as then Just a else Nothing
                                   _ -> Nothing
 matcherInAccount (MatchAnd ms) = headDef Nothing $ map Just $ catMaybes $ map matcherInAccount ms
-matcherInAccount (MatchInAcct True a) = Just a
+matcherInAccount (MatchInAcct True a) = Just $ strace a
 matcherInAccount _ = Nothing
 
 -- | What start date does this matcher specify, if any ?
@@ -192,6 +206,15 @@ tests_Hledger_Data_Matching :: Test
 tests_Hledger_Data_Matching = TestList
  [
 
-  -- "summarisePostingsByInterval" ~: do
-  --   summarisePostingsByInterval (Quarters 1) Nothing False (DateSpan Nothing Nothing) [] ~?= []
- ]
\ No newline at end of file
+  "parseMatcher" ~: do
+    let d = parsedate "2011/1/1"
+    parseMatcher d "in:'expenses:autres d\233penses'" `is`
+     (MatchAnd [MatchInAcct True "expenses:autres d\233penses"])
+
+  ,"matchesAccount" ~: do
+    assertBool "positive acct match" $ matchesAccount (MatchAcct True "b:c") "a:bb:c:d"
+    -- assertBool "acct should match at beginning" $ not $ matchesAccount (MatchAcct True "a:b") "c:a:b"
+
+  -- ,"matchesAccount" ~: do
+  --   matchesAccount (MatchAcct )
+ ]
diff --git a/hledger-web/Handlers.hs b/hledger-web/Handlers.hs
index 79413c618..f900ba593 100644
--- a/hledger-web/Handlers.hs
+++ b/hledger-web/Handlers.hs
@@ -436,14 +436,4 @@ getMessageOr mnewmsg = do
   oldmsg <- getMessage
   return $ maybe oldmsg (Just . toHtml) mnewmsg
 
-accountNameToAccountRegex :: String -> String
-accountNameToAccountRegex "" = ""
-accountNameToAccountRegex a = printf "^%s(:|$)" a
-
-accountRegexToAccountName :: String -> String
-accountRegexToAccountName = regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1"
-
-isAccountRegex  :: String -> Bool
-isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:("
-
 numbered = zip [1..]
diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs
index 51baf1dcb..d933bfb03 100644
--- a/hledger/Hledger/Cli.hs
+++ b/hledger/Hledger/Cli.hs
@@ -484,7 +484,8 @@ tests_Hledger_Cli = TestList
   
 -- fixtures/test data
 
-t1 = LocalTime date1 midday where date1 = parsedate "2008/11/26"
+date1 = parsedate "2008/11/26"
+t1 = LocalTime date1 midday
 
 samplejournal = readJournalWithOpts [] sample_journal_str
 samplejournalwithopts opts _ = readJournalWithOpts opts sample_journal_str