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
|
module History.IssueEvents
( IssueEvents (..),
)
where
import Backend qualified
import Data.Binary (Binary)
import Data.Function (on)
import Data.List
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Data.Proxy (Proxy)
import GHC.Generics (Generic)
import History.Plan (Id, Planable, Proto, assume, postprocess, propagate, protoOf)
import History.Scramble (Scramble (..), getScrambleOf)
import Issue (Issue (..))
import IssueEvent (IssueEvent (..))
import IssueEvent qualified as E
data IssueEvents = IssueEvents
{ commitHash :: Backend.CommitHash,
issueEvents :: [E.IssueEvent],
filesSeen :: M.Map FilePath Backend.CommitHash
}
deriving (Show, Generic, Binary)
instance Planable IssueEvents where
type Id IssueEvents = Backend.CommitHash
type Proto IssueEvents = Scramble
protoOf :: Proxy IssueEvents -> Backend.CommitHash -> IO Scramble
protoOf _ = getScrambleOf
assume :: Scramble -> IssueEvents
assume Scramble {..} =
IssueEvents
{ issueEvents =
[ IssueCreated commitHash issue
| issue <- M.elems issues
],
filesSeen =
M.unions
[ M.singleton issue.file commitHash
| issue <- M.elems issues
],
..
}
propagate ::
[Backend.CommitHash] ->
IssueEvents ->
Scramble ->
IssueEvents
propagate = propagateIssueEvents
postprocess :: [Backend.CommitHash] -> IssueEvents -> IssueEvents
postprocess log issueEvents =
issueEvents
{ issueEvents =
sortOn logOrder . concatMap dropLastDeleted . groupPerIssue $
issueEvents.issueEvents
}
where
dropLastDeleted xs =
case NE.last xs of
IssueDeleted _ _ -> NE.init xs
_ -> NE.toList xs
groupPerIssue =
map (NE.sortBy (comparing logOrder))
. NE.groupBy (sym `on` issue)
. sortOn ((.id) . issue)
logOrder = fromMaybe (-1) . (`elemIndex` log) . commitHash
sym :: Issue -> Issue -> Bool
sym = (==) `on` (.id)
commitHash (IssueChanged commitHash _ _) = commitHash
commitHash (IssueCreated commitHash _) = commitHash
commitHash (IssueDeleted commitHash _) = commitHash
issue (IssueChanged _ _ issue) = issue
issue (IssueCreated _ issue) = issue
issue (IssueDeleted _ issue) = issue
-- | Propagates issue events from a top commit to a consecutive bottom commit.
--
-- Because we are building the history of issue events backwards, we use *top* and *bottom* to refer to the later and earlier commit within the Git history, respectively. We use *earlier* and *later* to refer to the top and bottom commits within the application of this function. In particular, top commits are processed earlier, and bottom commits are processed later.
--
-- For the top/earlier commit, issue events are known. For the bottom/later commit, only the scramble is known.
--
-- The scramble is said to *witness* an issue, if its changed files contain the issue's file. Thus, in addition to the issues a scramble contains, it witnesses the issues that have been deleted in the scramble's commit.
--
-- Because we are building the history from top/earlier to bottom/later commits, we have to assume that at any top/earlier commit, the issues present have been created in that commit. This function advances the issue's original commit as we learn about bottom/later commits from scrambles.
--
-- Suppose an issue `1` is present since a top commit `b`, and we encounter a scramble that witnesses the issue at commit `a`. Has issue `1` originally been created in commit `b`, or has it been closed in commit `a` and re-opened in commit `b`? Answering that question depends on later information, ie. whether issue `1` is created in a later commit. In the first case, it would be correct to simply not advance the original commit of issue `a`. In the second case, it would be correct to create an event that the issue has been deleted. Not advancing the original commit of issue `a` leaves us no information to answer the question later. Thus, we create an event that the issue has been deleted.
--
-- This is incorrect for issues that have not been re-opened. Finally, those issues will have a chain of issue events that end in a deletion event, and we post-process issue events to remove precisely those.
propagateIssueEvents :: [Backend.CommitHash] -> IssueEvents -> Scramble -> IssueEvents
propagateIssueEvents log topIssueEvents bottomScramble =
IssueEvents
{ commitHash = bottomScramble.commitHash,
issueEvents =
sortOn logOrder $
let issueEventsPerIssue =
groupPerIssue topIssueEvents.issueEvents
in concat
[ -- CASE 1. The issue is present in the top/earlier history and bottom/later scramble. We advance the issue's original commit, and track any change if there was any.
concat
[ NE.init issueEvents ++ case NE.last issueEvents of
IssueCreated commitHash _ ->
concat
[ if topIssue `neq` bottomIssue
then
[ IssueChanged commitHash bottomIssue topIssue
]
else [],
[ IssueCreated bottomCommitHash bottomIssue
]
]
issueEvent@(IssueDeleted _ _) ->
[ issueEvent,
IssueCreated bottomCommitHash bottomIssue
]
issueEvent -> [issueEvent]
| issueEvents <- issueEventsPerIssue,
let topIssue = issue (NE.last issueEvents),
bottomIssue <- bottomIssues,
bottomIssue `sym` topIssue
],
concat
[ -- CASE 2. The issue is present in the top/earlier history, not contained in the bottom/later scramble, but witnessed by the bottom/later scramble. We track a deletion, because we don't know whether or not the issue has been re-opened (see above).
NE.init issueEvents ++ case NE.last issueEvents of
issueEvent@(IssueCreated _ issue) ->
[ issueEvent,
IssueDeleted bottomCommitHash issue {closed = True}
]
issueEvent -> [issueEvent]
| issueEvents <- issueEventsPerIssue,
let topIssue = issue (NE.last issueEvents),
all (`nsym` topIssue) bottomIssues,
topIssue.file `elem` bottomScramble.filesChanged
],
concat
[ -- CASE 3. The issue is present in the top/earlier history, but not witnessed by the bottom/later scramble. We keep the issue event unchanged.
NE.init issueEvents ++ case NE.last issueEvents of
issueEvent -> [issueEvent]
| issueEvents <- issueEventsPerIssue,
let topIssue = issue (NE.last issueEvents),
all (`nsym` topIssue) bottomIssues,
not (topIssue.file `elem` bottomScramble.filesChanged)
],
concat
[ -- CASE 4. The issue it not present in the top/earlier history, but contained in the bottom scramble. If we have seen the issue's file earlier, this means the issue had to be deleted at the earlier commit. If the file has not been seen earlier, we plainly track the issue's creation.
concat
[ case M.lookup bottomIssue.file topIssueEvents.filesSeen of
Nothing -> []
Just seenCommitHash ->
[IssueDeleted seenCommitHash bottomIssue {closed = True}],
[IssueCreated bottomCommitHash bottomIssue]
]
| bottomIssue <- bottomIssues,
all ((`nsym` bottomIssue) . issue . NE.last) issueEventsPerIssue
]
],
filesSeen =
M.union
( M.unions
[ M.singleton file bottomScramble.commitHash
| file <- bottomScramble.filesChanged
]
)
topIssueEvents.filesSeen
}
where
groupPerIssue =
map (NE.sortBy (comparing logOrder))
. NE.groupBy (sym `on` issue)
. sortOn ((.id) . issue)
logOrder = fromMaybe (-1) . (`elemIndex` log) . commitHash
bottomCommitHash = bottomScramble.commitHash
bottomIssues = M.elems bottomScramble.issues
neq, sym, nsym :: Issue -> Issue -> Bool
sym = (==) `on` (.id)
nsym = (/=) `on` (.id)
neq = (/=) `on` (.rawTextHash)
commitHash (IssueChanged commitHash _ _) = commitHash
commitHash (IssueCreated commitHash _) = commitHash
commitHash (IssueDeleted commitHash _) = commitHash
issue (IssueChanged _ _ issue) = issue
issue (IssueCreated _ issue) = issue
issue (IssueDeleted _ issue) = issue
|