[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)))))