diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/cuirass/database.scm | 26 | ||||
| -rw-r--r-- | src/cuirass/http.scm | 153 |
2 files changed, 109 insertions, 70 deletions
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index a0e6c63..4733d3d 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -58,6 +58,7 @@ db-get-evaluations-id-min db-get-evaluations-id-max db-get-evaluation-specification + db-get-evaluation-summary read-sql-file read-quoted-string sqlite-exec @@ -802,6 +803,31 @@ SELECT MAX(id) FROM Evaluations WHERE specification=" spec))) (and=> (expect-one-row rows) (cut vector-ref <> 0))))) +(define (db-get-evaluation-summary id) + (with-db-critical-section db + (let ((rows (sqlite-exec db " +SELECT E.id, E.in_progress, B.total, B.succeeded, B.failed, B.scheduled +FROM + (SELECT id, in_progress +FROM Evaluations +WHERE (id=" id ")) E +LEFT JOIN + (SELECT rowid, evaluation, SUM(status=0) as succeeded, +SUM(status>0) as failed, SUM(status<0) as scheduled, SUM(status>-100) as total +FROM Builds +GROUP BY evaluation) B +ON B.evaluation=E.id +ORDER BY E.id ASC;"))) + (and=> (expect-one-row rows) + (match-lambda + (#(id in-progress total succeeded failed scheduled) + `((#:id . ,id) + (#:in-progress . ,in-progress) + (#:total . ,(or total 0)) + (#:succeeded . ,(or succeeded 0)) + (#:failed . ,(or failed 0)) + (#:scheduled . ,(or scheduled 0))))))))) + (define (db-get-builds-query-min query) "Return the smallest build row identifier matching QUERY." (with-db-critical-section db diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 75201a5..5bd736b 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -333,77 +333,90 @@ Hydra format." (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)) - (specification (db-get-evaluation-specification id))) + (specification (db-get-evaluation-specification id)) + (evaluation (db-get-evaluation-summary id))) (if specification - (respond-html - (html-page - "Evaluation" - `((p (@ (class "lead")) - ,(format #f "~@[~a~] ~:[B~;b~]uilds of evaluation #~a" - (and=> status string-capitalize) - status - id)) - (ul (@ (class "nav nav-tabs")) - (li (@ (class "nav-item")) - (a (@ (class ,(string-append "nav-link " - (match status - (#f "active") - (_ "")))) - (href "?all=")) - "All")) - (li (@ (class "nav-item")) - (a (@ (class ,(string-append "nav-link " - (match status - ("pending" "active") - (_ "")))) - (href "?status=pending")) - (span (@ (class "oi oi-clock text-warning") - (title "Scheduled") - (aria-hidden "true")) - "") - " Scheduled")) - (li (@ (class "nav-item")) - (a (@ (class ,(string-append "nav-link " - (match status - ("succeeded" "active") - (_ "")))) - (href "?status=succeeded")) - (span (@ (class "oi oi-check text-success") - (title "Succeeded") - (aria-hidden "true")) - "") - " Succeeded")) - (li (@ (class "nav-item")) - (a (@ (class ,(string-append "nav-link " - (match status - ("failed" "active") - (_ "")))) - (href "?status=failed")) - (span (@ (class "oi oi-x text-danger") - (title "Failed") - (aria-hidden "true")) - "") - " Failed"))) - (div (@ (class "tab-content pt-3")) - (div (@ (class "tab-pane show active")) - ,(build-eval-table - id - (handle-builds-request - `((evaluation . ,id) - (status . ,(and=> status string->symbol)) - (nr . ,%page-size) - (order . finish-time+build-id) - (border-high-time . ,border-high-time) - (border-low-time . ,border-low-time) - (border-high-id . ,border-high-id) - (border-low-id . ,border-low-id))) - builds-id-min - builds-id-max - status)))) - `(((#:name . ,specification) - (#:link . ,(string-append "/jobset/" specification))) - ((#:name . ,(string-append "Evaluation " id)) - (#:link . ,(string-append "/eval/" id)))))) + (let ((total (assq-ref evaluation #:total)) + (succeeded (assq-ref evaluation #:succeeded)) + (failed (assq-ref evaluation #:failed)) + (scheduled (assq-ref evaluation #:scheduled))) + (respond-html + (html-page + "Evaluation" + `((p (@ (class "lead")) + ,(format #f "~@[~a~] ~:[B~;b~]uilds of evaluation #~a" + (and=> status string-capitalize) + status + id)) + (ul (@ (class "nav nav-tabs")) + (li (@ (class "nav-item")) + (a (@ (class ,(string-append "nav-link " + (match status + (#f "active") + (_ "")))) + (href "?all=")) + "All " + (span (@ (class "badge badge-light badge-pill")) + ,total))) + (li (@ (class "nav-item")) + (a (@ (class ,(string-append "nav-link " + (match status + ("pending" "active") + (_ "")))) + (href "?status=pending")) + (span (@ (class "oi oi-clock text-warning") + (title "Scheduled") + (aria-hidden "true")) + "") + " Scheduled " + (span (@ (class "badge badge-light badge-pill")) + ,scheduled))) + (li (@ (class "nav-item")) + (a (@ (class ,(string-append "nav-link " + (match status + ("succeeded" "active") + (_ "")))) + (href "?status=succeeded")) + (span (@ (class "oi oi-check text-success") + (title "Succeeded") + (aria-hidden "true")) + "") + " Succeeded " + (span (@ (class "badge badge-light badge-pill")) + ,succeeded))) + (li (@ (class "nav-item")) + (a (@ (class ,(string-append "nav-link " + (match status + ("failed" "active") + (_ "")))) + (href "?status=failed")) + (span (@ (class "oi oi-x text-danger") + (title "Failed") + (aria-hidden "true")) + "") + " Failed " + (span (@ (class "badge badge-light badge-pill")) + ,failed)))) + (div (@ (class "tab-content pt-3")) + (div (@ (class "tab-pane show active")) + ,(build-eval-table + id + (handle-builds-request + `((evaluation . ,id) + (status . ,(and=> status string->symbol)) + (nr . ,%page-size) + (order . finish-time+build-id) + (border-high-time . ,border-high-time) + (border-low-time . ,border-low-time) + (border-high-id . ,border-high-id) + (border-low-id . ,border-low-id))) + builds-id-min + builds-id-max + status)))) + `(((#:name . ,specification) + (#:link . ,(string-append "/jobset/" specification))) + ((#:name . ,(string-append "Evaluation " id)) + (#:link . ,(string-append "/eval/" id))))))) (respond-html-eval-not-found id)))) (("search") |