add --filter, filter by tags

2 files changed, 85 insertions, 28 deletions

diff --git a/app/Issue/Filter.hs b/app/Issue/Filter.hs
new file mode 100644
index 0000000..0ce945d
--- /dev/null
+++ b/app/Issue/Filter.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Issue.Filter
+  ( Filter,
+    filterOption,
+    applyFilter,
+  )
+where
+
+import Control.Arrow (second)
+import Data.Text (Text)
+import Data.Text qualified as T
+import Issue (Issue (..))
+import Issue.Tag (Tag (..))
+import Options.Applicative qualified as O
+
+data Filter
+  = ExcludeByTag Text (Maybe Text)
+  | IncludeByTag Text (Maybe Text)
+  deriving (Show)
+
+filterOption :: O.Parser [Filter]
+filterOption =
+  O.many
+    ( O.option
+        (O.maybeReader (parse . 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 (uncurry IncludeByTag (splitValue (T.drop 1 s)))
+      | "!@" `T.isPrefixOf` s =
+          Just (uncurry ExcludeByTag (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)
+
+applyFilter :: [Filter] -> Issue -> Bool
+applyFilter [] _ = True
+applyFilter (IncludeByTag k v : fs) i =
+  applyByTag k v i && applyFilter fs i
+applyFilter (ExcludeByTag k v : fs) i =
+  not (applyByTag k v i) && applyFilter fs i
+
+applyByTag :: Text -> Maybe Text -> Issue -> Bool
+applyByTag k v i = any ((&&) <$> matchKey <*> matchValue) i.tags
+  where
+    matchKey (Tag k' _) = k' == k
+    matchValue (Tag _ v') = maybe True ((==) v') v
diff --git a/app/Main.hs b/app/Main.hs
index 44b4242..1afb7a3 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -24,22 +24,11 @@
 -- # @original-issue more information on the issue
 -- ```
 
--- TODO Only one issue per comment block
---
--- Only the first TODO/FIXME inside a comment block should be considered
--- as the start of an issue.
-
 -- TODO Add support for other keywords
 --
 -- Additionally to TODO, also FIXME should start an issue.  There might
 -- be more interesting keywords.
 
--- TODO Add filter by tags
---
--- Users can filter issues for tags with the option -t/--tag @tag.
---
--- @assigned kirchner@posteo.de
-
 -- TODO Generate and show hash for each issue
 
 module Main where
@@ -55,6 +44,8 @@ import Data.String qualified as String
 import Data.Text qualified as T
 import Issue (Issue (..))
 import Issue qualified as I
+import Issue.Filter (Filter)
+import Issue.Filter qualified as I
 import Issue.Tag qualified as I
 import Options.Applicative ((<**>))
 import Options.Applicative qualified as O
@@ -75,10 +66,12 @@ data Options = Options
 
 data Command
   = List
-      { files :: [String]
+      { files :: [String],
+        filters :: [Filter]
       }
   | Show
-      { files :: [String]
+      { files :: [String],
+        filters :: [Filter]
       }
   deriving (Show)
 
@@ -93,10 +86,10 @@ optionsParser :: O.Parser Options
 optionsParser = Options <$> commandParser
 
 listCommandParser :: O.Parser Command
-listCommandParser = List <$> filesArg
+listCommandParser = List <$> filesArg <*> I.filterOption
 
 showCommandParser :: O.Parser Command
-showCommandParser = Show <$> filesArg
+showCommandParser = Show <$> filesArg <*> I.filterOption
 
 filesArg :: O.Parser [String]
 filesArg = O.many (O.strArgument (O.metavar "FILE" <> O.action "file"))
@@ -108,21 +101,26 @@ main = do
         | opts@(List {}) <- options = opts.files
         | opts@(Show {}) <- options = opts.files
   filePaths <- getFiles files
+  let filters
+        | opts@(List {}) <- options = opts.filters
+        | opts@(Show {}) <- options = opts.filters
   issues <-
-    catch
-      ( fmap Maybe.catMaybes $
-          mapM
-            (\filename -> catch (fmap Just (getIssues filename)) (forgetGetIssuesExceptions))
-            filePaths
-      )
-      ( \(InvalidTreeGrepperResult e) ->
-          do
-            hPutStrLn stderr e
-            exitWith (ExitFailure 1)
-      )
+    filter (I.applyFilter filters)
+      . concat
+      <$> catch
+        ( fmap Maybe.catMaybes $
+            mapM
+              (\filename -> catch (fmap Just (getIssues filename)) (forgetGetIssuesExceptions))
+              filePaths
+        )
+        ( \(InvalidTreeGrepperResult e) ->
+            do
+              hPutStrLn stderr e
+              exitWith (ExitFailure 1)
+        )
   case options of
-    List _ -> listMatches $ concat issues
-    Show _ -> showMatches $ concat issues
+    List {} -> listMatches issues
+    Show {} -> showMatches issues
 
 showMatches :: [Issue] -> IO ()
 showMatches issues = do