http: Show number of builds.

* src/cuirass/database.scm (db-get-evaluation-summary): New procedure.
* src/cuirass/http.scm (url-handler): Display number of builds in tabs.

2 files changed, 109 insertions, 70 deletions

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index a0e6c63..4733d3d 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -58,6 +58,7 @@
             db-get-evaluations-id-min
             db-get-evaluations-id-max
             db-get-evaluation-specification
+            db-get-evaluation-summary
             read-sql-file
             read-quoted-string
             sqlite-exec
@@ -802,6 +803,31 @@ SELECT MAX(id) FROM Evaluations
 WHERE specification=" spec)))
       (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
 
+(define (db-get-evaluation-summary id)
+  (with-db-critical-section db
+    (let ((rows (sqlite-exec db "
+SELECT E.id, E.in_progress, B.total, B.succeeded, B.failed, B.scheduled
+FROM
+ (SELECT id, in_progress
+FROM Evaluations
+WHERE (id=" id ")) E
+LEFT JOIN
+ (SELECT rowid, evaluation, SUM(status=0) as succeeded,
+SUM(status>0) as failed, SUM(status<0) as scheduled, SUM(status>-100) as total
+FROM Builds
+GROUP BY evaluation) B
+ON B.evaluation=E.id
+ORDER BY E.id ASC;")))
+      (and=> (expect-one-row rows)
+             (match-lambda
+               (#(id in-progress total succeeded failed scheduled)
+                `((#:id . ,id)
+                  (#:in-progress . ,in-progress)
+                  (#:total . ,(or total 0))
+                  (#:succeeded . ,(or succeeded 0))
+                  (#:failed . ,(or failed 0))
+                  (#:scheduled . ,(or scheduled 0)))))))))
+
 (define (db-get-builds-query-min query)
   "Return the smallest build row identifier matching QUERY."
   (with-db-critical-section db
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 75201a5..5bd736b 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -333,77 +333,90 @@ Hydra format."
             (border-low-time (assq-ref params 'border-low-time))
             (border-high-id (assq-ref params 'border-high-id))
             (border-low-id (assq-ref params 'border-low-id))
-            (specification (db-get-evaluation-specification id)))
+            (specification (db-get-evaluation-specification id))
+            (evaluation (db-get-evaluation-summary id)))
        (if specification
-           (respond-html
-            (html-page
-             "Evaluation"
-             `((p (@ (class "lead"))
-                  ,(format #f "~@[~a~] ~:[B~;b~]uilds of evaluation #~a"
-                           (and=> status string-capitalize)
-                           status
-                           id))
-               (ul (@ (class "nav nav-tabs"))
-                   (li (@ (class "nav-item"))
-                       (a (@ (class ,(string-append "nav-link "
-                                                    (match status
-                                                      (#f "active")
-                                                      (_ ""))))
-                             (href "?all="))
-                          "All"))
-                   (li (@ (class "nav-item"))
-                       (a (@ (class ,(string-append "nav-link "
-                                                    (match status
-                                                      ("pending" "active")
-                                                      (_ ""))))
-                             (href "?status=pending"))
-                          (span (@ (class "oi oi-clock text-warning")
-                                   (title "Scheduled")
-                                   (aria-hidden "true"))
-                                "")
-                          " Scheduled"))
-                   (li (@ (class "nav-item"))
-                       (a (@ (class ,(string-append "nav-link "
-                                                    (match status
-                                                      ("succeeded" "active")
-                                                      (_ ""))))
-                             (href "?status=succeeded"))
-                          (span (@ (class "oi oi-check text-success")
-                                (title "Succeeded")
-                                (aria-hidden "true"))
-                             "")
-                          " Succeeded"))
-                   (li (@ (class "nav-item"))
-                       (a (@ (class ,(string-append "nav-link "
-                                                    (match status
-                                                      ("failed" "active")
-                                                      (_ ""))))
-                             (href "?status=failed"))
-                          (span (@ (class "oi oi-x text-danger")
-                                   (title "Failed")
-                                   (aria-hidden "true"))
-                                "")
-                          " Failed")))
-               (div (@ (class "tab-content pt-3"))
-                    (div (@ (class "tab-pane show active"))
-                         ,(build-eval-table
-                           id
-                           (handle-builds-request
-                            `((evaluation . ,id)
-                              (status . ,(and=> status string->symbol))
-                              (nr . ,%page-size)
-                              (order . finish-time+build-id)
-                              (border-high-time . ,border-high-time)
-                              (border-low-time . ,border-low-time)
-                              (border-high-id . ,border-high-id)
-                              (border-low-id . ,border-low-id)))
-                           builds-id-min
-                           builds-id-max
-                           status))))
-             `(((#:name . ,specification)
-                (#:link . ,(string-append "/jobset/" specification)))
-               ((#:name . ,(string-append "Evaluation " id))
-                (#:link . ,(string-append "/eval/" id))))))
+           (let ((total     (assq-ref evaluation #:total))
+                 (succeeded (assq-ref evaluation #:succeeded))
+                 (failed    (assq-ref evaluation #:failed))
+                 (scheduled (assq-ref evaluation #:scheduled)))
+             (respond-html
+              (html-page
+               "Evaluation"
+               `((p (@ (class "lead"))
+                    ,(format #f "~@[~a~] ~:[B~;b~]uilds of evaluation #~a"
+                             (and=> status string-capitalize)
+                             status
+                             id))
+                 (ul (@ (class "nav nav-tabs"))
+                     (li (@ (class "nav-item"))
+                         (a (@ (class ,(string-append "nav-link "
+                                                      (match status
+                                                        (#f "active")
+                                                        (_ ""))))
+                               (href "?all="))
+                            "All "
+                            (span (@ (class "badge badge-light badge-pill"))
+                                  ,total)))
+                     (li (@ (class "nav-item"))
+                         (a (@ (class ,(string-append "nav-link "
+                                                      (match status
+                                                        ("pending" "active")
+                                                        (_ ""))))
+                               (href "?status=pending"))
+                            (span (@ (class "oi oi-clock text-warning")
+                                     (title "Scheduled")
+                                     (aria-hidden "true"))
+                                  "")
+                            " Scheduled "
+                            (span (@ (class "badge badge-light badge-pill"))
+                                  ,scheduled)))
+                     (li (@ (class "nav-item"))
+                         (a (@ (class ,(string-append "nav-link "
+                                                      (match status
+                                                        ("succeeded" "active")
+                                                        (_ ""))))
+                               (href "?status=succeeded"))
+                            (span (@ (class "oi oi-check text-success")
+                                     (title "Succeeded")
+                                     (aria-hidden "true"))
+                                  "")
+                            " Succeeded "
+                            (span (@ (class "badge badge-light badge-pill"))
+                                  ,succeeded)))
+                     (li (@ (class "nav-item"))
+                         (a (@ (class ,(string-append "nav-link "
+                                                      (match status
+                                                        ("failed" "active")
+                                                        (_ ""))))
+                               (href "?status=failed"))
+                            (span (@ (class "oi oi-x text-danger")
+                                     (title "Failed")
+                                     (aria-hidden "true"))
+                                  "")
+                            " Failed "
+                            (span (@ (class "badge badge-light badge-pill"))
+                                  ,failed))))
+                 (div (@ (class "tab-content pt-3"))
+                      (div (@ (class "tab-pane show active"))
+                           ,(build-eval-table
+                             id
+                             (handle-builds-request
+                              `((evaluation . ,id)
+                                (status . ,(and=> status string->symbol))
+                                (nr . ,%page-size)
+                                (order . finish-time+build-id)
+                                (border-high-time . ,border-high-time)
+                                (border-low-time . ,border-low-time)
+                                (border-high-id . ,border-high-id)
+                                (border-low-id . ,border-low-id)))
+                             builds-id-min
+                             builds-id-max
+                             status))))
+               `(((#:name . ,specification)
+                  (#:link . ,(string-append "/jobset/" specification)))
+                 ((#:name . ,(string-append "Evaluation " id))
+                  (#:link . ,(string-append "/eval/" id)))))))
            (respond-html-eval-not-found id))))
 
     (("search")