branch: web-interface commit a298d99dd552e7d9beca9ab73566aac76f44faed Author: TSholokhova <tanja201...@gmail.com> 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)))))