Add some basic pagination to the packages page

Lower powered devices will have problems displaying all ~9000+ packages, so
return a smaller number by default.

3 files changed, 93 insertions, 26 deletions

diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm
index 4d15e73..7cb1683 100644
--- a/guix-data-service/model/package.scm
+++ b/guix-data-service/model/package.scm
@@ -28,25 +28,46 @@
                  "packages.version = vals.version AND "
                  "packages.package_metadata_id = vals.package_metadata_id"))
 
-(define (select-packages-in-revision conn commit-hash)
+(define* (select-packages-in-revision conn commit-hash
+                                      #:key limit-results
+                                      after-name)
   (define query
-    "
-SELECT packages.name, packages.version, package_metadata.synopsis
-FROM packages
-INNER JOIN package_metadata
-  ON packages.package_metadata_id = package_metadata.id
-WHERE packages.id IN (
- SELECT package_derivations.package_id
- FROM package_derivations
- INNER JOIN guix_revision_package_derivations
-   ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
- INNER JOIN guix_revisions
-   ON guix_revision_package_derivations.revision_id = guix_revisions.id
- WHERE guix_revisions.commit = $1
-)
-ORDER BY packages.name, packages.version")
+    (string-append "
+WITH data AS (
+  SELECT packages.name, packages.version, package_metadata.synopsis
+  FROM packages
+  INNER JOIN package_metadata
+    ON packages.package_metadata_id = package_metadata.id
+  WHERE packages.id IN (
+   SELECT package_derivations.package_id
+   FROM package_derivations
+   INNER JOIN guix_revision_package_derivations
+     ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
+   INNER JOIN guix_revisions
+     ON guix_revision_package_derivations.revision_id = guix_revisions.id
+   WHERE guix_revisions.commit = $1
+  )
+  ORDER BY packages.name, packages.version
+), package_names AS (
+  SELECT DISTINCT name
+  FROM data"
+    (if after-name
+        "\nWHERE name > $2\n"
+        "")
+    "  ORDER BY name"
+    (if limit-results
+        (string-append " LIMIT " (number->string limit-results))
+        "")
+")
+SELECT data.*
+FROM data
+WHERE data.name IN (SELECT name FROM package_names);"))
 
-  (exec-query conn query (list commit-hash)))
+  (exec-query conn query
+              `(,commit-hash
+                ,@(if after-name
+                      (list after-name)
+                      '()))))
 
 (define (count-packages-in-revision conn commit-hash)
   (define query
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 7f60b84..245b775 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -107,8 +107,15 @@
 
 (define (render-revision-packages mime-types
                                   conn
-                                  commit-hash)
-  (let ((packages (select-packages-in-revision conn commit-hash)))
+                                  commit-hash
+                                  query-parameters)
+  (let ((packages (select-packages-in-revision
+                   conn
+                   commit-hash
+                   #:limit-results (assq-ref query-parameters
+                                             'limit_results)
+                   #:after-name (assq-ref query-parameters
+                                          'after_name))))
     (case (most-appropriate-mime-type
            '(application/json text/html)
            mime-types)
@@ -123,7 +130,9 @@
                              packages))))))
       (else
        (apply render-html
-              (view-revision-packages commit-hash packages))))))
+              (view-revision-packages commit-hash
+                                      query-parameters
+                                      packages))))))
 
 (define (render-revision-package mime-types
                                  conn
@@ -441,10 +450,17 @@
     ((GET "revision" commit-hash) (render-view-revision mime-types
                                                         conn
                                                         commit-hash))
-    ((GET "revision" commit-hash "packages") (render-revision-packages
-                                              mime-types
-                                              conn
-                                              commit-hash))
+    ((GET "revision" commit-hash "packages")
+     (let ((parsed-query-parameters
+            (parse-query-parameters
+             request
+             `((after_name     ,identity)
+               (limit_results  ,parse-result-limit #:default 100)))))
+
+       (render-revision-packages mime-types
+                                 conn
+                                 commit-hash
+                                 parsed-query-parameters)))
     ((GET "revision" commit-hash "package" name version) (render-revision-package
                                                           mime-types
                                                           conn
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index d7b5725..825835b 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -412,7 +412,9 @@
                           (td (samp ,count))))))
                  derivations-count)))))))))
 
-(define (view-revision-packages revision-commit-hash packages)
+(define (view-revision-packages revision-commit-hash
+                                query-parameters
+                                packages)
   (layout
    #:extra-headers
    '((cache-control . ((max-age . 60))))
@@ -430,6 +432,28 @@
       (div
        (@ (class "row"))
        (div
+        (@ (class "col-md-12"))
+        (div
+         (@ (class "well"))
+         (form
+          (@ (method "get")
+             (action "")
+             (class "form-horizontal"))
+          ,(form-horizontal-control
+            "After name" query-parameters
+            #:help-text
+            "List packages that are alphabetically after the given name.")
+          ,(form-horizontal-control
+            "Limit results" query-parameters
+            #:help-text "The maximum number of packages by name to return.")
+          (div (@ (class "form-group form-group-lg"))
+               (div (@ (class "col-sm-offset-2 col-sm-10"))
+                    (button (@ (type "submit")
+                               (class "btn btn-lg btn-primary"))
+                            "Update results")))))))
+      (div
+       (@ (class "row"))
+       (div
         (@ (class "col-sm-12"))
         (h1 "Packages")
         (table
@@ -453,7 +477,13 @@
                                     "/revision/" revision-commit-hash
                                     "/package/" name "/" version)))
                          "More information")))))
-             packages)))))))))
+             packages)))))
+      (div
+       (@ (class "row"))
+       (a (@ (href ,(string-append "/revision/" revision-commit-hash
+                                   "/packages?after_name="
+                                   (car (last packages)))))
+          "Next page"))))))
 
 (define (view-branches branches-with-most-recent-commits)
   (layout