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.
This commit is contained in:
Ludovic Courtès 2020-04-17 14:45:13 +02:00
parent ae8c067d19
commit c961de2f63
3 changed files with 26 additions and 0 deletions

View File

@ -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

View File

@ -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

View File

@ -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