branch master updated: Add specification job 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 0ba0786  Add specification job summary.
0ba0786 is described below

commit 0ba0786741f59c09ed7e1b09cb8f0b4a5967b0e6
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Thu Apr 8 11:56:37 2021 +0200

    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  | 33 ++++++++++++++++++++++++++++++++-
 src/cuirass/http.scm      |  3 ++-
 src/cuirass/templates.scm | 35 +++++++++++++++++++++++++++++++++--
 tests/database.scm        | 11 +++++++++++
 4 files changed, 78 insertions(+), 4 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 47340d3..212ff5e 100644
--- a/src/cuirass/database.scm
+++ b/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)
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index a5f282e..2c80de9 100644
--- a/src/cuirass/http.scm
+++ b/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)
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index ad2ae02..09f660d 100644
--- a/src/cuirass/templates.scm
+++ b/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
@@ -307,6 +314,30 @@ columnDefs: [
                                     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"))
                           (a (@ (class "oi oi-menu dropdown-toggle 
no-dropdown-arrow")
diff --git a/tests/database.scm b/tests/database.scm
index ef1d691..4e95686 100644
--- a/tests/database.scm
+++ b/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"))