metrics: Add pending builds support.

* src/cuirass/metrics.scm (db-pending-builds, db-current-day-timestamp): New
procedures.
(%metrics): Add 'pending-builds.
(db-update-metrics): Add it.
* src/cuirass/templates.scm (global-metrics-content): Add "pending-builds"
argument. Display pending builds in a line chart.
* src/cuirass/http.scm (url-handler): Adapt "global-metrics-content" call
accordingly.

3 files changed, 43 insertions, 7 deletions

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 61b1acc..6b20a2b 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -613,6 +613,9 @@ Hydra format."
        (let ((builds-per-day
               (db-get-metrics-with-id 'builds-per-day
                                       #:limit 10))
+             (pending-builds
+              (db-get-metrics-with-id 'pending-builds
+                                      #:limit 10))
              (avg-eval-durations
               (list
                (db-get-metrics-with-id
@@ -623,7 +626,8 @@ Hydra format."
                 'average-eval-duration-per-spec))))
          (global-metrics-content
           #:avg-eval-durations avg-eval-durations
-          #:builds-per-day builds-per-day))
+          #:builds-per-day builds-per-day
+          #:pending-builds pending-builds))
        '())))
 
     (('GET "status")
diff --git a/src/cuirass/metrics.scm b/src/cuirass/metrics.scm
index 3efe688..ea1482a 100644
--- a/src/cuirass/metrics.scm
+++ b/src/cuirass/metrics.scm
@@ -69,6 +69,13 @@ FROM Evaluations WHERE specification = " spec
 WHERE date(stoptime, 'unixepoch') = date('now', '-1 day');")))
       (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
 
+(define (db-pending-builds _)
+  "Return the current pending builds count."
+  (with-db-worker-thread db
+    (let ((rows (sqlite-exec db "SELECT COUNT(*) from Builds
+WHERE status < 0;")))
+      (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
@@ -76,6 +83,13 @@ WHERE date(stoptime, 'unixepoch') = date('now', '-1 day');")))
 date('now', '-1 day'));")))
       (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
 
+(define (db-current-day-timestamp)
+  "Return the timestamp of the current day."
+  (with-db-worker-thread db
+    (let ((rows (sqlite-exec db "SELECT strftime('%s',
+date('now'));")))
+      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+
 
 ;;;
 ;;; Definitions.
@@ -100,7 +114,13 @@ date('now', '-1 day'));")))
    (metric
     (id 'builds-per-day)
     (compute-proc db-builds-previous-day)
-    (field-proc db-previous-day-timestamp))))
+    (field-proc db-previous-day-timestamp))
+
+   ;; Pending builds count.
+   (metric
+    (id 'pending-builds)
+    (compute-proc db-pending-builds)
+    (field-proc db-current-day-timestamp))))
 
 (define (metric->type metric)
   "Return the index of the given METRIC in %metrics list.  This index is used
@@ -187,6 +207,7 @@ timestamp) VALUES ("
     (map (cut assq-ref <> #:name) (db-get-specifications)))
 
   (db-update-metric 'builds-per-day)
+  (db-update-metric 'pending-builds)
 
   ;; Update specification related metrics.
   (for-each (lambda (spec)
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 12df6e0..4f1a278 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -860,8 +860,9 @@ window.~a = new Chart\
 });" id id (scm->json-string chart))))))
 
 (define* (global-metrics-content #:key
+                                 avg-eval-durations
                                  builds-per-day
-                                 avg-eval-durations)
+                                 pending-builds)
   (define (avg-eval-duration-row . eval-durations)
     (let ((spec (match eval-durations
                   (((spec . _) . rest) spec))))
@@ -871,14 +872,15 @@ window.~a = new Chart\
                            (nearest-exact-integer duration))))
                   (map cdr eval-durations)))))
 
-  (define builds-json-scm
+  (define (builds->json-scm builds)
     (apply vector
            (map (match-lambda
                   ((field . value)
                    `((x . ,(* field 1000)) (y . ,value))))
-                builds-per-day)))
+                builds)))
 
-  (let ((builds-chart "builds_per_day"))
+  (let ((builds-chart "builds_per_day")
+        (pending-builds-chart "pending_builds"))
     `((div
        (p (@ (class "lead")) "Global metrics")
        (h6 "Average evaluation duration per specification (seconds).")
@@ -893,7 +895,16 @@ window.~a = new Chart\
        (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 builds-json-scm
+       ,@(make-line-chart builds-chart
+                          (builds->json-scm builds-per-day)
                           #:title "Builds per day"
+                          #:color "#3e95cd")
+       ,@(make-line-chart pending-builds-chart
+                          (builds->json-scm pending-builds)
+                          #:title "Pending builds"
                           #:color "#3e95cd")))))