guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]


From: Tatiana
Date: Sun, 5 Aug 2018 15:26:12 -0400 (EDT)

branch: web-interface
commit a298d99dd552e7d9beca9ab73566aac76f44faed
Author: TSholokhova <address@hidden>
Date:   Sun Aug 5 21:25:37 2018 +0200

    web-interface: Add navigation bar.
    
        * src/cuirass/database.scm (db-get-evaluation-specification): Request 
specification for given evaluation.
        * src/cuirass/templates.scm (html-page): Add navigation bar.
        * src/cuirass/http.scm: Fill navigation parameters.
---
 src/cuirass/database.scm  |  8 ++++++++
 src/cuirass/http.scm      | 19 +++++++++++++++----
 src/cuirass/templates.scm | 21 +++++++++++++++++----
 3 files changed, 40 insertions(+), 8 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 9232a06..ee09a97 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -55,6 +55,7 @@
             db-get-evaluations-build-summary
             db-get-evaluations-id-min
             db-get-evaluations-id-max
+            db-get-evaluation-specification
             read-sql-file
             read-quoted-string
             sqlite-exec
@@ -729,3 +730,10 @@ AND (" status "IS NULL OR (" status "= 'pending'
                        OR (" status "= 'failed'
                            AND Builds.status > 0)))")))
     (vector->list (car rows))))
+
+(define (db-get-evaluation-specification db eval)
+  "Return specification of evaluation with id EVAL."
+  (let ((rows (sqlite-exec db "
+SELECT specification FROM Evaluations
+WHERE id=" eval)))
+    (vector-ref (car rows) 0)))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index e1b6592..f020e30 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -286,7 +286,8 @@
                     "Cuirass"
                     (specifications-table
                      (with-critical-section db-channel (db)
-                       (db-get-specifications db))))))
+                       (db-get-specifications db)))
+                    '())))
 
     (("jobset" name)
      (respond-html
@@ -304,7 +305,10 @@
           (html-page name (evaluation-info-table name
                                                  evaluations
                                                  evaluation-id-min
-                                                 evaluation-id-max))))))
+                                                 evaluation-id-max)
+                          `(((#:name . ,name)
+                             (#:link . ,(string-append "/jobset/" name))
+                             (#:active . #t))))))))
 
     (("eval" id)
      (respond-html
@@ -316,7 +320,8 @@
                (border-low-id (assq-ref params 'border-low-id))
                (status (assq-ref params 'status))
                (builds-id-max (db-get-builds-max db id status))
-               (builds-id-min (db-get-builds-min db id status)))
+               (builds-id-min (db-get-builds-min db id status))
+               (specification (db-get-evaluation-specification db id)))
           (html-page
            "Evaluation"
            (build-eval-table
@@ -331,7 +336,13 @@
                                         (border-low-id . ,border-low-id)))
             builds-id-min
             builds-id-max
-            status))))))
+            status)
+           `(((#:name . ,specification)
+              (#:link . ,(string-append "/jobset/" specification))
+              (#:active . #f))
+             ((#:name . ,(string-append "Evaluation " id))
+              (#:link . ,(string-append "/eval/" id))
+              (#:active . #t))))))))
 
     (("static" path ...)
      (respond-static-file path))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 2e6c839..ceb56c3 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -26,7 +26,7 @@
             evaluation-info-table
             build-eval-table))
 
-(define (html-page title body)
+(define (html-page title body navigation)
   "Return HTML page with given TITLE and BODY."
   `(html (@ (xmlns "http://www.w3.org/1999/xhtml";)
             (xml:lang "en")
@@ -44,11 +44,24 @@
                    (href "/static/css/open-iconic-bootstrap.css")))
           (title ,title))
          (body
-          (nav (@ (class "navbar navbar-expand-lg navbar-light bg-light"))
-               (a (@ (class "navbar-brand") (href "/"))
+          (nav (@ (class "navbar navbar-expand navbar-light bg-light"))
+               (a (@ (class "navbar-brand pt-0")   (href "/"))
                   (img (@ (src "/static/images/logo.png")
                           (alt "logo")
-                          (height "25")))))
+                          (height "25")
+                          (style "margin-top: -12px"))))
+               (div (@ (class "navbar-nav-scroll"))
+                    (ul (@ (class "navbar-nav"))
+                        (li (@ (class "nav-item"))
+                            (a (@ (class "nav-link" ,(if (null? navigation) " 
active" ""))
+                                  (href "/"))
+                               Home))
+                        ,@(map (lambda (item)
+                                       `(li (@ (class "nav-item"))
+                                            (a (@ (class "nav-link" ,(if 
(assq-ref item #:active) " active" ""))
+                                                  (href ,(assq-ref item 
#:link)))
+                                               ,(assq-ref item #:name))))
+                             navigation))))
           (main (@ (role "main") (class "container pt-4 px-1"))
                 ,body
                 (hr)))))



reply via email to

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