Solves #1029 - Adds paging to recent packages and recent revisions (#1055)

paging on recent packages and uploads

Author: LeviButcher

datafiles/static/browse.js

@@ -253,14 +253,17 @@ const createPageLink = (num) => {
   return a;
 };
 
-const createPrevNext = (prevNextNum, cond, txt) => {
-  const el = d.createElement(cond ? "span" : "a");
-  el.setAttribute("href", "#");
-  el.addEventListener('click', (evt) => {
-    evt.preventDefault();
-    changePage(prevNextNum);
-  });
-  if (cond) el.classList.add("disabled");
+const createPrevNext = (prevNextNum, hasLink, txt) => {
+  const el = d.createElement("a");
+
+  if(hasLink) {
+    el.setAttribute("href", "#");
+    el.addEventListener('click', (evt) => {
+      evt.preventDefault();
+      changePage(prevNextNum);
+    });
+  }
+  
   el.appendChild(d.createTextNode(txt));
   return el;
 };
@@ -276,7 +279,7 @@ const createPaginator = () => {
 
   const pag = d.createElement("div");
   pag.classList.add("paginator");
-  pag.appendChild(createPrevNext(state.page - 1, state.page === 0, "Previous"));
+  pag.appendChild(createPrevNext(state.page - 1, state.page !== 0, "Previous"));
   // note that page is zero-indexed
   if (maxPage <= 4) {
     // No ellipsis
@@ -308,7 +311,8 @@ const createPaginator = () => {
     pag.appendChild(createPageLink(maxPage));
   }
   const isNowOnLastPage = state.page === maxPage;
-  pag.appendChild(createPrevNext(state.page + 1, isNowOnLastPage, "Next"));
+  
+  pag.appendChild(createPrevNext(state.page + 1, !isNowOnLastPage, "Next"));
 
   return pag;
 };

datafiles/static/hackage.css

@@ -1044,3 +1044,55 @@ a.deprecated[href]:visited {
 .versions a.normal[href]:visited {
     color: #61B01E;
 }
+
+/* Paginator */
+#paginatorContainer {
+  display: flex;
+  align-items: center;
+  flex-wrap: wrap;
+  justify-content: space-between;
+}
+
+#paginatorContainer > div {
+  padding: 1em 0;
+}
+
+.paginator {
+  display: flex;
+  flex-wrap: wrap;
+}
+
+/* Styles Next/Prev when they have no href */
+.paginator a {
+  color: #666;
+  cursor: default;
+  background: none;
+  border: none;
+  padding: 0.5em 1em;
+  text-decoration: none;
+}
+
+.paginator span {
+  color: #333;
+  padding: 0.5em 1em;
+}
+
+.paginator a:link, .paginator a:visited {
+  color: #333;
+  border: 1px solid transparent;
+  border-radius: 2px;
+}
+
+.paginator a:link:hover, .paginator a:visited:hover {
+  color: white;
+  border: 1px solid #111;
+  background: linear-gradient(to bottom, #585858 0%, #111 100%);
+  text-decoration: none;
+}
+
+.paginator .current,
+.paginator .current:hover {
+  color: #333;
+  border: 1px solid #979797;
+  background: linear-gradient(to bottom, #fff 0%, #dcdcdc 100%);
+}

datafiles/templates/Html/browse.html.st

@@ -51,38 +51,6 @@
     #browseTable th.descending {
       background-image: url(/static/images/sort_desc.png);
     }
-    .paginator {
-      margin-left: auto;
-    }
-    .paginator a {
-      box-sizing: border-box;
-      display: inline-block;
-      min-width: 1.5em;
-      padding: 0.5em 1em;
-      margin-left: 2px;
-      text-align: center;
-      text-decoration: none !important;
-      color: #333 !important;
-      border: 1px solid transparent;
-      border-radius: 2px;
-    }
-    .paginator .current, .paginator .current:hover {
-      color: #333 !important;
-      border: 1px solid #979797;
-      background: linear-gradient(to bottom, #fff 0%, #dcdcdc 100%);
-    }
-    .paginator a:hover {
-      color: white !important;
-      border: 1px solid #111;
-      background: linear-gradient(to bottom, #585858 0%, #111 100%);
-    }
-    .paginator span {
-      padding: 0 1em;
-      cursor: default;
-    }
-    .paginator .disabled {
-      color: #666;
-    }
     .filterSuggestion {
       display: flex;
       align-items: center;
@@ -102,11 +70,6 @@
     .filterSuggestion > div > input {
       margin: 0;
     }
-    #paginatorContainer {
-      display: flex;
-      align-items: center;
-      flex-wrap: wrap;
-    }
     #fatalError {
       display: none;
       color: red;

hackage-server.cabal

@@ -266,6 +266,7 @@ library lib-server
     Distribution.Server.Util.Merge
     Distribution.Server.Util.ParseSpecVer
     Distribution.Server.Util.Markdown
+    Distribution.Server.Util.Paging
 
     Distribution.Server.Features
     Distribution.Server.Features.Browse

src/Distribution/Server/Features.hs

@@ -193,7 +193,7 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
                                 tarIndexCacheFeature
                                 usersFeature
 
-    packagesFeature <- mkRecentPackagesFeature
+    recentPackagesFeature <- mkRecentPackagesFeature
                          usersFeature
                          coreFeature
 
@@ -313,6 +313,8 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
                          tarIndexCacheFeature
                          reportsCoreFeature
                          userDetailsFeature
+                         recentPackagesFeature
+                         
 
     editCabalFeature <- mkEditCabalFilesFeature
                           usersFeature
@@ -371,7 +373,7 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
 #ifndef MINIMAL
          , getFeatureInterface tarIndexCacheFeature
          , getFeatureInterface packageContentsFeature
-         , getFeatureInterface packagesFeature
+         , getFeatureInterface recentPackagesFeature
          , getFeatureInterface userDetailsFeature
          , getFeatureInterface userSignupFeature
          , getFeatureInterface legacyPasswdsFeature

src/Distribution/Server/Features/Html.hs

@@ -76,6 +76,11 @@ import qualified Text.XHtml.Strict as XHtml
 import Text.XHtml.Table (simpleTable)
 import Distribution.PackageDescription (hasLibs)
 import Distribution.PackageDescription.Configuration (flattenPackageDescription)
+import qualified Distribution.Server.Pages.Recent as Pages
+import qualified Distribution.Server.Util.Paging as Paging
+import Distribution.Server.Features.RecentPackages (RecentPackagesFeature (RecentPackagesFeature, getRecentRevisions, getRecentPackages))
+import Data.Time (getCurrentTime)
+import Text.Read (readMaybe)
 import Distribution.Server.Pages.Group (listGroupCompact)
 
 
@@ -115,6 +120,7 @@ initHtmlFeature :: ServerEnv
                     -> TarIndexCacheFeature
                     -> ReportsFeature
                     -> UserDetailsFeature
+                    -> RecentPackagesFeature
                     -> IO HtmlFeature)
 
 initHtmlFeature env@ServerEnv{serverTemplatesDir, serverTemplatesMode,
@@ -153,7 +159,8 @@ initHtmlFeature env@ServerEnv{serverTemplatesDir, serverTemplatesMode,
               docsCore docsCandidates
               tarIndexCache
               reportsCore
-              usersdetails -> do
+              usersdetails
+              recentPackagesFeature -> do
       -- do rec, tie the knot
       rec let (feature, packageIndex, packagesPage) =
                 htmlFeature env user core
@@ -172,6 +179,7 @@ initHtmlFeature env@ServerEnv{serverTemplatesDir, serverTemplatesMode,
                             (reverseHtmlUtil reversef)
                             mainCache namesCache
                             templates
+                            recentPackagesFeature
 
           -- Index page caches
           mainCache  <- newAsyncCacheNF packageIndex
@@ -224,6 +232,7 @@ htmlFeature :: ServerEnv
             -> AsyncCache Response
             -> AsyncCache Response
             -> Templates
+            -> RecentPackagesFeature 
             -> (HtmlFeature, IO Response, IO Response)
 
 htmlFeature env@ServerEnv{..}
@@ -245,6 +254,7 @@ htmlFeature env@ServerEnv{..}
             reverseH@ReverseHtmlUtil{..}
             cachePackagesPage cacheNamesPage
             templates
+            recentPackagesFeature
   = (HtmlFeature{..}, packageIndex, packagesPage)
   where
     htmlFeatureInterface = (emptyHackageFeature "html") {
@@ -288,6 +298,7 @@ htmlFeature env@ServerEnv{..}
                                       templates
                                       names
                                       candidates
+                                      recentPackagesFeature
     htmlUsers      = mkHtmlUsers      user usersdetails
     htmlUploads    = mkHtmlUploads    utilities upload
     htmlDocUploads = mkHtmlDocUploads utilities core docsCore templates
@@ -419,6 +430,7 @@ mkHtmlCore :: ServerEnv
            -> Templates
            -> SearchFeature
            -> PackageCandidatesFeature
+           -> RecentPackagesFeature
            -> HtmlCore
 mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
            utilities@HtmlUtilities{..}
@@ -448,10 +460,11 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
            templates
            SearchFeature{..}
            PackageCandidatesFeature{..}
+           RecentPackagesFeature{getRecentPackages, getRecentRevisions}
   = HtmlCore{..}
   where
     candidatesCore = candidatesCoreResource
-    cores@CoreResource{packageInPath, lookupPackageName, lookupPackageId} = coreResource
+    cores@CoreResource {packageInPath, lookupPackageName, lookupPackageId} = coreResource
     versions = versionsResource
     docs     = documentationResource
 
@@ -505,8 +518,76 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
       , (resourceAt "/package/:package/revisions/.:format") {
             resourceGet  = [("html", serveCabalRevisionsPage)]
           }
+      , (resourceAt "/packages/recent.:format") {
+            resourceGet = [("html", serveRecentPage),("rss", serveRecentRSS)]
+          }
+      , (resourceAt "/packages/recent/revisions.:format") {
+            resourceGet = [("html", serveRevisionPage), ("rss", serveRevisionRSS)]
+          }
       ]
 
+    readParamWithDefaultAndValid :: (Read a, HasRqData m, Monad m, Functor m, Alternative m) => 
+      a -> (a -> Bool) -> String -> m a
+    readParamWithDefaultAndValid n f queryParam = do
+        m <- optional (look queryParam)
+        let parsed = m >>= readMaybe >>= (\x -> if f x then Just x else Nothing)
+
+        return $ fromMaybe n parsed
+
+    lookupPageSize :: (HasRqData m, Monad m, Functor m, Alternative m) => Int -> m Int
+    lookupPageSize def = readParamWithDefaultAndValid def validPageSize "pageSize"
+      where validPageSize x = x > 1 && x <= 200
+
+    lookupPage :: (HasRqData m, Monad m, Functor m, Alternative m) => Int -> m Int
+    lookupPage def = readParamWithDefaultAndValid def validPage "page"
+      where validPage = (>= 1)
+
+    serveRecentPage :: DynamicPath -> ServerPartE Response
+    serveRecentPage _ = do
+      recentPackages <- getRecentPackages
+      users <- queryGetUserDb
+      page <-  lookupPage 1
+      pageSize <- lookupPageSize 20
+
+      let conf = Paging.createConf page pageSize recentPackages
+      
+      return . toResponse $ Pages.recentPage conf users recentPackages
+
+    serveRecentRSS :: DynamicPath -> ServerPartE Response
+    serveRecentRSS _ = do
+      recentPackages <- getRecentPackages
+      users <- queryGetUserDb
+      page <-  lookupPage 1
+      pageSize <- lookupPageSize 20
+      now   <- liftIO getCurrentTime
+      
+      let conf = Paging.createConf page pageSize recentPackages
+      
+      return . toResponse $ Pages.recentFeed conf users serverBaseURI now recentPackages
+
+    serveRevisionPage :: DynamicPath -> ServerPartE Response
+    serveRevisionPage _ = do
+      revisions <- getRecentRevisions
+      users <- queryGetUserDb
+      page <-  lookupPage 1
+      pageSize <- lookupPageSize 40
+      
+      let conf = Paging.createConf page pageSize revisions
+
+      return . toResponse $ Pages.revisionsPage conf users revisions
+
+    serveRevisionRSS :: DynamicPath -> ServerPartE Response
+    serveRevisionRSS _ = do
+      revisions <- getRecentRevisions
+      users <- queryGetUserDb
+      page <-  lookupPage 1
+      pageSize <- lookupPageSize 40
+      now   <- liftIO getCurrentTime
+      
+      let conf = Paging.createConf page pageSize revisions
+
+      return . toResponse $ Pages.recentRevisionsFeed conf users serverBaseURI now revisions
+
     serveBrowsePage :: DynamicPath -> ServerPartE Response
     serveBrowsePage _dpath = do
       template <- getTemplate templates "browse.html"