aboutsummaryrefslogtreecommitdiffstats
path: root/app/Issue.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/Issue.hs')
-rw-r--r--app/Issue.hs75
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