From ed0745096a2b2bc4b95aed408bc6c9b38470482f Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 17 Jun 2019 11:21:58 +0100
Subject: Add a new page listing jobs

---
 guix-data-service/jobs/load-new-guix-revision.scm | 32 ++++++++++++
 guix-data-service/web/controller.scm              |  8 +++
 guix-data-service/web/view/html.scm               | 60 +++++++++++++++++++++++
 3 files changed, 100 insertions(+)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index c741f55..2d1fe09 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/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
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 84afa1f..0fb5383 100644
--- a/guix-data-service/web/controller.scm
+++ b/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)))))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index fbd3241..4565d16 100644
--- a/guix-data-service/web/view/html.scm
+++ b/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
-- 
cgit v1.2.3