add issue marker as internal tag @type

1 files changed, 11 insertions, 9 deletions

diff --git a/app/Issue.hs b/app/Issue.hs
index 451b897..4326af1 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -7,11 +7,12 @@ module Issue
   )
 where
 
+import Control.Arrow qualified as W
 import Control.Exception (handle, throw)
 import Data.Aeson (eitherDecode)
 import Data.Binary (Binary)
 import Data.Function ((&))
-import Data.List (find, foldl')
+import Data.List (find)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -73,13 +74,13 @@ fromMatch cwd result match = do
                 start = match.start,
                 end = match.end,
                 tags = maybe [] I.extractTags description,
-                internalTags = I.internalTags title (Just provenance)
+                internalTags = I.internalTags title (Just provenance) markers
               }
         else Nothing
     )
   where
     (title', description) = I.extractText result.file_type match.text
-    title = stripIssueMarkers title'
+    (markers, title) = stripIssueMarkers title'
 
 issueMarkers :: [Text]
 issueMarkers =
@@ -88,13 +89,14 @@ issueMarkers =
     "QUESTION"
   ]
 
-stripIssueMarkers :: Text -> Text
+stripIssueMarkers :: Text -> ([Text], Text)
 stripIssueMarkers text =
-  foldl' (stripIssueMarker) text issueMarkers
-
-stripIssueMarker :: Text -> Text -> Text
-stripIssueMarker text marker =
-  maybe text T.stripStart (T.stripPrefix marker text)
+  case [marker | marker <- issueMarkers, T.isPrefixOf marker text] of
+    (marker : _) ->
+      W.first (marker :) . stripIssueMarkers $
+        T.drop (T.length marker) text
+    [] ->
+      ([], text)
 
 -- | Get all issues in the given directory and files.  Runs
 -- parallelized.