blob: 50ac0fd1923c2cf0aa2cdba605f0eebde85f4bd8 (
plain)
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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
-- TODO Add support for ammendments
--
-- The user can ammend more information to an issue which is located at
-- a different place by referencing the issue's id. Example:
--
-- ```bash
-- #!/usr/bin/env bash
--
-- set -efu
--
-- ls -al
-- # TODO Original issue
-- #
-- # @id original-issue
--
-- ls
-- # @original-issue more information on the issue
-- ```
-- TODO Only one issue per comment block
--
-- Only the first TODO/FIXME inside a comment block should be considered
-- as the start of an issue.
-- TODO Add support for other keywords
--
-- Additionally to TODO, also FIXME should start an issue. There might
-- be more interesting keywords.
-- TODO Add tags
--
-- Users can add tags inside issue title and description. Tags are slugs
-- and start with @
--
-- @assigned aforemny
-- TODO Add filter by tags
--
-- Users can filter issues for tags with the option -t/--tag @tag.
--
-- @assigned kirchner@posteo.de
-- TODO Generate and show hash for each issue
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.List as L
import Data.Maybe qualified as Maybe
import Data.Ord as O
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
import TreeGrepper.Match (Match (..), Position (..))
import TreeGrepper.Match qualified as TM
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)
)
let issuesWithMarker = issues
issuesWithTags = issuesWithMarker
issuesFilteredByTags = issuesWithTags
case options of
List -> mapM_ listMatches $ concat issues
Show -> mapM_ showMatches $ concat issues
showMatches :: TreeGrepperResult -> IO ()
showMatches treeGrepperResult =
mapM_ (putStrLn . (.text)) $ treeGrepperResult.matches
listMatches :: TreeGrepperResult -> IO ()
listMatches treeGrepperResult =
mapM_ (putStrLn . unlines . take 1 . lines . (.text)) $ treeGrepperResult.matches
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
getIssues :: String -> IO [TreeGrepperResult]
getIssues filename =
let extension = F.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 (UnknownFileExtension extension)
treeGrepperQuery =
case extension of
".elm" -> "([(line_comment) (block_comment)])"
".hs" -> "(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 (map fixTreeGrepper) $
fmap (decode . snd) $
P.readProcessStdout
( String.fromString
( "tree-grepper --query '"
++ treeGrepperLanguage
++ "' '"
++ treeGrepperQuery
++ "' --format json '"
++ filename
++ "'"
)
)
fixTreeGrepper :: TreeGrepperResult -> TreeGrepperResult
fixTreeGrepper treeGrepperResult =
treeGrepperResult {matches = TM.merge treeGrepperResult.matches}
getFiles :: IO [String]
getFiles =
fmap (lines . LB8.unpack . snd) $
P.readProcessStdout "git ls-files --cached --exclude-standard --other"
|
