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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
module Main where
import Control.Exception (Exception, catch, throw)
import Data.Aeson qualified as A
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy qualified as LB
import Data.ByteString.Lazy.Char8 qualified as LB8
import Data.Maybe qualified as Maybe
import Data.String qualified as String
import GHC.Generics (Generic)
import Options.Applicative ((<**>))
import Options.Applicative qualified as O
import System.Exit (ExitCode (ExitFailure), exitWith)
import System.FilePath as F
import System.IO (hPutStrLn, stderr)
import System.Process.Typed qualified as P
data Options = Options
{ optCommand :: Command
}
deriving (Show)
data Command
= List
| Show
deriving (Show)
optionsParser :: O.Parser Options
optionsParser =
Options
<$> commandParser
commandParser :: O.Parser Command
commandParser =
O.subparser
( O.command "list" (O.info listCommandParser (O.progDesc "List all issues"))
<> O.command "show" (O.info showCommandParser (O.progDesc "Show details of all issues"))
)
listCommandParser :: O.Parser Command
listCommandParser =
pure List
showCommandParser :: O.Parser Command
showCommandParser =
pure Show
main :: IO ()
main = do
options <- O.execParser (O.info (commandParser <**> O.helper) O.idm)
files <- getFiles
issues <-
catch
( fmap Maybe.catMaybes $
mapM
(\filename -> catch (fmap Just (getIssues filename)) (forgetGetIssuesExceptions))
files
)
( \(InvalidTreeGrepperResult error) ->
do
hPutStrLn stderr error
exitWith (ExitFailure 1)
)
mapM_ putStrLn $ fmap file $ concat issues
data UnknownFileExtension = UnknownFileExtension
{ extension :: String
}
deriving (Show)
instance Exception UnknownFileExtension
data InvalidTreeGrepperResult = InvalidTreeGrepperResult
{ error :: String
}
deriving (Show)
instance Exception InvalidTreeGrepperResult
forgetGetIssuesExceptions :: UnknownFileExtension -> IO (Maybe _)
forgetGetIssuesExceptions _ =
pure Nothing
data Issue = Issue {}
data TreeGrepperResult = TreeGrepperResult
{ file :: String,
file_type :: String,
matches :: [Match]
}
deriving (Show, Generic)
instance A.FromJSON TreeGrepperResult
data Match = Match
{ kind :: String,
name :: String,
text :: String,
start :: Position,
end :: Position
}
deriving (Show, Generic)
instance A.FromJSON Match
data Position = Position
{ row :: Int,
column :: Int
}
deriving (Show, Generic)
instance A.FromJSON Position
getIssues :: String -> IO [TreeGrepperResult]
getIssues filename =
let extension = F.takeExtension filename
treeGrepperLanguage =
case extension of
".elm" -> "elm"
".nix" -> "nix"
".sh" -> "sh"
_ -> throw (UnknownFileExtension extension)
treeGrepperQuery =
case extension of
".elm" -> "([(line_comment) (block_comment)])"
".nix" -> "(comment)"
".sh" -> "(comment)"
_ -> throw (UnknownFileExtension extension)
decode raw =
case A.eitherDecode raw of
Left error ->
throw (InvalidTreeGrepperResult error)
Right treeGrepperResult ->
treeGrepperResult
in fmap (decode . snd) $
P.readProcessStdout
( String.fromString
( "tree-grepper --query '"
++ treeGrepperLanguage
++ "' '"
++ treeGrepperQuery
++ "' --format json '"
++ filename
++ "'"
)
)
getFiles :: IO [String]
getFiles =
fmap (lines . LB8.unpack . snd) $
P.readProcessStdout "git ls-files --cached --exclude-standard --other"
|
