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
|
module History.CommitInfo
( CommitInfo (..),
fromPartialCommitInfos,
issueEvents,
diffCommitInfos,
)
where
import Data.Binary (Binary)
import Data.Function (on, (&))
import Data.List (deleteFirstsBy, find)
import Data.Maybe (isJust)
import Data.Text.IO qualified as T
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Encoding qualified as LT
import GHC.Generics (Generic)
import History.CommitHash (CommitHash)
import History.IssueEvent (IssueEvent (..))
import History.PartialCommitInfo (PartialCommitInfo (..))
import Issue (Issue (..))
import Issue.Provenance qualified as I
import Parallel (parSequence)
import Process (sh)
import System.FilePath ((</>))
import System.IO.Temp (withSystemTempDirectory)
import System.Process.Typed (setWorkingDir)
-- TODO Change `CommitInfo` -> `CommitIssuesAll`
data CommitInfo = CommitInfo
{ hash :: CommitHash,
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 =
mergeListsBy
eq
( \old new ->
new
{ provenance =
I.Provenance
{ first = old.provenance.first,
last =
if ((/=) `on` (.rawText)) old new
then new.provenance.last
else old.provenance.last
},
closed = False
}
)
( \old ->
if elemBy eq old newInfo.issues
|| not (old.file `elem` newInfo.filesChanged)
then old
else old {closed = True}
)
id
oldInfo.issues
newInfo.issues,
..
}
eq = (==) `on` (.id)
-- | We assume that [CommitInfo] is sorted starting with the oldest
-- commits.
issueEvents :: [CommitInfo] -> IO [(CommitHash, [IssueEvent])]
issueEvents xs = zip (map (.hash) xs) <$> parSequence (zipWith diffCommitInfos predecessors xs)
where
predecessors = Nothing : map Just xs
diffCommitInfos :: Maybe CommitInfo -> CommitInfo -> IO [IssueEvent]
diffCommitInfos maybeOldInfo newInfo =
sequence $
concat
[ [IssueCreated newHash issue <$> patchCreated issue | issue <- deleteFirstsBy eq newIssues oldIssues],
[ IssueChanged newHash oldIssue newIssue <$> patchChanged oldIssue newIssue
| (newIssue : oldIssue : _) <- intersectBy' eq newIssues oldIssues,
neq newIssue oldIssue
],
[IssueDeleted newHash issue <$> patchDeleted issue | issue <- deleteFirstsBy eq oldIssues newIssues]
]
where
newHash = newInfo.hash
newIssues' = newInfo.issues
oldIssues' = maybe [] (.issues) maybeOldInfo
newIssues = filter (not . (.closed)) newIssues'
oldIssues = filter (not . (.closed)) oldIssues'
eq = (==) `on` (.id)
neq = (/=) `on` (.rawText)
patchCreated new = diff "" new.rawText
patchChanged old new = diff old.rawText new.rawText
patchDeleted old = diff old.rawText ""
diff old new = withSystemTempDirectory "diff" $ \tmp -> do
let cwd = tmp
T.writeFile (tmp </> "old") old
T.writeFile (tmp </> "new") new
LT.toStrict . LT.decodeUtf8 <$> sh ("git diff --no-index -- old new || :" & setWorkingDir cwd)
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
|
