refactor TreeGrepper.Comment

1 files changed, 81 insertions, 0 deletions

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)