Web interface review 2

[Clément Lassieur]

Hi Tatiana,

Thank you for these changes!

> From: TSholokhova <address@hidden>
>
>     * 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 "address@hidden ~:[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&address@hidden&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&address@hidden&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&address@hidden&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&address@hidden&status=~a~]"
>                      (build-stoptime build-min)
> -                    (1- (build-id build-min))))))))
> +                    (1- (build-id build-min))
> +                    status))))))
>
> From: TSholokhova <address@hidden>
>
>     * 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 <address@hidden>
>
>     * 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