aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-04-17 14:45:13 +0200
committerLudovic Courtès <ludo@gnu.org>2020-04-17 15:07:17 +0200
commitc961de2f630ec43eb866d260b528fa0a73cdd004 (patch)
tree7a4370c08dfa6d7a459ba7b4ec45f47eec6c93cc
parentae8c067d19aa4d544e5aae0abacbfb5e56a1a218 (diff)
downloadcuirass-c961de2f630ec43eb866d260b528fa0a73cdd004.tar
cuirass-c961de2f630ec43eb866d260b528fa0a73cdd004.tar.gz
templates: Evaluation page shows each input and commit.
* src/cuirass/database.scm (db-get-inputs, db-get-checkouts): Export. * src/cuirass/http.scm (evaluation-html-page): Pass #:checkouts and #:inputs to 'evaluation-build-table'. * src/cuirass/templates.scm (evaluation-build-table): Add #:checkouts and #:inputs. Emit a table with "Input" and "Commit" columns.
-rw-r--r--src/cuirass/database.scm2
-rw-r--r--src/cuirass/http.scm4
-rw-r--r--src/cuirass/templates.scm20
3 files changed, 26 insertions, 0 deletions
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index e96dcc3..f80585e 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -49,6 +49,7 @@
db-add-build
db-update-build-status!
db-get-output
+ db-get-inputs
db-get-build
db-get-builds
db-get-builds-by-search
@@ -65,6 +66,7 @@
db-get-evaluations-id-max
db-get-evaluation-specification
db-get-evaluation-summary
+ db-get-checkouts
read-sql-file
read-quoted-string
sqlite-exec
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index dcb8052..c5901f0 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -170,6 +170,8 @@ Hydra format."
(define builds-id-max (db-get-builds-max id status))
(define builds-id-min (db-get-builds-min id status))
(define specification (db-get-evaluation-specification id))
+ (define checkouts (db-get-checkouts id))
+ (define inputs (db-get-inputs specification))
(define builds
(vector->list
@@ -186,6 +188,8 @@ Hydra format."
(html-page
"Evaluation"
(evaluation-build-table evaluation
+ #:checkouts checkouts
+ #:inputs inputs
#:status status
#:builds builds
#:builds-id-min builds-id-min
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 9171956..c639c9d 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -509,6 +509,8 @@ and BUILD-MAX are global minimal and maximal (stoptime, rowid) pairs."
(define* (evaluation-build-table evaluation
#:key
+ (checkouts '())
+ (inputs '())
status builds
builds-id-min builds-id-max)
"Return HTML for an evaluation page, containing a table of builds for that
@@ -518,8 +520,26 @@ evaluation."
(define succeeded (assq-ref evaluation #:succeeded))
(define failed (assq-ref evaluation #:failed))
(define scheduled (assq-ref evaluation #:scheduled))
+ (define spec (assq-ref evaluation #:spec))
`((p (@ (class "lead"))
+ ,(format #f "Evaluation #~a" id))
+ (table (@ (class "table table-sm table-hover"))
+ (thead
+ (tr (th (@ (class "border-0") (scope "col")) "Input")
+ (th (@ (class "border-0") (scope "col")) "Commit")))
+ (tbody
+ ,@(map (lambda (checkout)
+ (let* ((name (assq-ref checkout #:input))
+ (input (find (lambda (input)
+ (string=? (assq-ref input #:name)
+ name))
+ inputs)))
+ `(tr (td ,(assq-ref input #:url))
+ (td (code ,(assq-ref checkout #:commit))))))
+ checkouts)))
+
+ (p (@ (class "lead"))
,(format #f "~@[~a~] ~:[B~;b~]uilds of evaluation #~a"
(and=> status string-capitalize)
status