Add a new page listing jobs

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

@@ -2,6 +2,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (ice-9 hash-table)
+  #:use-module (json)
   #:use-module (squee)
   #:use-module (guix monads)
   #:use-module (guix store)
@@ -23,6 +24,7 @@
   #:use-module (guix-data-service model derivation)
   #:export (process-next-load-new-guix-revision-job
             select-job-for-commit
+            select-jobs-and-events
             enqueue-load-new-guix-revision-job
             most-recent-n-load-new-guix-revision-jobs))
 
@@ -459,6 +461,36 @@ RETURNING id;")
           (list commit))))
     result))
 
+(define (select-jobs-and-events conn)
+  (define query
+    "
+SELECT
+  load_new_guix_revision_jobs.id,
+  load_new_guix_revision_jobs.commit,
+  load_new_guix_revision_jobs.source,
+  load_new_guix_revision_jobs.git_repository_id,
+  load_new_guix_revision_jobs.created_at,
+  load_new_guix_revision_jobs.succeeded_at,
+  (
+    SELECT JSON_AGG(
+      json_build_object('event', event, 'occurred_at', occurred_at) ORDER BY occurred_at ASC
+    )
+    FROM load_new_guix_revision_job_events
+    WHERE job_id = load_new_guix_revision_jobs.id
+  )
+  FROM load_new_guix_revision_jobs
+ORDER BY load_new_guix_revision_jobs.id DESC")
+
+  (map
+   (match-lambda
+     ((id commit source git-repository-id created-at succeeded-at
+          events-json)
+      (list id commit source git-repository-id created-at succeeded-at
+            (if (string-null? events-json)
+                #()
+                (json-string->scm events-json)))))
+   (exec-query conn query)))
+
 (define (most-recent-n-load-new-guix-revision-jobs conn n)
   (let ((result
          (exec-query

guix-data-service/web/controller.scm

@@ -548,6 +548,11 @@
                                      derivations))
         #:extra-headers http-headers-for-unchanging-content)))))
 
+(define (render-jobs mime-types conn)
+  (render-html
+   #:sxml (view-jobs
+           (select-jobs-and-events conn))))
+
 (define (parse-commit conn)
   (lambda (s)
     (if (guix-commit-exists? conn s)
@@ -831,5 +836,8 @@
                                      base-revision-id
                                      target-commit
                                      target-revision-id)))))
+    ((GET "jobs")
+     (render-jobs mime-types
+                  conn))
     ((GET path ...)
      (not-found (request-uri request)))))

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

@@ -40,6 +40,7 @@
             view-builds
             view-derivation
             view-store-item
+            view-jobs
             compare
             compare/derivations
             compare/packages
@@ -906,6 +907,65 @@
              derivations
              derivations-using-store-item-list)))))
 
+(define (view-jobs jobs-and-events)
+  (layout
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h1 "Jobs")))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (table
+         (@ (class "table"))
+         (thead
+          (tr
+           (th "Commit")
+           (th "Source")
+           (th "Events")))
+         (tdata
+          ,@(map (match-lambda
+                   ((id commit source git-repository-id created-at succeeded-at
+                        events)
+                    `(tr
+                      (@ (class
+                           ,(let ((event-names
+                                   (map (lambda (event)
+                                          (assoc-ref event "event"))
+                                        (vector->list events))))
+                              (cond
+                               ((member "success" event-names)
+                                "success")
+                               ((member "failure" event-names)
+                                "danger")
+                               ((member "start" event-names)
+                                "info")
+                               (else
+                                "")))))
+                      (td (a (@ (href
+                                 ,(string-append
+                                   "/revision/" commit)))
+                             (samp ,commit)))
+                      (td ,source)
+                      (td
+                       (dl
+                        (@ (class "dl-horizontal"))
+                        ,@(map
+                           (lambda (event)
+                             `((dt ,(assoc-ref event "event"))
+                               (dd ,(assoc-ref event "occurred_at"))))
+                           (cons
+                            `(("event" . "created")
+                              ("occurred_at" . ,created-at))
+                            (vector->list events))))))))
+                 jobs-and-events)))))))))
+
 (define (view-derivation derivation derivation-inputs derivation-outputs
                          builds)
   (layout