query tests cleanup

NOTES.org

@@ -14,6 +14,7 @@ hledger project notes
 **** 7.4.1
 **** 7.2.2
 **** 7.0.4
+*** release 0.18
 ** errors
 *** hledger incomestatement --depth shows nothing
 *** duplicate test runs
@@ -619,6 +620,7 @@ This project will go forward if
 **** every parser has a test and is easy to test
 **** easy to run any single test or module's tests
 **** tests run bottom up by default
+**** test runner can select tests precisely eg by regexp
 **** test runner stops at first failure by default
 
 *** documentation
@@ -1865,7 +1867,7 @@ ExitFailure (-1073741819)
 
 
 * journal
-partial
+(partial)
 ** 2010
 *** 5/4
 **** balance sheet pomodoro 1
@@ -3021,3 +3023,5 @@ move *FromOpts into toOpts
 ** 2012
 *** 2012/5/5 release prep
 *** 5/14 finish parsing, tests changes
+*** 5/15 matcher -> query, cleanup
+*** 5/16 tests, using query consistently

hledger-lib/Hledger/Data.hs

@@ -47,7 +47,6 @@ tests_Hledger_Data = TestList
     ,tests_Hledger_Data_Dates
     ,tests_Hledger_Data_Journal
     ,tests_Hledger_Data_Ledger
-    ,tests_Hledger_Data_Query
     ,tests_Hledger_Data_Posting
     ,tests_Hledger_Data_TimeLog
     ,tests_Hledger_Data_Transaction

hledger-lib/Hledger/Data/Query.hs

@@ -162,6 +162,21 @@ parseQuery d s = (m,qopts)
                         (m':[]) -> m'
                         ms      -> And ms
 
+tests_parseQuery = [
+  "parseQuery" ~: do
+    let d = parsedate "2011/1/1"
+    parseQuery d "acct:'expenses:autres d\233penses' desc:b" `is` (And [Acct "expenses:autres d\233penses", Desc "b"], [])
+    parseQuery d "inacct:a desc:\"b b\"" `is` (Desc "b b", [QueryOptInAcct "a"])
+    parseQuery d "inacct:a inacct:b" `is` (Any, [QueryOptInAcct "a", QueryOptInAcct "b"])
+ ]
+
+-- keep synced with patterns below, excluding "not"
+prefixes = map (++":") [
+            "inacct","inacctonly",
+            "desc","acct","date","edate","status","real","empty","depth"
+           ]
+defaultprefix = "acct"
+
 -- | Quote-and-prefix-aware version of words - don't split on spaces which
 -- are inside quotes, including quotes which may have one of the specified
 -- prefixes in front, and maybe an additional not: prefix in front of that.
@@ -182,6 +197,18 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
         return $ stripquotes p
       pattern = many (noneOf " \n\r\"")
 
+tests_words'' = [
+   "words''" ~: do
+    assertEqual "1" ["a","b"]        (words'' [] "a b")
+    assertEqual "2" ["a b"]          (words'' [] "'a b'")
+    assertEqual "3" ["not:a","b"]    (words'' [] "not:a b")
+    assertEqual "4" ["not:a b"]    (words'' [] "not:'a b'")
+    assertEqual "5" ["not:a b"]    (words'' [] "'not:a b'")
+    assertEqual "6" ["not:desc:a b"]    (words'' ["desc:"] "not:desc:'a b'")
+    let s `gives` r = assertEqual "" r (words'' prefixes s)
+    "\"acct:expenses:autres d\233penses\"" `gives` ["acct:expenses:autres d\233penses"]
+ ]
+
 -- -- | Parse the query string as a boolean tree of match patterns.
 -- parseQueryTerm :: String -> Query
 -- parseQueryTerm s = either (const (Any)) id $ runParser query () "" $ lexmatcher s
@@ -192,13 +219,6 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
 -- query :: GenParser String () Query
 -- query = undefined
 
--- keep synced with patterns below, excluding "not"
-prefixes = map (++":") [
-            "inacct","inacctonly",
-            "desc","acct","date","edate","status","real","empty","depth"
-           ]
-defaultprefix = "acct"
-
 -- | Parse a single query term as either a query or a query option.
 parseQueryTerm :: Day -> String -> Either Query QueryOpt
 parseQueryTerm _ ('i':'n':'a':'c':'c':'t':'o':'n':'l':'y':':':s) = Right $ QueryOptInAcctOnly s
@@ -221,6 +241,21 @@ parseQueryTerm _ ('d':'e':'p':'t':'h':':':s) = Left $ Depth $ readDef 0 s
 parseQueryTerm _ "" = Left $ Any
 parseQueryTerm d s = parseQueryTerm d $ defaultprefix++":"++s
 
+tests_parseQueryTerm = [
+  "parseQueryTerm" ~: do
+    let s `gives` r = parseQueryTerm nulldate s `is` r
+    "a" `gives` (Left $ Acct "a")
+    "acct:expenses:autres d\233penses" `gives` (Left $ Acct "expenses:autres d\233penses")
+    "not:desc:a b" `gives` (Left $ Not $ Desc "a b")
+    "status:1" `gives` (Left $ Status True)
+    "status:0" `gives` (Left $ Status False)
+    "status:" `gives` (Left $ Status False)
+    "real:1" `gives` (Left $ Real True)
+    "date:2008" `gives` (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01"))
+    "date:from 2012/5/17" `gives` (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing)
+    "inacct:a" `gives` (Right $ QueryOptInAcct "a")
+ ]
+
 -- | Parse the boolean value part of a "status:" query, allowing "*" as
 -- another way to spell True, similar to the journal file format.
 parseStatus :: String -> Bool
@@ -257,6 +292,24 @@ matchesPosting (Real v) p = v == isReal p
 matchesPosting (Empty v) Posting{pamount=a} = v == isZeroMixedAmount a
 matchesPosting _ _ = False
 
+tests_matchesPosting = [
+   "matchesPosting" ~: do
+    -- matching posting status..
+    assertBool "positive match on true posting status"  $
+                   (Status True)  `matchesPosting` nullposting{pstatus=True}
+    assertBool "negative match on true posting status"  $
+               not $ (Not $ Status True)  `matchesPosting` nullposting{pstatus=True}
+    assertBool "positive match on false posting status" $
+                   (Status False) `matchesPosting` nullposting{pstatus=False}
+    assertBool "negative match on false posting status" $
+               not $ (Not $ Status False) `matchesPosting` nullposting{pstatus=False}
+    assertBool "positive match on true posting status acquired from transaction" $
+                   (Status True) `matchesPosting` nullposting{pstatus=False,ptransaction=Just nulltransaction{tstatus=True}}
+    assertBool "real:1 on real posting" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting}
+    assertBool "real:1 on virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting}
+    assertBool "real:1 on balanced virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}
+ ]
+
 -- | Does the match expression match this transaction ?
 matchesTransaction :: Query -> Transaction -> Bool
 matchesTransaction (Not m) t = not $ matchesTransaction m t
@@ -286,54 +339,19 @@ matchesAccount (And ms) a = all (`matchesAccount` a) ms
 matchesAccount (Acct r) a = regexMatchesCI r a
 matchesAccount _ _ = False
 
+tests_matchesAccount = [
+   "matchesAccount" ~: do
+    assertBool "positive acct match" $ matchesAccount (Acct "b:c") "a:bb:c:d"
+    -- assertBool "acct should match at beginning" $ not $ matchesAccount (Acct True "a:b") "c:a:b"
+ ]
+
 -- tests
 
 tests_Hledger_Data_Query :: Test
-tests_Hledger_Data_Query = TestList
+tests_Hledger_Data_Query = TestList $
- [
+ tests_words''
+ ++ tests_parseQueryTerm
+ ++ tests_parseQuery
+ ++ tests_matchesAccount
+ ++ tests_matchesPosting
 
-  "parseQuery" ~: do
-    let d = parsedate "2011/1/1"
-    parseQuery d "a" `is` (Acct "a", [])
-    parseQuery d "acct:a" `is` (Acct "a", [])
-    parseQuery d "acct:a desc:b" `is` (And [Acct "a", Desc "b"], [])
-    parseQuery d "\"acct:expenses:autres d\233penses\"" `is` (Acct "expenses:autres d\233penses", [])
-    parseQuery d "not:desc:'a b'" `is` (Not $ Desc "a b", [])
-
-    parseQuery d "inacct:a desc:b" `is` (Desc "b", [QueryOptInAcct "a"])
-    parseQuery d "inacct:a inacct:b" `is` (Any, [QueryOptInAcct "a", QueryOptInAcct "b"])
-
-    parseQuery d "status:1" `is` (Status True, [])
-    parseQuery d "status:0" `is` (Status False, [])
-    parseQuery d "status:" `is` (Status False, [])
-    parseQuery d "real:1" `is` (Real True, [])
-
-  ,"matchesAccount" ~: do
-    assertBool "positive acct match" $ matchesAccount (Acct "b:c") "a:bb:c:d"
-    -- assertBool "acct should match at beginning" $ not $ matchesAccount (Acct True "a:b") "c:a:b"
-
-  ,"matchesPosting" ~: do
-    -- matching posting status..
-    assertBool "positive match on true posting status"  $
-                   (Status True)  `matchesPosting` nullposting{pstatus=True}
-    assertBool "negative match on true posting status"  $
-               not $ (Not $ Status True)  `matchesPosting` nullposting{pstatus=True}
-    assertBool "positive match on false posting status" $
-                   (Status False) `matchesPosting` nullposting{pstatus=False}
-    assertBool "negative match on false posting status" $
-               not $ (Not $ Status False) `matchesPosting` nullposting{pstatus=False}
-    assertBool "positive match on true posting status acquired from transaction" $
-                   (Status True) `matchesPosting` nullposting{pstatus=False,ptransaction=Just nulltransaction{tstatus=True}}
-    assertBool "real:1 on real posting" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting}
-    assertBool "real:1 on virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting}
-    assertBool "real:1 on balanced virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}
-
-  ,"words''" ~: do
-    assertEqual "1" ["a","b"]        (words'' [] "a b")
-    assertEqual "2" ["a b"]          (words'' [] "'a b'")
-    assertEqual "3" ["not:a","b"]    (words'' [] "not:a b")
-    assertEqual "4" ["not:a b"]    (words'' [] "not:'a b'")
-    assertEqual "5" ["not:a b"]    (words'' [] "'not:a b'")
-    assertEqual "6" ["not:desc:a b"]    (words'' ["desc:"] "not:desc:'a b'")
-
- ]