Limit number of deps/revdeps shown

config/routes

@@ -17,6 +17,8 @@
     /cabal.config StackageCabalConfigR GET
     /00-index.tar.gz StackageIndexR GET
     /package/#PackageNameVersion StackageSdistR GET
+    /package/#PackageNameVersion/deps SnapshotPackageDepsR GET
+    /package/#PackageNameVersion/revdeps SnapshotPackageRevDepsR GET
     /packages SnapshotPackagesR GET
     /docs DocsR GET
     /hoogle HoogleR GET
@@ -33,6 +35,8 @@
 /package/#PackageName/snapshots PackageSnapshotsR GET
 /package/#PackageName/badge/#SnapshotBranch PackageBadgeR GET
 /package PackageListR GET
+/package/#PackageName/deps PackageDepsR GET
+/package/#PackageName/revdeps PackageRevDepsR GET
 
 /authors AuthorsR GET
 /install InstallR GET
@@ -51,4 +55,4 @@
 /stack DownloadStackListR GET
 /stack/#Text DownloadStackR GET
 
-/status/mirror MirrorStatusR GET
+/status/mirror MirrorStatusR GET

src/Application.hs

@@ -47,6 +47,7 @@ import           Handler.StackageSdist
 import           Handler.System
 import           Handler.Haddock
 import           Handler.Package
+import           Handler.PackageDeps
 import           Handler.PackageList
 import           Handler.Hoogle
 import           Handler.BuildVersion

src/Handler/Package.hs

@@ -64,8 +64,9 @@ packagePage mversion pname = track "Handler.Package.packagePage" $ do
     let pname' = toPathPiece pname
     (deprecated, inFavourOf) <- getDeprecated pname'
     latests <- getLatests pname'
-    deps' <- getDeps pname'
-    revdeps' <- getRevDeps pname'
+    deps' <- getDeps pname' $ Just maxDisplayedDeps
+    revdeps' <- getRevDeps pname' $ Just maxDisplayedDeps
+    (depsCount, revdepsCount) <- getDepsCount pname'
     Entity _ package <- getPackage pname' >>= maybe notFound return
 
     mdocs <-
@@ -134,6 +135,16 @@ packagePage mversion pname = track "Handler.Package.packagePage" $ do
                     pathRev' = component:pathRev
                     path'    = T.intercalate "." $ reverse pathRev'
 
+        maxDisplayedDeps :: Int
+        maxDisplayedDeps = 40
+
+        (packageDepsLink, packageRevDepsLink) =
+          case mversion of
+            Nothing -> (PackageDepsR pname, PackageRevDepsR pname)
+            Just (snap, version) ->
+              let wrap f = SnapshotR snap $ f $ PNVNameVersion pname version
+               in (wrap SnapshotPackageDepsR, wrap SnapshotPackageRevDepsR)
+
 -- | An identifier specified in a package. Because this field has
 -- quite liberal requirements, we often encounter various forms. A
 -- name, a name and email, just an email, or maybe nothing at all.

src/Handler/PackageDeps.hs

@@ -0,0 +1,59 @@
+module Handler.PackageDeps
+  ( getPackageDepsR
+  , getPackageRevDepsR
+  , getSnapshotPackageDepsR
+  , getSnapshotPackageRevDepsR
+  ) where
+
+import Import
+import Stackage.Database
+
+getPackageDepsR :: PackageName -> Handler Html
+getPackageDepsR = packageDeps Nothing
+
+getSnapshotPackageDepsR :: SnapName -> PackageNameVersion -> Handler Html
+getSnapshotPackageDepsR snap (PNVNameVersion pname version) =
+  packageDeps (Just (snap, version)) pname
+getSnapshotPackageDepsR _ _ = notFound
+
+packageDeps :: Maybe (SnapName, Version) -> PackageName -> Handler Html
+packageDeps = helper Deps
+
+getPackageRevDepsR :: PackageName -> Handler Html
+getPackageRevDepsR = packageRevDeps Nothing
+
+getSnapshotPackageRevDepsR :: SnapName -> PackageNameVersion -> Handler Html
+getSnapshotPackageRevDepsR snap (PNVNameVersion pname version) =
+  packageRevDeps (Just (snap, version)) pname
+getSnapshotPackageRevDepsR _ _ = notFound
+
+packageRevDeps :: Maybe (SnapName, Version) -> PackageName -> Handler Html
+packageRevDeps = helper Revdeps
+
+data DepType = Deps | Revdeps
+
+helper :: DepType -> Maybe (SnapName, Version) -> PackageName -> Handler Html
+helper depType mversion pname = track "Handler.PackageDeps.helper" $ do
+  deps <-
+    (case depType of
+       Deps -> getDeps
+       Revdeps -> getRevDeps) (toPathPiece pname) Nothing
+  let packagePage =
+        case mversion of
+          Nothing -> PackageR pname
+          Just (snap, version) -> SnapshotR snap $ StackageSdistR $ PNVNameVersion pname version
+  defaultLayout $ do
+    let title = toHtml $
+          (case depType of
+            Deps -> "Dependencies"
+            Revdeps -> "Reverse dependencies ") ++ " for " ++ toPathPiece pname
+    setTitle title
+    [whamlet|
+      <h1>#{title}
+      <p>
+        <a href=#{packagePage}>Return to package page
+      <ul>
+        $forall (name, range) <- deps
+          <li>
+            <a href=@{PackageR $ PackageName name} title=#{range}>#{name}
+    |]

src/Stackage/Database.hs

@@ -30,6 +30,7 @@ module Stackage.Database
     , getLatests
     , getDeps
     , getRevDeps
+    , getDepsCount
     , Package (..)
     , getPackage
     , prettyName
@@ -695,8 +696,8 @@ latestHelper pname requireDocs clause order = do
         , liGhc = ghc
         }
 
-getDeps :: GetStackageDatabase m => Text -> m [(Text, Text)]
-getDeps pname = run $ do
+getDeps :: GetStackageDatabase m => Text -> Maybe Int -> m [(Text, Text)]
+getDeps pname mcount = run $ do
     mp <- getBy $ UniquePackage pname
     case mp of
         Nothing -> return []
@@ -704,21 +705,33 @@ getDeps pname = run $ do
             E.where_ $
                 (d E.^. DepUser E.==. E.val pid)
             E.orderBy [E.asc $ d E.^. DepUses]
+            forM_ mcount $ E.limit . fromIntegral
             return (d E.^. DepUses, d E.^. DepRange)
   where
     toPair (E.Value x, E.Value y) = (x, y)
 
-getRevDeps :: GetStackageDatabase m => Text -> m [(Text, Text)]
-getRevDeps pname = run $ do
+getRevDeps :: GetStackageDatabase m => Text -> Maybe Int -> m [(Text, Text)]
+getRevDeps pname mcount = run $ do
     fmap (map toPair) $ E.select $ E.from $ \(d,p) -> do
         E.where_ $
             (d E.^. DepUses E.==. E.val pname) E.&&.
             (d E.^. DepUser E.==. p E.^. PackageId)
         E.orderBy [E.asc $ p E.^. PackageName]
+        forM_ mcount $ E.limit . fromIntegral
         return (p E.^. PackageName, d E.^. DepRange)
   where
     toPair (E.Value x, E.Value y) = (x, y)
 
+getDepsCount :: GetStackageDatabase m => Text -> m (Int, Int)
+getDepsCount pname = run $ (,)
+  <$> (do
+          mp <- getBy $ UniquePackage pname
+          case mp of
+            Nothing -> return 0
+            Just (Entity pid _) -> count [DepUser ==. pid]
+      )
+  <*> count [DepUses ==. pname]
+
 getPackage :: GetStackageDatabase m => Text -> m (Maybe (Entity Package))
 getPackage = run . getBy . UniquePackage
 

templates/package.hamlet

@@ -129,25 +129,32 @@ $if not (LT.null (LT.renderHtml (packageChangelog package)))
 <div .container #snapshot-home .content>
     <div .row>
         <div .span12>
-            <div .dependencies #dependencies>
-                Depends on:
+            $if depsCount > 0
+              <div .dependencies #dependencies>
+                Depends on #{renderNoPackages depsCount}:
                 <div .dep-list>
                     $forall (i,(name, range)) <- deps
                         $if i /= 0
                             , #
                         <a href=@{PackageR $ PackageName name} title=#{range}>
                             #{name}
-            $if not $ null revdeps
-              <div .reverse-dependencies .expanding #reverse-dependencies>
-                Used by #{renderNoPackages $ length revdeps}:
+                    $if depsCount > maxDisplayedDeps
+                      , #
+                      <a href=@{packageDepsLink}>
+                        <b>and many more
+            $if revdepsCount > 0
+              <div .reverse-dependencies #reverse-dependencies>
+                Used by #{renderNoPackages revdepsCount}:
                 <div .dep-list>
                     $forall (i,(name, range)) <- revdeps
                         $if i /= 0
                             , #
                         <a href=@{PackageR $ PackageName name} title=#{range}>
                             #{name}
-                <div .bottom-gradient>
-                    <i class="fa fa-angle-down">
+                    $if revdepsCount > maxDisplayedDeps
+                      , #
+                      <a href=@{packageRevDepsLink}>
+                        <b>and many more
 
 <div .container .content>
     <div .row>