refactor TreeGrepper.Comment

1 files changed, 14 insertions, 61 deletions

diff --git a/app/Issue.hs b/app/Issue.hs
index 54ef5e4..e6568ad 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -1,17 +1,15 @@
 module Issue
   ( Issue (..),
     Provenance (..),
-    fromMatch,
+    fromComment,
     id,
     getIssues,
   )
 where
 
 import Control.Arrow qualified as W
-import Control.Exception (handle, throw)
-import Data.Aeson (eitherDecode)
+import Control.Exception (handle)
 import Data.Binary (Binary)
-import Data.Function ((&))
 import Data.List (find)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
@@ -22,13 +20,9 @@ import Issue.Provenance (Provenance (..), commitFromHEAD)
 import Issue.Tag (Tag (..))
 import Issue.Tag qualified as I
 import Issue.Text qualified as I
-import Process (proc, sh)
-import System.FilePath (takeExtension)
-import System.Process.Typed (setWorkingDir)
-import TreeGrepper.Match (Match (..))
+import TreeGrepper.Comment (Comment (..))
+import TreeGrepper.Comment qualified as G
 import TreeGrepper.Match qualified as G
-import TreeGrepper.Result (Result (..))
-import TreeGrepper.Result qualified as G
 import Prelude hiding (id)
 
 data Issue = Issue
@@ -58,8 +52,8 @@ id issue =
 -- This does not return an issue, as provenance is not computed over its
 -- history. Maybe this should return a different type, or be internal to
 -- `History`? Also, `internalTags` suffer.
-fromMatch :: FilePath -> G.Result -> G.Match -> IO (Maybe Issue)
-fromMatch cwd result match = do
+fromComment :: FilePath -> Comment -> IO (Maybe Issue)
+fromComment cwd comment = do
   commit <- commitFromHEAD cwd
   let provenance = Provenance commit commit
 
@@ -70,17 +64,17 @@ fromMatch cwd result match = do
             Issue
               { title = title,
                 description = description,
-                file = result.file,
+                file = comment.file,
                 provenance = Just provenance,
-                start = match.start,
-                end = match.end,
+                start = comment.start,
+                end = comment.end,
                 tags = maybe [] I.extractTags description,
                 internalTags = I.internalTags title (Just provenance) markers
               }
         else Nothing
     )
   where
-    (title', description) = I.extractText result.file_type match.text
+    (title', description) = I.extractText comment.file_type comment.text
     (markers, title) = stripIssueMarkers title'
 
 issueMarkers :: [Text]
@@ -99,50 +93,9 @@ stripIssueMarkers text =
     [] ->
       ([], text)
 
--- | Get all issues in the given directory and files.  Runs
--- parallelized.
 -- | Get all issues in the given directory and file.
 getIssues :: FilePath -> FilePath -> IO [Issue]
-getIssues cwd filename = handle (\(_ :: E.UnknownFileExtension) -> pure []) $ do
-  let extension = takeExtension filename
-      treeGrepperLanguage =
-        -- TODO Add support for all tree-grepper supported files
-        --
-        -- tree-grepper supported files can be listed through `tree-grepper
-        -- --languages`.
-        case extension of
-          ".elm" -> "elm"
-          ".hs" -> "haskell"
-          ".nix" -> "nix"
-          ".sh" -> "sh"
-          _ -> throw (E.UnknownFileExtension extension)
-      treeGrepperQuery =
-        case extension of
-          ".elm" -> "([(line_comment) (block_comment)])"
-          ".hs" -> "(comment)"
-          ".nix" -> "(comment)"
-          ".sh" -> "(comment)"
-          _ -> throw (E.UnknownFileExtension extension)
-      decode raw =
-        case eitherDecode raw of
-          Left e -> throw (E.InvalidTreeGrepperResult e)
-          Right treeGrepperResult -> treeGrepperResult
-
-  matches <-
-    concatMap (\result -> map ((,) result) result.matches)
-      . map fixTreeGrepper
-      . decode
-      <$> sh
-        ( proc
-            "tree-grepper --query % % --format json %"
-            (treeGrepperLanguage :: String)
-            (treeGrepperQuery :: String)
-            filename
-            & setWorkingDir cwd
-        )
-
-  catMaybes <$> mapM (uncurry (fromMatch cwd)) matches
-
-fixTreeGrepper :: G.Result -> G.Result
-fixTreeGrepper treeGrepperResult =
-  treeGrepperResult {G.matches = G.merge treeGrepperResult.matches}
+getIssues cwd filename =
+  handle (\(_ :: E.UnknownFileExtension) -> pure []) $
+    fmap catMaybes . mapM (fromComment cwd)
+      =<< G.getComments cwd filename