[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Tatiana |
|
Date: |
Sun, 8 Jul 2018 15:17:53 -0400 (EDT) |
branch: web-interface
commit c31a5d36fc41fe96d59d4e9a2081cfb98a50ee5a
Author: TSholokhova <address@hidden>
Date: Sun Jul 8 21:16:00 2018 +0200
Add pagination for each evaluation page.
* src/cuirass/templates.scm (build-eval-table): Add pagination.
* src/cuirass/database.scm: Add border filters for pagination in
db-get-builds. Add functions for searching max and min stoptimes.
* src/cuirass/http.scm: Add pagination parameters in "eval" query.
---
src/cuirass/database.scm | 52 ++++++++++++++++++++++++++++++++++++++---------
src/cuirass/http.scm | 30 +++++++++++++++------------
src/cuirass/templates.scm | 9 +++++---
3 files changed, 65 insertions(+), 26 deletions(-)
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index b3d43fc..37494da 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -45,6 +45,8 @@
db-update-build-status!
db-get-build
db-get-builds
+ db-get-builds-id-min
+ db-get-builds-id-max
db-get-evaluations
db-get-evaluations-build-summary
db-get-evaluations-count
@@ -467,17 +469,27 @@ Assumes that if group id stays the same the group headers
stay the same."
(collect-outputs x-builds-id x-repeated-row '() rows)))))
(let* ((order (match (assq 'order filters)
- (('order 'build-id) "Builds.id ASC")
- (('order 'decreasing-build-id) "Builds.id DESC")
- (('order 'finish-time) "Builds.stoptime DESC")
- (('order 'start-time) "Builds.starttime DESC")
- (('order 'submission-time) "Builds.timestamp DESC")
+ ;(('order 'build-id) "Builds.id ASC")
+ ;(('order 'decreasing-build-id) "Builds.id DESC")
+ ;(('order 'finish-time) "Builds.stoptime DESC")
+ ;(('order 'start-time) "Builds.starttime DESC")
+ ;(('order 'submission-time) "Builds.timestamp DESC")
+ ;(('order 'status+submission-time)
+ (('order 'build-id) "id ASC")
+ (('order 'decreasing-build-id) "id DESC")
+ (('order 'finish-time) "stoptime DESC")
+ (('order 'start-time) "starttime DESC")
+ (('order 'submission-time) "timestamp DESC")
(('order 'status+submission-time)
;; With this order, builds in 'running' state (-1) appear
;; before those in 'scheduled' state (-2).
- "Builds.status DESC, Builds.timestamp DESC")
- (_ "Builds.id DESC")))
+ ;"Builds.status DESC, Builds.timestamp DESC")
+ ;(_ "Builds.id DESC")))
+ "status DESC, timestamp DESC")
+ (_ "id DESC")))
(stmt-text (format #f "\
+SELECT *
+FROM (
SELECT Builds.id, Outputs.name, Outputs.path, Builds.timestamp,
Builds.starttime, Builds.stoptime, Builds.log, Builds.status,
Builds.derivation,\
Derivations.job_name, Derivations.system, Derivations.nix_name,\
Specifications.repo_name, Specifications.branch \
@@ -493,7 +505,11 @@ 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)) \
-ORDER BY ~a, Builds.id ASC LIMIT :nr;" order))
+AND (:borderlow IS NULL OR (:borderlow < Builds.stoptime)) \
+AND (:borderhigh IS NULL OR (:borderhigh > Builds.stoptime))
+ORDER BY CASE WHEN :borderlow IS NULL THEN Builds.stoptime ELSE
-Builds.stoptime END DESC
+LIMIT :nr)
+ORDER BY ~a, id ASC;" order))
(stmt (sqlite-prepare db stmt-text #:cache? #t)))
(sqlite-bind-arguments stmt #:id (assqx-ref filters 'id)
#:project (assqx-ref filters 'project)
@@ -503,6 +519,8 @@ ORDER BY ~a, Builds.id ASC LIMIT :nr;" order))
#:system (assqx-ref filters 'system)
#:status (and=> (assqx-ref filters 'status)
object->string)
+ #:borderlow (assqx-ref filters 'border-low)
+ #:borderhigh (assqx-ref filters 'border-high)
#:nr (match (assqx-ref filters 'nr)
(#f -1)
(x x)))
@@ -600,15 +618,29 @@ 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"
+ "Return the max id 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"
+ "Return the min id 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)))
+
+
+(define (db-get-builds-id-max db eval)
+ (let ((rows (sqlite-exec db
+"SELECT MAX(stoptime) FROM Builds
+WHERE evaluation=" eval)))
+ (array-ref (list-ref rows 0) 0)))
+
+
+(define (db-get-builds-id-min db eval)
+ (let ((rows (sqlite-exec db
+"SELECT MIN(stoptime) FROM Builds
+WHERE evaluation=" eval)))
+ (array-ref (list-ref rows 0) 0)))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 698872b..be21b3d 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -312,13 +312,8 @@ Hydra format."
(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 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
@@ -336,14 +331,23 @@ Hydra format."
evaluation-id-max)))))
(("eval" id)
- (respond-html
- (html-page
- "Evaluations"
- (build-eval-table
- (handle-builds-request db-channel
- `((evaluation ,id)
- (nr ,PAGESIZE)
- (order finish-time)))))))
+ (let* ((builds-id-max (with-critical-section db-channel (db)
(db-get-builds-id-max db id)))
+ (builds-id-min (with-critical-section db-channel (db)
(db-get-builds-id-min db id)))
+ (params (request-parameters request))
+ (border-high (normalize-parameter (assq-ref params 'border-high)))
+ (border-low (normalize-parameter (assq-ref params 'border-low))))
+ (respond-html
+ (html-page
+ "Evaluations"
+ (build-eval-table
+ (handle-builds-request db-channel
+ `((evaluation ,id)
+ (nr ,PAGESIZE)
+ (order finish-time)
+ (border-high ,border-high)
+ (border-low ,border-low)))
+ builds-id-min
+ builds-id-max)))))
(("static" path ...)
;(display (request-uri request))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 6e4d7bd..0e72981 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -134,7 +134,7 @@
data)))))
,(pagination id-min id-max evaluation-id-min evaluation-id-max))))
-(define (build-eval-table data)
+(define (build-eval-table data build-id-min build-id-max)
(define (table-header)
`(thead
@@ -159,13 +159,16 @@
(td ,(assq-ref build #:job))
(td ,(assq-ref build #:nixname))
(td ,(assq-ref build #:system))))
- `(table
+ (let ((id-min (minimum (map (lambda (row) (assq-ref row #:stoptime)) data)
build-id-max))
+ (id-max (maximum (map (lambda (row) (assq-ref row #:stoptime)) data)
build-id-min)))
+ `((table
(@ (class "table table-sm table-hover table-striped"))
,@(if (null? data)
`((th (@ (scope "col")) "No elements here."))
`(,(table-header)
(tbody
- ,@(map table-row data))))))
+ ,@(map table-row data)))))
+ ,(pagination id-min id-max build-id-min build-id-max))))
(define (build-table done pending)
"Return body for project's html-page"