1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
module TreeGrepper.Comment
( Comment (..),
getComments,
CommentStyle (..),
uncomment,
comment,
)
where
import Control.Exception (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 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.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 :: 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`.
--
-- @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)
|
