diff options
| -rw-r--r-- | src/cuirass/database.scm | 38 | ||||
| -rw-r--r-- | src/cuirass/http.scm | 11 | ||||
| -rw-r--r-- | src/cuirass/templates.scm | 47 |
3 files changed, 63 insertions, 33 deletions
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 9664f1b..e17d4f0 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -559,7 +559,9 @@ AND (:job IS NULL OR (:job = Builds.job_name)) AND (:system IS NULL OR (:system = Builds.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.rowid))) AND (:borderhightime IS NULL OR :borderhighid IS NULL @@ -712,26 +714,40 @@ SELECT MAX(id) FROM Evaluations WHERE specification=" spec))) (vector-ref (car rows) 0)))) -(define (db-get-builds-min eval) - "Return the min build (stoptime, id) pair for - the given evaluation EVAL." +(define (db-get-builds-min eval status) + "Return the min build (stoptime, rowid) pair for the given evaluation EVAL +and STATUS." (with-db-critical-section db (let ((rows (sqlite-exec db " SELECT stoptime, MIN(rowid) FROM (SELECT rowid, 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))))"))) (vector->list (car rows))))) -(define (db-get-builds-max eval) - "Return the max build (stoptime, id) pair for - the given evaluation EVAL." +(define (db-get-builds-max eval status) + "Return the max build (stoptime, rowid) pair for the given evaluation EVAL +and STATUS." (with-db-critical-section db (let ((rows (sqlite-exec db " SELECT stoptime, MAX(rowid) FROM (SELECT rowid, 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))))"))) (vector->list (car rows))))) diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index d70517b..7878452 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -295,9 +295,10 @@ Hydra format." (("eval" id) (respond-html - (let* ((builds-id-max (db-get-builds-max id)) - (builds-id-min (db-get-builds-min id)) - (params (request-parameters request)) + (let* ((params (request-parameters request)) + (status (assq-ref params 'status)) + (builds-id-max (db-get-builds-max id status)) + (builds-id-min (db-get-builds-min id status)) (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)) @@ -306,6 +307,7 @@ Hydra format." "Evaluation" (build-eval-table (handle-builds-request `((evaluation . ,id) + (status . ,(and=> status string->symbol)) (nr . ,%page-size) (order . finish-time+build-id) (border-high-time . ,border-high-time) @@ -313,7 +315,8 @@ Hydra format." (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 7ee579c..31c6081 100644 --- a/src/cuirass/templates.scm +++ b/src/cuirass/templates.scm @@ -113,11 +113,14 @@ (define (evaluation-badges evaluation) (if (zero? (assq-ref evaluation #:in-progress)) - `((a (@ (href "#") (class "badge badge-success")) + `((a (@ (href "/eval/" ,(assq-ref evaluation #:id) "?status=succeeded") + (class "badge badge-success")) ,(assq-ref evaluation #:succeeded)) - (a (@ (href "#") (class "badge badge-danger")) + (a (@ (href "/eval/" ,(assq-ref evaluation #:id) "?status=failed") + (class "badge badge-danger")) ,(assq-ref evaluation #:failed)) - (a (@ (href "#") (class "badge badge-secondary")) + (a (@ (href "/eval/" ,(assq-ref evaluation #:id) "?status=pending") + (class "badge badge-secondary")) ,(assq-ref evaluation #:scheduled))) '((em "In progress…")))) @@ -158,9 +161,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 - global minimal and maximal (stoptime, id) pairs." +(define (build-eval-table builds build-min build-max status) + "Return HTML for the BUILDS table evaluation with given STATUS. BUILD-MIN +and BUILD-MAX are global minimal and maximal (stoptime, rowid) pairs." (define (table-header) `(thead (tr @@ -217,19 +220,27 @@ (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" - (build-stoptime page-build-max) - (build-id page-build-max))) + (format + #f "?border-low-time=~d&border-low-id=~d~@[&status=~a~]" + (build-stoptime 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" - (build-stoptime page-build-min) - (build-id page-build-min))) - (format #f "?border-low-time=~d&border-low-id=~d" - (build-stoptime build-min) - (1- (build-id build-min)))))))) + (format + #f "?border-high-time=~d&border-high-id=~d~@[&status=~a~]" + (build-stoptime page-build-min) + (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)) + status)))))) |