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
|
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module Issue (Issue (..), Provenance (..), fromMatch, id) where
import Data.Binary (Binary, get, put)
import Data.ByteString.Lazy (toStrict)
import Data.ByteString.Lazy.Char8 (unpack)
import Data.List (find, foldl')
import Data.String (fromString)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8)
import Data.Time.Clock (UTCTime)
import GHC.Generics (Generic)
import Issue.Tag (Tag (..))
import Issue.Tag qualified as I
import Issue.Text qualified as I
import Process (quote, sh)
import Text.Printf (printf)
import TreeGrepper.Match (Match (..))
import TreeGrepper.Match qualified as G
import TreeGrepper.Result (Result (..))
import TreeGrepper.Result qualified as G
import Prelude hiding (id)
data Issue = Issue
{ title :: Text,
description :: Maybe Text,
file :: String,
provenance :: Maybe Provenance,
start :: G.Position,
end :: G.Position,
tags :: [Tag],
internalTags :: [Tag]
}
deriving (Show, Binary, Generic)
data Provenance = Provenance
{ firstCommit :: Text,
date :: UTCTime,
authorEmail :: Text,
authorName :: Text
}
deriving (Show, Generic, Binary)
instance Binary UTCTime where
-- TODO Serialize UTCTime using POSIX time stamps
put = put . show
get = fmap read get
id :: Issue -> Maybe String
id issue =
(\(Tag _ v) -> T.unpack v)
<$> ( find (\(Tag k _) -> k == "id") $
issue.tags ++ issue.internalTags
)
fromMatch :: G.Result -> G.Match -> IO (Maybe Issue)
fromMatch result match = do
rawProvenance <-
fmap (T.splitOn "\NUL" . head . T.lines . decodeUtf8 . toStrict) $
sh $
"git show --quiet --format='%H%x00%ai%x00%ae%x00%an'"
let provenance =
case rawProvenance of
firstCommit' : rawDate : authorEmail : authorName : _ ->
let date = read (T.unpack rawDate)
in Just
Provenance
{ firstCommit = firstCommit',
date = date,
authorEmail = authorEmail,
authorName = authorName
}
_ ->
Nothing
pure
( if any (\marker -> T.isPrefixOf marker title') issueMarkers
then
Just
Issue
{ title = title,
description = description,
file = result.file,
provenance = provenance,
start = match.start,
end = match.end,
tags = maybe [] I.extractTags description,
internalTags = I.internalTags title
}
else Nothing
)
where
(title', description) = I.extractText result.file_type match.text
title = stripIssueMarkers title'
issueMarkers :: [Text]
issueMarkers =
[ "TODO",
"FIXME",
"QUESTION"
]
stripIssueMarkers :: Text -> Text
stripIssueMarkers text =
foldl' (stripIssueMarker) text issueMarkers
stripIssueMarker :: Text -> Text -> Text
stripIssueMarker text marker =
maybe text T.stripStart (T.stripPrefix marker text)
|
