branch master updated: Simplify dashboard display.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 962923c  Simplify dashboard display.
962923c is described below

commit 962923c13b914b84098b409948f8e328c74b4056
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Apr 21 12:59:18 2021 +0200

    Simplify dashboard display.
---
 src/cuirass/http.scm      | 90 +++++++++++++++++++++++++++++++----------------
 src/cuirass/templates.scm | 22 ++++++++----
 2 files changed, 75 insertions(+), 37 deletions(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 31b7a22..45a000d 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -425,6 +425,39 @@ into a specification record and return it."
      (priority priority)
      (systems systems))))
 
+(define* (dashboard-page evaluation-id
+                         #:key dashboard-id system)
+  "Return a dashboard page for the evaluation EVALUATION-ID.  If DASHBOARD-ID
+is passed, only display jobs registered for this DASHBOARD-ID.  If SYSTEM is
+passed, only display JOBS targeting this SYSTEM."
+  (let* ((spec-name (db-get-evaluation-specification evaluation-id))
+         (spec (db-get-specification spec-name))
+         (systems (specification-systems spec))
+         (default-system
+           (if (member "x86_64-linux" systems)
+               "x86_64-linux"
+               (car systems)))
+         (dashboard (db-get-dashboard dashboard-id))
+         (names (and dashboard
+                     (assq-ref dashboard #:jobs)))
+         (prev (db-get-previous-eval evaluation-id))
+         (next (db-get-next-eval evaluation-id)))
+    (html-page
+     "Dashboard"
+     (evaluation-dashboard evaluation-id systems
+                           #:current-system
+                           (or system default-system)
+                           #:dashboard-id dashboard-id
+                           #:names names
+                           #:prev-eval prev
+                           #:next-eval next)
+     `(((#:name . ,spec-name)
+        (#:link . ,(string-append "/jobset/" spec-name)))
+       ((#:name . ,(string-append "Evaluation "
+                                  (number->string evaluation-id)))
+        (#:link . ,(string-append "/eval/" (number->string evaluation-id)))))
+     #:margin? #f)))
+
 
 ;;;
 ;;; Web server.
@@ -516,6 +549,11 @@ into a specification record and return it."
                  (content-disposition . (inline))
                  (x-raw-file . ,file)))))
 
+  (define (respond-dashboard-not-found dashboard-id)
+    (respond-json-with-error
+     404
+     (format #f "Dashboard with ID ~a doesn't exist." dashboard-id)))
+
   (define (respond-build-not-found build-id)
     (respond-json-with-error
      404
@@ -825,7 +863,6 @@ into a specification record and return it."
      (let ((dashboard (db-get-dashboard id)))
        (if dashboard
            (let* ((spec (assq-ref dashboard #:specification))
-                  (jobs (assq-ref dashboard #:jobs))
                   (evaluations (db-get-latest-evaluations))
                   (evaluation
                    (any (lambda (eval)
@@ -835,8 +872,8 @@ into a specification record and return it."
                         evaluations))
                   (uri
                    (string->uri-reference
-                    (format #f "/eval/~a/dashboard?names=~a"
-                            evaluation jobs))))
+                    (format #f "/eval/~a/dashboard/~a"
+                            evaluation id))))
              (respond (build-response #:code 302
                                       #:headers `((location . ,uri)))
                       #:body ""))
@@ -896,36 +933,27 @@ into a specification record and return it."
 
     (('GET "eval" (= string->number id) "dashboard")
      (let* ((params (request-parameters request))
-            (names (and=> (assq-ref params 'names)
-                          uri-decode))
-            (system (assq-ref params 'system))
-            (spec-name (db-get-evaluation-specification id)))
-       (if spec-name
-           (let* ((spec (db-get-specification spec-name))
-                  (systems (specification-systems spec))
-                  (default-system
-                    (if (member "x86_64-linux" systems)
-                        "x86_64-linux"
-                        (car systems)))
-                  (prev (db-get-previous-eval id))
-                  (next (db-get-next-eval id)))
-             (respond-html
-              (html-page
-               "Dashboard"
-               (evaluation-dashboard id systems
-                                     #:current-system
-                                     (or system default-system)
-                                     #:names names
-                                     #:prev-eval prev
-                                     #:next-eval next)
-               `(((#:name . ,spec-name)
-                  (#:link . ,(string-append "/jobset/" spec-name)))
-                 ((#:name . ,(string-append "Evaluation "
-                                            (number->string id)))
-                  (#:link . ,(string-append "/eval/" (number->string id)))))
-               #:margin? #f)))
+            (spec (db-get-evaluation-specification id))
+            (system (assq-ref params 'system)))
+       (if spec
+           (respond-html
+            (dashboard-page id #:system system))
            (respond-html-eval-not-found id))))
 
+    (('GET "eval" (= string->number evaluation-id) "dashboard" dashboard-id)
+     (let* ((params (request-parameters request))
+            (eval (db-get-evaluation evaluation-id))
+            (dashboard (db-get-dashboard dashboard-id)))
+       (cond
+        ((not eval)
+         (respond-html-eval-not-found evaluation-id))
+        ((not dashboard)
+         (respond-html-eval-not-found dashboard-id))
+        (else
+         (respond-html
+          (dashboard-page evaluation-id
+                          #:dashboard-id dashboard-id))))))
+
     (('GET "search")
      (let* ((params (request-parameters request))
             (query (and=> (assq-ref params 'query) uri-decode))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 3b61972..5b18fc0 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -1874,6 +1874,7 @@ text-dark d-flex position-absolute w-100"))
 (define* (evaluation-dashboard evaluation systems
                                #:key
                                current-system
+                               dashboard-id
                                names
                                prev-eval
                                next-eval)
@@ -1888,9 +1889,6 @@ $(document).ready(function() {
   var url = new URL(window.location.href);
   var params = url.searchParams;
   var size = Array.from(params).length;
-  if (params.get('names')) {
-    $('#get-dashboard').remove();
-  }
   $('#prev-link').attr('href', function(i, href) {
     if (size > 0)
       return href + '?' + params;
@@ -1920,7 +1918,11 @@ $(document).ready(function() {
                       (class "page-link")
                       (href
                        ,(if prev-eval
-                            (format #f "/eval/~a/dashboard" prev-eval)
+                            (format #f "/eval/~a/dashboard~a"
+                                    prev-eval
+                                    (if dashboard-id
+                                        (format #f "/~a" dashboard-id)
+                                        ""))
                             "#")))
                      (span
                       (@ (aria-hidden "true"))
@@ -1938,7 +1940,11 @@ $(document).ready(function() {
                       (class "page-link")
                       (href
                        ,(if next-eval
-                            (format #f "/eval/~a/dashboard" next-eval)
+                            (format #f "/eval/~a/dashboard~a"
+                                    next-eval
+                                    (if dashboard-id
+                                        (format #f "/~a" dashboard-id)
+                                        ""))
                             "#")))
                      (span
                       (@ (aria-hidden "true"))
@@ -1947,7 +1953,11 @@ $(document).ready(function() {
                       (@ (class "sr-only"))
                       "Next"))))))
       (form (@ (id "get-dashboard")
-               (class "row g-3 mb-3")
+               (class
+                 ,(string-append "row g-3 mb-3 "
+                                 (if names
+                                     "d-none"
+                                     "")))
                (action "/eval/" ,evaluation "/dashboard")
                (method "GET"))
             (div (@ (class "col-auto"))