blob: 0d9f6ad3c61f12e4d64743e954162c3b4eec043d (
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
|
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module Issue (Issue (..), fromMatch) where
import Data.List (find)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Issue.Tag (Tag)
import Issue.Tag qualified as I
import TreeGrepper.FileType qualified as G
import TreeGrepper.Match (Match (..))
import TreeGrepper.Match qualified as G
import TreeGrepper.Result (Result (..))
import TreeGrepper.Result qualified as G
data Issue = Issue
{ title :: Text,
description :: Text,
start :: G.Position,
end :: G.Position,
tags :: [Tag]
}
fromMatch :: G.Result -> G.Match -> Maybe Issue
fromMatch result match =
if T.isPrefixOf marker (T.unlines (take 1 lns))
then
Just
Issue
{ title = stripMarker (T.strip (T.unlines title)),
description = stripTags (T.strip (T.unlines description)),
start = match.start,
end = match.end,
tags = I.extract text
}
else Nothing
where
text = stripComments result.file_type (T.strip match.text)
lns = T.lines text
title = takeWhile (not . isEmpty) lns
description = drop (length title + 1) lns
isEmpty = T.null . T.strip
marker :: Text
marker = "TODO"
stripTags :: Text -> Text
stripTags text =
T.strip (T.unlines (filter (not . T.isPrefixOf "@") (T.lines text)))
stripMarker :: Text -> Text
stripMarker text = maybe text T.stripStart (T.stripPrefix marker text)
stripComments :: G.FileType -> Text -> Text
stripComments fileType text =
maybe
(stripLineComments (G.info fileType).lineStart text)
( \(blockInfo, blockStart) ->
stripBlockComment blockStart blockInfo.blockEnd text
)
$ do
blockInfo <- (G.info fileType).block
(,) blockInfo <$> find (`T.isPrefixOf` text) blockInfo.blockStart
stripLineComments :: Text -> Text -> Text
stripLineComments lineStart text =
onLines
( \line ->
fromMaybe line . fmap T.stripStart $
T.stripPrefix lineStart line
)
text
where
onLines f = T.unlines . map f . T.lines
stripBlockComment :: Text -> Text -> Text -> Text
stripBlockComment blockStart blockEnd text =
T.strip
. (fromMaybe text . T.stripSuffix blockEnd)
. (fromMaybe text . T.stripPrefix blockStart)
$ text
|