database: Add a Checkouts table.

It is used to know when a new evaluation must be triggered and to display
input changes.

* Makefile.am (dist_sql_DATA): Add 'src/sql/upgrade-3.sql'.
* bin/cuirass.in (main): Call DB-SET-EVALUATION-DONE at startup to clear
'in-progress' evaluations.
* bin/evaluate.in (input-checkout, format-checkouts): Rename '#:name' to
'#:input'.
* doc/cuirass.texi (Stamps): Remove section.
(Checkouts): New section.
* src/cuirass/base.scm (fetch-input, fetch-inputs, compile-checkouts): Rename
'#:name' to '#:input'.
(evaluate): Remove the COMMITS argument.  Add an EVAL-ID argument.  Don't call
DB-ADD-EVALUATION because it was called sooner.  Remove the EVAL-ID argument
to AUGMENT-JOB because it's a closure.
(build-packages): Add an EVAL-ID argument.  Call DB-SET-EVALUATION-DONE once
all the derivations are registered.
(process-specs): Replace the stamping mechanism by the primary key constraint
of the Checkouts table: call "evaluate" only when DB-ADD-EVALUATION is true,
which means that at least one checkout was added.  Change the EVALUATE and
BUILD-PACKAGES arguments accordingly.
* src/cuirass/database.scm (db-add-stamp, db-get-stamp): Remove procedures.
(db-set-evaluations-done, db-set-evaluation-done): New exported procedure.
(db-add-checkout): New procedure that returns #f if a checkout with the same
revision already exists.
(db-add-evaluation): Replace the EVAL argument with a SPEC-NAME and a
CHECKOUTS arguments.  Insert the evaluation only if at least one checkout was
inserted.  Return #f otherwise.
(db-get-checkouts): New procedure.
(db-get-evaluations, db-get-evaluations-build-summary): Handle the
'in_progress' column, remove the 'commits' column.  Return the result of
DB-GET-CHECKOUTS as part of the evaluation.
* src/cuirass/templates.scm (input-changes, evaluation-badges): New
procedures.
(evaluation-info-table): Rename "Commits" to "Input changes".  Use
INPUT-CHANGES to display the input changes that triggered the evaluation.  Use
EVALUATION-BADGES to display a message indicating that the evaluation is in
progress.
* src/schema.sql (Stamps): Remove table.
(Checkouts): New table.
(Evaluations): Remove the 'commits' column.  Add an 'in_progress' column.
* src/sql/upgrade-3.sql: New file with SQL queries to upgrade the database.
* tests/database.scm (make-dummy-eval): Remove procedure.
(make-dummy-checkouts): New procedure.
("sqlite-exec"): Remove the 'commits' column.  Add the 'in_progress' column.
("db-update-build-status!", "db-get-builds", "db-get-pending-derivations"):
Update the arguments of DB-ADD-EVALUATION accordingly.
* tests/http.scm (hash-table=?): Add support for lists of hash tables.
(evaluations-query-result): Replace '#:commits' with '#:checkouts'.  Return a
list instead of returning one element, for symmetry.
("fill-db"): Add a new input so that the second checkout can refer to it.
Replace EVALUATION1 and EVALUATION2 with CHECKOUTS1 and CHECKOUTS2.  Update
the arguments of DB-ADD-EVALUATION accordingly.
("/api/queue?nr=100"): Take the CAR of the EVALUATIONS-QUERY-RESULT list to
make it symmetrical with the other argument of HASH-TABLE=?.

1 files changed, 24 insertions, 11 deletions

diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 6ba3a06..7ee579c 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -100,6 +100,27 @@
                        (href ,last-link))
                     "Last >>"))))))
 
+(define (input-changes checkouts)
+  (let ((changes
+         (string-join
+          (map (lambda (checkout)
+                 (let ((input (assq-ref checkout #:input))
+                       (commit (assq-ref checkout #:commit)))
+                   (format #f "~a → ~a" input (substring commit 0 7))))
+               checkouts)
+          ", ")))
+    (if (string=? changes "") '(em "None") changes)))
+
+(define (evaluation-badges evaluation)
+  (if (zero? (assq-ref evaluation #:in-progress))
+      `((a (@ (href "#") (class "badge badge-success"))
+           ,(assq-ref evaluation #:succeeded))
+        (a (@ (href "#") (class "badge badge-danger"))
+           ,(assq-ref evaluation #:failed))
+        (a (@ (href "#") (class "badge badge-secondary"))
+           ,(assq-ref evaluation #:scheduled)))
+      '((em "In progress…"))))
+
 (define (evaluation-info-table name evaluations id-min id-max)
   "Return HTML for the EVALUATION table NAME. ID-MIN and ID-MAX are
   global minimal and maximal id."
@@ -111,7 +132,7 @@
            `((thead
               (tr
                (th (@ (scope "col")) "#")
-               (th (@ (scope "col")) Commits)
+               (th (@ (scope "col")) "Input changes")
                (th (@ (scope "col")) Success)))
              (tbody
               ,@(map
@@ -119,16 +140,8 @@
                    `(tr (th (@ (scope "row"))
                             (a (@ (href "/eval/" ,(assq-ref row #:id)))
                                ,(assq-ref row #:id)))
-                        (td ,(string-join
-                              (map (cut substring <> 0 7)
-                                   (string-tokenize (assq-ref row #:commits)))
-                              ", "))
-                        (td (a (@ (href "#") (class "badge badge-success"))
-                               ,(assq-ref row #:succeeded))
-                            (a (@ (href "#") (class "badge badge-danger"))
-                               ,(assq-ref row #:failed))
-                            (a (@ (href "#") (class "badge badge-secondary"))
-                               ,(assq-ref row #:scheduled)))))
+                        (td ,(input-changes (assq-ref row #:checkouts)))
+                        (td ,@(evaluation-badges row))))
                  evaluations)))))
     ,(if (null? evaluations)
          (pagination "" "" "" "")