2 files changed, 94 insertions, 21 deletions

diff --git a/app/Issue/Filter.hs b/app/Issue/Filter.hs
index fb6d205..efcf88c 100644
--- a/app/Issue/Filter.hs
+++ b/app/Issue/Filter.hs
@@ -5,46 +5,99 @@ module Issue.Filter
   )
 where
 
-import Control.Applicative (liftA2)
-import Control.Arrow (second)
+import Control.Applicative (liftA2, (<|>))
+import Data.Attoparsec.Text qualified as A
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Issue (Issue (..))
-import Issue.Tag (Tag (..))
+import Issue.Tag (tagKey, tagValue)
 import Options.Applicative qualified as O
 
+-- TODO Revise filter negation
+--
+-- Currently the following syntax in valid:
+--
+-- ```
+-- --filter !@t                      (*)
+-- --filter !@t v
+-- --filter !@t <v
+-- ```
+--
+-- It does not do what one might expect.
+--
+-- Currently the following syntax is invalid[1]:
+--
+-- ```
+-- --filter @t !v
+-- --filter @t !<v
+-- ```
+--
+-- I will have to think about what types of negation to support and with what
+-- semantics.
+--
+-- I am leaning towards only being able to use negation on the tag when no
+-- operators are used, ie. only allowing (*). Thoughts?
+--
+-- [1] Not in the sense that it is rejected, but in the sense that the negation
+-- is not parsed. It is just the literal value `!<v`.
 data Filter = Filter Mode SimpleFilter deriving (Show)
 
 data Mode = Include | Exclude deriving (Show)
 
 data SimpleFilter
-  = ByTag Text (Maybe Text)
+  = ByTag Text (Maybe (Op Text))
+  deriving (Show)
+
+filterParser :: A.Parser Filter
+filterParser = Filter <$> modeParser <*> simpleFilterParser
+  where
+    modeParser :: A.Parser Mode
+    modeParser = (const Exclude <$> A.string "!") <|> (pure Include)
+
+    simpleFilterParser :: A.Parser SimpleFilter
+    simpleFilterParser =
+      A.choice
+        [ byTagParser
+        ]
+
+    byTagParser :: A.Parser SimpleFilter
+    byTagParser =
+      ByTag
+        <$> (A.string "@" *> A.takeWhile1 (/= ' ') <* A.skipSpace)
+        <*> ((Just <$> opParser (A.takeWhile1 (/= '\n'))) <|> pure Nothing)
+
+    opParser :: A.Parser a -> A.Parser (Op a)
+    opParser p =
+      ( A.choice
+          [ A.try (pure Ge <* A.string ">="),
+            A.try (pure Le <* A.string "<="),
+            pure Gt <* A.string ">",
+            pure Lt <* A.string "<",
+            pure Eq
+          ]
+      )
+        <*> p
+
+data Op a
+  = Eq a
+  | Ge a
+  | Gt a
+  | Le a
+  | Lt a
   deriving (Show)
 
 filterArg :: O.Parser [Filter]
 filterArg =
   O.many
     ( O.option
-        (O.maybeReader (parse . T.pack))
+        (O.eitherReader (A.parseOnly filterParser . T.pack))
         ( O.long "filter"
             <> O.short 'f'
             <> O.metavar "FILTER"
             <> O.help "Filters selected issues. Examples: @assigned, !@assigned joe"
         )
     )
-  where
-    parse s
-      | "@" `T.isPrefixOf` s =
-          Just (Filter Include (uncurry ByTag (splitValue (T.drop 1 s))))
-      | "!@" `T.isPrefixOf` s =
-          Just (Filter Exclude (uncurry ByTag (splitValue (T.drop 2 s))))
-      | otherwise = Nothing
-
-    splitValue :: Text -> (Text, Maybe Text)
-    splitValue s = case second T.strip (T.breakOn " " s) of
-      (k, "") -> (k, Nothing)
-      (k, v) -> (k, Just v)
 
 applyFilters :: [Filter] -> ([Issue] -> [Issue])
 applyFilters fs = filter (filtersPredicate fs)
@@ -61,7 +114,14 @@ modePredicate Include p = p
 modePredicate Exclude p = not . p
 
 simpleFilterPredicate :: SimpleFilter -> (Issue -> Bool)
-simpleFilterPredicate (ByTag k v) i = any ((&&) <$> matchKey <*> matchValue) i.tags
+simpleFilterPredicate (ByTag k v) i = any ((&&) <$> matchKey <*> matchValue) (i.tags ++ i.internalTags)
   where
-    matchKey (Tag k' _) = k' == k
-    matchValue (Tag _ v') = fromMaybe True ((==) <$> v' <*> v)
+    matchKey = (==) k . tagKey
+    matchValue = fromMaybe True . (<*>) (op <$> v) . tagValue
+
+op :: Ord a => Op a -> (a -> Bool)
+op (Eq a) = flip (==) a
+op (Ge a) = flip (>=) a
+op (Gt a) = flip (>) a
+op (Le a) = flip (<=) a
+op (Lt a) = flip (<) a
diff --git a/app/Issue/Tag.hs b/app/Issue/Tag.hs
index 8b6d6d4..85636b5 100644
--- a/app/Issue/Tag.hs
+++ b/app/Issue/Tag.hs
@@ -1,4 +1,11 @@
-module Issue.Tag (Tag (..), extractTags, internalTags) where
+module Issue.Tag
+  ( Tag (..),
+    extractTags,
+    internalTags,
+    tagKey,
+    tagValue,
+  )
+where
 
 import Data.Binary (Binary)
 import Data.Maybe (catMaybes)
@@ -10,6 +17,12 @@ import Issue.Provenance (Provenance (..))
 
 data Tag = Tag Text (Maybe Text) deriving (Show, Generic, Binary)
 
+tagKey :: Tag -> Text
+tagKey (Tag k _) = k
+
+tagValue :: Tag -> Maybe Text
+tagValue (Tag _ v) = v
+
 extractTags :: Text -> [Tag]
 extractTags =
   catMaybes