Add specification job summary.

* src/cuirass/database.scm (db-get-specifications-summary): New procedure.
* tests/database.scm ("db-get-specifications-summary"): New test.
* src/cuirass/templates.scm (specifications-table): Add a summary argument.
* src/cuirass/http.scm (url-handler): Adapt it.

src/cuirass/database.scm

@@ -54,6 +54,7 @@
             db-remove-specification
             db-get-specification
             db-get-specifications
+            db-get-specifications-summary
             evaluation-status
             db-add-evaluation
             db-abort-pending-evaluations
@@ -471,6 +472,37 @@ priority, systems FROM Specifications ORDER BY name ASC;")))
                       (systems (with-input-from-string systems read)))
                      specs)))))))
 
+(define (db-get-specifications-summary)
+  (define (number n)
+    (if n (string->number n) 0))
+
+  (with-db-worker-thread db
+    (let ((query "
+SELECT specification, 100 * CAST(succeeded AS FLOAT) / total,
+succeeded, failed, scheduled FROM
+(SELECT DISTINCT ON(specification) specification, MAX(id) FROM Specifications
+LEFT JOIN Evaluations ON Specifications.name = Evaluations.specification
+WHERE Evaluations.status = 0
+GROUP BY Evaluations.specification) evals LEFT JOIN (SELECT
+SUM(CASE WHEN Builds.status > -100 THEN 1 ELSE 0 END) AS total,
+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
+GROUP BY Jobs.evaluation) b on evals.max = b.evaluation;"))
+      (let loop ((rows (exec-query db query))
+                 (summary '()))
+        (match rows
+          (() (reverse summary))
+          (((specification percentage succeeded failed scheduled) . rest)
+           (loop rest
+                 (cons `((#:specification . ,specification)
+                         (#:percentage . ,(number percentage))
+                         (#:succeeded . ,(number succeeded))
+                         (#:failed . ,(number failed))
+                         (#:scheduled . ,(number scheduled)))
+                       summary))))))))
+
 (define-enumeration evaluation-status
   (started          -1)
   (succeeded         0)
@@ -691,7 +723,6 @@ JOB derivation."
                        (((name . path) _ ...)
                         path)))
          (system     (assq-ref job #:system)))
-    (pk output derivation)
     (with-db-worker-thread db
       (exec-query/bind db "\
 INSERT INTO Jobs (name, evaluation, build, system)

src/cuirass/http.scm

@@ -760,7 +760,8 @@ into a specification record and return it."
      (respond-html (html-page
                     "Cuirass"
                     (specifications-table
-                     (db-get-specifications))
+                     (db-get-specifications)
+                     (db-get-specifications-summary))
                     '())))
 
     (('GET "jobset" name)

src/cuirass/templates.scm

@@ -148,7 +148,8 @@ order: [],
 ...default_opts,
 /* Do not sort the 'Action' column. */
 columnDefs: [
-    { orderable: false, targets: 5 }
+    { orderable: false, targets: 5 },
+    { orderable: false, targets: 6 }
   ],
 });
 }
@@ -255,7 +256,12 @@ columnDefs: [
    (else
     "Invalid status")))
 
-(define (specifications-table specs)
+(define (specifications-table specs summary)
+  (define (spec-summary name)
+    (find (lambda (s)
+            (string=? (assq-ref s #:specification) name))
+          summary))
+
   "Return HTML for the SPECS table."
   `((p (@ (class "lead")) "Specifications"
        (a (@ (href "/events/rss/"))
@@ -282,6 +288,7 @@ columnDefs: [
                         (th (@ (scope "col")) Channels)
                         (th (@ (scope "col")) Priority)
                         (th (@ (scope "col")) Systems)
+                        (th (@ (scope "col")) Jobs)
                         (th (@ (scope "col")) Action)))
              (tbody
               ,@(map
@@ -306,6 +313,30 @@ columnDefs: [
                               (sort (specification-systems spec)
                                     string<?)
                               ", "))
+                        (td
+                         ,@(let ((summary
+                                  (spec-summary
+                                   (specification-name spec))))
+                             (if summary
+                                 `((div
+                                    (@ (class "badge badge-success")
+                                       (title "Percentage succeeded"))
+                                    ,(format #f "~1,2f%"
+                                             (assq-ref summary #:percentage)))
+                                   " "
+                                   (div
+                                    (@ (class "badge badge-success")
+                                       (title "Succeeded"))
+                                    ,(assq-ref summary #:succeeded))
+                                   (div
+                                    (@ (class "badge badge-danger")
+                                       (title "Failed"))
+                                    ,(assq-ref summary #:failed))
+                                   (div
+                                    (@ (class "badge badge-secondary")
+                                       (title "Scheduled"))
+                                    ,(assq-ref summary #:scheduled)))
+                                 '())))
                         (td
                          (div
                           (@ (class "dropdown"))

tests/database.scm

@@ -312,6 +312,17 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);")
               (assq-ref summary #:scheduled)))
            summaries)))
 
+  (test-equal "db-get-specifications-summary"
+    '("guix" 0 0 1 0)
+    (match (db-get-specifications-summary)
+      ((summary)
+       (list
+        (assq-ref summary #:specification)
+        (assq-ref summary #:percentage)
+        (assq-ref summary #:succeeded)
+        (assq-ref summary #:failed)
+        (assq-ref summary #:scheduled)))))
+
   (test-equal "db-get-evaluations-id-min"
     1
     (db-get-evaluations-id-min "guix"))