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
|
module Issue
( Issue (..),
Provenance (..),
fromComment,
id,
internalTags,
getIssues,
)
where
import Control.Arrow qualified as W
import Control.Exception (handle)
import Data.Binary (Binary)
import Data.List (find)
import Data.Maybe (catMaybes)
import Data.Text qualified as T
import Data.Time.Clock (UTCTime (utctDay))
import Exception qualified as E
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import Issue.Provenance (Author (..), Commit (..), Provenance (..), commitFromHEAD)
import Issue.Tag (Tag (..))
import Issue.Tag qualified as I
import Issue.Text qualified as I
import TreeGrepper.Comment (Comment (..))
import TreeGrepper.Comment qualified as G
import TreeGrepper.Match qualified as G
import Prelude hiding (id)
data Issue = Issue
{ title :: T.Text,
description :: Maybe T.Text,
file :: String,
-- TODO Make provenance obligatory
--
-- I cannot think of instances where an issue exists without a provenance..
--
-- @difficulty easy
provenance :: Maybe Provenance,
start :: G.Position,
end :: G.Position,
tags :: [Tag],
markers :: [T.Text]
}
deriving (Show, Binary, Generic, Eq)
id :: Issue -> Maybe String
id issue =
(\(Tag _ v) -> T.unpack <$> v)
=<< find (\(Tag k _) -> k == "id") (issue.tags ++ issue.internalTags)
internalTags :: Issue -> [Tag]
internalTags (Issue {..}) =
concat
[ [ Tag "id" $ Just $ toSpinalCase title,
Tag "title" $ Just $ title
],
maybe
[]
( \provenance' ->
[ Tag "createdAt" $ Just $ T.pack $ show $ utctDay provenance'.first.date,
Tag "modifiedAt" $ Just $ T.pack $ show $ utctDay provenance'.last.date,
Tag "author" $ Just $ provenance'.first.author.name,
Tag "editor" $ Just $ provenance'.last.author.name
]
)
provenance,
map (Tag "type" . Just) markers
]
instance HasField "internalTags" Issue [Tag] where
getField issue = internalTags issue
toSpinalCase :: T.Text -> T.Text
toSpinalCase = T.replace " " "-" . T.filter keep . T.toLower
where
keep = (`elem` (concat [[' ', '-'], ['a' .. 'z'], ['0' .. '9']]))
-- TODO Refactor non-issues
--
-- This does not return an issue, as provenance is not computed over its
-- history. Maybe this should return a different type, or be internal to
-- `History`?
fromComment :: FilePath -> Comment -> IO (Maybe Issue)
fromComment cwd comment = do
commit <- commitFromHEAD cwd
let provenance = Provenance commit commit
pure
( if any (\marker -> T.isPrefixOf marker title') issueMarkers
then
Just
Issue
{ title = title,
description = description,
file = comment.file,
provenance = Just provenance,
start = comment.start,
end = comment.end,
tags = maybe [] I.extractTags description,
markers = markers
}
else Nothing
)
where
(title', description) = I.extractText comment.file_type comment.text
(markers, title) = stripIssueMarkers title'
issueMarkers :: [T.Text]
issueMarkers =
[ "TODO",
"FIXME",
"QUESTION"
]
stripIssueMarkers :: T.Text -> ([T.Text], T.Text)
stripIssueMarkers text =
case [marker | marker <- issueMarkers, T.isPrefixOf marker text] of
(marker : _) ->
W.first (marker :) . stripIssueMarkers $
T.stripStart (T.drop (T.length marker) text)
[] ->
([], text)
-- | Get all issues in the given directory and file.
getIssues :: FilePath -> FilePath -> IO [Issue]
getIssues cwd filename =
handle (\(_ :: E.UnknownFileExtension) -> pure []) $
fmap catMaybes . mapM (fromComment cwd)
=<< G.getComments cwd filename
|
