diff --git a/src/Distribution/Server/Features/Html.hs b/src/Distribution/Server/Features/Html.hs
index 47f6b83db..f3e485111 100644
--- a/src/Distribution/Server/Features/Html.hs
+++ b/src/Distribution/Server/Features/Html.hs
@@ -1782,8 +1782,8 @@ mkHtmlTags HtmlUtilities{..}
serveTagsListing :: DynamicPath -> ServerPartE Response
serveTagsListing _ = do
- tagList <- queryGetTagList
- let withCounts = filter ((>0) . snd) . map (\(tg, pkgs) -> (tg, Set.size pkgs)) $ tagList
+ tagCounts <- queryTagCounts
+ let withCounts = filter ((>0) . snd) tagCounts
countSort = sortBy (flip compare `on` snd) withCounts
return $ toResponse $ Resource.XHtml $ hackagePage "Hackage tags"
[ h2 << "Hackage tags"
diff --git a/src/Distribution/Server/Features/PackageCandidates.hs b/src/Distribution/Server/Features/PackageCandidates.hs
index dfc9a9849..fb4329977 100644
--- a/src/Distribution/Server/Features/PackageCandidates.hs
+++ b/src/Distribution/Server/Features/PackageCandidates.hs
@@ -145,7 +145,7 @@ initPackageCandidatesFeature env@ServerEnv{serverStateDir} = do
-- one-off migration
migratedPkgTarball <- Store.candidateTarballIsMigrated candidatesStore
unless migratedPkgTarball $ do
- candidateIndex <- Store.getCandidateIndex candidatesStore
+ candidateIndex <- PackageIndex.fromList <$> Store.allCandidates candidatesStore
migrateCandidatePkgTarball_v1_to_v2 env candidateIndex $ \pkgid pkginfo ->
void $ Store.updateCandidatePkgInfo candidatesStore pkgid pkginfo
Store.setCandidateTarballMigrated candidatesStore
@@ -195,7 +195,7 @@ candidatesFeature ServerEnv{serverBlobStore = store}
}
queryGetCandidateIndex :: MonadIO m => m (PackageIndex CandPkgInfo)
- queryGetCandidateIndex = Store.getCandidateIndex candidatesStore
+ queryGetCandidateIndex = PackageIndex.fromList <$> Store.allCandidates candidatesStore
candidatesCoreResource = fix $ \r -> CoreResource {
-- TODO: There is significant overlap between this definition and the one in Core
@@ -541,8 +541,7 @@ candidatesFeature ServerEnv{serverBlobStore = store}
lookupCandidateName :: PackageName -> ServerPartE [CandPkgInfo]
lookupCandidateName pkgname = do
guardValidPackageName core pkgname
- candidateIndex <- queryGetCandidateIndex
- return $ PackageIndex.lookupPackageName candidateIndex pkgname
+ Store.lookupCandidateName candidatesStore pkgname
-- TODO: Unlike the corresponding function in core, we don't return the
-- "latest" candidate when Version is empty. Should we?
@@ -550,8 +549,8 @@ candidatesFeature ServerEnv{serverBlobStore = store}
lookupCandidateId :: PackageId -> ServerPartE CandPkgInfo
lookupCandidateId pkgid = do
guard (pkgVersion pkgid /= nullVersion)
- candidateIndex <- queryGetCandidateIndex
- case PackageIndex.lookupPackageId candidateIndex pkgid of
+ mcand <- Store.lookupCandidateId candidatesStore pkgid
+ case mcand of
Just pkg -> return pkg
_ -> errNotFound "Candidate not found" [MText $ "No such candidate version for " ++ display (packageName pkgid)]
diff --git a/src/Distribution/Server/Features/PackageCandidates/Acid.hs b/src/Distribution/Server/Features/PackageCandidates/Acid.hs
index 5a26e6c1d..a3adc9b3d 100644
--- a/src/Distribution/Server/Features/PackageCandidates/Acid.hs
+++ b/src/Distribution/Server/Features/PackageCandidates/Acid.hs
@@ -7,13 +7,19 @@ import qualified Distribution.Server.Features.PackageCandidates.State as State
import Distribution.Server.Features.PackageCandidates.Backup
import qualified Distribution.Server.Features.PackageCandidates.Store as Store
import Distribution.Server.Framework
+import Distribution.Server.Features.PackageCandidates.Types (CandPkgInfo)
+import qualified Distribution.Server.Packages.PackageIndex as PackageIndex
acidStore :: FilePath -> IO Store.Backend
acidStore stateDir = do
candidatesState <- candidatesStateComponent False stateDir
+ let withCandidates :: MonadIO m => (PackageIndex.PackageIndex CandPkgInfo -> a) -> m a
+ withCandidates f = f . State.candidateList <$> queryState candidatesState State.GetCandidatePackages
pure Store.Backend {
Store.backendStore = Store.Store {
- Store.getCandidateIndex = State.candidateList <$> queryState candidatesState State.GetCandidatePackages
+ Store.lookupCandidateName = \pkgname -> withCandidates (`PackageIndex.lookupPackageName` pkgname)
+ , Store.lookupCandidateId = \pkgid -> withCandidates (`PackageIndex.lookupPackageId` pkgid)
+ , Store.allCandidates = withCandidates PackageIndex.allPackages
, Store.candidateTarballIsMigrated = State.candidateMigratedPkgTarball <$> queryState candidatesState State.GetCandidatePackages
, Store.setCandidateTarballMigrated = updateState candidatesState State.SetMigratedPkgTarball
, Store.addCandidate = \candidate -> updateState candidatesState (State.AddCandidate candidate)
diff --git a/src/Distribution/Server/Features/PackageCandidates/Store.hs b/src/Distribution/Server/Features/PackageCandidates/Store.hs
index 461d67f35..d9bc0d28d 100644
--- a/src/Distribution/Server/Features/PackageCandidates/Store.hs
+++ b/src/Distribution/Server/Features/PackageCandidates/Store.hs
@@ -8,7 +8,6 @@ module Distribution.Server.Features.PackageCandidates.Store
import Distribution.Package (PackageId, PackageName)
import Distribution.Server.Features.PackageCandidates.Types (CandPkgInfo)
import Distribution.Server.Framework (AbstractStateComponent)
-import Distribution.Server.Packages.PackageIndex (PackageIndex)
import Distribution.Server.Packages.Types (PkgInfo)
import Control.Monad.Trans (MonadIO)
@@ -19,7 +18,9 @@ data Backend = Backend {
}
data Store = Store {
- getCandidateIndex :: forall m. MonadIO m => m (PackageIndex CandPkgInfo)
+ lookupCandidateName :: forall m. MonadIO m => PackageName -> m [CandPkgInfo]
+ , lookupCandidateId :: forall m. MonadIO m => PackageId -> m (Maybe CandPkgInfo)
+ , allCandidates :: forall m. MonadIO m => m [CandPkgInfo]
, candidateTarballIsMigrated :: forall m. MonadIO m => m Bool
, setCandidateTarballMigrated :: forall m. MonadIO m => m ()
, addCandidate :: forall m. MonadIO m => CandPkgInfo -> m ()
diff --git a/src/Distribution/Server/Features/PreferredVersions.hs b/src/Distribution/Server/Features/PreferredVersions.hs
index e86b54d18..4c4194fb5 100644
--- a/src/Distribution/Server/Features/PreferredVersions.hs
+++ b/src/Distribution/Server/Features/PreferredVersions.hs
@@ -57,7 +57,7 @@ data VersionsFeature = VersionsFeature {
queryGetPreferredInfo :: forall m. MonadIO m => PackageName -> m PreferredInfo,
queryGetDeprecatedFor :: forall m. MonadIO m => PackageName -> m (Maybe [PackageName]),
- queryGetPreferredVersions :: forall m. MonadIO m => m PreferredVersions,
+ queryAllPreferredInfo :: forall m. MonadIO m => m (Map.Map PackageName PreferredInfo),
versionsResource :: VersionsResource,
deprecatedHook :: Hook (PackageName, Maybe [PackageName]) (),
@@ -158,11 +158,11 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
queryGetDeprecatedFor :: MonadIO m => PackageName -> m (Maybe [PackageName])
queryGetDeprecatedFor = Store.getDeprecatedFor preferredStore
- queryGetPreferredVersions :: MonadIO m => m PreferredVersions
- queryGetPreferredVersions = Store.getPreferredVersions preferredStore
+ queryAllPreferredInfo :: MonadIO m => m (Map.Map PackageName PreferredInfo)
+ queryAllPreferredInfo = Store.getAllPreferredInfo preferredStore
updateDeprecatedTags = do
- pkgs <- deprecatedMap <$> Store.getPreferredVersions preferredStore
+ pkgs <- Store.getAllDeprecated preferredStore
setCalculatedTag (Tag "deprecated") (Map.keysSet pkgs)
CoreResource{..} = coreResource
@@ -212,7 +212,7 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
handlePackagesDeprecatedGet :: DynamicPath -> ServerPartE Response
handlePackagesDeprecatedGet _ = do
- deprPkgs <- deprecatedMap <$> Store.getPreferredVersions preferredStore
+ deprPkgs <- Store.getAllDeprecated preferredStore
return $ toResponse $ array
[ object
[ ("deprecated-package", string $ display deprPkg)
@@ -387,16 +387,16 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
Store.getDeprecatedFor preferredStore pkgname
doPreferredsRender :: MonadIO m => m [(PackageName, PreferredRender)]
- doPreferredsRender = Store.getPreferredVersions preferredStore >>=
- return . map (second renderPrefInfo) . Map.toList . preferredMap
+ doPreferredsRender = Store.getAllPreferredInfo preferredStore >>=
+ return . map (second renderPrefInfo) . Map.toList
doDeprecatedsRender :: MonadIO m => m [(PackageName, [PackageName])]
- doDeprecatedsRender = Store.getPreferredVersions preferredStore >>=
- return . Map.toList . deprecatedMap
+ doDeprecatedsRender = Store.getAllDeprecated preferredStore >>=
+ return . Map.toList
makeGlobalPreferredVersions :: (Functor m, MonadIO m) => m String
makeGlobalPreferredVersions = do
- prefs <- preferredMap <$> Store.getPreferredVersions preferredStore
+ prefs <- Store.getAllPreferredInfo preferredStore
return $! formatGlobalPreferredVersions (Map.toList prefs)
formatSinglePreferredVersions :: PackageName -> PreferredInfo -> Maybe String
@@ -422,10 +422,10 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
-- One-off complex migration
ephemeralPrefsMigration = do
- PreferredVersions {migratedEphemeralPrefs, preferredMap}
- <- Store.getPreferredVersions preferredStore
+ migratedEphemeralPrefs <- Store.isMigratedEphemeralPrefs preferredStore
unless migratedEphemeralPrefs $
logTiming verbosity "preferred-versions migration" $ do
+ preferredMap <- Store.getAllPreferredInfo preferredStore
sequence_
[ updateIndexPackagePreferredVersions pkgname prefinfo
| (pkgname, prefinfo) <- Map.toList preferredMap ]
diff --git a/src/Distribution/Server/Features/PreferredVersions/Acid.hs b/src/Distribution/Server/Features/PreferredVersions/Acid.hs
index a96406242..9ca4847bd 100644
--- a/src/Distribution/Server/Features/PreferredVersions/Acid.hs
+++ b/src/Distribution/Server/Features/PreferredVersions/Acid.hs
@@ -15,7 +15,9 @@ acidStore stateDir = do
Store.backendStore = Store.Store {
Store.getPreferredInfo = \name -> queryState preferredState (State.GetPreferredInfo name)
, Store.getDeprecatedFor = \name -> queryState preferredState (State.GetDeprecatedFor name)
- , Store.getPreferredVersions = queryState preferredState State.GetPreferredVersions
+ , Store.getAllPreferredInfo = State.preferredMap <$> queryState preferredState State.GetPreferredVersions
+ , Store.getAllDeprecated = State.deprecatedMap <$> queryState preferredState State.GetPreferredVersions
+ , Store.isMigratedEphemeralPrefs = State.migratedEphemeralPrefs <$> queryState preferredState State.GetPreferredVersions
, Store.setDeprecatedFor = \name deprs -> updateState preferredState (State.SetDeprecatedFor name deprs)
, Store.setPreferredInfo = \name ranges versions -> updateState preferredState (State.SetPreferredInfo name ranges versions)
, Store.setMigratedEphemeralPrefs = updateState preferredState State.SetMigratedEphemeralPrefs
diff --git a/src/Distribution/Server/Features/PreferredVersions/Store.hs b/src/Distribution/Server/Features/PreferredVersions/Store.hs
index e49450f60..8a6f6e50e 100644
--- a/src/Distribution/Server/Features/PreferredVersions/Store.hs
+++ b/src/Distribution/Server/Features/PreferredVersions/Store.hs
@@ -6,11 +6,12 @@ module Distribution.Server.Features.PreferredVersions.Store
) where
import Distribution.Package (PackageName)
-import Distribution.Server.Features.PreferredVersions.State (PreferredInfo, PreferredVersions)
+import Distribution.Server.Features.PreferredVersions.State (PreferredInfo)
import Distribution.Server.Framework (AbstractStateComponent)
import Distribution.Version (Version, VersionRange)
import Control.Monad.Trans (MonadIO)
+import Data.Map (Map)
data Backend = Backend {
backendStore :: Store
@@ -20,7 +21,9 @@ data Backend = Backend {
data Store = Store {
getPreferredInfo :: forall m. MonadIO m => PackageName -> m PreferredInfo
, getDeprecatedFor :: forall m. MonadIO m => PackageName -> m (Maybe [PackageName])
- , getPreferredVersions :: forall m. MonadIO m => m PreferredVersions
+ , getAllPreferredInfo :: forall m. MonadIO m => m (Map PackageName PreferredInfo)
+ , getAllDeprecated :: forall m. MonadIO m => m (Map PackageName [PackageName])
+ , isMigratedEphemeralPrefs :: forall m. MonadIO m => m Bool
, setDeprecatedFor :: forall m. MonadIO m => PackageName -> Maybe [PackageName] -> m ()
, setPreferredInfo :: forall m. MonadIO m => PackageName -> [VersionRange] -> [Version] -> m PreferredInfo
, setMigratedEphemeralPrefs :: forall m. MonadIO m => m ()
diff --git a/src/Distribution/Server/Features/ReverseDependencies.hs b/src/Distribution/Server/Features/ReverseDependencies.hs
index 2bdbe1ac2..0df3b656c 100644
--- a/src/Distribution/Server/Features/ReverseDependencies.hs
+++ b/src/Distribution/Server/Features/ReverseDependencies.hs
@@ -12,7 +12,6 @@ module Distribution.Server.Features.ReverseDependencies (
import Distribution.Server.Framework
import Distribution.Server.Features.Core
import Distribution.Server.Features.PreferredVersions
-import Distribution.Server.Features.PreferredVersions.State (PreferredVersions)
import qualified Distribution.Server.Packages.PackageIndex as PackageIndex
import Distribution.Server.Packages.PackageIndex (PackageIndex, packageNames, allPackagesByNameNE)
import Distribution.Server.Packages.Types (PkgInfo)
@@ -84,11 +83,11 @@ initReverseFeature _ = do
updateReverse <- newHook
return $ \CoreFeature{queryGetPackageIndex,packageChangeHook}
- VersionsFeature{queryGetPreferredVersions} -> do
+ VersionsFeature{queryAllPreferredInfo} -> do
idx <- queryGetPackageIndex
memState <- newMemStateWHNF $ constructReverseIndex idx
- let feature = reverseFeature queryGetPackageIndex queryGetPreferredVersions memState updateReverse
+ let feature = reverseFeature queryGetPackageIndex queryAllPreferredInfo memState updateReverse
registerHookJust packageChangeHook isPackageChangeAny $ \(pkgid, mpkginfo) ->
case mpkginfo of
@@ -125,13 +124,13 @@ instance ToJSON Edge
-- instance ToJSON PackageName
reverseFeature :: IO (PackageIndex PkgInfo)
- -> IO PreferredVersions
+ -> IO (Map.Map PackageName PreferredInfo)
-> MemState ReverseIndex
-> Hook [NE.NonEmpty PkgInfo] ()
-> ReverseFeature
reverseFeature queryGetPackageIndex
- queryGetPreferredVersions
+ queryAllPreferredInfo
reverseMemState
reverseHook
= ReverseFeature{..}
@@ -211,7 +210,7 @@ reverseFeature queryGetPackageIndex
revDisplayInfo :: MonadIO m => m VersionIndex
revDisplayInfo = do
pkgIndex <- liftIO queryGetPackageIndex
- prefs <- liftIO queryGetPreferredVersions
+ prefs <- liftIO queryAllPreferredInfo
return $ getDisplayInfo prefs pkgIndex
renderReverseWith :: MonadIO m => PackageName -> ReverseDisplay -> (Maybe VersionStatus -> Bool) -> m ReversePageRender
diff --git a/src/Distribution/Server/Features/ReverseDependencies/State.hs b/src/Distribution/Server/Features/ReverseDependencies/State.hs
index a8345fe3f..781981f25 100644
--- a/src/Distribution/Server/Features/ReverseDependencies/State.hs
+++ b/src/Distribution/Server/Features/ReverseDependencies/State.hs
@@ -181,9 +181,9 @@ constructReverseDisplay :: (PackageName -> (PreferredInfo, [Version])) -> Map Pa
constructReverseDisplay indexFunc =
Map.mapMaybeWithKey (uncurry maybeBestVersion . indexFunc)
-getDisplayInfo :: PreferredVersions -> PackageIndex PkgInfo -> VersionIndex
+getDisplayInfo :: Map PackageName PreferredInfo -> PackageIndex PkgInfo -> VersionIndex
getDisplayInfo preferred index pkgname = (,)
- (Map.findWithDefault emptyPreferredInfo pkgname $ preferredMap preferred)
+ (Map.findWithDefault emptyPreferredInfo pkgname preferred)
(map packageVersion . PackageIndex.lookupPackageName index $ pkgname)
diff --git a/src/Distribution/Server/Features/Sitemap.hs b/src/Distribution/Server/Features/Sitemap.hs
index 04fcc0cc1..a2cf95653 100644
--- a/src/Distribution/Server/Features/Sitemap.hs
+++ b/src/Distribution/Server/Features/Sitemap.hs
@@ -155,7 +155,7 @@ sitemapFeature ServerEnv{..}
updateSitemapCache :: IO Sitemap
updateSitemapCache = do
- alltags <- queryGetTagList
+ alltags <- queryTagCounts
pkgIndex <- queryGetPackageIndex
docIndex <- queryDocumentationIndex
diff --git a/src/Distribution/Server/Features/Tags.hs b/src/Distribution/Server/Features/Tags.hs
index b9a6fa112..6e2a95d71 100644
--- a/src/Distribution/Server/Features/Tags.hs
+++ b/src/Distribution/Server/Features/Tags.hs
@@ -45,7 +45,8 @@ data TagsFeature = TagsFeature {
tagsResource :: TagsResource,
- queryGetTagList :: forall m. MonadIO m => m [(Tag, Set PackageName)],
+ -- | Retrieves every tag with its number of packages, in tag order.
+ queryTagCounts :: forall m. MonadIO m => m [(Tag, Int)],
queryTagsForPackage :: forall m. MonadIO m => PackageName -> m (Set Tag),
queryReviewTagsForPackage :: forall m. MonadIO m => PackageName -> m (Set Tag,Set Tag),
queryAliasForTag :: forall m. MonadIO m => Tag -> m Tag,
@@ -178,8 +179,8 @@ tagsFeature CoreFeature{ queryLatestPackages }
let calcTags' = Map.toList . Map.fromListWith Set.union $ zip aliases (Map.elems calcTags)
forM_ calcTags' $ uncurry setCalculatedTag
- queryGetTagList :: MonadIO m => m [(Tag, Set PackageName)]
- queryGetTagList = Store.getTagList tagsStore
+ queryTagCounts :: MonadIO m => m [(Tag, Int)]
+ queryTagCounts = Store.getTagCounts tagsStore
queryTagsForPackage :: MonadIO m => PackageName -> m (Set Tag)
queryTagsForPackage = Store.getTagsForPackage tagsStore
@@ -204,9 +205,7 @@ tagsFeature CoreFeature{ queryLatestPackages }
func tag pkgs
collectTags :: MonadIO m => Set PackageName -> m (Map PackageName (Set Tag))
- collectTags pkgs = do
- pkgMap <- liftM State.packageTags $ Store.getPackageTags tagsStore
- return $ Map.fromDistinctAscList . map (\pkg -> (pkg, Map.findWithDefault Set.empty pkg pkgMap)) $ Set.toList pkgs
+ collectTags pkgs = Store.getTagsForPackages tagsStore (Set.toList pkgs)
mergeTags :: Maybe String -> Tag -> ServerPartE ()
mergeTags targetTag deprTag =
diff --git a/src/Distribution/Server/Features/Tags/Acid.hs b/src/Distribution/Server/Features/Tags/Acid.hs
index 14995306a..2b2a0e125 100644
--- a/src/Distribution/Server/Features/Tags/Acid.hs
+++ b/src/Distribution/Server/Features/Tags/Acid.hs
@@ -10,18 +10,24 @@ import Distribution.Server.Features.Tags.Backup
import Distribution.Server.Framework
import Distribution.Server.Framework.BackupDump
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
acidStore :: FilePath -> IO Store.Backend
acidStore stateDir = do
tagsState <- tagsStateComponent stateDir
tagAlias <- tagsAliasComponent stateDir
pure Store.Backend {
Store.backendStore = Store.Store {
- Store.getTagList = queryState tagsState State.GetTagList
+ Store.getTagCounts = map (fmap Set.size) <$> queryState tagsState State.GetTagList
, Store.getTagsForPackage = \pkgname -> queryState tagsState (State.TagsForPackage pkgname)
, Store.getReviewTagsForPackage = \pkgname -> queryState tagsState (State.LookupReviewTags pkgname)
, Store.getTagAlias = \tag -> queryState tagAlias (State.GetTagAlias tag)
, Store.getPackagesForTag = \tag -> queryState tagsState (State.PackagesForTag tag)
- , Store.getPackageTags = queryState tagsState State.GetPackageTags
+ , Store.getTagsForPackages = \pkgnames -> do
+ pkgTags <- State.packageTags <$> queryState tagsState State.GetPackageTags
+ pure $ Map.fromList
+ [ (pkgname, Map.findWithDefault Set.empty pkgname pkgTags) | pkgname <- pkgnames ]
, Store.setPackageTags = \pkgname tags -> updateState tagsState (State.SetPackageTags pkgname tags)
, Store.setTagPackages = \tag pkgs -> updateState tagsState (State.SetTagPackages tag pkgs)
, Store.addTagAlias = \tag alias -> updateState tagAlias (State.AddTagAlias tag alias)
diff --git a/src/Distribution/Server/Features/Tags/Store.hs b/src/Distribution/Server/Features/Tags/Store.hs
index d303b0668..4988efcda 100644
--- a/src/Distribution/Server/Features/Tags/Store.hs
+++ b/src/Distribution/Server/Features/Tags/Store.hs
@@ -6,11 +6,11 @@ module Distribution.Server.Features.Tags.Store
) where
import Distribution.Package (PackageName)
-import Distribution.Server.Features.Tags.State (PackageTags)
import Distribution.Server.Features.Tags.Types (Tag)
import Distribution.Server.Framework (AbstractStateComponent)
import Control.Monad.Trans (MonadIO)
+import Data.Map (Map)
import Data.Set (Set)
data Backend = Backend {
@@ -19,12 +19,14 @@ data Backend = Backend {
}
data Store = Store {
- getTagList :: forall m. MonadIO m => m [(Tag, Set PackageName)]
+ -- | Every tag with its number of packages, in tag order.
+ getTagCounts :: forall m. MonadIO m => m [(Tag, Int)]
, getTagsForPackage :: forall m. MonadIO m => PackageName -> m (Set Tag)
, getReviewTagsForPackage :: forall m. MonadIO m => PackageName -> m (Set Tag, Set Tag)
, getTagAlias :: forall m. MonadIO m => Tag -> m Tag
, getPackagesForTag :: forall m. MonadIO m => Tag -> m (Set PackageName)
- , getPackageTags :: forall m. MonadIO m => m PackageTags
+ -- | The tags of each given package, including packages with none.
+ , getTagsForPackages :: forall m. MonadIO m => [PackageName] -> m (Map PackageName (Set Tag))
, setPackageTags :: forall m. MonadIO m => PackageName -> Set Tag -> m ()
, setTagPackages :: forall m. MonadIO m => Tag -> Set PackageName -> m ()
, addTagAlias :: forall m. MonadIO m => Tag -> Tag -> m ()
diff --git a/src/Distribution/Server/Features/Votes.hs b/src/Distribution/Server/Features/Votes.hs
index b23761e8c..c4db6ebc6 100644
--- a/src/Distribution/Server/Features/Votes.hs
+++ b/src/Distribution/Server/Features/Votes.hs
@@ -14,8 +14,7 @@ import Distribution.Server.Features.Votes.Types (Score)
import Distribution.Server.Features.Votes.Acid (acidStore)
import qualified Distribution.Server.Features.Votes.Render as Render
import Distribution.Server.Features.Votes.Store
- ( votesScore
- , Backend(..)
+ ( Backend(..)
, Store(..) )
import Distribution.Server.Framework
@@ -125,10 +124,10 @@ votesFeature ServerEnv{..}
servePackageVotesGet :: DynamicPath -> ServerPartE Response
servePackageVotesGet _ = do
cacheControlWithoutETag [Public, maxAgeMinutes 10]
- votesMap <- getAllPackageVoteSets votesState
+ scores <- getAllPackageVoteScores votesState
ok . toResponse $ objectL
- [ (display pkgname, toJSON (votesScore pkgMap))
- | (pkgname, pkgMap) <- Map.toList votesMap ]
+ [ (display pkgname, toJSON score)
+ | (pkgname, score) <- Map.toList scores ]
-- Get the number of votes a package has. If the package
-- has never been voted for, returns 0.
diff --git a/src/Distribution/Server/Features/Votes/Acid.hs b/src/Distribution/Server/Features/Votes/Acid.hs
index aa9ee0997..7b8eee354 100644
--- a/src/Distribution/Server/Features/Votes/Acid.hs
+++ b/src/Distribution/Server/Features/Votes/Acid.hs
@@ -16,7 +16,7 @@ acidStore stateDir = do
votesState <- votesStateComponent stateDir
return Backend {
backendStore = Store {
- getAllPackageVoteSets = queryState votesState Acid.GetAllPackageVoteSets
+ getAllPackageVoteScores = Map.map votesScore <$> queryState votesState Acid.GetAllPackageVoteSets
, addVote = \pkgname uid score -> updateState votesState (Acid.AddVote pkgname uid score)
, removeVote = \pkgname uid -> updateState votesState (Acid.RemoveVote pkgname uid)
, getPackageVoteCount = \pkgname -> queryState votesState (Acid.GetPackageVoteCount pkgname)
diff --git a/src/Distribution/Server/Features/Votes/Store.hs b/src/Distribution/Server/Features/Votes/Store.hs
index 5cc87fd61..010b42cbf 100644
--- a/src/Distribution/Server/Features/Votes/Store.hs
+++ b/src/Distribution/Server/Features/Votes/Store.hs
@@ -24,7 +24,7 @@ data Backend = Backend {
}
data Store = Store {
- getAllPackageVoteSets :: forall m. MonadIO m => m (Map.Map PackageName (Map.Map UserId Score))
+ getAllPackageVoteScores :: forall m. MonadIO m => m (Map.Map PackageName Float)
, addVote :: forall m. MonadIO m => PackageName -> UserId -> Score -> m Float
, removeVote :: forall m. MonadIO m => PackageName -> UserId -> m Bool
, getPackageVoteCount :: forall m. MonadIO m => PackageName -> m Int
diff --git a/tests/ReverseDependenciesTest.hs b/tests/ReverseDependenciesTest.hs
index b536633eb..88b03cf76 100644
--- a/tests/ReverseDependenciesTest.hs
+++ b/tests/ReverseDependenciesTest.hs
@@ -23,7 +23,7 @@ import Network.URI (parseURI)
import System.Random (mkStdGen)
import Distribution.Package (PackageIdentifier(..), mkPackageName, packageId, packageName)
-import Distribution.Server.Features.PreferredVersions.State (PreferredVersions(..), PreferredInfo(..))
+import Distribution.Server.Features.PreferredVersions.State (PreferredInfo(..))
import Distribution.Server.Features.PreferredVersions.Types (VersionStatus(NormalVersion))
import Distribution.Server.Features.ReverseDependencies (ReverseFeature(..), ReverseCount(..), reverseFeature)
import Distribution.Server.Features.ReverseDependencies.State (ReverseIndex(..), addPackage, constructReverseIndex, emptyReverseIndex, getDependenciesFlat, getDependencies, getDependenciesFlatRaw, getDependenciesRaw)
@@ -123,19 +123,13 @@ mkRevFeat :: [PkgInfo] -> IO ReverseFeature
mkRevFeat pkgs = do
let
idx = PackageIndex.fromList pkgs
- preferredVersions =
- PreferredVersions
- { preferredMap = mempty
- , deprecatedMap = mempty
- , migratedEphemeralPrefs = False
- }
updateReverse <- newHook
let constructed = constructReverseIndex idx
memState <- newMemStateWHNF constructed
pure $
reverseFeature
(pure idx)
- (pure preferredVersions)
+ (pure mempty)
memState
updateReverse