[no subject]

[Ludovic Courtès]

branch: master
commit 9a9656b4f51fe77e0f9c6a829a13704143652be0
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Aug 23 22:07:46 2023 +0200

    templates: Worker page colors progress bars as a function of the system.
    
    The progress bar of an x86_64-linux build might be blue, that of an
    i686-linux build green, and so on.
    
    * src/cuirass/templates.scm (system->color-class): New procedure.
    (workers-status): Use it to choose progress bar color class based on
    system type.
---
 src/cuirass/templates.scm | 36 +++++++++++++++++++++++++++---------
 1 file changed, 27 insertions(+), 9 deletions(-)

diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 96809f3..222d826 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -1712,15 +1712,26 @@ completed builds divided by the time required to build 
them.")
                          #:labels '("Pending builds")
                          #:colors (list "#3e95cd")))))
 
+(define system->color-class
+  (let ((alist (map cons
+                    %supported-systems
+                    (circular-list "" "bg-success"
+                                   "bg-info" "bg-warning"
+                                   "bg-danger"))))
+    (lambda (system)
+      "Return a Bootstrap color class for SYSTEM, a system type such as
+\"x86_64-linux\"."
+      (or (assoc-ref alist system) ""))))
+
 (define (workers-status workers builds percentages)
   (define (machine-row machine)
-    (let* ((workers (sort (filter-map
-                           (lambda (worker)
-                             (and (string=? (worker-machine worker)
-                                            machine)
-                                  (worker-name worker)))
-                           workers)
-                          string<?)))
+    (let* ((workers (sort (filter (lambda (worker)
+                                    (string=? (worker-machine worker)
+                                              machine))
+                                  workers)
+                          (lambda (w1 w2)
+                            (string<? (worker-name w1)
+                                      (worker-name w2))))))
       `(div (@ (class "col-sm-4 mt-3"))
             (a (@(href "/machine/" ,machine))
                (h6 ,machine))
@@ -1728,8 +1739,10 @@ completed builds divided by the time required to build 
them.")
                     (define build
                       (find (lambda (build)
                               (and (build-worker build)
-                                   (string=? (build-worker build) worker)))
+                                   (string=? (build-worker build)
+                                             (worker-name worker))))
                             builds))
+
                     (define percentage
                       (and build (assq-ref percentages build)))
 
@@ -1740,7 +1753,12 @@ completed builds divided by the time required to build 
them.")
                                              0))))
                       `(div (@ (class "progress mt-1")
                                (style "height: 20px"))
-                            (div (@ (class "progress-bar")
+                            (div (@ (class
+                                      "progress-bar "
+                                      ,(system->color-class
+                                        (if build
+                                            (build-system build)
+                                            (first (worker-systems worker)))))
                                     (role "progressbar")
                                     (style ,style)
                                     (aria-valuemin "0")