templates: Allow to filter builds by status.

* src/cuirass/database.scm (db-get-builds): Add 'succeeded' and 'failed'
status filters.
(db-get-builds-min, db-get-builds-max): Add support for a new 'status'
argument.
* src/cuirass/http.scm (url-handler): Add a status argument for the '/eval/id'
endpoint.
* src/cuirass/templates.scm (evaluation-badges): Add links to the buttons.
(build-eval-table): Add a 'status' argument.

Co-authored-by: Clément Lassieur <clement@lassieur.org>

3 files changed, 63 insertions, 33 deletions

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 9664f1b..e17d4f0 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -559,7 +559,9 @@ AND (:job IS NULL OR (:job = Builds.job_name))
 AND (:system IS NULL OR (:system = Builds.system))
 AND (:evaluation IS NULL OR (:evaluation = Builds.evaluation))
 AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0)
-                     OR (:status = 'pending' AND Builds.status < 0))
+                     OR (:status = 'pending' AND Builds.status < 0)
+                     OR (:status = 'succeeded' AND Builds.status = 0)
+                     OR (:status = 'failed' AND Builds.status > 0))
 AND (:borderlowtime IS NULL OR :borderlowid IS NULL
  OR ((:borderlowtime, :borderlowid) < (Builds.stoptime, Builds.rowid)))
 AND (:borderhightime IS NULL OR :borderhighid IS NULL
@@ -712,26 +714,40 @@ SELECT MAX(id) FROM Evaluations
 WHERE specification=" spec)))
       (vector-ref (car rows) 0))))
 
-(define (db-get-builds-min eval)
-  "Return the min build (stoptime, id) pair for
-   the given evaluation EVAL."
+(define (db-get-builds-min eval status)
+  "Return the min build (stoptime, rowid) pair for the given evaluation EVAL
+and STATUS."
   (with-db-critical-section db
     (let ((rows (sqlite-exec db "
 SELECT stoptime, MIN(rowid) FROM
 (SELECT rowid, stoptime FROM Builds
-WHERE evaluation=" eval " AND
-stoptime = (SELECT MIN(stoptime)
-FROM Builds WHERE evaluation=" eval "))")))
+WHERE evaluation=" eval "
+AND stoptime = (SELECT MIN(stoptime)
+FROM Builds
+WHERE evaluation = " eval "
+AND (" status " IS NULL OR (" status " = 'pending'
+                            AND Builds.status < 0)
+                        OR (" status " = 'succeeded'
+                            AND Builds.status = 0)
+                        OR (" status " = 'failed'
+                            AND Builds.status > 0))))")))
       (vector->list (car rows)))))
 
-(define (db-get-builds-max eval)
-  "Return the max build (stoptime, id) pair for
-   the given evaluation EVAL."
+(define (db-get-builds-max eval status)
+  "Return the max build (stoptime, rowid) pair for the given evaluation EVAL
+and STATUS."
   (with-db-critical-section db
     (let ((rows (sqlite-exec db "
 SELECT stoptime, MAX(rowid) FROM
 (SELECT rowid, stoptime FROM Builds
 WHERE evaluation=" eval " AND
 stoptime = (SELECT MAX(stoptime)
-FROM Builds WHERE evaluation=" eval "))")))
+FROM Builds
+WHERE evaluation = " eval "
+AND (" status " IS NULL OR (" status " = 'pending'
+                            AND Builds.status < 0)
+                        OR (" status " = 'succeeded'
+                            AND Builds.status = 0)
+                        OR (" status " = 'failed'
+                            AND Builds.status > 0))))")))
       (vector->list (car rows)))))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index d70517b..7878452 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -295,9 +295,10 @@ Hydra format."
 
     (("eval" id)
      (respond-html
-      (let* ((builds-id-max (db-get-builds-max id))
-             (builds-id-min (db-get-builds-min id))
-             (params (request-parameters request))
+      (let* ((params (request-parameters request))
+             (status (assq-ref params 'status))
+             (builds-id-max (db-get-builds-max id status))
+             (builds-id-min (db-get-builds-min id status))
              (border-high-time (assq-ref params 'border-high-time))
              (border-low-time (assq-ref params 'border-low-time))
              (border-high-id (assq-ref params 'border-high-id))
@@ -306,6 +307,7 @@ Hydra format."
          "Evaluation"
          (build-eval-table
           (handle-builds-request `((evaluation . ,id)
+                                   (status . ,(and=> status string->symbol))
                                    (nr . ,%page-size)
                                    (order . finish-time+build-id)
                                    (border-high-time . ,border-high-time)
@@ -313,7 +315,8 @@ Hydra format."
                                    (border-high-id . ,border-high-id)
                                    (border-low-id . ,border-low-id)))
           builds-id-min
-          builds-id-max)))))
+          builds-id-max
+          status)))))
 
     (("static" path ...)
      (respond-static-file path))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 7ee579c..31c6081 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -113,11 +113,14 @@
 
 (define (evaluation-badges evaluation)
   (if (zero? (assq-ref evaluation #:in-progress))
-      `((a (@ (href "#") (class "badge badge-success"))
+      `((a (@ (href "/eval/" ,(assq-ref evaluation #:id) "?status=succeeded")
+              (class "badge badge-success"))
            ,(assq-ref evaluation #:succeeded))
-        (a (@ (href "#") (class "badge badge-danger"))
+        (a (@ (href "/eval/" ,(assq-ref evaluation #:id) "?status=failed")
+              (class "badge badge-danger"))
            ,(assq-ref evaluation #:failed))
-        (a (@ (href "#") (class "badge badge-secondary"))
+        (a (@ (href "/eval/" ,(assq-ref evaluation #:id) "?status=pending")
+              (class "badge badge-secondary"))
            ,(assq-ref evaluation #:scheduled)))
       '((em "In progress…"))))
 
@@ -158,9 +161,9 @@
                 (format #f "?border-high=~d" page-id-min))
             (format #f "?border-low=~d" (1- id-min)))))))
 
-(define (build-eval-table builds build-min build-max)
-  "Return HTML for the BUILDS table NAME. BUILD-MIN and BUILD-MAX are
-   global minimal and maximal (stoptime, id) pairs."
+(define (build-eval-table builds build-min build-max status)
+  "Return HTML for the BUILDS table evaluation with given STATUS.  BUILD-MIN
+and BUILD-MAX are global minimal and maximal (stoptime, rowid) pairs."
   (define (table-header)
     `(thead
       (tr
@@ -217,19 +220,27 @@
                 (page-build-min (last build-time-ids))
                 (page-build-max (first build-time-ids)))
            (pagination
-            (format #f "?border-high-time=~d&border-high-id=~d"
-                    (build-stoptime build-max)
-                    (1+ (build-id build-max)))
+            (format
+             #f "?border-high-time=~d&border-high-id=~d~@[&status=~a~]"
+             (build-stoptime build-max)
+             (1+ (build-id build-max))
+             status)
             (if (equal? page-build-max build-max)
                 ""
-                (format #f "?border-low-time=~d&border-low-id=~d"
-                        (build-stoptime page-build-max)
-                        (build-id page-build-max)))
+                (format
+                 #f "?border-low-time=~d&border-low-id=~d~@[&status=~a~]"
+                 (build-stoptime page-build-max)
+                 (build-id page-build-max)
+                 status))
             (if (equal? page-build-min build-min)
                 ""
-                (format #f "?border-high-time=~d&border-high-id=~d"
-                        (build-stoptime page-build-min)
-                        (build-id page-build-min)))
-            (format #f "?border-low-time=~d&border-low-id=~d"
-                    (build-stoptime build-min)
-                    (1- (build-id build-min))))))))
+                (format
+                 #f "?border-high-time=~d&border-high-id=~d~@[&status=~a~]"
+                 (build-stoptime page-build-min)
+                 (build-id page-build-min)
+                 status))
+            (format
+             #f "?border-low-time=~d&border-low-id=~d~@[&status=~a~]"
+             (build-stoptime build-min)
+             (1- (build-id build-min))
+             status))))))