aboutsummaryrefslogtreecommitdiffstats
path: root/app/TreeGrepper
diff options
context:
space:
mode:
Diffstat (limited to 'app/TreeGrepper')
-rw-r--r--app/TreeGrepper/Comment.hs149
-rw-r--r--app/TreeGrepper/FileType.hs75
-rw-r--r--app/TreeGrepper/Match.hs69
-rw-r--r--app/TreeGrepper/Result.hs15
4 files changed, 0 insertions, 308 deletions
diff --git a/app/TreeGrepper/Comment.hs b/app/TreeGrepper/Comment.hs
deleted file mode 100644
index 7c2ca90..0000000
--- a/app/TreeGrepper/Comment.hs
+++ /dev/null
@@ -1,149 +0,0 @@
-module TreeGrepper.Comment
- ( Comment (..),
- getComments,
- CommentStyle (..),
- uncomment,
- comment,
- )
-where
-
-import Control.Exception (catch, throw)
-import Data.Aeson qualified as A
-import Data.Binary (Binary)
-import Data.ByteString.Lazy.Char8 qualified as B
-import Data.Function ((&))
-import Data.List (find)
-import Data.Maybe (fromMaybe)
-import Data.Text qualified as T
-import Data.Text.Lazy.IO qualified as LT
-import Exception qualified as E
-import GHC.Generics (Generic)
-import Git qualified
-import Process (proc, sh)
-import System.Directory (createDirectoryIfMissing)
-import System.FilePath (takeDirectory, takeExtension, takeFileName, (</>))
-import System.IO.Temp (withSystemTempDirectory)
-import System.Process.Typed qualified as P
-import TreeGrepper.FileType (FileType (..))
-import TreeGrepper.FileType qualified as G
-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)
-
-data CommentStyle
- = LineStyle T.Text
- | BlockStyle T.Text T.Text
- deriving (Eq, Show, Generic, Binary)
-
-comment :: CommentStyle -> T.Text -> T.Text
-comment (LineStyle linePrefix) = T.unlines . map ((linePrefix <> " ") <>) . T.lines
-comment (BlockStyle blockStart blockEnd) = (blockStart <>) . (<> blockEnd)
-
-uncomment :: FileType -> T.Text -> (CommentStyle, T.Text)
-uncomment fileType rawText =
- maybe
- ( ( LineStyle info.lineStart,
- stripLineComments (G.info fileType).lineStart text
- )
- )
- ( \(blockInfo, blockStart) ->
- ( BlockStyle blockStart blockInfo.blockEnd,
- stripBlockComment blockStart blockInfo.blockEnd text
- )
- )
- $ do
- blockInfo <- info.block
- (,) blockInfo <$> find (`T.isPrefixOf` text) blockInfo.blockStart
- where
- info = G.info fileType
- text = stripLines rawText
- stripLines = T.intercalate "\n" . map T.strip . T.lines
-
-stripLineComments :: T.Text -> T.Text -> T.Text
-stripLineComments lineStart text =
- onLines
- ( \line ->
- fromMaybe line . fmap T.stripStart $
- T.stripPrefix lineStart line
- )
- text
- where
- onLines f = T.intercalate "\n" . map f . T.lines
-
-stripBlockComment :: T.Text -> T.Text -> T.Text -> T.Text
-stripBlockComment blockStart blockEnd text =
- T.strip
- . (fromMaybe text . T.stripSuffix blockEnd)
- . (fromMaybe text . T.stripPrefix blockStart)
- $ text
-
-fromMatch :: Result -> Match -> Comment
-fromMatch Result {..} Match {..} = Comment {..}
-
-getComments :: Git.CommitHash -> FilePath -> IO [Comment]
-getComments commitHash fn = do
- let ext = takeExtension fn
- s <-
- catch
- (Git.readTextFileOf commitHash fn)
- (\(_ :: E.ProcessException) -> pure "")
- withSystemTempDirectory (takeFileName fn) $ \cwd -> do
- createDirectoryIfMissing True (cwd </> takeDirectory fn)
- LT.writeFile (cwd </> fn) s
- concatMap (\result -> map (fromMatch result) result.matches)
- . map fixTreeGrepper
- . decode
- <$> sh
- ( ( proc
- "tree-grepper % --query % % --format json"
- fn
- (treeGrepperLanguage ext)
- (treeGrepperQuery ext)
- )
- & P.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`.
- --
- -- @backlog
- 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)
diff --git a/app/TreeGrepper/FileType.hs b/app/TreeGrepper/FileType.hs
deleted file mode 100644
index 506cbc5..0000000
--- a/app/TreeGrepper/FileType.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-module TreeGrepper.FileType
- ( FileType (..),
- all,
- Info (..),
- BlockInfo (..),
- info,
- )
-where
-
-import Data.Aeson (FromJSON (parseJSON))
-import Data.Binary (Binary)
-import Data.Text (Text)
-import GHC.Generics (Generic)
-import Prelude hiding (all)
-
-data FileType
- = Elm
- | Haskell
- | Nix
- | Shell
- deriving (Eq, Show, Generic, Binary)
-
-instance FromJSON FileType where
- parseJSON v =
- parseJSON v >>= \case
- "elm" -> pure Elm
- "haskell" -> pure Haskell
- "nix" -> pure Nix
- "sh" -> pure Shell
- fileType -> fail ("parsing file_type failed, got " ++ fileType)
-
-all :: [FileType]
-all =
- [ Elm,
- Haskell,
- Nix,
- Shell
- ]
-
-data Info = Info
- { exts :: [String],
- lineStart :: Text,
- block :: Maybe BlockInfo
- }
-
-data BlockInfo = BlockInfo
- { blockStart :: [Text],
- blockEnd :: Text
- }
-
-info :: FileType -> Info
-info Elm =
- Info
- { exts = [".elm"],
- lineStart = "--",
- block = Just BlockInfo {blockStart = ["{-|", "{-"], blockEnd = "-}"}
- }
-info Haskell =
- Info
- { exts = [".hs"],
- lineStart = "--",
- block = Just BlockInfo {blockStart = ["{-"], blockEnd = "-}"}
- }
-info Nix =
- Info
- { exts = [".nix"],
- lineStart = "#",
- block = Just BlockInfo {blockStart = ["/*"], blockEnd = "*/"}
- }
-info Shell =
- Info
- { exts = [".sh"],
- lineStart = "#",
- block = Nothing
- }
diff --git a/app/TreeGrepper/Match.hs b/app/TreeGrepper/Match.hs
deleted file mode 100644
index 5d9479e..0000000
--- a/app/TreeGrepper/Match.hs
+++ /dev/null
@@ -1,69 +0,0 @@
-module TreeGrepper.Match
- ( Match (..),
- Position (..),
- merge,
- )
-where
-
-import Data.Aeson (FromJSON)
-import Data.Binary (Binary)
-import Data.Function (on)
-import Data.List (sortBy)
-import Data.List.NonEmpty (NonEmpty ((:|)))
-import Data.List.NonEmpty qualified as N
-import Data.Ord (comparing)
-import Data.Text (Text)
-import Data.Text qualified as T
-import GHC.Generics (Generic)
-
-data Match = Match
- { kind :: String,
- name :: String,
- text :: Text,
- start :: Position,
- end :: Position
- }
- deriving (Show, Generic)
-
-instance FromJSON Match
-
-data Position = Position
- { row :: Int,
- column :: Int
- }
- deriving (Eq, Show, Generic, Binary)
-
-instance Ord Position where
- compare = compare `on` (\p -> (p.row, p.column))
-
-instance FromJSON Position
-
-{- tree-grepper (tree-sitter) is unable to match sibling comments blocks as a whole. We thus merge matches if they are line-adjacent. -}
-merge :: [Match] -> [Match]
-merge matches =
- map mergeGroup
- . chainsBy (\a b -> a.end.row + 1 == b.start.row)
- $ sortBy (comparing (.start)) matches
-
-mergeGroup :: NonEmpty Match -> Match
-mergeGroup (m :| ms) =
- m
- { text = text,
- start = start,
- end = end
- }
- where
- mss = m : ms
- text = T.unlines $ map (.text) mss
- start = minimum $ map (.start) mss
- end = maximum $ map (.end) mss
-
-{- A version of `Data.List.groupBy` that uses the last added group-member for comparison with new candidates for the group. `Data.List.groupBy` uses the initial member for all subsequent comparisons. -}
-chainsBy :: (a -> a -> Bool) -> [a] -> [NonEmpty a]
-chainsBy p = reverse . map N.reverse . go []
- where
- go rs [] = rs
- go [] (x : xs) = go [N.singleton x] xs
- go (ass@((a :| as) : rs)) (x : xs)
- | p a x = go ((x :| a : as) : rs) xs
- | otherwise = go (N.singleton x : ass) xs
diff --git a/app/TreeGrepper/Result.hs b/app/TreeGrepper/Result.hs
deleted file mode 100644
index 856871a..0000000
--- a/app/TreeGrepper/Result.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module TreeGrepper.Result (Result (..)) where
-
-import Data.Aeson (FromJSON)
-import GHC.Generics (Generic)
-import TreeGrepper.FileType (FileType)
-import TreeGrepper.Match (Match)
-
-data Result = Result
- { file :: String,
- file_type :: FileType,
- matches :: [Match]
- }
- deriving (Show, Generic)
-
-instance FromJSON Result
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-23 18:15:33 +0000