1 files changed, 77 insertions, 0 deletions
diff --git a/app/Issue.hs b/app/Issue.hs
new file mode 100644
index 0000000..02de257
--- /dev/null
+++ b/app/Issue.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Issue (Issue (..), fromMatch) where
+
+import Data.List (find)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Data.Text qualified as T
+import TreeGrepper.FileType qualified as G
+import TreeGrepper.Match (Match (..))
+import TreeGrepper.Match qualified as G
+import TreeGrepper.Result (Result (..))
+import TreeGrepper.Result qualified as G
+
+data Issue = Issue
+  { title :: Text,
+    description :: Text,
+    start :: G.Position,
+    end :: G.Position
+  }
+
+fromMatch :: G.Result -> G.Match -> Maybe Issue
+fromMatch result match =
+  if T.isPrefixOf marker (T.unlines (take 1 lns))
+    then
+      Just
+        Issue
+          { title = stripMarker (T.strip (T.unlines title)),
+            description = T.strip (T.unlines description),
+            start = match.start,
+            end = match.end
+          }
+    else Nothing
+  where
+    text = stripComments result.file_type match.text
+    lns = T.lines text
+    title = takeWhile (not . isEmpty) lns
+    description = drop (length title + 1) lns
+    isEmpty = T.null . T.strip
+
+marker :: Text
+marker = "TODO"
+
+stripMarker :: Text -> Text
+stripMarker text = maybe text T.stripStart (T.stripPrefix marker text)
+
+stripComments :: G.FileType -> Text -> Text
+stripComments fileType text =
+  maybe
+    (stripLineComments (G.info fileType).lineStart text)
+    ( \(blockInfo, blockStart) ->
+        stripBlockComment blockStart blockInfo.blockEnd text
+    )
+    $ do
+      blockInfo <- (G.info fileType).block
+      (,) blockInfo <$> find (`T.isPrefixOf` text) blockInfo.blockStart
+
+stripLineComments :: Text -> Text -> Text
+stripLineComments lineStart text =
+  onLines
+    ( \line ->
+        fromMaybe line . fmap T.stripStart $
+          T.stripPrefix lineStart line
+    )
+    text
+  where
+    onLines f = T.unlines . map f . T.lines
+
+stripBlockComment :: Text -> Text -> Text -> Text
+stripBlockComment blockStart blockEnd text =
+  T.strip
+    . (fromMaybe text . T.stripSuffix blockEnd)
+    . (fromMaybe text . T.stripPrefix blockStart)
+    $ text