[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
From: |
Tatiana |
Date: |
Sun, 5 Aug 2018 10:55:49 -0400 (EDT) |
branch: web-interface
commit 0ce7d867822edf4495e39aad5445f471ba172501
Author: TSholokhova <address@hidden>
Date: Sun Aug 5 16:55:16 2018 +0200
web-interface: Add builds filtering by status. Add links for different
build status to evaluation table.
* 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'
+ 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)))")))
(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)))")))
(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)))))
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))
+ (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~]"
(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))))))