branch: web-interface commit 5d61dea08e5067783492573b53c650da2a5a80c1 Author: TSholokhova <tanja201...@gmail.com> Date: Wed Jul 4 22:38:40 2018 +0200
Update id pagination. * src/cuirass/http.scm: Change parameters. * src/cuirass/templates.scm: Fix pagination function. Added min and max functions for lists. * src/cuirass/database.scm: Add borders parameters to evaluation request. --- src/cuirass/database.scm | 27 +++++++++++--- src/cuirass/http.scm | 31 +++++++++++----- src/cuirass/templates.scm | 90 ++++++++++++++++++++++++++++------------------- 3 files changed, 98 insertions(+), 50 deletions(-) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index ecf9a39..30dc706 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -48,6 +48,8 @@ db-get-evaluations db-get-evaluations-build-summary db-get-evaluations-count + db-get-evaluations-id-min + db-get-evaluations-id-max read-sql-file read-quoted-string sqlite-exec @@ -561,7 +563,7 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) (#:revision . ,revision)) evaluations)))))) -(define (db-get-evaluations-build-summary db spec limit offset) +(define (db-get-evaluations-build-summary db spec limit border-low border-high) (let loop ((rows (sqlite-exec db "SELECT E.id, E.revision, B.succeeded, B.failed, B.scheduled FROM (SELECT id, evaluation, SUM(status=0) as succeeded, SUM(status>0) as failed, SUM(status<0) as scheduled @@ -570,10 +572,11 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) JOIN (SELECT id, revision FROM Evaluations - WHERE specification=" spec - "ORDER BY id DESC - LIMIT " limit " OFFSET " offset " - ) E + WHERE (specification=" spec ")\ + AND (" border-low "IS NULL OR (id >" border-low "))\ + AND (" border-high "IS NULL OR (id <" border-high "))\ + ORDER BY id DESC + LIMIT " limit ") E ON B.evaluation=E.id;")) (evaluations '())) (match rows @@ -594,3 +597,17 @@ ON B.evaluation=E.id;")) "SELECT COUNT(id) FROM Evaluations WHERE specification=" spec))) (array-ref (list-ref rows 0) 0))) + +(define (db-get-evaluations-id-max db spec) + "Return the number of evaluations of the given specification SPEC" + (let ((rows (sqlite-exec db +"SELECT MAX(id) FROM Evaluations +WHERE specification=" spec))) + (array-ref (list-ref rows 0) 0))) + +(define (db-get-evaluations-id-min db spec) + "Return the number of evaluations of the given specification SPEC" + (let ((rows (sqlite-exec db +"SELECT MIN(id) FROM Evaluations +WHERE specification=" spec))) + (array-ref (list-ref rows 0) 0))) diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 712db10..698872b 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -152,6 +152,11 @@ Hydra format." (define (request-path-components request) (split-and-decode-uri-path (uri-path (request-uri request)))) +(define (normalize-parameter parameter) + (if parameter + (list-ref parameter 0) + #f)) + (define (url-handler request body db-channel) (define* (respond response #:key body (db-channel db-channel)) @@ -304,21 +309,31 @@ Hydra format." (nr 10) (order status+submission-time))))))) (("jobset" name) - (let* ((evaluation-count (with-critical-section db-channel (db) (db-get-evaluations-count db name))) - (page-count (quotient (+ evaluation-count (- PAGESIZE 1)) PAGESIZE)) + (let* ((evaluation-id-max (with-critical-section db-channel (db) (db-get-evaluations-id-max db name))) + (evaluation-id-min (with-critical-section db-channel (db) (db-get-evaluations-id-min db name))) (params (request-parameters request)) - (page-exist? (assq-ref params 'page)) - (page-number? (if page-exist? (list-ref page-exist? 0) 1)) - (page (if page-number? (min (max 1 page-number?) page-count) 1))) + (page 1) + (border-high (normalize-parameter (assq-ref params 'border-high))) + (border-low (normalize-parameter (assq-ref params 'border-low)))) + ;(page-exist? (assq-ref params 'page)) + ;(page-number? (if page-exist? (list-ref page-exist? 0) 1)) + ;(page (if page-number? (min (max 1 page-number?) page-count) 1))) + ;(display border-low))) (respond-html (html-page name (evaluation-info-table name - page (with-critical-section db-channel (db) - (db-get-evaluations-build-summary db name PAGESIZE (* PAGESIZE (- page 1)))) - evaluation-count))))) + (db-get-evaluations-build-summary + db + name + PAGESIZE + border-low + border-high + )) + evaluation-id-min + evaluation-id-max))))) (("eval" id) (respond-html diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm index 927c156..c134ec3 100644 --- a/src/cuirass/templates.scm +++ b/src/cuirass/templates.scm @@ -25,7 +25,7 @@ build-eval-table PAGESIZE)) -(define PAGESIZE 20) +(define PAGESIZE 10) (define (html-page title body) "Return html page with given title and body" @@ -69,7 +69,7 @@ (td ,(assq-ref spec #:branch)))) specs))))))) -(define (pagination page page-count) +(define (pagination page-id-min page-id-max id-min id-max) "Return page navigation buttons" `(div (@ (class row)) (nav @@ -77,46 +77,62 @@ (ul (@ (class "pagination")) (li (@ (class "page-item")) (a (@ (class "page-link") - (href "?page=1")) + (href "?border-low=" ,(number->string (- id-min 1)))) "<< First")) - (li (@ (class "page-item" ,(if (= page 1) " disabled" ""))) + ;(li (@ (class "page-item" ,(if (= page-id-max id-max) " disabled" ""))) + ; (a (@ (class "page-link") + ; (href "?border-low=" ,(number->string page-id-max))) + ; "< Previous")) + (li (@ (class "page-item" ,(if (= page-id-min id-min) " disabled" ""))) (a (@ (class "page-link") - (href "?page=" ,(number->string (- page 1)))) - "< Previous")) - (li (@ (class "page-item",(if (= page page-count) " disabled" ""))) - (a (@ (class "page-link") - (href "?page=" ,(number->string (+ page 1)))) + (href "?border-high=" ,(number->string page-id-min))) "Next >")) - (li (@ (class "page-item")) - (a (@ (class "page-link") - (href "?page=" ,(number->string page-count))) - "Last >>")))))) + ;(li (@ (class "page-item")) + ; (a (@ (class "page-link") + ; (href "?border-high=" ,(number->string (+ id-min PAGESIZE)))) + ; "Last >>")) + )))) + + +(define (minimum lst cur-min) + (cond ((null? lst) cur-min) + ((< (car lst) cur-min) (minimum (cdr lst) (car lst))) + (else (minimum (cdr lst) cur-min)))) + + +(define (maximum lst cur-max) + (cond ((null? lst) cur-max) + ((> (car lst) cur-max) (maximum (cdr lst) (car lst))) + (else (maximum (cdr lst) cur-max)))) + -(define (evaluation-info-table name page data evaluation-count) +(define (evaluation-info-table name data evaluation-id-min evaluation-id-max) "Return body for (Evaluation) html-page" - `((p (@ (class "lead")) "Evaluations of " ,name) - (p (@ (class "text-muted")) "Showing evaluations ",(+ 1 (* PAGESIZE (- page 1)))"-",(min evaluation-count (* PAGESIZE page))" out of ",evaluation-count) - (table - (@ (class "table table-sm table-hover table-striped")) - ,@(if (null? data) - `((th (@ (scope "col")) "No elements here.")) - `((thead - (tr - (th (@ (scope "col")) "#") - (th (@ (scope "col")) Revision) - (th (@ (scope "col")) Success))) - (tbody - ,@(map - (lambda (row) - `(tr - (th (@ (scope "row")) (a (@ (href "/eval/" ,(assq-ref row #:id))) ,(assq-ref row #:id))) - (td ,(assq-ref row #:revision)) - (td - (a (@ (href "#") (class "badge badge-success")) ,(assq-ref row #:succeeded)) - (a (@ (href "#") (class "badge badge-danger")) ,(assq-ref row #:failed)) - (a (@ (href "#") (class "badge badge-secondary")) ,(assq-ref row #:scheduled))))) - data))))) - ,(pagination page (quotient (+ evaluation-count (- PAGESIZE 1)) PAGESIZE)))) + (let ((id-min (minimum (map (lambda (row) (assq-ref row #:id)) data) evaluation-id-max)) + (id-max (maximum (map (lambda (row) (assq-ref row #:id)) data) evaluation-id-min))) + `((p (@ (class "lead")) "Evaluations of " ,name) + ;(p (@ (class "text-muted")) "Showing evaluations ",id-min "-",id-max " out of ",evaluation-id-max) + (table + (@ (class "table table-sm table-hover table-striped")) + ,@(if (null? data) + `((th (@ (scope "col")) "No elements here.")) + `((thead + (tr + (th (@ (scope "col")) "#") + (th (@ (scope "col")) Revision) + (th (@ (scope "col")) Success))) + (tbody + ,@(map + (lambda (row) + `(tr + (th (@ (scope "row")) (a (@ (href "/eval/" ,(assq-ref row #:id))) ,(assq-ref row #:id))) + (td ,(assq-ref row #:revision)) + (td + (a (@ (href "#") (class "badge badge-success")) ,(assq-ref row #:succeeded)) + (a (@ (href "#") (class "badge badge-danger")) ,(assq-ref row #:failed)) + (a (@ (href "#") (class "badge badge-secondary")) ,(assq-ref row #:scheduled))))) + data))))) + ,(pagination id-min id-max evaluation-id-min evaluation-id-max)))) (define (build-eval-table data)