[no subject]

[Ludovic Courtès]

branch: main
commit 9eea7c42bb2d0d17941c69bc6fcd957bcaf3274b
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jun 7 18:08:24 2024 +0200

    http: Improve HTML page titles.
    
    * src/cuirass/http.scm (evaluation-html-page, metrics-page)
    (machine-page, dashboard-page, url-handler): Capitalize page titles
    passed to ‘html-page’ and contextualize them.
---
 src/cuirass/http.scm | 61 ++++++++++++++++++++++++++++++----------------------
 1 file changed, 35 insertions(+), 26 deletions(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 0a2a30f..a29e18f 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -311,7 +311,8 @@ Hydra format."
         (order . finish-time+build-id)))))
 
   (html-page
-   "Evaluation"
+   (string-append "Evaluation " (number->string id)
+                  " — " specification)
    (evaluation-build-table evaluation
                            #:channels channels
                            #:checkouts checkouts
@@ -327,7 +328,7 @@ Hydra format."
 
 (define* (metrics-page)
   (html-page
-   "Global metrics"
+   "Global Metrics"
    (global-metrics-content
     #:avg-eval-durations
     (list
@@ -408,7 +409,7 @@ Hydra format."
                            (string=? name (worker-machine worker)))
                          (db-get-workers))))
     (html-page
-     name
+     (string-append name " — Machine Status")
      (machine-status name workers
                      (map (lambda (worker)
                             (filter (lambda (build)
@@ -502,7 +503,8 @@ passed, only display JOBS targeting this SYSTEM."
          (prev (db-get-previous-eval evaluation-id))
          (next (db-get-next-eval evaluation-id)))
     (html-page
-     "Dashboard"
+     (string-append "Evaluation " (number->string evaluation-id)
+                    " — " spec-name " — Dashboard")
      (evaluation-dashboard (db-get-evaluation evaluation-id)
                            systems
                            #:channels channels
@@ -681,7 +683,7 @@ bogus reply is received, return DEFAULT."
 
   (define (respond-html-eval-not-found eval-id)
     (respond-html
-     (html-page "Page not found"
+     (html-page "Page Not Found"
                 (format #f "Evaluation with ID ~a doesn't exist." eval-id)
                 '())
      #:code 404))
@@ -711,7 +713,7 @@ bogus reply is received, return DEFAULT."
        (if (db-get-specification name)
            (respond-html
             (html-page
-             "Creation error"
+             "Error — Failed to Add Specification"
              `(div (@ (class "alert alert-danger"))
                    ,(format #f "Specification ~a already exists" name))
              '())
@@ -840,7 +842,7 @@ bogus reply is received, return DEFAULT."
     (('GET "specification" "add")
      (respond-html
       (html-page
-       "Add specification"
+       "Add Specification"
        (specification-edit)
        '())))
 
@@ -848,7 +850,8 @@ bogus reply is received, return DEFAULT."
      (let ((spec (db-get-specification name)))
        (respond-html
         (html-page
-         "Edit specification"
+         (string-append "Jobset " name
+                        " — Edit Specification")
          (specification-edit spec)
          '()))))
 
@@ -896,7 +899,9 @@ bogus reply is received, return DEFAULT."
        (if build
            (respond-html
             (html-page
-             (string-append "Build " (number->string id))
+             (string-append "Build " (number->string id)
+                            " — " (build-nix-name build)
+                            " — " (build-specification-name build))
              (build-details build dependencies products history
                             #:channels (specification-channels spec)
                             #:checkouts checkouts
@@ -919,7 +924,9 @@ bogus reply is received, return DEFAULT."
        (if (and log (file-exists? log))
            (respond-html
             (html-page
-             (string-append "Build log of build #" (number->string id))
+             (string-append "Log — Build " (number->string id)
+                            " — " (build-nix-name build)
+                            " — " (build-specification-name build))
              (pretty-build-log id)
              `(((#:name . ,(string-append "Build #" (number->string id)))
                 (#:link
@@ -1074,7 +1081,7 @@ bogus reply is received, return DEFAULT."
                                     (order . status+submission-time)))))))))
     (('GET)
      (respond-html (html-page
-                    "Cuirass"
+                    "Cuirass — Your friendly Guix continuous integration 
service."
                     (let ((evals (db-get-latest-evaluations)))
                       (specifications-table
                        (db-get-specifications)
@@ -1122,18 +1129,20 @@ bogus reply is received, return DEFAULT."
              (last-updates
               (call-bridge `(jobset-last-update-times ,(string->symbol name))
                            bridge)))
-        (html-page name (evaluation-info-table name
-                                               evaluations
-                                               evaluation-id-min
-                                               evaluation-id-max
-                                               #:active?
-                                               active?
-                                               #:absolute-summary
-                                               absolute-summary
-                                               #:last-update-times
-                                               last-updates)
-                   `(((#:name . ,name)
-                      (#:link . ,(string-append "/jobset/" name))))))))
+        (html-page
+         (string-append "Jobset " name)
+         (evaluation-info-table name
+                                evaluations
+                                evaluation-id-min
+                                evaluation-id-max
+                                #:active?
+                                active?
+                                #:absolute-summary
+                                absolute-summary
+                                #:last-update-times
+                                last-updates)
+         `(((#:name . ,name)
+            (#:link . ,(string-append "/jobset/" name))))))))
 
     (('GET "eval" "latest")
      (let* ((params (request-parameters request))
@@ -1229,7 +1238,7 @@ bogus reply is received, return DEFAULT."
        (if query
            (respond-html
             (html-page
-             "Search results"
+             "Search Results"
              (build-search-results-table
               query
               (with-time-logging
@@ -1339,7 +1348,7 @@ bogus reply is received, return DEFAULT."
     (('GET "workers")
      (respond-html
       (html-page
-       "Workers status"
+       "Worker Status"
        (let* ((workers (db-get-workers))
               (builds (db-worker-current-builds))
               (percentages (db-get-build-percentages builds)))
@@ -1353,7 +1362,7 @@ bogus reply is received, return DEFAULT."
     (('GET "status")
      (respond-html
       (html-page
-       "Running builds"
+       "Running Builds"
        (running-builds-table
         (db-get-builds `((status . started)
                          (order . status+submission-time))))