branch master updated: Add build history support.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new a57b066  Add build history support.
a57b066 is described below

commit a57b066e4fe7fde8ba12c128a091c8df2e58b724
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Mon Feb 1 17:47:14 2021 +0100

    Add build history support.
    
    * src/cuirass/database.scm (db-get-builds): Add "oldevaluation" filter.
    * src/cuirass/templates.scm (build-details): Add "history" argument.
    * src/cuirass/http.scm (url-handler): Adapt it.
---
 src/cuirass/database.scm  |  3 ++-
 src/cuirass/http.scm      | 12 ++++++++++--
 src/cuirass/templates.scm | 35 +++++++++++++++++++++++++++++++----
 3 files changed, 43 insertions(+), 7 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index d59c1b0..20a98c1 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -987,6 +987,7 @@ CASE WHEN CAST(:borderlowid AS integer) IS NULL THEN
         (job             . "Builds.job_name = :job")
         (system          . "Builds.system = :system")
         (worker          . "Builds.worker = :worker")
+        (oldevaluation   . "Builds.evaluation < :oldevaluation")
         (evaluation      . "Builds.evaluation = :evaluation")
         (status          . ,(match (assq-ref filters 'status)
                               (#f         #f)
@@ -1088,7 +1089,7 @@ ORDER BY ~a;"
                                 name)
                                name))
                           (match name
-                            ('nr (or value -1))
+                            ('nr value)
                             ('order #f) ; Doesn't need binding.
                             ('status #f) ; Doesn't need binding.
                             (else value)))))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index e973926..fd63c7d 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -439,11 +439,19 @@ Hydra format."
            (respond-build-not-found id))))
     (('GET "build" (= string->number id) "details")
      (let* ((build (and id (db-get-build id)))
-            (products (and build (assoc-ref build #:buildproducts))))
+            (products (and build (assoc-ref build #:buildproducts)))
+            (history
+             (db-get-builds
+              `((jobset . ,(assq-ref build #:specification))
+                (job . ,(assq-ref build #:job-name))
+                (oldevaluation . ,(assq-ref build #:eval-id))
+                (status . done)
+                (order . evaluation)
+                (nr . 5)))))
        (if build
            (respond-html
             (html-page (string-append "Build " (number->string id))
-                       (build-details build products)
+                       (build-details build products history)
                        `(((#:name . ,(assq-ref build #:specification))
                           (#:link . ,(string-append "/jobset/" (assq-ref build 
#:specification)))))))
            (respond-build-not-found id))))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 111fc3b..5d641c4 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -241,7 +241,7 @@ system whose names start with " (code "guile-") ":" (br)
                             "Add")))))
            '()))))
 
-(define (build-details build products)
+(define (build-details build products history)
   "Return HTML showing details for the BUILD."
   (define status (assq-ref build #:status))
   (define weather (assq-ref build #:weather))
@@ -269,6 +269,21 @@ system whose names start with " (code "guile-") ":" (br)
   (define evaluation
     (assq-ref build #:eval-id))
 
+  (define (history-table-row build)
+    (define status
+      (assq-ref build #:status))
+
+    `(tr
+      (td (span (@ (class ,(status-class status))
+                   (title ,(status-title status))
+                   (aria-hidden "true"))
+                ""))
+      (th (@ (scope "row"))
+          (a (@ (href "/build/" ,(assq-ref build #:id) "/details"))
+             ,(assq-ref build #:id)))
+      (td ,(assq-ref build #:nix-name))
+      (td ,(time->string (assq-ref build #:stoptime)))))
+
   `((p (@ (class "lead")) "Build details")
     (table
      (@ (class "table table-sm table-hover"))
@@ -282,7 +297,7 @@ system whose names start with " (code "guile-") ":" (br)
       (tr (th "Status")
           (td (span (@ (class ,(status-class status))
                        (title ,(status-title status)))
-                ,(string-append " " (status-title status)))
+                    ,(string-append " " (status-title status)))
               ,@(map (lambda (output)
                        `((br)
                          (a (@ (href ,(string-append "/log/" (basename 
output))))
@@ -349,12 +364,24 @@ system whose names start with " (code "guile-") ":" (br)
                                   (div (@ (class "col-md-auto"))
                                        "(" ,type ")")
                                   (div (@ (class "col-md-auto"))
-                                   ,(byte-count->string size))))))))
+                                       ,(byte-count->string size))))))))
                     products)))
               `((tr (th "Build outputs")
                     (td
                      (ul (@ (class "list-group d-flex flex-row"))
-                         ,product-items))))))))))
+                         ,product-items))))))))
+    ,@(if (null? history)
+          '()
+          `((h6 "Build history")
+            (table
+             (@ (class "table table-sm table-hover table-striped"))
+             (thead
+              (tr
+               (th (@ (scope "col") (class "border-0")) ())
+               (th (@ (scope "col") (class "border-0")) "ID")
+               (th (@ (scope "col") (class "border-0")) "Name")
+               (th (@ (scope "col") (class "border-0")) "Completion time")))
+             (tbody ,@(map history-table-row history)))))))
 
 (define (pagination first-link prev-link next-link last-link)
   "Return html page navigation buttons with LINKS."