diff options
| -rw-r--r-- | src/cuirass/database.scm | 2 | ||||
| -rw-r--r-- | src/cuirass/http.scm | 4 | ||||
| -rw-r--r-- | src/cuirass/templates.scm | 20 |
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 |