Skip to content

Commit 23eae0c

Browse files
brandonchinn178ysangkok
authored andcommitted
Give dependencyReleaseEmails more accurate name + type
1 parent 0ded9fc commit 23eae0c

File tree

2 files changed

+42
-30
lines changed

2 files changed

+42
-30
lines changed

src/Distribution/Server/Features/UserNotify.hs

Lines changed: 15 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ module Distribution.Server.Features.UserNotify (
1212
NotifyTriggerBounds(..),
1313
UserNotifyFeature(..),
1414
defaultNotifyPrefs,
15-
dependencyReleaseEmails,
15+
getUserNotificationsOnRelease,
1616
importNotifyPref,
1717
initUserNotifyFeature,
1818
notifyDataToCSV,
@@ -446,24 +446,26 @@ initUserNotifyFeature env@ServerEnv{ serverStateDir, serverTemplatesDir,
446446

447447
data InRange = InRange | OutOfRange
448448

449-
-- | Get the release notification emails when a new package has been released.
450-
-- The new package (PackageIdentifier) must already be in the indexes.
451-
-- The keys in the returned map are the new packages. The values are the revDeps.
452-
dependencyReleaseEmails
449+
-- | Get the users to notify when a new package has been released.
450+
-- The new package (PackageId) must already be in the indexes.
451+
-- The keys in the returned map are the user to notify, and the values are
452+
-- the packages the user maintains that depend on the new package (i.e. the
453+
-- reverse dependencies of the new package).
454+
getUserNotificationsOnRelease
453455
:: forall m. Monad m
454456
=> (PackageName -> m UserIdSet)
455457
-> PackageIndex.PackageIndex PkgInfo
456458
-> ReverseIndex
457459
-> (UserId -> m (Maybe NotifyPref))
458-
-> PackageIdentifier
459-
-> m (Map.Map (UserId, PackageId) [PackageId])
460-
dependencyReleaseEmails _ index _ _ pkgId
460+
-> PackageId
461+
-> m (Map.Map UserId [PackageId])
462+
getUserNotificationsOnRelease _ index _ _ pkgId
461463
| let versionsForNewRelease = packageVersion <$> PackageIndex.lookupPackageName index (pkgName pkgId)
462464
, pkgVersion pkgId /= maximum versionsForNewRelease
463465
-- If e.g. a minor bugfix release is made for an old release series, never notify maintainers.
464466
-- Only start checking if the new version is the highest.
465467
= pure mempty
466-
dependencyReleaseEmails userSetIdForPackage index (ReverseIndex revs nodemap dependencies) queryGetUserNotifyPref pkgId =
468+
getUserNotificationsOnRelease userSetIdForPackage index (ReverseIndex revs nodemap dependencies) queryGetUserNotifyPref pkgId =
467469
case lookup (pkgName pkgId) nodemap :: Maybe NodeId of
468470
Nothing -> pure mempty
469471
Just foundPackage -> do
@@ -475,7 +477,7 @@ dependencyReleaseEmails userSetIdForPackage index (ReverseIndex revs nodemap dep
475477
toNotify <- traverse maintainersToNotify revDepNames
476478
pure $
477479
Map.fromListWith (++)
478-
[ ( (maintainerId, pkgId), [ packageId latestRevDep ] )
480+
[ (maintainerId, [packageId latestRevDep])
479481
| (ids, latestRevDep) <- toNotify
480482
, maintainerId <- ids
481483
]
@@ -812,8 +814,9 @@ userNotifyFeature ServerEnv{serverBaseURI, serverCron}
812814
maintainers <- queryUserGroup $ maintainersGroup (fst pkgTags)
813815
return $ foldr addNotification mp (toList maintainers)
814816

815-
genDependencyUpdateList idx revIdx =
816-
dependencyReleaseEmails (queryUserGroup . maintainersGroup) idx revIdx queryGetUserNotifyPref
817+
genDependencyUpdateList idx revIdx pid =
818+
Map.mapKeys (, pid) <$>
819+
getUserNotificationsOnRelease (queryUserGroup . maintainersGroup) idx revIdx queryGetUserNotifyPref pid
817820

818821
describeRevision users earlier now pkg
819822
| pkgNumRevisions pkg <= 1 =

tests/ReverseDependenciesTest.hs

Lines changed: 27 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,16 @@ import Distribution.Package (PackageIdentifier(..), mkPackageName, packageId, pa
1414
import Distribution.Server.Features.PreferredVersions.State (PreferredVersions(..), VersionStatus(NormalVersion), PreferredInfo(..))
1515
import Distribution.Server.Features.ReverseDependencies (ReverseFeature(..), ReverseCount(..), reverseFeature)
1616
import Distribution.Server.Features.ReverseDependencies.State (ReverseIndex(..), addPackage, constructReverseIndex, emptyReverseIndex, getDependenciesFlat, getDependencies, getDependenciesFlatRaw, getDependenciesRaw)
17-
import Distribution.Server.Features.UserNotify (NotifyData(..), NotifyPref(..), NotifyRevisionRange, NotifyTriggerBounds(..), defaultNotifyPrefs, dependencyReleaseEmails, importNotifyPref, notifyDataToCSV)
17+
import Distribution.Server.Features.UserNotify
18+
( NotifyData(..)
19+
, NotifyPref(..)
20+
, NotifyRevisionRange
21+
, NotifyTriggerBounds(..)
22+
, defaultNotifyPrefs
23+
, getUserNotificationsOnRelease
24+
, importNotifyPref
25+
, notifyDataToCSV
26+
)
1827
import Distribution.Server.Framework.BackupRestore (runRestore)
1928
import Distribution.Server.Framework.Hook (newHook)
2029
import Distribution.Server.Framework.MemState (newMemStateWHNF)
@@ -186,7 +195,7 @@ allTests = testGroup "ReverseDependenciesTest"
186195
ReverseFeature{revDisplayInfo} <- mkRevFeat mtlBeelineLens
187196
res <- revDisplayInfo
188197
assertEqual "beeline preferred is old" (PreferredInfo [] [] Nothing, [mkVersion [0]]) (res "beeline")
189-
, testCase "dependencyReleaseEmails sends notification" $ do
198+
, testCase "getUserNotificationsOnRelease sends notification" $ do
190199
let userSetIdForPackage arg | arg == mkPackageName "mtl" = Identity (UserIdSet.fromList [UserId 0])
191200
| otherwise = error "should only get user ids for mtl"
192201
notifyPref triggerBounds =
@@ -197,9 +206,9 @@ allTests = testGroup "ReverseDependenciesTest"
197206
}
198207
pref triggerBounds (UserId 0) = Identity (Just $ notifyPref triggerBounds)
199208
pref _ _ = error "should only get preferences for UserId 0"
200-
refNotification base = Map.fromList
209+
userNotification = Map.fromList
201210
[
202-
( (UserId 0, base)
211+
( UserId 0
203212
, [PackageIdentifier (mkPackageName "mtl") (mkVersion [2,3])]
204213
)
205214
]
@@ -208,51 +217,51 @@ allTests = testGroup "ReverseDependenciesTest"
208217
base4_15 = PackageIdentifier "base" (mkVersion [4,15])
209218
base4_16 = PackageIdentifier "base" (mkVersion [4,16])
210219
runWithPref preferences index pkg = runIdentity $
211-
dependencyReleaseEmails userSetIdForPackage index (constructReverseIndex index) preferences pkg
220+
getUserNotificationsOnRelease userSetIdForPackage index (constructReverseIndex index) preferences pkg
212221
runWithPrefAlsoMtl2 preferences index pkg = runIdentity $
213-
dependencyReleaseEmails userSet index (constructReverseIndex index) preferences pkg
222+
getUserNotificationsOnRelease userSet index (constructReverseIndex index) preferences pkg
214223
where
215224
userSet arg | arg == mkPackageName "mtl" = Identity (UserIdSet.fromList [UserId 0])
216225
| arg == mkPackageName "mtl2" = Identity (UserIdSet.fromList [UserId 0])
217226
| otherwise = error "should only get user ids for mtl and mtl2"
218227
assertEqual
219-
"dependencyReleaseEmails(trigger=NewIncompatibility) shouldn't generate a notification when there are packages, but none are behind"
228+
"getUserNotificationsOnRelease(trigger=NewIncompatibility) shouldn't generate a notification when there are packages, but none are behind"
220229
mempty
221230
(runWithPref (pref NewIncompatibility) (PackageIndex.fromList twoPackagesWithNoDepsOutOfRange) base4_14)
222231
assertEqual
223-
"dependencyReleaseEmails(trigger=NewIncompatibility) should generate a notification when package is a single base version behind"
224-
(refNotification base4_15)
232+
"getUserNotificationsOnRelease(trigger=NewIncompatibility) should generate a notification when package is a single base version behind"
233+
userNotification
225234
(runWithPref (pref NewIncompatibility) (PackageIndex.fromList newBaseReleased) base4_15)
226235
assertEqual
227-
"dependencyReleaseEmails(trigger=NewIncompatibility) should generate a notification for two packages that are a single base version behind"
236+
"getUserNotificationsOnRelease(trigger=NewIncompatibility) should generate a notification for two packages that are a single base version behind"
228237
(Just $
229238
Set.fromList
230239
[ PackageIdentifier (mkPackageName "mtl") (mkVersion [2,3])
231240
, PackageIdentifier (mkPackageName "mtl2") (mkVersion [2,3])
232241
]
233242
)
234243
( fmap Set.fromList
235-
. Map.lookup (UserId 0, base4_15)
244+
. Map.lookup (UserId 0)
236245
$ runWithPrefAlsoMtl2 (pref NewIncompatibility) (PackageIndex.fromList newBaseReleasedMultiple) base4_15
237246
)
238247
assertEqual
239-
"dependencyReleaseEmails(trigger=BoundsOutOfRange) should generate a notification when package is a single base version behind"
240-
(refNotification base4_15)
248+
"getUserNotificationsOnRelease(trigger=BoundsOutOfRange) should generate a notification when package is a single base version behind"
249+
userNotification
241250
(runWithPref (pref BoundsOutOfRange) (PackageIndex.fromList newBaseReleased) base4_15)
242251
assertEqual
243-
"dependencyReleaseEmails(trigger=NewIncompatibility) shouldn't generate a notification when package is two base versions behind"
252+
"getUserNotificationsOnRelease(trigger=NewIncompatibility) shouldn't generate a notification when package is two base versions behind"
244253
mempty
245254
(runWithPref (pref NewIncompatibility) (PackageIndex.fromList twoNewBasesReleased) base4_16)
246255
assertEqual
247-
"dependencyReleaseEmails(trigger=BoundsOutOfRange) should generate a notification when package is two base versions behind"
248-
(refNotification base4_16)
256+
"getUserNotificationsOnRelease(trigger=BoundsOutOfRange) should generate a notification when package is two base versions behind"
257+
userNotification
249258
(runWithPref (pref BoundsOutOfRange) (PackageIndex.fromList twoNewBasesReleased) base4_16)
250259
assertEqual
251-
"dependencyReleaseEmails(trigger=BoundsOutOfRange) shouldn't generate a notification when the new package is for an old release series"
260+
"getUserNotificationsOnRelease(trigger=BoundsOutOfRange) shouldn't generate a notification when the new package is for an old release series"
252261
mempty
253262
(runWithPref (pref BoundsOutOfRange) (PackageIndex.fromList newVersionOfOldBase) base4_14_1)
254263
assertEqual
255-
"dependencyReleaseEmails(trigger=BoundsOutOfRange) should only generate a notification when the new version is forbidden across all branches"
264+
"getUserNotificationsOnRelease(trigger=BoundsOutOfRange) should only generate a notification when the new version is forbidden across all branches"
256265
mempty -- The two branches below should get OR'd and therefore the dependency is not out of bounds
257266
(runWithPref
258267
(pref BoundsOutOfRange)

0 commit comments

Comments
 (0)