Reverse Dependencies

Distribution/Server/Features.hs

@@ -31,7 +31,7 @@ import Distribution.Server.Features.Documentation       (initDocumentationFeatur
 import Distribution.Server.Features.BuildReports        (initBuildReportsFeature)
 import Distribution.Server.Features.LegacyRedirects     (legacyRedirectsFeature)
 import Distribution.Server.Features.PreferredVersions   (initVersionsFeature)
--- [reverse index disabled] import Distribution.Server.Features.ReverseDependencies (initReverseFeature)
+import Distribution.Server.Features.ReverseDependencies (initReverseFeature)
 import Distribution.Server.Features.DownloadCount       (initDownloadFeature)
 import Distribution.Server.Features.Tags                (initTagsFeature)
 import Distribution.Server.Features.Search              (initSearchFeature)
@@ -127,8 +127,8 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
                                initTagsFeature env
     mkVersionsFeature       <- logStartup "versions" $
                                initVersionsFeature env
-    -- mkReverseFeature     <- logStartup "reverse deps" $
-    --                         initReverseFeature env
+    mkReverseFeature     <- logStartup "reverse deps" $
+                            initReverseFeature env
     mkListFeature           <- logStartup "list" $
                                initListFeature env
     mkSearchFeature         <- logStartup "search" $
@@ -248,15 +248,14 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
                          uploadFeature
                          tagsFeature
 
-    {- [reverse index disabled]
     reverseFeature  <- mkReverseFeature
                          coreFeature
                          versionsFeature
-                         -}
+
 
     listFeature     <- mkListFeature
                          coreFeature
-                         -- [reverse index disabled] reverseFeature
+                         reverseFeature
                          downloadFeature
                          votesFeature
                          tagsFeature
@@ -277,7 +276,7 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
                          uploadFeature
                          candidatesFeature
                          versionsFeature
-                         -- [reverse index disabled] reverseFeature
+                         reverseFeature
                          tagsFeature
                          downloadFeature
                          votesFeature

Distribution/Server/Features/Html/HtmlUtilities.hs

@@ -25,6 +25,9 @@ data HtmlUtilities = HtmlUtilities {
   , makeRow :: PackageItem -> Html
   , renderTags :: Set Tag -> [Html]
   , renderReviewTags :: Set Tag -> (Set Tag, Set Tag) -> PackageName -> [Html]
+  , renderDeps :: PackageName -> ([PackageName], [PackageName]) -> Html
+  , renderPkgPageDeps :: ([PackageName], [PackageName]) -> Html
+
   }
 
 htmlUtilities :: CoreFeature -> TagsFeature -> UserFeature -> HtmlUtilities
@@ -41,6 +44,7 @@ htmlUtilities CoreFeature{coreResource}
     makeRow item = tr << [ td $ itemNameHtml
                          , td $ toHtml $ show $ itemDownloads item
                          , td $ toHtml $ show $ itemVotes item
+                         , td $ toHtml $ show $ itemRevDepsCount item
                          , td $ toHtml $ itemDesc item
                          , td $ " (" +++ renderTags (itemTags item) +++ ")"
                          , td $ toHtml $ formatTime defaultTimeLocale "%F" (itemLastUpload item)
@@ -91,4 +95,23 @@ htmlUtilities CoreFeature{coreResource}
             ]
 
 
+    renderPkgPageDeps :: ([PackageName], [PackageName])-> Html
+    renderPkgPageDeps (direct, indirect) =
+        map toHtml [show (length direct), " direct", ", ", show (length indirect), " indirect "] +++
+            thespan ! [thestyle "font-size: small", theclass "revdepdetails"]
+                << (" [" +++ anchor ! [href ""] << "details" +++ "]")
+
+    renderDeps :: PackageName -> ([PackageName], [PackageName])-> Html
+    renderDeps pkg (direct, indirect) =
+        (if null direct then (toHtml "") else summary "Direct" direct) +++
+        (if null indirect then (toHtml "") else summary "Indirect" indirect) +++
+        detailsLink
+      where
+        summary title_ dep = thediv << [ bold (toHtml title_), br
+                                     , p << intersperse (toHtml ", ") (map packageNameLink dep)
+                                     ]
+        detailsLink = thespan ! [thestyle "font-size: small"]
+                        << (" [" +++ anchor ! [href detailURL] << "details" +++ "]")
+        detailURL = "/package/" ++ unPackageName pkg ++ "/reverse"
+
     cores = coreResource

Distribution/Server/Features/PackageList.hs

@@ -9,7 +9,7 @@ module Distribution.Server.Features.PackageList (
 import Distribution.Server.Framework
 
 import Distribution.Server.Features.Core
--- [reverse index disabled] import Distribution.Server.Features.ReverseDependencies
+import Distribution.Server.Features.ReverseDependencies
 import Distribution.Server.Features.Votes
 import Distribution.Server.Features.DownloadCount
 import Distribution.Server.Features.Tags
@@ -23,15 +23,14 @@ import qualified Distribution.Server.Packages.PackageIndex as PackageIndex
 import Distribution.Server.Util.CountingMap (cmFind)
 
 import Distribution.Server.Packages.Types
--- [reverse index disabled] import Distribution.Server.Packages.Reverse
 import Distribution.Server.Users.Types
 
 import Distribution.Package
 import Distribution.PackageDescription
 import Distribution.PackageDescription.Configuration
 
 import Control.Concurrent
-import Data.Maybe (catMaybes)
+import Data.Maybe (mapMaybe)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
@@ -74,7 +73,7 @@ data PackageItem = PackageItem {
     itemDownloads :: !Int,
     -- The number of direct revdeps. (Likewise.)
     -- also: distinguish direct/flat?
-    -- [reverse index disabled] itemRevDepsCount :: !Int,
+    itemRevDepsCount :: !Int,
     -- Whether there's a library here.
     itemHasLibrary :: !Bool,
     -- How many executables (>=0) this package has.
@@ -84,23 +83,24 @@ data PackageItem = PackageItem {
     -- How many benchmarks (>=0) this package has.
     itemNumBenchmarks :: !Int,
     -- Last upload date
-    itemLastUpload :: !UTCTime
-    -- Hotness: a more heuristic way to sort packages. presently non-existent.
-  --itemHotness :: Int
+    itemLastUpload :: !UTCTime,
+    -- Hotness: a more heuristic way to sort packages
+    -- Hotness = recent downloads + stars + 2 * no rev deps
+    itemHotness :: !Float
 }
 
 instance MemSize PackageItem where
-    memSize (PackageItem a b c d e f g h i j k l) = memSize12 a b c d e f g h i j k l
+    memSize (PackageItem a b c d e f g h i j k l m n) = memSize11 a b c d e f g h i j (k, l, m, n)
 
 
 emptyPackageItem :: PackageName -> PackageItem
 emptyPackageItem pkg = PackageItem pkg Set.empty Nothing "" []
-                                   0 0 False 0 0 0 (UTCTime (toEnum 0) 0)
+                                   0 0 0 False 0 0 0 (UTCTime (toEnum 0) 0) 0
 
 
 initListFeature :: ServerEnv
                 -> IO (CoreFeature
-                    -- [reverse index disabled] -> ReverseFeature
+                    -> ReverseFeature
                     -> DownloadFeature
                     -> VotesFeature
                     -> TagsFeature
@@ -113,7 +113,7 @@ initListFeature _env = do
     itemUpdate <- newHook
 
     return $ \core@CoreFeature{..}
-              -- [reverse index disabled] revs
+              revs@ReverseFeature{..}
               download
               votesf@VotesFeature{..}
               tagsf@TagsFeature{..}
@@ -122,7 +122,7 @@ initListFeature _env = do
               uploads@UploadFeature{..} -> do
 
       let (feature, modifyItem, updateDesc) =
-            listFeature core download votesf tagsf versions users uploads
+            listFeature core revs download votesf tagsf versions users uploads
                         itemCache itemUpdate
 
       registerHookJust packageChangeHook isPackageChangeAny $ \(pkgid, _) ->
@@ -142,15 +142,12 @@ initListFeature _env = do
                    runHook_ itemUpdate (Set.singleton pkgname)
               Nothing -> return ()
 
-      {- [reverse index disabled]
-              votesf@VotesFeature{..}
-      registerHook (reverseUpdateHook revs) $ \mrev -> do
-          let pkgs = Map.keys mrev
+      registerHook reverseHook $ \pkgids -> do
+          let pkgs = map pkgName pkgids
           forM_ pkgs $ \pkgname -> do
-              revCount <- query . GetReverseCount $ pkgname
+              revCount <- revPackageStats pkgname
               modifyItem pkgname (updateReverseItem revCount)
-          runHook' itemUpdate $ Set.fromDistinctAscList pkgs
-      -}
+          runHook_ itemUpdate $ Set.fromDistinctAscList pkgs
 
       registerHook votesUpdated $ \(pkgname, _) -> do
           votes <- pkgNumScore pkgname
@@ -171,6 +168,7 @@ initListFeature _env = do
 
 
 listFeature :: CoreFeature
+            -> ReverseFeature
             -> DownloadFeature
             -> VotesFeature
             -> TagsFeature
@@ -184,6 +182,7 @@ listFeature :: CoreFeature
                 PackageName -> IO ())
 
 listFeature CoreFeature{..}
+            ReverseFeature{..}
             DownloadFeature{..}
             VotesFeature{..}
             TagsFeature{..}
@@ -248,7 +247,7 @@ listFeature CoreFeature{..}
     constructItem :: PkgInfo -> IO (PackageName, PackageItem)
     constructItem pkg = do
         let pkgname = packageName pkg
-        -- [reverse index disabled] revCount <- query . GetReverseCount $ pkgname
+        revCount <- revPackageStats pkgname
         users <- queryGetUserDb
         tags  <- queryTagsForPackage pkgname
         downs <- recentPackageDownloads
@@ -261,16 +260,17 @@ listFeature CoreFeature{..}
           , itemMaintainer = map (userIdToName users) (UserIdSet.toList maintainers)
           , itemDeprecated = deprs
           , itemDownloads  = cmFind pkgname downs
-            -- [reverse index disabled] , itemRevDepsCount = directReverseCount revCount
           , itemVotes      = votes
           , itemLastUpload = fst (pkgOriginalUploadInfo pkg)
+          , itemRevDepsCount = directCount revCount
+          , itemHotness = votes + fromIntegral (cmFind pkgname downs) + fromIntegral (directCount revCount)*2
           }
 
     ------------------------------
     makeItemList :: [PackageName] -> IO [PackageItem]
     makeItemList pkgnames = do
         mainMap <- readMemState itemCache
-        return $ catMaybes $ map (flip Map.lookup mainMap) pkgnames
+        return $ mapMaybe (`Map.lookup` mainMap) pkgnames
 
     makeItemMap :: Map PackageName a -> IO (Map PackageName (PackageItem, a))
     makeItemMap pkgmap = do
@@ -304,10 +304,13 @@ updateTagItem tags item =
         itemTags = tags
     }
 
+-- TODO factor out hotness function
+
 updateVoteItem :: Float -> PackageItem -> PackageItem
 updateVoteItem score item =
     item {
-        itemVotes = score
+        itemVotes = score,
+        itemHotness = fromIntegral (itemRevDepsCount item)*2 + score + fromIntegral (itemDownloads item)
     }
 
 updateDeprecation :: Maybe [PackageName] -> PackageItem -> PackageItem
@@ -316,16 +319,16 @@ updateDeprecation pkgs item =
         itemDeprecated = pkgs
     }
 
-{- [reverse index disabled]
 updateReverseItem :: ReverseCount -> PackageItem -> PackageItem
 updateReverseItem revCount item =
     item {
-        itemRevDepsCount = directReverseCount revCount
+        itemRevDepsCount = directCount revCount,
+        itemHotness = fromIntegral (directCount revCount)*2 + itemVotes item + fromIntegral (itemDownloads item)
     }
--}
 
 updateDownload :: Int -> PackageItem -> PackageItem
 updateDownload count item =
     item {
-        itemDownloads = count
+        itemDownloads = count,
+        itemHotness = fromIntegral (itemRevDepsCount item)*2 + itemVotes item + fromIntegral count
     }

Distribution/Server/Features/PreferredVersions.hs

@@ -46,6 +46,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,
 
     versionsResource :: VersionsResource,
     deprecatedHook :: Hook (PackageName, Maybe [PackageName]) (),
@@ -58,6 +59,7 @@ data VersionsFeature = VersionsFeature {
     doPreferredsRender    :: forall m. MonadIO m => m [(PackageName, PreferredRender)],
     doDeprecatedsRender   :: forall m. MonadIO m => m [(PackageName, [PackageName])],
 
+    withPackageVersion       :: forall a. PackageId -> (PkgInfo -> ServerPartE a) -> ServerPartE a,
     withPackagePreferred     :: forall a. PackageId -> (PkgInfo -> [PkgInfo] -> ServerPartE a) -> ServerPartE a,
     withPackagePreferredPath :: forall a. DynamicPath -> (PkgInfo -> [PkgInfo] -> ServerPartE a) -> ServerPartE a
 }
@@ -151,6 +153,10 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
     queryGetDeprecatedFor :: MonadIO m => PackageName -> m (Maybe [PackageName])
     queryGetDeprecatedFor name = queryState preferredState (GetDeprecatedFor name)
 
+    queryGetPreferredVersions :: MonadIO m => m PreferredVersions
+    queryGetPreferredVersions = queryState preferredState GetPreferredVersions
+
+
     updateDeprecatedTags = do
       pkgs <- deprecatedMap <$> queryState preferredState GetPreferredVersions
       setCalculatedTag (Tag "deprecated") (Map.keysSet pkgs)
@@ -256,6 +262,18 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
       runHook_ deprecatedHook (pkgname, deprs)
       updateDeprecatedTags
 
+    withPackageVersion :: PackageId -> (PkgInfo -> ServerPartE a) -> ServerPartE a
+    withPackageVersion pkgid func = do
+        pkgIndex <- queryGetPackageIndex
+        guard (packageVersion pkgid /= nullVersion)
+        case PackageIndex.lookupPackageName pkgIndex (packageName pkgid) of
+            []   ->  packageError [MText $ "No such package in package index. ", MLink "Search for related terms instead?"$ "/packages/search?terms=" ++ (display $ pkgName pkgid)]
+            pkg -> case find ((== packageVersion pkgid) . packageVersion) pkg of
+                Nothing  -> packageError [MText $ "No such package version for " ++ display (packageName pkgid)]
+                Just pkg' -> func pkg'
+      where packageError = errNotFound "Package not found"
+
+
     ---------------------------
     -- This is a function used by the HTML feature to select the version to display.
     -- It could be enhanced by displaying a search page in the case of failure,