diff options
| -rw-r--r-- | anissue.cabal | 1 | ||||
| -rw-r--r-- | app/Issue.hs | 75 | ||||
| -rw-r--r-- | app/TreeGrepper/Comment.hs | 81 |
3 files changed, 96 insertions, 61 deletions
diff --git a/anissue.cabal b/anissue.cabal index 8e86631..170f0ae 100644 --- a/anissue.cabal +++ b/anissue.cabal @@ -88,6 +88,7 @@ executable anissue Parallel Process Settings + TreeGrepper.Comment TreeGrepper.FileType TreeGrepper.Match TreeGrepper.Result 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 diff --git a/app/TreeGrepper/Comment.hs b/app/TreeGrepper/Comment.hs new file mode 100644 index 0000000..c912e27 --- /dev/null +++ b/app/TreeGrepper/Comment.hs @@ -0,0 +1,81 @@ +module TreeGrepper.Comment + ( Comment (..), + getComments, + ) +where + +import Control.Exception (throw) +import Data.Aeson qualified as A +import Data.ByteString.Lazy.Char8 qualified as B +import Data.Function ((&)) +import Data.Text qualified as T +import Exception qualified as E +import GHC.Generics (Generic) +import Process (proc, sh) +import System.FilePath (takeExtension) +import System.Process.Typed (setWorkingDir) +import TreeGrepper.FileType (FileType (..)) +import TreeGrepper.Match (Match (..), Position (..)) +import TreeGrepper.Match qualified as G +import TreeGrepper.Result (Result (..)) +import TreeGrepper.Result qualified as G + +data Comment = Comment + { -- result fields + file :: String, + file_type :: FileType, + -- match fields + kind :: String, + name :: String, + text :: T.Text, + start :: Position, + end :: Position + } + deriving (Show, Generic) + +fromMatch :: Result -> Match -> Comment +fromMatch Result {..} Match {..} = Comment {..} + +getComments :: FilePath -> FilePath -> IO [Comment] +getComments cwd fn = do + let ext = takeExtension fn + concatMap (\result -> map (fromMatch result) result.matches) + . map fixTreeGrepper + . decode + <$> sh + ( proc + "tree-grepper --query % % --format json %" + (treeGrepperLanguage ext) + (treeGrepperQuery ext) + fn + & setWorkingDir cwd + ) + +decode :: B.ByteString -> [Result] +decode = either (throw . E.InvalidTreeGrepperResult) id . A.eitherDecode + +fixTreeGrepper :: G.Result -> G.Result +fixTreeGrepper treeGrepperResult = + treeGrepperResult {G.matches = G.merge treeGrepperResult.matches} + +treeGrepperLanguage :: String -> String +treeGrepperLanguage ext = + -- TODO Add support for all tree-grepper supported files + -- + -- tree-grepper supported files can be listed through `tree-grepper + -- --languages`. + case ext of + ".elm" -> "elm" + ".hs" -> "haskell" + ".nix" -> "nix" + ".sh" -> "sh" + _ -> throw (E.UnknownFileExtension ext) + +treeGrepperQuery :: String -> String +treeGrepperQuery ext = + case ext of + ".elm" -> "([(line_comment) (block_comment)])" + ".hs" -> "(comment)" + ".nix" -> "(comment)" + ".sh" -> "(comment)" + _ -> throw (E.UnknownFileExtension ext) |