Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 11 additions & 9 deletions src/Distribution/Server/Features/PackageList.hs
Original file line number Diff line number Diff line change
Expand Up @@ -34,9 +34,10 @@ import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.Utils.ShortText (fromShortText)
import Distribution.Simple.Utils (safeLast)

import Control.Concurrent
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (mapMaybe)
import Data.Map (Map)
import qualified Data.Map as Map
Expand Down Expand Up @@ -233,9 +234,9 @@ listFeature CoreFeature{..}
False -> do
index <- queryGetPackageIndex
let pkgs = PackageIndex.lookupPackageName index pkgname
case pkgs of
[] -> return () --this shouldn't happen
_ -> modifyMemState itemCache . uncurry Map.insert =<< constructItem pkgs
case NE.nonEmpty pkgs of
Nothing -> return () --this shouldn't happen
Just ne -> modifyMemState itemCache . uncurry Map.insert =<< constructItem ne

updateDesc pkgname = do
index <- queryGetPackageIndex
Expand All @@ -256,13 +257,14 @@ listFeature CoreFeature{..}
constructItemIndex :: IO (Map PackageName PackageItem)
constructItemIndex = do
index <- queryGetPackageIndex
items <- mapM constructItem $ PackageIndex.allPackagesByName index
return $ Map.fromList items
let byName = PackageIndex.allPackagesByNameNE index
mPkgInfos <- traverse (mapM constructItem) (NE.nonEmpty byName)
pure $ foldMap (Map.fromList . NE.toList) mPkgInfos

constructItem :: [PkgInfo] -> IO (PackageName, PackageItem)
constructItem :: NonEmpty PkgInfo -> IO (PackageName, PackageItem)
constructItem pkgs = do
let pkgname = packageName pkg
pkg = last pkgs
pkg = NE.last pkgs
-- [reverse index disabled] revCount <- query . GetReverseCount $ pkgname
users <- queryGetUserDb
tags <- queryTagsForPackage pkgname
Expand All @@ -271,7 +273,7 @@ listFeature CoreFeature{..}
deprs <- queryGetDeprecatedFor pkgname
maintainers <- queryUserGroup (maintainersGroup pkgname)
packageR <- rankPackage versions (cmFind pkgname downs)
(UserIdSet.size maintainers) documentation tar env pkgs (safeLast pkgs)
(UserIdSet.size maintainers) documentation tar env pkgs

return $ (,) pkgname $ (updateDescriptionItem (pkgDesc pkg) $ emptyPackageItem pkgname) {
itemTags = tags
Expand Down
15 changes: 8 additions & 7 deletions src/Distribution/Server/Features/PackageList/PackageRank.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,8 @@ import Control.Exception ( SomeException(..)
import qualified Data.ByteString.Lazy as BSL
import Data.List ( maximumBy
, sortBy )
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty ( NonEmpty )
import Data.Maybe ( isNothing )
import Data.Ord ( comparing )
import qualified Data.Time.Clock as CL
Expand Down Expand Up @@ -299,11 +301,9 @@ rankPackage
-> DocumentationFeature
-> TarIndexCacheFeature
-> ServerEnv
-> [PkgInfo]
-> Maybe PkgInfo
-> NonEmpty PkgInfo
-> IO Float
rankPackage _ _ _ _ _ _ _ Nothing = return 0
rankPackage versions recentDownloads maintainers docs tarCache env pkgs (Just pkgUsed)
rankPackage versions recentDownloads maintainers docs tarCache env pkgs
= do
t <- temporalScore pkgD uploads versionList recentDownloads

Expand All @@ -320,15 +320,16 @@ rankPackage versions recentDownloads maintainers docs tarCache env pkgs (Just pk
Nothing -> 1
_ -> 0.2
where
pkgUsed = NE.last pkgs
pkgname = pkgName . package $ pkgD
pkgD = packageDescription . pkgDesc $ pkgUsed
deprP = queryGetDeprecatedFor versions pkgname
sAverage x y = (total x + total y) * 0.5

versionList :: [Version]
versionList = sortBy (flip compare)
$ map (pkgVersion . package . packageDescription) (pkgDesc <$> pkgs)
$ map (pkgVersion . package . packageDescription . pkgDesc) (NE.toList pkgs)
uploads =
sortBy (flip compare)
$ (fst . pkgOriginalUploadInfo <$> pkgs)
++ (fst . pkgLatestUploadInfo <$> pkgs)
$ (fst . pkgOriginalUploadInfo <$> NE.toList pkgs)
++ (fst . pkgLatestUploadInfo <$> NE.toList pkgs)
10 changes: 9 additions & 1 deletion src/Distribution/Server/Packages/PackageIndex.hs
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,8 @@ module Distribution.Server.Packages.PackageIndex (
-- ** Bulk queries
allPackageNames,
allPackages,
allPackagesByName
allPackagesByName,
allPackagesByNameNE
) where

import Distribution.Server.Prelude hiding (lookup)
Expand All @@ -58,6 +59,8 @@ import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)
import qualified Data.Foldable as Foldable
import Data.List (groupBy, find, isInfixOf)
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty)
import Data.SafeCopy

import Distribution.Types.PackageName
Expand Down Expand Up @@ -258,6 +261,11 @@ allPackages (PackageIndex m) = concat (Map.elems m)
allPackagesByName :: Package pkg => PackageIndex pkg -> [[pkg]]
allPackagesByName (PackageIndex m) = Map.elems m

allPackagesByNameNE :: Package pkg => PackageIndex pkg -> [NonEmpty pkg]
allPackagesByNameNE (PackageIndex m) =
-- This is safe because there will always be at least one version of a package
NE.fromList <$> Map.elems m

allPackageNames :: PackageIndex pkg -> [PackageName]
allPackageNames (PackageIndex m) = Map.keys m

Expand Down