Simplify getting all package names and use itemCache in Browse (#1049)

* Simplify getting all package names

* Browse: Avoid linear amount of map lookups

Author: ysangkok

src/Distribution/Server/Features/Browse.hs

@@ -6,6 +6,7 @@ import Control.Monad.Except (ExceptT, liftIO, throwError)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Except (except)
 import Data.ByteString.Lazy (ByteString)
+import qualified Data.Map as Map
 import Data.Time (getCurrentTime)
 
 import Data.Aeson (Value(Array), eitherDecode, object, toJSON, (.=))
@@ -14,17 +15,16 @@ import qualified Data.Vector as V
 
 import Distribution.Server.Features.Browse.ApplyFilter (applyFilter)
 import Distribution.Server.Features.Browse.Options (BrowseOptions(..), IsSearch(..))
-import Distribution.Server.Features.Core (CoreFeature(CoreFeature), queryGetPackageIndex, coreResource)
+import Distribution.Server.Features.Core (CoreFeature(CoreFeature), coreResource)
 import Distribution.Server.Features.Distro (DistroFeature)
-import Distribution.Server.Features.PackageList (ListFeature(ListFeature), makeItemList)
+import Distribution.Server.Features.PackageList (ListFeature(ListFeature), getAllLists, makeItemList)
 import Distribution.Server.Features.Search (SearchFeature(SearchFeature), searchPackages)
 import Distribution.Server.Features.Tags (TagsFeature(TagsFeature), tagsResource)
 import Distribution.Server.Features.Users (UserFeature(UserFeature), userResource)
 import Distribution.Server.Framework.Error (ErrorResponse(ErrorResponse))
 import Distribution.Server.Framework.Feature (HackageFeature(..), emptyHackageFeature)
 import Distribution.Server.Framework.Resource (Resource(..), resourceAt)
 import Distribution.Server.Framework.ServerEnv (ServerEnv(..))
-import qualified Distribution.Server.Pages.Index as Pages
 
 import Happstack.Server.Monads (ServerPartT)
 import Happstack.Server.Response (ToMessage(toResponse))
@@ -92,14 +92,18 @@ paginate PaginationConfig{totalNumberOfElements, pageNumber} = do
    )
 
 getNewPkgList :: CoreFeature -> UserFeature -> TagsFeature -> ListFeature -> SearchFeature -> DistroFeature -> ServerPartT (ExceptT ErrorResponse IO) Response
-getNewPkgList CoreFeature{queryGetPackageIndex, coreResource} UserFeature{userResource} TagsFeature{tagsResource} ListFeature{makeItemList} SearchFeature{searchPackages} distroFeature = do
+getNewPkgList CoreFeature{coreResource} UserFeature{userResource} TagsFeature{tagsResource} ListFeature{getAllLists, makeItemList} SearchFeature{searchPackages} distroFeature = do
   browseOptionsBS <- lookBS "browseOptions"
   browseOptions <- lift (parseBrowseOptions browseOptionsBS)
-  (isSearch, packageNames) <-
-    case boSearchTerms browseOptions of
-      [] ->    (IsNotSearch,) <$> Pages.toPackageNames <$> queryGetPackageIndex
-      terms -> (IsSearch,)    <$> liftIO (searchPackages terms)
-  pkgDetails <- liftIO (makeItemList packageNames)
+  (isSearch, pkgDetails) <-
+    liftIO $ case boSearchTerms browseOptions of
+      [] -> do
+        allItemsMap <- getAllLists
+        pure (IsNotSearch, Map.elems allItemsMap)
+      terms -> do
+        packageNames <- searchPackages terms
+        items <- makeItemList packageNames
+        pure (IsSearch, items)
   now <- liftIO getCurrentTime
   listOfPkgs <- liftIO $ applyFilter now isSearch coreResource userResource tagsResource distroFeature browseOptions pkgDetails
   let config =

src/Distribution/Server/Features/Core.hs

@@ -683,8 +683,8 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
     servePackageList :: DynamicPath -> ServerPartE Response
     servePackageList _ = do
       pkgIndex <- queryGetPackageIndex
-      let pkgs = PackageIndex.allPackagesByName pkgIndex
-          list = [display . pkgName . pkgInfoId $ pkg | pkg <- map head pkgs]
+      let pkgNames = PackageIndex.allPackageNames pkgIndex
+          list = map display pkgNames
       -- We construct the JSON manually so that we control what it looks like;
       -- in particular, we use objects for the packages so that we can add
       -- additional fields later without (hopefully) breaking clients

src/Distribution/Server/Features/Tags.hs

@@ -242,10 +242,8 @@ tagsFeature CoreFeature{ queryGetPackageIndex }
 
     -- tags on merging
     constructMergedTagIndex :: forall m. (Functor m, MonadIO m) => Tag -> Tag -> PackageIndex PkgInfo -> m PackageTags
-    constructMergedTagIndex orig depr = foldM addToTags emptyPackageTags . PackageIndex.allPackagesByName
-      where addToTags calcTags pkgList = do
-                let info = pkgDesc $ last pkgList
-                    !pn = packageName info
+    constructMergedTagIndex orig depr = foldM addToTags emptyPackageTags . PackageIndex.allPackageNames
+      where addToTags calcTags pn = do
                 pkgTags <- queryTagsForPackage pn
                 if Set.member depr pkgTags
                     then do

src/Distribution/Server/Packages/PackageIndex.hs

@@ -42,6 +42,7 @@ module Distribution.Server.Packages.PackageIndex (
     searchByNameSubstring,
 
     -- ** Bulk queries
+    allPackageNames,
     allPackages,
     allPackagesByName
   ) where
@@ -257,6 +258,9 @@ allPackages (PackageIndex m) = concat (Map.elems m)
 allPackagesByName :: Package pkg => PackageIndex pkg -> [[pkg]]
 allPackagesByName (PackageIndex m) = Map.elems m
 
+allPackageNames :: PackageIndex pkg -> [PackageName]
+allPackageNames (PackageIndex m) = Map.keys m
+
 --
 -- * Lookups
 --

src/Distribution/Server/Pages/Index.hs

@@ -1,6 +1,6 @@
 -- Generate an HTML page listing all available packages
 
-module Distribution.Server.Pages.Index (packageIndex, toPackageNames) where
+module Distribution.Server.Pages.Index (packageIndex) where
 
 import Distribution.Server.Pages.Template       ( hackagePage )
 import Distribution.Server.Pages.Util           ( packageType )
@@ -31,15 +31,6 @@ packageIndex = formatPkgGroups
                       . maximumBy (comparing packageVersion))
                  . PackageIndex.allPackagesByName
 
-toPackageNames :: PackageIndex.PackageIndex PkgInfo -> [PackageName]
-toPackageNames = map (pii_pkgName
-                      . mkPackageIndexInfo
-                      . flattenPackageDescription
-                      . pkgDesc
-                      . maximumBy (comparing packageVersion))
-                 . PackageIndex.allPackagesByName
-
-
 data PackageIndexInfo = PackageIndexInfo {
                             pii_pkgName :: !PackageName,
                             pii_categories :: ![Category],