[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Ricardo Wurmus |
|
Date: |
Wed, 19 Jun 2019 04:23:02 -0400 (EDT) |
branch: master
commit efe7d36e64aae5f96fd2e75ceb841990e721f4af
Author: Ricardo Wurmus <address@hidden>
Date: Wed Jun 19 10:21:33 2019 +0200
http: Show number of builds.
* src/cuirass/database.scm (db-get-evaluation-summary): New procedure.
* src/cuirass/http.scm (url-handler): Display number of builds in tabs.
---
src/cuirass/database.scm | 26 ++++++++
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")