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
|
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 TreeGrepper.Match (Position (..))
import Prelude hiding (id)
-- TODO Change `CommitInfo` -> `CommitIssuesAll`
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 =
I.Provenance
{ first = old.provenance.first,
last =
if ((/=) `on` (.rawText)) old new
then new.provenance.last
else old.provenance.last
}
}
)
( \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, ((/=) `on` (.rawText)) x y])
],
[IssueDeleted newHash issue | issue <- deleteFirstsBy eq oldIssues newIssues]
]
where
newHash = newInfo.hash
newIssues = newInfo.issues
oldIssues = oldInfo.issues
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
|
