1 files changed, 47 insertions, 39 deletions

diff --git a/app/Issue/Filter.hs b/app/Issue/Filter.hs
index 68eda87..6d6d608 100644
--- a/app/Issue/Filter.hs
+++ b/app/Issue/Filter.hs
@@ -10,12 +10,12 @@ where
 import Control.Applicative (liftA2, (<|>))
 import Data.Attoparsec.Text qualified as A
 import Data.List (isPrefixOf)
-import Data.Text (Text)
 import Data.Text qualified as T
 import Issue (Issue (..))
 import Issue.Tag (tagKey, tagValue)
 import Issue.TypedValue (castDef)
 import Options.Applicative qualified as O
+import Text.RE.TDFA.Text qualified as R
 
 -- TODO Revise filter negation
 --
@@ -46,13 +46,12 @@ import Options.Applicative qualified as O
 -- is not parsed. It is just the literal value `!<v`.
 --
 -- @backlog
-data Filter = Filter Mode SimpleFilter deriving (Show)
+data Filter = Filter Mode SimpleFilter
 
-data Mode = Include | Exclude deriving (Show)
+data Mode = Include | Exclude
 
 data SimpleFilter
-  = ByTag Text (Maybe (Op, Text))
-  deriving (Show)
+  = ByTag T.Text (Maybe Test)
 
 filterParser :: A.Parser Filter
 filterParser = Filter <$> modeParser <*> simpleFilterParser
@@ -61,37 +60,48 @@ filterParser = Filter <$> modeParser <*> simpleFilterParser
     modeParser = (const Exclude <$> A.string "!") <|> (pure Include)
 
     simpleFilterParser :: A.Parser SimpleFilter
-    simpleFilterParser =
-      A.choice
-        [ byTagParser
-        ]
+    simpleFilterParser = 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
-  = Eq
-  | Ge
-  | Gt
-  | Le
-  | Lt
-  deriving (Show)
+        <*> ((Just <$> testParser) <|> pure Nothing)
+
+data Test
+  = Eq T.Text
+  | Ge T.Text
+  | Gt T.Text
+  | Le T.Text
+  | Lt T.Text
+  | Match R.RE
+
+testParser :: A.Parser Test
+testParser =
+  A.choice
+    [ A.try
+        ( A.string "/"
+            *> ( Match
+                   <$> ( R.compileRegex . T.unpack . T.concat
+                           =<< O.many
+                             ( A.choice
+                                 [ A.string "\\" *> A.string "/",
+                                   A.string "\\" *> A.string "\\",
+                                   T.pack . (: []) <$> A.notChar '/'
+                                 ]
+                             )
+                       )
+               )
+            <* A.string "/"
+        ),
+      A.try (A.string ">=" *> (Ge . T.pack <$> value)),
+      A.try (A.string "<=" *> (Le . T.pack <$> value)),
+      A.try (A.string ">" *> (Gt . T.pack <$> value)),
+      A.try (A.string "<" *> (Lt . T.pack <$> value)),
+      (Eq . T.pack <$> A.many1 A.anyChar)
+    ]
+  where
+    value = A.many1 A.anyChar
 
 filterArg :: O.Parser [Filter]
 filterArg =
@@ -125,17 +135,15 @@ simpleFilterPredicate (ByTag k v) i = any ((&&) <$> matchKey <*> matchValue) (i.
     matchKey = (==) k . tagKey
     matchValue t =
       case (v, tagValue t) of
-        (Just (o, v'), Just w') -> castDef False (op o) v' w'
+        (Just (Eq v'), Just w') -> castDef False (==) w' v'
+        (Just (Ge v'), Just w') -> castDef False (>=) w' v'
+        (Just (Gt v'), Just w') -> castDef False (>) w' v'
+        (Just (Le v'), Just w') -> castDef False (<=) w' v'
+        (Just (Lt v'), Just w') -> castDef False (<) w' v'
+        (Just (Match p), Just w') -> R.matched (w' R.?=~ p)
         (Just _, Nothing) -> False
         (Nothing, _) -> True
 
-op :: Ord a => Op -> (a -> a -> Bool)
-op (Eq) = flip (==)
-op (Ge) = flip (>=)
-op (Gt) = flip (>)
-op (Le) = flip (<=)
-op (Lt) = flip (<)
-
 applyClosed :: Bool -> [Issue] -> [Issue]
 applyClosed closed = filter (\issue -> closed || not issue.closed)