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
|
module Issue
( Issue (..),
Provenance (..),
fromComment,
id,
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 (Text)
import Data.Text qualified as T
import Exception qualified as E
import GHC.Generics (Generic)
import Issue.Provenance (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 :: Text,
description :: Maybe 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],
internalTags :: [Tag]
}
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)
-- 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`? Also, `internalTags` suffer.
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,
internalTags = I.internalTags title (Just provenance) markers
}
else Nothing
)
where
(title', description) = I.extractText comment.file_type comment.text
(markers, title) = stripIssueMarkers title'
issueMarkers :: [Text]
issueMarkers =
[ "TODO",
"FIXME",
"QUESTION"
]
stripIssueMarkers :: Text -> ([Text], 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
|
