Skip to content

Commit 2a7d751

Browse files
committed
Fix package list when user has multiple packages
1 parent 9279b9a commit 2a7d751

File tree

2 files changed

+38
-1
lines changed

2 files changed

+38
-1
lines changed

src/Distribution/Server/Features/UserNotify.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -473,7 +473,7 @@ dependencyReleaseEmails userSetIdForPackage index (ReverseIndex revs nodemap dep
473473
revDepNames = mapMaybe (`lookupR` nodemap) (Set.toList vertices)
474474
toNotify <- traverse maintainersToNotify revDepNames
475475
pure $
476-
Map.fromList
476+
Map.fromListWith (++)
477477
[ ( (maintainerId, pkgId), [ packageId latestRevDep ] )
478478
| (ids, latestRevDep) <- toNotify
479479
, maintainerId <- ids

tests/ReverseDependenciesTest.hs

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,14 @@ newBaseReleased =
5656
, mkPackage "mtl" [2,3] ["base < 4.15"]
5757
]
5858

59+
newBaseReleasedMultiple :: [PkgInfo]
60+
newBaseReleasedMultiple =
61+
[ mkPackage "base" [4,14] []
62+
, mkPackage "base" [4,15] []
63+
, mkPackage "mtl" [2,3] ["base < 4.15"]
64+
, mkPackage "mtl2" [2,3] ["base < 4.15"]
65+
]
66+
5967
newVersionOfOldBase :: [PkgInfo]
6068
newVersionOfOldBase =
6169
[ mkPackage "base" [4,14] []
@@ -104,6 +112,17 @@ allTests = testGroup "ReverseDependenciesTest"
104112
res <- revPackageName "mtl"
105113
let ref = Map.fromList [("beeline", (version0, Just NormalVersion))]
106114
assertEqual "reverse dependencies must be [beeline]" ref res
115+
, testCase "with set [beeline->mtl, beeline2->mtl] and querying for mtl, we get [beeline, beeline2]" $ do
116+
let pkgs =
117+
[ mkPackage "base" [4,15] []
118+
, mkPackage "mtl" [2,3] ["base"]
119+
, mkPackage "beeline" [0] ["mtl"]
120+
, mkPackage "beeline2" [0] ["mtl"]
121+
]
122+
ReverseFeature{revPackageName} <- mkRevFeat pkgs
123+
res <- revPackageName "mtl"
124+
let ref = Map.fromList [("beeline", (version0, Just NormalVersion)), ("beeline2", (version0, Just NormalVersion))]
125+
assertEqual "reverse dependencies must be [beeline, beeline2]" ref res
107126
, testCase "revPackageName selects only the version with an actual dependency, even if it is not the newest" $ do
108127
let pkgs =
109128
[ mkPackage "base" [4,15] []
@@ -190,6 +209,12 @@ allTests = testGroup "ReverseDependenciesTest"
190209
base4_16 = PackageIdentifier "base" (mkVersion [4,16])
191210
runWithPref preferences index pkg = runIdentity $
192211
dependencyReleaseEmails userSetIdForPackage index (constructReverseIndex index) preferences pkg
212+
runWithPrefAlsoMtl2 preferences index pkg = runIdentity $
213+
dependencyReleaseEmails userSet index (constructReverseIndex index) preferences pkg
214+
where
215+
userSet arg | arg == mkPackageName "mtl" = Identity (UserIdSet.fromList [UserId 0])
216+
| arg == mkPackageName "mtl2" = Identity (UserIdSet.fromList [UserId 0])
217+
| otherwise = error "should only get user ids for mtl and mtl2"
193218
assertEqual
194219
"dependencyReleaseEmails(trigger=NewIncompatibility) shouldn't generate a notification when there are packages, but none are behind"
195220
mempty
@@ -198,6 +223,18 @@ allTests = testGroup "ReverseDependenciesTest"
198223
"dependencyReleaseEmails(trigger=NewIncompatibility) should generate a notification when package is a single base version behind"
199224
(refNotification base4_15)
200225
(runWithPref (pref NewIncompatibility) (PackageIndex.fromList newBaseReleased) base4_15)
226+
assertEqual
227+
"dependencyReleaseEmails(trigger=NewIncompatibility) should generate a notification for two packages that are a single base version behind"
228+
(Just $
229+
Set.fromList
230+
[ PackageIdentifier (mkPackageName "mtl") (mkVersion [2,3])
231+
, PackageIdentifier (mkPackageName "mtl2") (mkVersion [2,3])
232+
]
233+
)
234+
( fmap Set.fromList
235+
. Map.lookup (UserId 0, base4_15)
236+
$ runWithPrefAlsoMtl2 (pref NewIncompatibility) (PackageIndex.fromList newBaseReleasedMultiple) base4_15
237+
)
201238
assertEqual
202239
"dependencyReleaseEmails(trigger=BoundsOutOfRange) should generate a notification when package is a single base version behind"
203240
(refNotification base4_15)

0 commit comments

Comments
 (0)