Display the jobs related to a revision on the revision page

3 files changed, 142 insertions, 12 deletions

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index d1a5fb7..a24e24a 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -30,6 +30,7 @@
             process-load-new-guix-revision-job
             select-job-for-commit
             select-jobs-and-events
+            select-jobs-and-events-for-commit
             record-job-event
             enqueue-load-new-guix-revision-job
             most-recent-n-load-new-guix-revision-jobs))
@@ -676,6 +677,40 @@ ORDER BY load_new_guix_revision_jobs.id DESC")
             (string=? log-exists? "t"))))
    (exec-query conn query)))
 
+(define (select-jobs-and-events-for-commit conn commit)
+  (define query
+    "
+SELECT
+  load_new_guix_revision_jobs.id,
+  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
+  ),
+  EXISTS (
+    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
+WHERE commit = $1
+ORDER BY load_new_guix_revision_jobs.id DESC")
+
+  (map
+   (match-lambda
+     ((id source git-repository-id created-at succeeded-at
+          events-json log-exists?)
+      (list id commit source git-repository-id created-at succeeded-at
+            (if (string-null? events-json)
+                #()
+                (json-string->scm events-json))
+            (string=? log-exists? "t"))))
+   (exec-query conn query (list commit))))
+
 (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 e49e0a7..6f2511c 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -103,7 +103,9 @@
         (git-repositories-and-branches
          (git-branches-with-repository-details-for-commit conn commit-hash))
         (derivations-counts
-         (count-packages-derivations-in-revision conn commit-hash)))
+         (count-packages-derivations-in-revision conn commit-hash))
+        (jobs-and-events
+         (select-jobs-and-events-for-commit conn commit-hash)))
     (case (most-appropriate-mime-type
            '(application/json text/html)
            mime-types)
@@ -125,6 +127,7 @@
                 packages-count
                 git-repositories-and-branches
                 derivations-counts
+                jobs-and-events
                 #:path-base path-base
                 #:header-text header-text)
         #:extra-headers http-headers-for-unchanging-content)))))
@@ -152,7 +155,9 @@
               commit-hash
               (select-job-for-commit
                conn commit-hash)
-              (git-branches-with-repository-details-for-commit conn commit-hash))))))
+              (git-branches-with-repository-details-for-commit conn commit-hash)
+              (select-jobs-and-events-for-commit conn commit-hash))))))
+
 
 (define* (render-revision-packages mime-types
                                    conn
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index 8c34f05..25b759e 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -396,6 +396,7 @@
 
 (define* (view-revision commit-hash packages-count
                         git-repositories-and-branches derivations-count
+                        jobs-and-events
                         #:key (path-base "/revision/")
                         header-text)
   (layout
@@ -441,7 +442,51 @@
                                               commit-hash)))
                                    ,name " at " ,datetime))))
                         branches))))
-                git-repositories-and-branches))))
+                git-repositories-and-branches)))
+        (h3 "Jobs")
+        (table
+         (@ (class "table"))
+         (thead
+          (tr
+           (th "Source")
+           (th "Events")
+           (th "")))
+         (tbody
+          ,@(map (match-lambda
+                   ((id commit source git-repository-id created-at succeeded-at
+                        events log-exists?)
+                    `(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 ,source)
+                      (td
+                       (dl
+                        ,@(map
+                           (lambda (event)
+                             `((dt ,(assoc-ref event "event"))
+                               (dd ,(assoc-ref event "occurred_at"))))
+                           (cons
+                            `(("event" . "created")
+                              ("occurred_at" . ,created-at))
+                            (vector->list events)))))
+                      (td
+                       ,@(if log-exists?
+                             `((a (@ (href ,(string-append "/job/" id)))
+                                  "View log"))
+                             '())))))
+                 jobs-and-events))))
        (div
         (@ (class "col-md-6"))
         (h3 "Derivations")
@@ -1491,7 +1536,8 @@
       (h1 ,header-text)
       (p ,body)))))
 
-(define (unknown-revision commit-hash job git-repositories-and-branches)
+(define (unknown-revision commit-hash job git-repositories-and-branches
+                          jobs-and-events)
   (layout
    #:body
    `(,(header)
@@ -1524,7 +1570,7 @@
                   `((h3 "Git repositories")
                     ,@(map
                        (match-lambda
-                         (((label url cgit-url-base) . branches)
+                         (((id label url cgit-url-base) . branches)
                           `((h4 ,url)
                             ,@(map
                                (match-lambda
@@ -1537,13 +1583,57 @@
                                                      commit-hash)))
                                           ,name " at " ,datetime))))
                                branches))))
-                       git-repositories-and-branches))))
-                     (div
-                      (@ (class "col-md-6"))
-                      (h3 "Derivations")
-                      (strong (@ (class "text-center")
-                                 (style "font-size: 2em; display: block;"))
-                              "Unknown"))))))))))
+                       git-repositories-and-branches)))
+               (h3 "Jobs")
+               (table
+                (@ (class "table"))
+                (thead
+                 (tr
+                  (th "Source")
+                  (th "Events")
+                  (th "")))
+                (tbody
+                 ,@(map (match-lambda
+                          ((id commit source git-repository-id created-at succeeded-at
+                               events log-exists?)
+                           `(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 ,source)
+                             (td
+                              (dl
+                               ,@(map
+                                  (lambda (event)
+                                    `((dt ,(assoc-ref event "event"))
+                                      (dd ,(assoc-ref event "occurred_at"))))
+                                  (cons
+                                   `(("event" . "created")
+                                     ("occurred_at" . ,created-at))
+                                   (vector->list events)))))
+                             (td
+                              ,@(if log-exists?
+                                    `((a (@ (href ,(string-append "/job/" id)))
+                                         "View log"))
+                                    '())))))
+                        jobs-and-events))))
+              (div
+               (@ (class "col-md-6"))
+               (h3 "Derivations")
+               (strong (@ (class "text-center")
+                          (style "font-size: 2em; display: block;"))
+                       "Unknown"))))))))))
 
 (define (compare-unknown-commit base-commit target-commit
                                 base-exists? target-exists?