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: Mon, 12 Jun 2023 17:29:43 -0400 (EDT)

branch: master
commit 8a4cb66123ee909a8966fc0adb3131981b2e95a3
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Jun 12 23:16:13 2023 +0200

    templates: Factorize 'checkout-table'.
    
    * src/cuirass/templates.scm (checkout-table): New procedure.
    (evaluation-build-table): Use it.
---
 src/cuirass/templates.scm | 44 ++++++++++++++++++++++++--------------------
 1 file changed, 24 insertions(+), 20 deletions(-)

diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index b34beb9..c4b2db6 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -1251,6 +1251,29 @@ the nearest exact even integer."
       (format #f "~a minute~:p" (nearest-exact-integer
                                  (/ duration 60)))))
 
+(define (checkout-table checkouts channels)
+  "Return SHTML for a table representing CHECKOUTS."
+  `(table (@ (class "table table-sm table-hover"))
+          (thead
+           (tr (th (@ (class "border-0") (scope "col")) "Channel")
+               (th (@ (class "border-0") (scope "col")) "Commit")))
+          (tbody
+           ,@(map (lambda (checkout)
+                    (let* ((name  (assq-ref checkout #:channel))
+                           (channel (find (lambda (channel)
+                                            (eq? (channel-name channel)
+                                                 name))
+                                          channels))
+                           (url   (channel-url channel))
+                           (commit (assq-ref checkout #:commit)))
+                      ;; Some checkout entries may refer to removed
+                      ;; inputs.
+                      (if channel
+                          `(tr (td ,url)
+                               (td (code ,(commit-hyperlink url commit))))
+                          '())))
+                  checkouts))))
+
 (define* (evaluation-build-table evaluation
                                  #:key
                                  channels
@@ -1280,26 +1303,7 @@ evaluation."
                      (format #f "Evaluation completed ~a in ~a."
                              (time->string evaltime)
                              (seconds->string duration))))))
-    (table (@ (class "table table-sm table-hover"))
-           (thead
-            (tr (th (@ (class "border-0") (scope "col")) "Channel")
-                (th (@ (class "border-0") (scope "col")) "Commit")))
-           (tbody
-            ,@(map (lambda (checkout)
-                     (let* ((name  (assq-ref checkout #:channel))
-                            (channel (find (lambda (channel)
-                                           (eq? (channel-name channel)
-                                                name))
-                                         channels))
-                            (url   (channel-url channel))
-                            (commit (assq-ref checkout #:commit)))
-                       ;; Some checkout entries may refer to removed
-                       ;; inputs.
-                       (if channel
-                           `(tr (td ,url)
-                                (td (code ,(commit-hyperlink url commit))))
-                           '())))
-                   checkouts)))
+    ,(checkout-table checkouts channels)
 
     (p (@ (class "lead"))
        ,(format #f "~@[~a~] ~:[B~;b~]uilds of evaluation #~a"



reply via email to

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