Add pagination to the jobs page

guix-data-service/jobs/load-new-guix-revision.scm

@@ -1050,8 +1050,9 @@ RETURNING id;")
           (list commit))))
     result))
 
-(define (select-jobs-and-events conn)
+(define (select-jobs-and-events conn before-id limit)
   (define query
+    (string-append
      "
 SELECT
   load_new_guix_revision_jobs.id,
@@ -1071,7 +1072,19 @@ SELECT
     SELECT 1 FROM load_new_guix_revision_job_logs WHERE job_id = load_new_guix_revision_jobs.id
   ) AS log_exists
 FROM load_new_guix_revision_jobs
-ORDER BY load_new_guix_revision_jobs.id DESC")
+"
+     (if before-id
+         (string-append
+          "WHERE load_new_guix_revision_jobs.id < "
+          (number->string before-id))
+         "")
+     "
+ORDER BY load_new_guix_revision_jobs.id DESC
+"
+     (if limit
+         (string-append
+          "LIMIT " (number->string limit))
+         "")))
 
   (map
    (match-lambda

guix-data-service/web/jobs/controller.scm

@@ -30,8 +30,19 @@
                          conn)
   (match method-and-path-components
     (('GET "jobs")
+     (let ((parsed-query-parameters
+            (guard-against-mutually-exclusive-query-parameters
+             (parse-query-parameters
+              request
+              `((before_id  ,parse-number)
+                (limit_results  ,parse-result-limit
+                                #:no-default-when (all_results)
+                                #:default 20)
+                (all_results    ,parse-checkbox-value)))
+             '((limit_results all_results)))))
        (render-jobs mime-types
-                  conn))
+                    conn
+                    parsed-query-parameters)))
     (('GET "jobs" "queue")
      (render-job-queue mime-types
                        conn))
@@ -47,10 +58,20 @@
                    parsed-query-parameters)))
     (_ #f)))
 
-(define (render-jobs mime-types conn)
+(define (render-jobs mime-types conn query-parameters)
+  (let* ((limit-results
+          (assq-ref query-parameters 'limit_results))
+         (jobs (select-jobs-and-events
+                conn
+                (assq-ref query-parameters 'before_id)
+                limit-results)))
     (render-html
      #:sxml (view-jobs
-           (select-jobs-and-events conn))))
+             query-parameters
+             jobs
+             (and limit-results
+                  (>= (length jobs)
+                      limit-results))))))
 
 (define (render-job-queue mime-types conn)
   (render-html

guix-data-service/web/jobs/html.scm

@@ -16,13 +16,17 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (guix-data-service web jobs html)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
+  #:use-module (guix-data-service web html-utils)
   #:use-module (guix-data-service web view html)
   #:export (view-jobs
             view-job-queue
             view-job))
 
-(define (view-jobs jobs-and-events)
+(define (view-jobs query-parameters
+                   jobs-and-events
+                   show-next-page?)
   (layout
    #:body
    `(,(header)
@@ -42,6 +46,33 @@
                (href "/jobs/queue")
                (role "button"))
             "Queue"))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (div
+         (@ (class "well"))
+         (form
+          (@ (method "get")
+             (action "")
+             (style "padding-bottom: 0")
+             (class "form-horizontal"))
+          ,(form-horizontal-control
+            "Before ID" 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.")
+          ,(form-horizontal-control
+            "All results" query-parameters
+            #:type "checkbox"
+            #:help-text "Return all results.")
+          (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
@@ -94,7 +125,17 @@
                              `((a (@ (href ,(string-append "/job/" id)))
                                   "View log"))
                              '())))))
-                 jobs-and-events)))))))))
+                 jobs-and-events)))
+        ,@(if show-next-page?
+              `((div
+                 (@ (class "row"))
+                 (a (@ (href
+                        ,(next-page-link "/jobs"
+                                         query-parameters
+                                         'before_id
+                                         (car (last jobs-and-events)))))
+                    "Next page")))
+              '())))))))
 
 (define (view-job-queue jobs-and-events)
   (layout