new query by tag implementation

MANUAL.md

@@ -890,10 +890,9 @@ currently supported:
 - `status:1` or `status:0` - match cleared/uncleared transactions
 - `depth:N` - match (or display, depending on command) accounts at or above this depth
 - `not:` before any of the above negates the match
+- `tag:NAME[=VALUEREGEX]` - match by exact [tag](#tags) name, and optionally match the tag value by regular expression
 
 <!--
-- `tag:TAGNAMEREGEX[:TAGVALUEREGEX]` - match a [tag](#tags) name, and
-  optionally the value, by regular expression
 - `TAGNAME:[TAGVALUEREGEX]` - match a tag name exactly, and optionally
   the value by regular expression.
 - `code:CODEREGEX` -->

hledger-lib/Hledger/Data/Posting.hs

@@ -17,6 +17,8 @@ module Hledger.Data.Posting (
   isBalancedVirtual,
   isEmptyPosting,
   hasAmount,
+  postingAllTags,
+  transactionAllTags,
   -- * date operations
   postingDate,
   isPostingInDateSpan,
@@ -127,6 +129,14 @@ postingCleared p = if pstatus p
                     then True
                     else maybe False tstatus $ ptransaction p
 
+-- | Tags for this posting including any inherited from its parent transaction.
+postingAllTags :: Posting -> [Tag]
+postingAllTags p = ptags p ++ maybe [] transactionAllTags (ptransaction p)
+
+-- | Tags for this transaction including any inherited from above, when that is implemented.
+transactionAllTags :: Transaction -> [Tag]
+transactionAllTags t = ttags t
+
 -- | Does this posting fall within the given date span ?
 isPostingInDateSpan :: DateSpan -> Posting -> Bool
 isPostingInDateSpan s = spanContainsDate s . postingDate

hledger-lib/Hledger/Data/Query.hs

@@ -36,14 +36,13 @@ import Data.Either
 import Data.List
 import Data.Maybe
 import Data.Time.Calendar
-import Safe (readDef, headDef)
+import Safe (readDef, headDef, headMay)
 import Test.HUnit
 import Text.ParserCombinators.Parsec
 
 import Hledger.Utils
 import Hledger.Data.Types
 import Hledger.Data.AccountName
-import Hledger.Data.Amount
 import Hledger.Data.Dates
 import Hledger.Data.Posting
 import Hledger.Data.Transaction
@@ -65,6 +64,8 @@ data Query = Any              -- ^ always match
            | Empty Bool       -- ^ if true, show zero-amount postings/accounts which are usually not shown
                               --   more of a query option than a query criteria ?
            | Depth Int        -- ^ match if account depth is less than or equal to this value
+           | Tag String (Maybe String)  -- ^ match if a tag with this exact name, and with value
+                                        -- matching the regexp if provided, exists
     deriving (Show, Eq)
 
 -- | A query option changes a query's/report's behaviour and output in some way.
@@ -128,8 +129,6 @@ tests_parseQuery = [
     parseQuery d "inacct:a inacct:b" `is` (Any, [QueryOptInAcct "a", QueryOptInAcct "b"])
     parseQuery d "desc:'x x'" `is` (Desc "x x", [])
     parseQuery d "'a a' 'b" `is` (Or [Acct "a a",Acct "'b"], [])
-    -- parseQuery d "a b desc:x desc:y status:1" `is` 
-    --   (And [Or [Acct "a", Acct "b"], Or [Desc "x", Desc "y"], Status True], [])
  ]
 
 -- keep synced with patterns below, excluding "not"
@@ -200,6 +199,7 @@ parseQueryTerm _ ('s':'t':'a':'t':'u':'s':':':s) = Left $ Status $ parseStatus s
 parseQueryTerm _ ('r':'e':'a':'l':':':s) = Left $ Real $ parseBool s
 parseQueryTerm _ ('e':'m':'p':'t':'y':':':s) = Left $ Empty $ parseBool s
 parseQueryTerm _ ('d':'e':'p':'t':'h':':':s) = Left $ Depth $ readDef 0 s
+parseQueryTerm _ ('t':'a':'g':':':s) = Left $ Tag n v where (n,v) = parseTag s
 parseQueryTerm _ "" = Left $ Any
 parseQueryTerm d s = parseQueryTerm d $ defaultprefix++":"++s
 
@@ -216,8 +216,15 @@ tests_parseQueryTerm = [
     "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")
+    "tag:a" `gives` (Left $ Tag "a" Nothing)
+    "tag:a=some value" `gives` (Left $ Tag "a" (Just "some value"))
  ]
 
+parseTag :: String -> (String, Maybe String)
+parseTag s | '=' `elem` s = (n, Just $ tail v)
+           | otherwise    = (s, Nothing)
+           where (n,v) = break (=='=') s
+
 -- | 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
@@ -419,6 +426,7 @@ matchesAccount (Or ms) a = any (`matchesAccount` a) ms
 matchesAccount (And ms) a = all (`matchesAccount` a) ms
 matchesAccount (Acct r) a = regexMatchesCI r a
 matchesAccount (Depth d) a = accountNameLevel a <= d
+matchesAccount (Tag _ _) _ = False
 matchesAccount _ _ = True
 
 tests_matchesAccount = [
@@ -432,6 +440,7 @@ tests_matchesAccount = [
     assertBool "" $ not $ Depth 2 `matchesAccount` "a:b:c"
     assertBool "" $ Date nulldatespan `matchesAccount` "a"
     assertBool "" $ EDate nulldatespan `matchesAccount` "a"
+    assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a"
  ]
 
 -- | Does the match expression match this posting ?
@@ -457,6 +466,8 @@ matchesPosting (Depth d) Posting{paccount=a} = Depth d `matchesAccount` a
 -- matchesPosting (Empty False) Posting{pamount=a} = True
 -- matchesPosting (Empty True) Posting{pamount=a} = isZeroMixedAmount a
 matchesPosting (Empty _) _ = True
+matchesPosting (Tag n Nothing) p = isJust $ lookupTagByName n $ postingAllTags p
+matchesPosting (Tag n (Just v)) p = isJust $ lookupTagByNameAndValue (n,v) $ postingAllTags p
 -- matchesPosting _ _ = False
 
 tests_matchesPosting = [
@@ -476,6 +487,15 @@ tests_matchesPosting = [
     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}
     assertBool "" $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"}
+    assertBool "" $ not $ (Tag "a" (Just "r$")) `matchesPosting` nullposting
+    assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","")]}
+    assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]}
+    assertBool "" $ (Tag "foo" (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
+    assertBool "" $ not $ (Tag "foo" (Just "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
+    assertBool "" $ not $ (Tag " foo " (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
+    assertBool "" $ not $ (Tag "foo foo" (Just " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]}
+    -- a tag match on a posting also sees inherited tags
+    assertBool "" $ (Tag "txntag" Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
  ]
 
 -- | Does the match expression match this transaction ?
@@ -493,6 +513,9 @@ matchesTransaction (Status v) t = v == tstatus t
 matchesTransaction (Real v) t = v == hasRealPostings t
 matchesTransaction (Empty _) _ = True
 matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t
+matchesTransaction (Tag n Nothing) t = isJust $ lookupTagByName n $ transactionAllTags t
+matchesTransaction (Tag n (Just v)) t = isJust $ lookupTagByNameAndValue (n,v) $ transactionAllTags t
+
 -- matchesTransaction _ _ = False
 
 tests_matchesTransaction = [
@@ -501,8 +524,24 @@ tests_matchesTransaction = [
    Any `matches` nulltransaction
    assertBool "" $ not $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x"}
    assertBool "" $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x x"}
+   -- see posting for more tag tests
+   assertBool "" $ (Tag "foo" (Just "a")) `matchesTransaction` nulltransaction{ttags=[("foo","bar")]}
+   -- a tag match on a transaction usually ignores posting tags
+   assertBool "" $ not $ (Tag "postingtag" Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]}
  ]
 
+lookupTagByName :: String -> [Tag] -> Maybe Tag
+lookupTagByName namepat tags = headMay [(n,v) | (n,v) <- tags, matchTagName namepat n]
+
+lookupTagByNameAndValue :: Tag -> [Tag] -> Maybe Tag
+lookupTagByNameAndValue (namepat, valpat) tags = headMay [(n,v) | (n,v) <- tags, matchTagName namepat n, matchTagValue valpat v]
+
+matchTagName :: String -> String -> Bool
+matchTagName pat name = pat == name
+
+matchTagValue :: String -> String -> Bool
+matchTagValue pat value = regexMatchesCI pat value
+
 postingEffectiveDate :: Posting -> Maybe Day
 postingEffectiveDate p = maybe Nothing (Just . transactionEffectiveDate) $ ptransaction p
 

hledger-lib/Hledger/Data/Types.hs

@@ -89,13 +89,15 @@ newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord)
 data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting
                    deriving (Eq,Show)
 
+type Tag = (String, String)
+
 data Posting = Posting {
       pstatus :: Bool,
       paccount :: AccountName,
       pamount :: MixedAmount,
       pcomment :: String, -- ^ this posting's non-tag comment lines, as a single non-indented string
       ptype :: PostingType,
-      ptags :: [(String,String)],
+      ptags :: [Tag],
       ptransaction :: Maybe Transaction  -- ^ this posting's parent transaction (co-recursive types).
                                         -- Tying this knot gets tedious, Maybe makes it easier/optional.
     }
@@ -112,7 +114,7 @@ data Transaction = Transaction {
       tcode :: String,
       tdescription :: String,
       tcomment :: String, -- ^ this transaction's non-tag comment lines, as a single non-indented string
-      ttags :: [(String,String)],
+      ttags :: [Tag],
       tpostings :: [Posting],            -- ^ this transaction's postings (co-recursive types).
       tpreceding_comment_lines :: String
     } deriving (Eq)

hledger-lib/Hledger/Read/JournalReader.hs

@@ -752,8 +752,6 @@ commentline = do
 
 -- newer comment parsers
 
-type Tag = (String, String)
-
 inlinecomment :: GenParser Char JournalContext ([String],[Tag])
 inlinecomment = try (do {md <- tagcomment; newline; return ([], [md])})
                     <|> (do {c <- comment; newline; return ([rstrip c], [])})

tests/tags.test

@@ -25,57 +25,80 @@ bin/hledger -f - print
 >>>2
 >>>=0
 
-# 2. print (and a few other commands) can filter by tag value
+# 2. reports can filter by tag existence
-# bin/hledger -f - print tag foo=bar
+bin/hledger -f - print tag:foo
-# <<<
+<<<
-# 2010/01/01
+2010/01/01 ; foo:bar
-#   ; foo:bar
+  a             1
-#   a             1
+  b            -1
-#   b            -1
 
-# 2010/01/02
+2010/01/02
-#   ; foo:baz
+  ; foo:baz
-#   c             1
+  c             1
-#   d            -1
+  d            -1
 
-# 2010/01/03
+2010/01/03
-#     e             1
+    e             1
-#     f            -1
+    f            -1
-# >>>
+>>>
-# 2010/01/01
+2010/01/01
-#     ; foo: bar
+    ; foo: bar
-#     a             1
+    a             1
-#     b            -1
+    b            -1
 
-# >>>2
+2010/01/02
-# >>>=0
+    ; foo: baz
+    c             1
+    d            -1
 
-# # 3. or tag existence ? not yet
+>>>2
-# bin/hledger -f - print tag foo
+>>>=0
-# <<<
-# 2010/01/01
-#   ; foo:bar
-#   a             1
-#   b            -1
 
-# 2010/01/02
+# 3. or tag value
-#   ; foo:baz
+bin/hledger -f - print tag:foo=bar
-#   c             1
+<<<
-#   d            -1
+2010/01/01
+  ; foo:bar
+  a             1
+  b            -1
 
-# 2010/01/03
+2010/01/02
-#     e             1
+  ; foo:baz
-#     f            -1
+  c             1
-# >>>
+  d            -1
-# 2010/01/01
-#   ; foo:bar
-#     a             1
-#     b            -1
 
-# 2010/01/02
+2010/01/03
-#   ; foo:baz
+    e             1
-#     c             1
+    f            -1
-#     d            -1
+>>>
+2010/01/01
+    ; foo: bar
+    a             1
+    b            -1
+
+>>>2
+>>>=0
+
+# 4. postings inherit their transaction's tags
+bin/hledger -f - register tag:foo=bar
+<<<
+2010/01/01
+  a             1  ; foo:bar
+  b            -1
+
+2010/01/02
+  ; foo:baz
+  c             1
+  d            -1
+
+2010/01/03
+  ; foo:bar
+  e             1
+  f            -1
+>>>
+2010/01/01                      a                                 1            1
+2010/01/03                      e                                 1            2
+                                f                                -1            1
+>>>2
+>>>=0
 
-# >>>2
-# >>>=0