branch master updated: Add the evaluations absolute build summary.

[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 7542d62  Add the evaluations absolute build summary.
7542d62 is described below

commit 7542d626dc476c7e00fc8e756e97f498fb272f45
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Fri Apr 9 09:27:32 2021 +0200

    Add the evaluations absolute build summary.
    
    * src/cuirass/database.scm (db-get-evaluations-absolute-summary): New
    procedure.
    * src/cuirass/http.scm (url-handler): Pass the evaluation absolute summary 
to
    "evaluation-info-table".
    * src/cuirass/templates.scm (evaluation-info-table): Adapt it.
    * src/static/css/cuirass.css (job-abs): New section.
    * tests/database.scm ("db-get-evaluations-absolute-summary"): New test.
---
 src/cuirass/database.scm   | 32 +++++++++++++++++++++
 src/cuirass/http.scm       |  8 ++++--
 src/cuirass/templates.scm  | 71 +++++++++++++++++++++++++++++++++-------------
 src/static/css/cuirass.css |  4 +++
 tests/database.scm         | 13 +++++++++
 5 files changed, 106 insertions(+), 22 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 6f64701..2d015f2 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -92,6 +92,7 @@
             db-get-evaluations-id-min
             db-get-evaluations-id-max
             db-get-evaluation-summary
+            db-get-evaluations-absolute-summary
             db-get-builds-query-min
             db-get-builds-query-max
             db-get-builds-min
@@ -1396,6 +1397,37 @@ ORDER BY Evaluations.id ASC;"))
          (#:scheduled . ,(or (string->number scheduled) 0))))
       (else #f))))
 
+(define (db-get-evaluations-absolute-summary evaluations)
+  (define eval-ids
+    (format #f "{~a}"
+            (string-join
+             (map number->string
+                  (map (cut assq-ref <> #:id) evaluations))
+             ",")))
+
+  (define (number n)
+    (if n (string->number n) 0))
+
+  (with-db-worker-thread db
+    (let loop ((rows
+                (exec-query/bind db  "SELECT
+SUM(CASE WHEN Builds.status = 0 THEN 1 ELSE 0 END) AS succeeded,
+SUM(CASE WHEN Builds.status > 0 THEN 1 ELSE 0 END) AS failed,
+SUM(CASE WHEN Builds.status < 0 THEN 1 ELSE 0 END) AS scheduled,
+Jobs.evaluation FROM Jobs INNER JOIN Builds ON Jobs.build = Builds.id
+WHERE Jobs.evaluation = ANY(" eval-ids ")
+GROUP BY Jobs.evaluation;"))
+               (summary '()))
+      (match rows
+        (() (reverse summary))
+        (((succeeded failed scheduled evaluation) . rest)
+         (loop rest
+               (cons `((#:evaluation . ,(number evaluation))
+                       (#:succeeded . ,(number succeeded))
+                       (#:failed . ,(number failed))
+                       (#:scheduled . ,(number scheduled)))
+                     summary)))))))
+
 (define (db-get-builds-query-min filters)
   "Return the smallest build row identifier matching QUERY."
   (with-db-worker-thread db
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index b1eff84..11876c1 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -778,11 +778,15 @@ into a specification record and return it."
              (evaluations (db-get-evaluations-build-summary name
                                                             %page-size
                                                             border-low
-                                                            border-high)))
+                                                            border-high))
+             (absolute-summary
+              (db-get-evaluations-absolute-summary evaluations)))
         (html-page name (evaluation-info-table name
                                                evaluations
                                                evaluation-id-min
-                                               evaluation-id-max)
+                                               evaluation-id-max
+                                               #:absolute-summary
+                                               absolute-summary)
                    `(((#:name . ,name)
                       (#:link . ,(string-append "/jobset/" name))))))))
 
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index c5aeeec..53275b2 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -856,7 +856,7 @@ if ($('.param-select-row').is(':visible')) {
           ", ")))
     (if (string=? changes "") '(em "None") changes)))
 
-(define (evaluation-badges evaluation)
+(define (evaluation-badges evaluation absolute)
   (let ((status (assq-ref evaluation #:status)))
     (if (= status (evaluation-status started))
         '((em "In progress…"))
@@ -874,33 +874,62 @@ if ($('.param-select-row').is(':visible')) {
                   (aria-hidden "true"))
                "")))
          ((= status (evaluation-status succeeded))
-          `((a (@ (href "/eval/" ,(assq-ref evaluation #:id)
-                        "?status=succeeded")
-                  (class "badge badge-success")
-                  (title "Succeeded"))
-               ,(assq-ref evaluation #:succeeded))
-            (a (@ (href "/eval/" ,(assq-ref evaluation #:id)
-                        "?status=failed")
-                  (class "badge badge-danger")
-                  (title "Failed"))
-               ,(assq-ref evaluation #:failed))
-            (a (@ (href "/eval/" ,(assq-ref evaluation #:id)
-                        "?status=pending")
-                  (class "badge badge-secondary")
-                  (title "Scheduled"))
-               ,(assq-ref evaluation #:scheduled))))))))
-
-(define (evaluation-info-table name evaluations id-min id-max)
+          `((div
+             (@ (class "job-abs"))
+             (div (@ (class "badge badge-success")
+                     (title "Succeeded"))
+                  ,(assq-ref absolute #:succeeded))
+             (div (@ (class "badge badge-danger")
+                     (title "Failed"))
+                  ,(assq-ref absolute #:failed))
+             (div (@ (class "badge badge-secondary")
+                     (title "Scheduled"))
+                  ,(assq-ref absolute #:scheduled)))
+            (div
+             (@ (class "job-rel"))
+             (a (@ (href "/eval/" ,(assq-ref evaluation #:id)
+                         "?status=succeeded")
+                   (class "badge badge-success")
+                   (title "Succeeded"))
+                ,(assq-ref evaluation #:succeeded))
+             (a (@ (href "/eval/" ,(assq-ref evaluation #:id)
+                         "?status=failed")
+                   (class "badge badge-danger")
+                   (title "Failed"))
+                ,(assq-ref evaluation #:failed))
+             (a (@ (href "/eval/" ,(assq-ref evaluation #:id)
+                         "?status=pending")
+                   (class "badge badge-secondary")
+                   (title "Scheduled"))
+                ,(assq-ref evaluation #:scheduled)))))))))
+
+(define* (evaluation-info-table name evaluations id-min id-max
+                                #:key absolute-summary)
   "Return HTML for the EVALUATION table NAME. ID-MIN and ID-MAX are
   global minimal and maximal id."
+  (define (eval-absolute-summary eval)
+    (find (lambda (e)
+            (= (assq-ref e #:evaluation) (assq-ref eval #:id)))
+          absolute-summary))
+
   `((p (@ (class "lead")) "Evaluations of " ,name
+       (button (@ (class "btn btn-outline-primary float-right job-toggle")
+                  (type "button"))
+               (span (@ (class "oi oi-contrast d-inline-block")
+                        (title "Toggle jobs"))))
        (a (@ (href "/events/rss/?specification=" ,name))
-          (button (@ (class "btn btn-outline-warning float-right")
+          (button (@ (class "btn btn-outline-warning float-right mr-1")
                      (type "button"))
                   (span (@(class "oi oi-rss text-warning align-right")
                          (title "RSS")
                          (aria-hidden "true"))
                         ""))))
+    (script "
+$(document).ready(function() {
+$('.job-toggle').click(function() {
+  $('.job-abs').toggle();
+  $('.job-rel').toggle();
+})});")
     (table
      (@ (class "table table-sm table-hover table-striped"))
      ,@(if (null? evaluations)
@@ -918,7 +947,9 @@ if ($('.param-select-row').is(':visible')) {
                             (a (@ (href "/eval/" ,(assq-ref row #:id)))
                                ,(assq-ref row #:id)))
                         (td ,(input-changes (assq-ref row #:checkouts)))
-                        (td ,@(evaluation-badges row))
+                        (td
+                         ,@(evaluation-badges row
+                                              (eval-absolute-summary row)))
                         (td
                          (a (@ (href "/eval/" ,(assq-ref row #:id)
                                      "/dashboard"))
diff --git a/src/static/css/cuirass.css b/src/static/css/cuirass.css
index 9967e11..1adfada 100644
--- a/src/static/css/cuirass.css
+++ b/src/static/css/cuirass.css
@@ -96,3 +96,7 @@ div.tooltip {
 .job-val {
     display: none;
 }
+
+.job-abs {
+    display: none;
+}
diff --git a/tests/database.scm b/tests/database.scm
index a436e86..ec7d6ca 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -325,6 +325,19 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 
0, 0);")
               (assq-ref summary #:scheduled)))
            summaries)))
 
+  (test-equal "db-get-evaluations-absolute-summary"
+    '((0 1 0) (0 1 0))
+    (let* ((evaluations
+            (db-get-evaluations-build-summary "guix" 3 #f #f))
+           (summaries
+            (db-get-evaluations-absolute-summary evaluations)))
+      (map (lambda (summary)
+             (list
+              (assq-ref summary #:succeeded)
+              (assq-ref summary #:failed)
+              (assq-ref summary #:scheduled)))
+           summaries)))
+
   (test-equal "db-get-evaluations-id-min"
     1
     (db-get-evaluations-id-min "guix"))