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