branch master updated: Add "latest builds" support.

[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 136a829  Add "latest builds" support.
136a829 is described below

commit 136a8295e4e09724eccc230c127fb880aa84b57d
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Thu Jul 2 21:07:21 2020 +0200

    Add "latest builds" support.
    
    Add a "status" dropdown menu in the navigation bar. For now this menu only
    contains one item, a link to the "latest builds" page at "/status" location.
    
    * src/cuirass/database.scm (db-get-builds): Add support for 'started status.
    * src/cuirass/http.scm (url-handler): Add "/status" route.
    * src/cuirass/templates.scm (running-builds-table): New procedure,
    (html-page): add a dropdown menu containing one item, a link to "/status"
    route defined above.
    * src/static/css/cuirass.css: Add new class to allow bootstrap dropdown 
menus
    to work without javascript plugin.
---
 src/cuirass/database.scm   |  1 +
 src/cuirass/http.scm       |  9 +++++++++
 src/cuirass/templates.scm  | 46 ++++++++++++++++++++++++++++++++++++++++++----
 src/static/css/cuirass.css | 22 ++++++++++++++++++++++
 4 files changed, 74 insertions(+), 4 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index ea56db3..3564217 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -770,6 +770,7 @@ FILTERS is an assoc list whose possible keys are 
'derivation | 'id | 'jobset |
         (status          . ,(match (assq-ref filters 'status)
                               (#f         #f)
                               ('done      "Builds.status >= 0")
+                              ('started   "Builds.status = -1")
                               ('pending   "Builds.status < 0")
                               ('succeeded "Builds.status = 0")
                               ('failed    "Builds.status > 0")))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 3602f9f..36143b4 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -570,6 +570,15 @@ Hydra format."
               (respond-json-with-error 500 "No build found.")))
            (respond-json-with-error 500 "Query parameter not provided."))))
 
+    (('GET "status")
+     (respond-html
+      (html-page
+       "Running builds"
+       (running-builds-table
+        (db-get-builds `((status . started)
+                         (order . status+submission-time))))
+       '())))
+
     (('GET "download" id)
      (let ((path (db-get-build-product-path id)))
        (respond-file path)))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 0f90b53..4c43e8a 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -38,7 +38,8 @@
             build-eval-table
             build-search-results-table
             build-details
-            evaluation-build-table))
+            evaluation-build-table
+            running-builds-table))
 
 (define (navigation-items navigation)
   (match navigation
@@ -112,15 +113,28 @@ system whose names start with " (code "guile-") ":" (br)
                    (href "/static/css/cuirass.css")))
           (title ,title))
          (body
-          (nav (@ (class "navbar navbar-expand navbar-light bg-light"))
+          (nav (@ (class "navbar navbar-expand-lg navbar-light bg-light"))
                (a (@ (class "navbar-brand pt-0")
                      (href "/"))
                   (img (@ (src "/static/images/logo.png")
                           (alt "logo")
                           (height "25")
                           (style "margin-top: -12px"))))
-               (div (@ (class "navbar-collapse"))
-                    (ul (@ (class "navbar-nav"))
+               (div (@ (class "collapse navbar-collapse"))
+                    (ul (@ (class "navbar-nav mr-auto"))
+                        (li (@ (class "nav-item dropdown"))
+                            (a (@ (class "nav-link dropdown-toggle")
+                                  (data-toggle "dropdown")
+                                  (href "#")
+                                  (role "button")
+                                  (aria-haspopup "true")
+                                  (aria-expanded "false"))
+                               "Status")
+                            (div (@ (class "dropdown-menu")
+                                    (aria-labelledby "navbarDropdow"))
+                                 (a (@ (class "dropdown-item")
+                                       (href "/status"))
+                                    "Latest builds")))
                         (li (@ (class "nav-item"))
                             (a (@ (class "nav-link" ,(if (null? navigation)
                                                          " active" ""))
@@ -748,3 +762,27 @@ and BUILD-MAX are global minimal and maximal row 
identifiers."
              #f "?query=~a&border-low-id=~d"
              query
              (1- (first build-min))))))))
+
+(define (running-builds-table builds)
+  "Return HTML for the running builds table."
+  (define (build-row build)
+    `(tr
+      (th (@ (scope "row"))
+          (a (@ (href "/build/" ,(assq-ref build #:id) "/details"))
+             ,(assq-ref build #:id)))
+      (td ,(assq-ref build #:job-name))
+      (td ,(time->string
+            (assq-ref build #:starttime)))
+      (td ,(assq-ref build #:system))))
+
+  `((p (@ (class "lead")) "Running builds")
+    (table
+     (@ (class "table table-sm table-hover table-striped"))
+     ,@(if (null? builds)
+           `((th (@ (scope "col")) "No elements here."))
+           `((thead (tr (th (@ (scope "col")) "ID")
+                        (th (@ (scope "col")) "Job")
+                        (th (@ (scope "col")) "Queued at")
+                        (th (@ (scope "col")) "System")))
+             (tbody
+              ,(map build-row builds)))))))
diff --git a/src/static/css/cuirass.css b/src/static/css/cuirass.css
index 313b6a8..4e97c3d 100644
--- a/src/static/css/cuirass.css
+++ b/src/static/css/cuirass.css
@@ -15,3 +15,25 @@
 #search:focus-within #search-hints {
     display: block;
 }
+
+/*
+ This is taken from: https://gist.github.com/YushengLi/824d3317f36c31f3d3e9 to
+ allow bootstrap dropdown menus to work without the associated javascript
+ plugin.
+ */
+a.dropdown-toggle:focus {
+    pointer-events: none;
+}
+
+a.dropdown-toggle:focus + .dropdown-menu {
+    opacity: 1;
+    visibility: visible;
+    pointer-events: auto;
+}
+
+.dropdown-menu {
+    opacity: 0;
+    display: block;
+    visibility: hidden;
+    transition: visibility 0.5s;
+}