* Web interface review 2
[not found] <20180810093539.1125-1-clement@lassieur.org>
@ 2018-08-10 13:19 ` Clément Lassieur
2018-09-30 17:22 ` Clément Lassieur
0 siblings, 1 reply; 3+ messages in thread
From: Clément Lassieur @ 2018-08-10 13:19 UTC (permalink / raw)
To: Tatiana Sholokhova; +Cc: guix-devel
Hi Tatiana,
Thank you for these changes!
> From: TSholokhova <tanja201396@gmail.com>
>
> * src/cuirass/database.scm (db-get-builds): Add 'succeeded' and 'failed' status filters.
> (db-get-builds-min, db-get-builds-max): Extend functional to support min/max extraction for a given status.
>
> * src/cuirass/http.scm: Add status parameter for /eval/id endpoint.
>
> * src/cuirass/templates.scm (evaluation-info-table): Add links to a build table filtered by satus.
> (build-eval-table): Add status parameter to pagination links.
> ---
> src/cuirass/database.scm | 46 +++++++++++++++++++++++++++++++--------
> src/cuirass/http.scm | 14 +++++++-----
> src/cuirass/templates.scm | 43 +++++++++++++++++++++++-------------
> 3 files changed, 74 insertions(+), 29 deletions(-)
>
> diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
> index 4927f2a..9232a06 100644
> --- a/src/cuirass/database.scm
> +++ b/src/cuirass/database.scm
> @@ -547,7 +547,9 @@ AND (:job IS NULL OR (:job = Derivations.job_name))
> AND (:system IS NULL OR (:system = Derivations.system))
> AND (:evaluation IS NULL OR (:evaluation = Builds.evaluation))
> AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0)
> - OR (:status = 'pending' AND Builds.status < 0))
> + OR (:status = 'pending' AND Builds.status < 0)
> + OR (:status = 'succeeded' AND Builds.status = 0)
> + OR (:status = 'failed' AND Builds.status > 0))
> AND (:borderlowtime IS NULL OR :borderlowid IS NULL
> OR ((:borderlowtime, :borderlowid) < (Builds.stoptime, Builds.id)))
> AND (:borderhightime IS NULL OR :borderhighid IS NULL
> @@ -680,24 +682,50 @@ SELECT MAX(id) FROM Evaluations
> WHERE specification=" spec)))
> (vector-ref (car rows) 0)))
>
> -(define (db-get-builds-min db eval)
> +(define (db-get-builds-min db eval status)
> "Return the min build (stoptime, id) pair for
> - the given evaluation EVAL."
> + the given evaluation EVAL and STATUS."
> (let ((rows (sqlite-exec db "
> SELECT stoptime, MIN(id) FROM
> (SELECT id, stoptime FROM Builds
> -WHERE evaluation=" eval " AND
> -stoptime = (SELECT MIN(stoptime)
> -FROM Builds WHERE evaluation=" eval "))")))
> +WHERE evaluation=" eval "
> +AND stoptime = (SELECT MIN(stoptime)
> + FROM Builds
> + WHERE evaluation=" eval "
> + AND (" status "IS NULL OR (" status "= 'pending'
^ ^
Can you add a space here and here?
> + AND Builds.status < 0)
> + OR (" status "= 'succeeded'
> + AND Builds.status = 0)
> + OR (" status "= 'failed'
> + AND Builds.status > 0)))
> +AND (" status "IS NULL OR (" status "= 'pending'
> + AND Builds.status < 0)
> + OR (" status "= 'succeeded'
> + AND Builds.status = 0)
> + OR (" status "= 'failed'
> + AND Builds.status > 0)))")))
I think you wrote twice the same thing. :-)
> (vector->list (car rows))))
>
> -(define (db-get-builds-max db eval)
> +(define (db-get-builds-max db eval status)
> "Return the max build (stoptime, id) pair for
> - the given evaluation EVAL."
> + the given evaluation EVAL and STATUS."
> (let ((rows (sqlite-exec db "
> SELECT stoptime, MAX(id) FROM
> (SELECT id, stoptime FROM Builds
> WHERE evaluation=" eval " AND
> stoptime = (SELECT MAX(stoptime)
> -FROM Builds WHERE evaluation=" eval "))")))
> + FROM Builds
> + WHERE evaluation=" eval "
> + AND (" status "IS NULL OR (" status "= 'pending'
> + AND Builds.status < 0)
> + OR (" status "= 'succeeded'
> + AND Builds.status = 0)
> + OR (" status "= 'failed'
> + AND Builds.status > 0)))
> +AND (" status "IS NULL OR (" status "= 'pending'
> + AND Builds.status < 0)
> + OR (" status "= 'succeeded'
> + AND Builds.status = 0)
> + OR (" status "= 'failed'
> + AND Builds.status > 0)))")))
Idem :-)
> (vector->list (car rows))))
> diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
> index 16bbda0..e1b6592 100644
> --- a/src/cuirass/http.scm
> +++ b/src/cuirass/http.scm
> @@ -309,17 +309,20 @@
> (("eval" id)
> (respond-html
> (with-critical-section db-channel (db)
> - (let* ((builds-id-max (db-get-builds-max db id))
> - (builds-id-min (db-get-builds-min db id))
> - (params (request-parameters request))
> + (let* ((params (request-parameters request))
> (border-high-time (assq-ref params 'border-high-time))
> (border-low-time (assq-ref params 'border-low-time))
> (border-high-id (assq-ref params 'border-high-id))
> - (border-low-id (assq-ref params 'border-low-id)))
> + (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)))
> (html-page
> "Evaluation"
> (build-eval-table
> + id
> (handle-builds-request db `((evaluation . ,id)
> + (status . ,(and=> status string->symbol))
> (nr . ,%page-size)
> (order . finish-time+build-id)
> (border-high-time . ,border-high-time)
> @@ -327,7 +330,8 @@
> (border-high-id . ,border-high-id)
> (border-low-id . ,border-low-id)))
> builds-id-min
> - builds-id-max))))))
> + builds-id-max
> + status))))))
>
> (("static" path ...)
> (respond-static-file path))
> diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
> index 6ba3a06..5799ee1 100644
> --- a/src/cuirass/templates.scm
> +++ b/src/cuirass/templates.scm
> @@ -123,11 +123,14 @@
> (map (cut substring <> 0 7)
> (string-tokenize (assq-ref row #:commits)))
> ", "))
> - (td (a (@ (href "#") (class "badge badge-success"))
> + (td (a (@ (href "/eval/" ,(assq-ref row #:id) "?status=succeeded")
> + (class "badge badge-success"))
> ,(assq-ref row #:succeeded))
> - (a (@ (href "#") (class "badge badge-danger"))
> + (a (@ (href "/eval/" ,(assq-ref row #:id) "?status=failed")
> + (class "badge badge-danger"))
> ,(assq-ref row #:failed))
> - (a (@ (href "#") (class "badge badge-secondary"))
> + (a (@ (href "/eval/" ,(assq-ref row #:id) "?status=pending")
> + (class "badge badge-secondary"))
> ,(assq-ref row #:scheduled)))))
Could you please avoid lines with more than 80 columns?
> evaluations)))))
> ,(if (null? evaluations)
> @@ -145,8 +148,9 @@
> (format #f "?border-high=~d" page-id-min))
> (format #f "?border-low=~d" (1- id-min)))))))
>
> -(define (build-eval-table builds build-min build-max)
> - "Return HTML for the BUILDS table NAME. BUILD-MIN and BUILD-MAX are
> +(define (build-eval-table eval-id builds build-min build-max status)
> + "Return HTML for the BUILDS table of EVAL-ID evaluation
> + with given STATUS. BUILD-MIN and BUILD-MAX are
> global minimal and maximal (stoptime, id) pairs."
> (define (table-header)
> `(thead
> @@ -189,7 +193,12 @@
> (match build
> ((stoptime id) stoptime)))
>
> - `((table
> + `((p (@ (class "lead"))
> + ,(format #f "~@[~a~] ~:[B~;b~]uilds of evaluation #~a"
> + (and=> status string-capitalize)
> + status
> + eval-id))
I think this is unrelated to the "succeeded", "pending" and "failed"
buttons. Could you add that as another commit?
> + (table
> (@ (class "table table-sm table-hover table-striped"))
> ,@(if (null? builds)
> `((th (@ (scope "col")) "No elements here."))
> @@ -204,19 +213,23 @@
> (page-build-min (last build-time-ids))
> (page-build-max (first build-time-ids)))
> (pagination
> - (format #f "?border-high-time=~d&border-high-id=~d"
> - (build-stoptime build-max)
> - (1+ (build-id build-max)))
> + (format #f "?border-high-time=~d&border-high-id=~d~@[&status=~a~]"
> + (build-stoptime build-max)
> + (1+ (build-id build-max))
> + status)
> (if (equal? page-build-max build-max)
> ""
> - (format #f "?border-low-time=~d&border-low-id=~d"
> + (format #f "?border-low-time=~d&border-low-id=~d~@[&status=~a~]"
> (build-stoptime page-build-max)
> - (build-id page-build-max)))
> + (build-id page-build-max)
> + status))
> (if (equal? page-build-min build-min)
> ""
> - (format #f "?border-high-time=~d&border-high-id=~d"
> + (format #f "?border-high-time=~d&border-high-id=~d~@[&status=~a~]"
80 columns :-)
> (build-stoptime page-build-min)
> - (build-id page-build-min)))
> - (format #f "?border-low-time=~d&border-low-id=~d"
> + (build-id page-build-min)
> + status))
> + (format #f "?border-low-time=~d&border-low-id=~d~@[&status=~a~]"
> (build-stoptime build-min)
> - (1- (build-id build-min))))))))
> + (1- (build-id build-min))
> + status))))))
>
> From: TSholokhova <tanja201396@gmail.com>
>
> * src/cuirass/templates.scm (build-eval-table): Add build log links to the table.
> ---
> src/cuirass/templates.scm | 7 +++++--
> 1 file changed, 5 insertions(+), 2 deletions(-)
LGTM!
> From: TSholokhova <tanja201396@gmail.com>
>
> * 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)))
Here, the problem is that if eval 42 doesn't exist, /eval/42 will crash
because (car '()) will be called. I think we should return #f if the
query doesn't return any evaluations. Could you use 'match', as in
DB-GET-BUILD?
> 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))
We need to handle the case where SPECIFICATION is #f. Maybe with
VALID-PARAMS?, as in "api/queue"?
> + (#:active . #f))
> + ((#:name . ,(string-append "Evaluation " id))
> + (#:link . ,(string-append "/eval/" id))
> + (#:active . #t))))))))
The 'active' field is always the last one isn't it? Thus it's not
necessary to specify it explicitely. What do you think?
> (("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" ""))
80 columns
> + (href "/"))
> + Home))
> + ,@(map (lambda (item)
> + `(li (@ (class "nav-item"))
> + (a (@ (class "nav-link" ,(if (assq-ref item #:active) " active" ""))
Idem :-)
> + (href ,(assq-ref item #:link)))
> + ,(assq-ref item #:name))))
> + navigation))))
> (main (@ (role "main") (class "container pt-4 px-1"))
> ,body
> (hr)))))
Could you update your branch?
Thanks!
Clément
^ permalink raw reply [flat|nested] 3+ messages in thread