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
209
210
211
|
module History
( History (..),
getHistory,
getIssues,
)
where
import CMark qualified as D
import Cache (cachedMaybe)
import Comment qualified as G
import Control.Arrow (first)
import Control.Exception (catch, handle, try)
import Data.Binary (Binary)
import Data.ByteString.Lazy qualified as LB
import Data.Function (on)
import Data.List.NonEmpty qualified as N
import Data.Map qualified as M
import Data.Maybe (catMaybes)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Die (die)
import Exception qualified as E
import GHC.Generics (Generic)
import Git qualified
import Git.CommitHash (CommitHash (..))
import Git.CommitHash qualified as C
import Issue qualified as I
import Issue.Parser qualified as I
import Issue.Tag qualified as I
import Issue.Text qualified as I
import IssueEvent (IssueEvent (..))
import Parallel (parMapM)
import Process (proc, sh)
import Render qualified as P
import Tuple ()
-- TODO Reduce cached data size
--
-- Right now we are caching complete `Issue` instances, which
-- contain the full issue title and description. For a fast
-- lookup it may already be enough to only store the issue's
--
-- \* filename
-- \* start position
-- \* end position
--
-- With this information we can use git to quickly look up the
-- complete issue text and parse it.
--
-- @topic caching
-- @backlog
data History = History
{ commitHash :: CommitHash,
issues :: M.Map T.Text I.Issue,
issueEvents :: [IssueEvent]
}
deriving (Show, Generic, Binary)
getHistory :: IO History
getHistory = getHistoryOf WorkingTree
getHistoryOf :: CommitHash -> IO History
getHistoryOf commitHash = cachedMaybe (C.toText commitHash) do
maybeParentCommitHash <- getParentCommitHashOf commitHash
case maybeParentCommitHash of
Just parentCommitHash ->
propagate commitHash
<$> (getHistoryOf parentCommitHash)
<*> (getScrambleOf commitHash)
Nothing -> unsafeAssume commitHash <$> getScrambleOf commitHash
getParentCommitHashOf :: CommitHash -> IO (Maybe CommitHash)
getParentCommitHashOf commitHash =
either
(\_ -> Nothing)
(Just . Commit . T.strip . T.decodeUtf8 . LB.toStrict)
<$> try @E.ProcessException
( case commitHash of
WorkingTree -> sh "git show -s --format=%H HEAD"
Commit hash -> sh (proc "git show -s --format=%%H %^" hash)
)
-- | `Scramble` records the complete issues ONLY in files that have
-- been changed in the commit.
data Scramble = Scramble
{ commitHash :: CommitHash,
filesChanged :: [FilePath],
issues :: M.Map T.Text I.Issue
}
deriving (Show, Binary, Generic)
getScrambleOf :: CommitHash -> IO Scramble
getScrambleOf commitHash = do
(issues, filesChanged) <- first (M.fromList . map (\i -> (i.id, i))) <$> getIssuesAndFilesChanged commitHash
pure $ Scramble {..}
getIssuesAndFilesChanged :: CommitHash -> IO ([I.Issue], [FilePath])
getIssuesAndFilesChanged commitHash = do
files <- Git.getChangedFilesOf commitHash
issues <-
concat
<$> catch
(parMapM (getIssues commitHash) files)
(\(e :: E.InvalidTreeGrepperResult) -> die (show e))
pure (issues, files)
-- | Get all issues in the given directory and file.
getIssues :: CommitHash -> FilePath -> IO [I.Issue]
getIssues commitHash filename =
handle (\(_ :: E.UnknownFileExtension) -> pure []) $
fmap catMaybes . parMapM (fromComment commitHash)
=<< G.getComments commitHash filename
-- | Note that `provenance` is trivial and needs to be fixed up later.
fromComment :: CommitHash -> G.Comment -> IO (Maybe I.Issue)
fromComment commitHash comment = do
commit <- Git.getCommitOf commitHash
let provenance = I.Provenance commit commit
pure $
( \parseResult ->
let (markers, title) =
I.stripIssueMarkers (T.pack (show (P.render parseResult.heading)))
in I.Issue
{ title = title,
description = N.nonEmpty parseResult.paragraphs,
file = comment.filePath,
provenance = provenance,
startPoint = comment.startPoint,
endPoint = comment.endPoint,
tags = I.extractTags parseResult.tags,
markers = markers,
rawText = rawText,
commentStyle = commentStyle,
comments = N.nonEmpty parseResult.comments,
closed = False
}
)
<$> I.parse I.issueMarkers (D.commonmarkToNode [] rawText)
where
(commentStyle, rawText) = G.uncomment comment.language comment.text
propagate :: CommitHash -> History -> Scramble -> History
propagate commitHash oldHistory scramble =
let issues = propagateIssues oldHistory.issues scramble
in History
{ issueEvents = propagateIssueEvents oldHistory.issueEvents oldHistory.issues commitHash issues,
..
}
propagateIssues :: M.Map T.Text I.Issue -> Scramble -> M.Map T.Text I.Issue
propagateIssues oldIssues scramble =
M.mergeWithKey
( \_ old new ->
Just $
new
{ I.provenance =
I.Provenance
{ first = old.provenance.first,
last =
if ((/=) `on` (.rawText)) old new
then new.provenance.last
else old.provenance.last
},
I.closed = False
}
)
( M.map
( \old ->
if M.member old.id scramble.issues
|| not (old.file `elem` scramble.filesChanged)
then old
else old {I.closed = True}
)
)
id
oldIssues
scramble.issues
propagateIssueEvents :: [IssueEvent] -> M.Map T.Text I.Issue -> CommitHash -> M.Map T.Text I.Issue -> [IssueEvent]
propagateIssueEvents oldIssueEvents oldIssues commitHash issues =
oldIssueEvents ++ newIssueEvents oldIssues commitHash issues
newIssueEvents :: M.Map T.Text I.Issue -> CommitHash -> M.Map T.Text I.Issue -> [IssueEvent]
newIssueEvents oldIssues' commitHash issues' =
concat
[ [ IssueCreated commitHash issue
| issue <- M.elems (issues `M.difference` oldIssues)
],
[ IssueChanged commitHash oldIssue newIssue
| (newIssue, oldIssue) <- M.elems (M.intersectionWith (,) issues oldIssues),
newIssue `neq` oldIssue
],
[ IssueDeleted commitHash issue {I.closed = True}
| issue <- M.elems (oldIssues `M.difference` issues)
]
]
where
issues = M.filter (not . (.closed)) issues'
oldIssues = M.filter (not . (.closed)) oldIssues'
neq = (/=) `on` (.rawText)
unsafeAssume :: CommitHash -> Scramble -> History
unsafeAssume commitHash scramble =
History
{ issues = scramble.issues,
issueEvents = propagateIssueEvents [] M.empty commitHash scramble.issues,
..
}
|
