guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]


From: Ludovic Courtès
Date: Fri, 17 Apr 2020 09:08:09 -0400 (EDT)

branch: master
commit c961de2f630ec43eb866d260b528fa0a73cdd004
Author: Ludovic Courtès <address@hidden>
AuthorDate: Fri Apr 17 14:45:13 2020 +0200

    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.
---
 src/cuirass/database.scm  |  2 ++
 src/cuirass/http.scm      |  4 ++++
 src/cuirass/templates.scm | 20 ++++++++++++++++++++
 3 files changed, 26 insertions(+)

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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]