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
|
module History.CommitInfo
( CommitInfo (..),
fromPartialCommitInfos,
issueEvents,
diffCommitInfos,
)
where
import Data.Binary (Binary)
import Data.Function (on)
import Data.List (deleteFirstsBy, find)
import Data.Maybe (catMaybes, isJust)
import GHC.Generics (Generic)
import History.CommitHash (CommitHash)
import History.IssueEvent (IssueEvent (..))
import History.PartialCommitInfo (PartialCommitInfo (..))
import Issue (Issue (..), id)
import Issue.Provenance qualified as I
import Issue.Tag qualified as I
import TreeGrepper.Match (Position (..))
import Prelude hiding (id)
data CommitInfo = CommitInfo
{ hash :: CommitHash,
filesChanged :: [FilePath],
issues :: [Issue]
}
deriving (Show, Binary, Generic)
fromPartialCommitInfos :: [PartialCommitInfo] -> [CommitInfo]
fromPartialCommitInfos [] = []
fromPartialCommitInfos (partialCommitInfo : partialCommitInfos) =
scanl propagate (assume partialCommitInfo) partialCommitInfos
where
assume :: PartialCommitInfo -> CommitInfo
assume (PartialCommitInfo {..}) = CommitInfo {..}
propagate :: CommitInfo -> PartialCommitInfo -> CommitInfo
propagate oldInfo newInfo@(PartialCommitInfo {..}) =
CommitInfo
{ issues =
catMaybes $
mergeListsBy
eq
( \old new ->
Just
new
{ provenance =
(\oldProvenance newProvenance ->
( I.Provenance
{ first = oldProvenance.first,
last = newProvenance.last
}
)
)
<$> old.provenance <*> new.provenance,
internalTags = I.internalTags new.title old.provenance
}
)
( \old ->
if elemBy eq old newInfo.issues
|| not (old.file `elem` newInfo.filesChanged)
then Just old
else Nothing
)
(\new -> Just new)
oldInfo.issues
newInfo.issues,
..
}
eq = (==) `on` id
issueEvents :: [CommitInfo] -> [(CommitHash, [IssueEvent])]
issueEvents xs = zip (map (.hash) xs') (zipWith diffCommitInfos xs xs')
where
xs' = tail xs
diffCommitInfos :: CommitInfo -> CommitInfo -> [IssueEvent]
diffCommitInfos oldInfo newInfo =
concat
[ [IssueCreated newHash issue | issue <- deleteFirstsBy eq newIssues oldIssues],
[ IssueChanged newHash (last issues)
| issues <- intersectBy' eq newIssues oldIssues,
not (null [(x, y) | x <- issues, y <- issues, clear x /= clear y])
],
[IssueDeleted newHash issue | issue <- deleteFirstsBy eq oldIssues newIssues]
]
where
newHash = newInfo.hash
newIssues = newInfo.issues
oldIssues = oldInfo.issues
-- TODO Fix issue comparison
--
-- Because issues carry `provenance` and `internalTags`, issues compare
-- unequally when we want them to be equal.
clear i =
i
{ provenance = Nothing,
internalTags = [],
start = Position 0 0,
end = Position 0 0,
file = ""
}
eq = (==) `on` id
mergeListsBy :: (a -> a -> Bool) -> (a -> a -> b) -> (a -> b) -> (a -> b) -> [a] -> [a] -> [b]
mergeListsBy eq onBoth onLeft onRight lefts rights =
concat
[ [ maybe (onLeft left) (onBoth left) right
| left <- lefts,
right <-
let rights' = filter (eq left) rights
in if null rights' then [Nothing] else (map Just rights')
],
[ onRight right
| right <- rights,
not (elemBy eq right lefts)
]
]
-- | A variant of `Data.List.intersectBy` that retuns the witnesses of the
-- intersection.
intersectBy' :: (a -> a -> Bool) -> [a] -> [a] -> [[a]]
intersectBy' eq xs ys = filter (not . null) (map (\x -> x : filter (eq x) ys) xs)
-- | A variant of `elem` that uses a custom comparison function.
elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
elemBy eq x xs = isJust $ find (eq x) xs
|
