more tests cleanup, and start to move match functions to Utils

Ledger/RawLedger.hs

@@ -86,14 +86,13 @@ filterRawLedgerTransactionsByRealness True (RawLedger ms ps es f) =
     where filtertxns e@Entry{etransactions=ts} = e{etransactions=filter isReal ts}
 
 -- | Check if a set of ledger account/description patterns matches the
--- given account name or entry description, applying ledger's special
--- cases.  
+-- given account name or entry description.  Patterns are case-insensitive
+-- regular expression strings; those beginning with - are anti-patterns.
 -- 
--- Patterns are case-insensitive 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.
+-- Call with forbalancereport=True to mimic ledger's balance report
+-- matching. Account patterns usually match the full account name, but in
+-- balance reports when the pattern does not contain : and is not an
+-- anti-pattern, 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))

Tests.hs

@@ -18,38 +18,12 @@ runtests args = do
         tests = [unittests, functests]
         deeptests = tfilter matchname $ TestList tests
         flattests = TestList $ filter matchname $ concatMap tflatten tests
-        matchname = Tests.matchpats args . tname
+        matchname = matchpats args . tname
         n = length ts where (TestList ts) = flattests
         s | null args = ""
           | otherwise = printf " matching %s" 
                         (intercalate ", " $ map (printf "\"%s\"") args)
 
-matchpats pats str = (null positives || any match positives) && (null negatives || not (any match negatives))
-    where
-      (negatives,positives) = partition isnegative pats
-      isnegative = (== [Ledger.negativepatternchar]) . take 1
-      match "" = True
-      match pat = containsRegex (mkRegexWithOpts pat' True True) str
-          where 
-            pat' = if isnegative pat then drop 1 pat else pat
-
--- | Get a Test's label, or the empty string.
-tname :: Test -> String
-tname (TestLabel n _) = n
-tname _ = ""
-
--- | Flatten a Test containing TestLists into a list of single tests.
-tflatten :: Test -> [Test]
-tflatten (TestLabel _ t@(TestList _)) = tflatten t
-tflatten (TestList ts) = concatMap tflatten ts
-tflatten t = [t]
-
--- | Filter any TestLists in a Test, recursively, preserving the structure.
-tfilter :: (Test -> Bool) -> Test -> Test
-tfilter p (TestList ts) = TestList $ filter (any p . tflatten) $ map (tfilter p) ts
-tfilter p (TestLabel l t) = TestLabel l (tfilter p t)
-tfilter _ t = t
-
 ------------------------------------------------------------------------------
 
 unittests = TestList [
@@ -108,18 +82,16 @@ unittests = TestList [
   ,
   "setAmountDisplayPrefs" ~: do
     let l = setAmountDisplayPrefs $ rawLedgerWithAmounts ["1","2.00"]
-    -- should be using the greatest precision everywhere
-    assertequal [2,2] (rawLedgerPrecisions l)
+    assertequal [2,2] (rawLedgerPrecisions l) -- use greatest precision everywhere
 
-  ]
-
-rawLedgerWithAmounts as = 
-    RawLedger 
-      [] 
-      [] 
-      [nullentry{etransactions=[nullrawtxn{tamount=parse a}]} | a <- as]
-      ""
-    where parse = fromparse . parsewith transactionamount . (" "++)
+  ] where
+    rawLedgerWithAmounts as = 
+        RawLedger 
+        [] 
+        [] 
+        [nullentry{etransactions=[nullrawtxn{tamount=parse a}]} | a <- as]
+        ""
+            where parse = fromparse . parsewith transactionamount . (" "++)
 
 ------------------------------------------------------------------------------
 
@@ -248,12 +220,8 @@ registercommandtests = TestList [
      $ showRegisterReport [] [] l
   ]
   
--- | Assert a parsed thing equals some expected thing, or print a parse error.
-assertparseequal :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion
-assertparseequal expected parsed = either printParseError (assertequal expected) parsed
-
 ------------------------------------------------------------------------------
--- data
+-- test data
 
 rawtransaction1_str  = "  expenses:food:dining  $10.00\n"
 
@@ -560,3 +528,31 @@ timelog1 = TimeLog [
             timelogentry2
            ]
 
+------------------------------------------------------------------------------
+-- test utils
+
+-- | Get a Test's label, or the empty string.
+tname :: Test -> String
+tname (TestLabel n _) = n
+tname _ = ""
+
+-- | Flatten a Test containing TestLists into a list of single tests.
+tflatten :: Test -> [Test]
+tflatten (TestLabel _ t@(TestList _)) = tflatten t
+tflatten (TestList ts) = concatMap tflatten ts
+tflatten t = [t]
+
+-- | Filter TestLists in a Test, recursively, preserving the structure.
+tfilter :: (Test -> Bool) -> Test -> Test
+tfilter p (TestLabel l ts) = TestLabel l (tfilter p ts)
+tfilter p (TestList ts) = TestList $ filter (any p . tflatten) $ map (tfilter p) ts
+tfilter _ t = t
+
+-- | Combine a list of TestLists into one.
+tlistconcat :: [Test] -> Test
+tlistconcat = foldr (\(TestList as) (TestList bs) -> TestList (as ++ bs)) (TestList []) 
+
+-- | Assert a parsed thing equals some expected thing, or print a parse error.
+assertparseequal :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion
+assertparseequal expected parsed = either printParseError (assertequal expected) parsed
+

Utils.hs

@@ -41,3 +41,53 @@ myledger = do
 myaccount :: AccountName -> IO Account
 myaccount a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accountmap)
 
+-- | Check if a set of ledger account/description patterns matches the
+-- given account name or entry description.  Patterns are case-insensitive
+-- regular expression strings; those beginning with - are anti-patterns.
+matchpats :: [String] -> String -> Bool
+matchpats pats str =
+    (null positives || any match positives) && (null negatives || not (any match negatives))
+    where
+      (negatives,positives) = partition isnegativepat pats
+      match "" = True
+      match pat = matchregex (abspat pat) str
+
+-- | Similar to matchpats, but follows the special behaviour of ledger
+-- 2.6's balance command: positive patterns which do not contain : match
+-- the account leaf name, other patterns match the full account name.
+matchpats_balance :: [String] -> String -> Bool
+matchpats_balance pats str = match_positive_pats pats str && (not $ match_negative_pats pats str)
+--    (null positives || any match positives) && (null negatives || not (any match negatives))
+--     where
+--       (negatives,positives) = partition isnegativepat pats
+--       match "" = True
+--       match pat = matchregex (abspat pat) matchee
+--           where 
+--             matchee = if not (':' `elem` pat) && not (isnegativepat pat)
+--                       then accountLeafName str
+--                       else str
+
+-- | Do the positives in these patterns permit a match for this string ?
+match_positive_pats :: [String] -> String -> Bool
+match_positive_pats pats str = (null ps) || (any match ps)
+    where
+      ps = positivepats pats
+      match "" = True
+      match p = matchregex (abspat p) matchee
+          where 
+            matchee | ':' `elem` p = str
+                    | otherwise = accountLeafName str
+
+-- | Do the negatives in these patterns prevent a match for this string ?
+match_negative_pats :: [String] -> String -> Bool
+match_negative_pats pats str = (not $ null ns) && (any match ns)
+    where
+      ns = map abspat $ negativepats pats
+      match "" = True
+      match p = matchregex (abspat p) str
+
+matchregex pat str = containsRegex (mkRegexWithOpts pat True True) str
+isnegativepat pat = (== [Ledger.negativepatternchar]) $ take 1 pat
+abspat pat = if isnegativepat pat then drop 1 pat else pat
+positivepats = filter (not . isnegativepat)
+negativepats = filter isnegativepat