metrics: Add 'percentage-failed-eval-per-spec support.

* src/cuirass/metrics.scm (db-percentage-failed-eval-per-spec): New procedure.
(%metrics): Add 'percentage-failure-10-last-eval-per-spec,
'percentage-failure-100-last-eval-per-spec and
'percentage-failed-eval-per-spec metrics.
(db-update-metrics): Add them.
* src/cuirass/templates.scm (global-metrics-content): Add
"percentage-failed-eval" argument. Use it to display the "percentage of failed
evaluations" table.
* src/cuirass/templates.scm (url-handler): Adapt accordingly.

3 files changed, 99 insertions, 38 deletions

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index b9f1eb6..d91d5a2 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -626,12 +626,21 @@ Hydra format."
                (db-get-metrics-with-id
                 'average-100-last-eval-duration-per-spec)
                (db-get-metrics-with-id
-                'average-eval-duration-per-spec))))
+                'average-eval-duration-per-spec)))
+            (percentage-failed-eval
+              (list
+               (db-get-metrics-with-id
+                'percentage-failure-10-last-eval-per-spec)
+               (db-get-metrics-with-id
+                'percentage-failure-100-last-eval-per-spec)
+               (db-get-metrics-with-id
+                'percentage-failed-eval-per-spec))) )
          (global-metrics-content
           #:avg-eval-durations avg-eval-durations
           #:builds-per-day builds-per-day
           #:new-derivations-per-day new-derivations-per-day
-          #:pending-builds pending-builds))
+          #:pending-builds pending-builds
+          #:percentage-failed-eval percentage-failed-eval))
        '())))
 
     (('GET "status")
diff --git a/src/cuirass/metrics.scm b/src/cuirass/metrics.scm
index 6151baf..ba5ed95 100644
--- a/src/cuirass/metrics.scm
+++ b/src/cuirass/metrics.scm
@@ -86,6 +86,16 @@ WHERE date(timestamp, 'unixepoch') = date('now', '-1 day');")))
 WHERE status < 0;")))
       (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
 
+(define* (db-percentage-failed-eval-per-spec spec #:key limit)
+  "Return the failed evaluation percentage for SPEC.  If LIMIT is set, limit
+the percentage computation to the most recent LIMIT records."
+  (with-db-worker-thread db
+    (let ((rows (sqlite-exec db "\
+SELECT 100 * CAST(SUM(status > 0) as float) / COUNT(*) FROM
+(SELECT status from Evaluations WHERE specification = " spec
+" ORDER BY rowid DESC LIMIT " (or limit -1) ");")))
+      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+
 (define (db-previous-day-timestamp)
   "Return the timestamp of the previous day."
   (with-db-worker-thread db
@@ -140,7 +150,22 @@ date('now'));")))
    (metric
     (id 'new-derivations-per-day)
     (compute-proc db-new-derivations-previous-day)
-    (field-proc db-previous-day-timestamp))))
+    (field-proc db-previous-day-timestamp))
+
+   ;; Percentage of failed evaluations per specification.
+   (metric
+    (id 'percentage-failure-10-last-eval-per-spec)
+    (compute-proc
+     (cut db-percentage-failed-eval-per-spec <> #:limit 10)))
+
+   (metric
+    (id 'percentage-failure-100-last-eval-per-spec)
+    (compute-proc
+     (cut db-percentage-failed-eval-per-spec <> #:limit 100)))
+
+   (metric
+    (id 'percentage-failed-eval-per-spec)
+    (compute-proc db-percentage-failed-eval-per-spec))))
 
 (define (metric->type metric)
   "Return the index of the given METRIC in %metrics list.  This index is used
@@ -237,5 +262,12 @@ timestamp) VALUES ("
               (db-update-metric
                'average-100-last-eval-duration-per-spec spec)
               (db-update-metric
-               'average-eval-duration-per-spec spec))
+               'average-eval-duration-per-spec spec)
+
+              (db-update-metric
+               'percentage-failure-10-last-eval-per-spec spec)
+              (db-update-metric
+               'percentage-failure-100-last-eval-per-spec spec)
+              (db-update-metric
+               'percentage-failed-eval-per-spec spec))
             specifications))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 3491d3b..2dfac33 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -874,7 +874,8 @@ window.~a = new Chart\
                                  avg-eval-durations
                                  builds-per-day
                                  new-derivations-per-day
-                                 pending-builds)
+                                 pending-builds
+                                 percentage-failed-eval)
   (define (avg-eval-duration-row . eval-durations)
     (let ((spec (match eval-durations
                   (((spec . _) . rest) spec))))
@@ -884,6 +885,16 @@ window.~a = new Chart\
                            (nearest-exact-integer duration))))
                   (map cdr eval-durations)))))
 
+  (define (percentage-failed-eval-row . percentages)
+    (let ((spec (match percentages
+                  (((spec . _) . rest) spec))))
+      `(tr (td ,spec)
+           ,@(map (lambda (duration)
+                    `(td ,(number->string
+                           (nearest-exact-integer duration))
+                         "%"))
+                  (map cdr percentages)))))
+
   (define (builds->json-scm builds)
     (apply vector
            (map (match-lambda
@@ -893,36 +904,45 @@ window.~a = new Chart\
 
   (let ((builds-chart "builds_per_day")
         (pending-builds-chart "pending_builds"))
-    `((div
-       (p (@ (class "lead")) "Global metrics")
-       (h6 "Average evaluation duration per specification (seconds).")
-       (table
-        (@ (class "table table-sm table-hover table-striped"))
-        (thead (tr (th (@ (scope "col")) "Specification")
-                   (th (@ (scope "col")) "10 last evaluations")
-                   (th (@ (scope "col")) "100 last evaluations")
-                   (th (@ (scope "col")) "All evaluations")))
-        (tbody
-         ,(apply map avg-eval-duration-row avg-eval-durations)))
-       (br)
-       (h6 "Build speed.")
-       (canvas (@ (id ,builds-chart)))
-       (br)
-       (h6 "Pending builds.")
-       (canvas (@ (id ,pending-builds-chart)))
-       ;; Scripts.
-       (script (@ (src "/static/js/chart.js")))
-       ,@(make-line-chart builds-chart
-                          (list (builds->json-scm new-derivations-per-day)
-                                (builds->json-scm builds-per-day))
-                          #:interpolation? #f
-                          #:title "Builds per day"
-                          #:legend? #t
-                          #:labels '("New derivations"
-                                     "Builds completed")
-                          #:colors (list "#f6dd27" "#3e95cd"))
-       ,@(make-line-chart pending-builds-chart
-                          (list (builds->json-scm pending-builds))
-                          #:title "Pending builds"
-                          #:labels '("Pending builds")
-                          #:colors (list "#3e95cd"))))))
+    `((p (@ (class "lead")) "Global metrics")
+      (h6 "Average evaluation duration per specification (seconds).")
+      (table
+       (@ (class "table table-sm table-hover table-striped"))
+       (thead (tr (th (@ (scope "col")) "Specification")
+                  (th (@ (scope "col")) "10 last evaluations")
+                  (th (@ (scope "col")) "100 last evaluations")
+                  (th (@ (scope "col")) "All evaluations")))
+       (tbody
+        ,(apply map avg-eval-duration-row avg-eval-durations)))
+      (br)
+      (h6 "Build speed.")
+      (canvas (@ (id ,builds-chart)))
+      (br)
+      (h6 "Pending builds.")
+      (canvas (@ (id ,pending-builds-chart)))
+      (br)
+      (h6 "Percentage of failed evaluations.")
+      (table
+       (@ (class "table table-sm table-hover table-striped"))
+       (thead (tr (th (@ (scope "col")) "Specification")
+                  (th (@ (scope "col")) "10 last evaluations")
+                  (th (@ (scope "col")) "100 last evaluations")
+                  (th (@ (scope "col")) "All evaluations")))
+       (tbody
+        ,(apply map percentage-failed-eval-row percentage-failed-eval)))
+      ;; Scripts.
+      (script (@ (src "/static/js/chart.js")))
+      ,@(make-line-chart builds-chart
+                         (list (builds->json-scm new-derivations-per-day)
+                               (builds->json-scm builds-per-day))
+                         #:interpolation? #f
+                         #:title "Builds per day"
+                         #:legend? #t
+                         #:labels '("New derivations"
+                                    "Builds completed")
+                         #:colors (list "#f6dd27" "#3e95cd"))
+      ,@(make-line-chart pending-builds-chart
+                         (list (builds->json-scm pending-builds))
+                         #:title "Pending builds"
+                         #:labels '("Pending builds")
+                         #:colors (list "#3e95cd")))))