[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Mathieu Othacehe |
|
Date: |
Wed, 14 Apr 2021 09:05:58 -0400 (EDT) |
branch: master
commit 17e8759efe65c643c3670401216a9b2a3c755057
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Apr 14 15:05:00 2021 +0200
Optimize Jobs table.
---
Makefile.am | 3 +-
src/cuirass/database.scm | 83 ++++++++++++++++++++--------------------------
src/cuirass/http.scm | 11 ++++--
src/cuirass/templates.scm | 69 +++++++++++++++++++++++++++++---------
src/schema.sql | 4 ++-
src/sql/upgrade-7.sql | 10 ++++++
src/static/css/cuirass.css | 16 +++++++++
tests/database.scm | 19 ++++-------
8 files changed, 134 insertions(+), 81 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index bf093a1..74ba573 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -93,7 +93,8 @@ dist_sql_DATA = \
src/sql/upgrade-3.sql \
src/sql/upgrade-4.sql \
src/sql/upgrade-5.sql \
- src/sql/upgrade-6.sql
+ src/sql/upgrade-6.sql \
+ src/sql/upgrade-7.sql
dist_css_DATA = \
src/static/css/choices.min.css \
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 2d015f2..7194562 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -54,7 +54,6 @@
db-remove-specification
db-get-specification
db-get-specifications
- db-get-specifications-summary
evaluation-status
db-add-evaluation
db-abort-pending-evaluations
@@ -91,6 +90,7 @@
db-get-evaluations-build-summary
db-get-evaluations-id-min
db-get-evaluations-id-max
+ db-get-latest-evaluations
db-get-evaluation-summary
db-get-evaluations-absolute-summary
db-get-builds-query-min
@@ -477,39 +477,6 @@ period, priority, systems FROM Specifications ORDER BY
name ASC;")))
(systems (with-input-from-string systems read)))
specs)))))))
-(define (db-get-specifications-summary)
- (define (number n)
- (if n (string->number n) 0))
-
- (with-db-worker-thread db
- (let ((query "
-SELECT specification, 100 * CAST(succeeded AS FLOAT) / total,
-succeeded, failed, scheduled, evaluation FROM
-(SELECT DISTINCT ON(specification) specification, MAX(id) FROM Specifications
-LEFT JOIN Evaluations ON Specifications.name = Evaluations.specification
-WHERE Evaluations.status = 0
-GROUP BY Evaluations.specification) evals LEFT JOIN (SELECT
-SUM(CASE WHEN Builds.status > -100 THEN 1 ELSE 0 END) AS total,
-SUM(CASE WHEN Builds.status = 0 THEN 1 ELSE 0 END) AS succeeded,
-SUM(CASE WHEN Builds.status > 0 THEN 1 ELSE 0 END) AS failed,
-SUM(CASE WHEN Builds.status < 0 THEN 1 ELSE 0 END) AS scheduled,
-Jobs.evaluation FROM Jobs INNER JOIN Builds ON Jobs.build = Builds.id
-GROUP BY Jobs.evaluation) b on evals.max = b.evaluation;"))
- (let loop ((rows (exec-query db query))
- (summary '()))
- (match rows
- (() (reverse summary))
- (((specification percentage succeeded
- failed scheduled evaluation) . rest)
- (loop rest
- (cons `((#:specification . ,specification)
- (#:evaluation . ,evaluation)
- (#:percentage . ,(number percentage))
- (#:succeeded . ,(number succeeded))
- (#:failed . ,(number failed))
- (#:scheduled . ,(number scheduled)))
- summary))))))))
-
(define-enumeration evaluation-status
(started -1)
(succeeded 0)
@@ -730,11 +697,12 @@ JOB derivation."
(system (assq-ref job #:system)))
(with-db-worker-thread db
(exec-query/bind db "\
-INSERT INTO Jobs (name, evaluation, build, system)
-(SELECT " name ", " eval-id ",
-(SELECT id FROM Builds WHERE derivation =
+WITH b AS
+(SELECT id, status FROM Builds WHERE derivation =
(SELECT COALESCE((SELECT derivation FROM Outputs WHERE
-PATH = " output "), " derivation ")))," system ")
+PATH = " output "), " derivation ")))
+INSERT INTO Jobs (name, evaluation, build, status, system)
+(SELECT " name ", " eval-id ", b.id, b.status," system " FROM b)
ON CONFLICT ON CONSTRAINT jobs_pkey DO NOTHING;"))))
(define (db-get-jobs eval-id filters)
@@ -746,8 +714,7 @@ the symbols system and names."
(with-db-worker-thread db
(let ((query "
-SELECT Builds.id, Builds.status, Jobs.name FROM Jobs
-INNER JOIN Builds ON Jobs.build = Builds.id
+SELECT build, status, name FROM Jobs
WHERE Jobs.evaluation = :evaluation
AND ((Jobs.system = :system) OR :system IS NULL)
AND ((Jobs.name = ANY(:names)) OR :names IS NULL)
@@ -901,7 +868,11 @@ UPDATE Builds SET stoptime =" now
(build-weather new-failure)))
(db-push-notification notif
(assq-ref build #:id))))
- notifications)))))))
+ notifications)))))
+ (exec-query/bind db
+ "UPDATE Jobs SET status=" status
+ "WHERE build = (SELECT id FROM Builds WHERE
+ derivation = " drv ");")))
(define* (db-update-build-worker! drv worker)
"Update the database so that DRV's worker is WORKER."
@@ -1368,6 +1339,23 @@ SELECT MAX(id) FROM Evaluations
WHERE specification=" spec))
((max) (and max (string->number max))))))
+(define (db-get-latest-evaluations)
+ "Return the latest successful evaluation for each specification."
+ (with-db-worker-thread db
+ (let loop ((rows (exec-query db "
+SELECT specification, max(id) FROM Evaluations
+WHERE status = 0 GROUP BY Evaluations.specification;"))
+ (evaluations '()))
+ (match rows
+ (() (reverse evaluations))
+ (((specification evaluation)
+ . rest)
+ (loop rest
+ (cons `((#:specification . ,specification)
+ (#:evaluation
+ . ,(string->number evaluation)))
+ evaluations)))))))
+
(define (db-get-evaluation-summary id)
(with-db-worker-thread db
(match (expect-one-row
@@ -1411,18 +1399,19 @@ ORDER BY Evaluations.id ASC;"))
(with-db-worker-thread db
(let loop ((rows
(exec-query/bind db "SELECT
-SUM(CASE WHEN Builds.status = 0 THEN 1 ELSE 0 END) AS succeeded,
-SUM(CASE WHEN Builds.status > 0 THEN 1 ELSE 0 END) AS failed,
-SUM(CASE WHEN Builds.status < 0 THEN 1 ELSE 0 END) AS scheduled,
-Jobs.evaluation FROM Jobs INNER JOIN Builds ON Jobs.build = Builds.id
-WHERE Jobs.evaluation = ANY(" eval-ids ")
+SUM(CASE WHEN Jobs.status > -100 THEN 1 ELSE 0 END) as total,
+SUM(CASE WHEN Jobs.status = 0 THEN 1 ELSE 0 END) AS succeeded,
+SUM(CASE WHEN Jobs.status > 0 THEN 1 ELSE 0 END) AS failed,
+SUM(CASE WHEN Jobs.status < 0 THEN 1 ELSE 0 END) AS scheduled,
+Jobs.evaluation FROM Jobs WHERE Jobs.evaluation = ANY(" eval-ids ")
GROUP BY Jobs.evaluation;"))
(summary '()))
(match rows
(() (reverse summary))
- (((succeeded failed scheduled evaluation) . rest)
+ (((total succeeded failed scheduled evaluation) . rest)
(loop rest
(cons `((#:evaluation . ,(number evaluation))
+ (#:total . ,(number total))
(#:succeeded . ,(number succeeded))
(#:failed . ,(number failed))
(#:scheduled . ,(number scheduled)))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 72d3eea..5339a84 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -763,9 +763,14 @@ into a specification record and return it."
(('GET)
(respond-html (html-page
"Cuirass"
- (specifications-table
- (db-get-specifications)
- (db-get-specifications-summary))
+ (let ((evals (db-get-latest-evaluations)))
+ (specifications-table
+ (db-get-specifications)
+ evals
+ (db-get-evaluations-absolute-summary
+ (map (lambda (e)
+ `((#:id . ,(assq-ref e #:evaluation))))
+ evals))))
'())))
(('GET "jobset" name)
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 56ceb0e..47815ac 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -256,11 +256,22 @@ columnDefs: [
(else
"Invalid status")))
-(define (specifications-table specs summary)
- (define (spec-summary name)
+(define (specifications-table specs evaluations summaries)
+ (define (spec->latest-eval name)
(find (lambda (s)
(string=? (assq-ref s #:specification) name))
- summary))
+ evaluations))
+
+ (define (eval-summary eval)
+ (find (lambda (s)
+ (eq? (assq-ref s #:evaluation)
+ (assq-ref eval #:evaluation)))
+ summaries))
+
+ (define (summary->percentage summary)
+ (let ((total (assq-ref summary #:total))
+ (succeeded (assq-ref summary #:succeeded)))
+ (nearest-exact-integer (* 100 (/ succeeded total)))))
"Return HTML for the SPECS table."
`((p (@ (class "lead")) "Specifications"
@@ -321,21 +332,47 @@ $('.job-toggle').click(function() {
(specification-channels spec)) ", "))
(td ,(number->string
(specification-priority spec)))
- (td ,(string-join
- (sort (specification-systems spec)
- string<?)
- ", "))
(td
- ,@(let ((summary
- (spec-summary
- (specification-name spec))))
+ ,(let* ((systems (specification-systems spec))
+ (systems*
+ (string-join
+ (sort systems string<?)
+ ", "))
+ (tooltip?
+ (> (length systems) 1)))
+ `(span
+ (@ ,@(if tooltip?
+ `((data-toggle "tooltip")
+ (title ,systems*))
+ '()))
+ ,(if tooltip?
+ (string-append (car systems) ", ...")
+ systems))))
+ (td
+ (@
+ (style "vertical-align: middle"))
+ ,@(let* ((summary
+ (eval-summary
+ (spec->latest-eval
+ (specification-name spec))))
+ (percentage
+ (summary->percentage summary))
+ (style
+ (format #f "width: ~a%" percentage)))
(if summary
`((div
- (@ (class "badge badge-success job-per mr-3")
+ (@ (class "progress job-per")
(title "Percentage succeeded"))
- ,(nearest-exact-integer
- (assq-ref summary #:percentage))
- "%")
+ (div (@ (class "progress-bar")
+ (role "progressbar")
+ (style ,style)
+ (aria-valuemin "0")
+ (aria-valuemax "100"))
+ (strong
+ (span
+ (@ (class "text-dark"))
+ ,percentage
+ "%"))))
" "
(div
(@ (class "job-val"))
@@ -353,8 +390,8 @@ $('.job-toggle').click(function() {
,(assq-ref summary #:scheduled))))
'())))
(td
- ,@(let ((eval (and=> (spec-summary
- (specification-name spec))
+ ,@(let ((eval (and=> (spec->latest-eval
+ (specification-name spec))
(cut assq-ref <> #:evaluation))))
(if eval
`((a (@ (href "/eval/" ,eval
diff --git a/src/schema.sql b/src/schema.sql
index 5158732..bd20327 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -62,7 +62,8 @@ CREATE TABLE Jobs (
name TEXT NOT NULL,
evaluation INTEGER NOT NULL,
build INTEGER NOT NULL,
- system TEXT NOT NULL,
+ status INTEGER NOT NULL, --caches Builds.status
+ system TEXT NOT NULL, --caches Builds.system
PRIMARY KEY (evaluation, build),
FOREIGN KEY (build) REFERENCES Builds(id) ON DELETE CASCADE,
FOREIGN KEY (evaluation) REFERENCES Evaluations(id) ON DELETE CASCADE
@@ -124,6 +125,7 @@ CREATE INDEX Builds_priority_timestamp on Builds(priority
ASC, timestamp DESC);
CREATE INDEX Builds_weather_evaluation ON Builds (weather, evaluation);
CREATE INDEX Jobs_name ON Jobs (name);
+CREATE INDEX Jobs_system_status ON Jobs (system, status);
CREATE INDEX Evaluations_status_index ON Evaluations (id, status);
CREATE INDEX Evaluations_specification_index ON Evaluations (specification, id
DESC);
diff --git a/src/sql/upgrade-7.sql b/src/sql/upgrade-7.sql
new file mode 100644
index 0000000..e9e221f
--- /dev/null
+++ b/src/sql/upgrade-7.sql
@@ -0,0 +1,10 @@
+BEGIN TRANSACTION;
+
+ALTER TABLE Jobs ADD COLUMN status INTEGER NOT NULL DEFAULT 0;
+CREATE INDEX Jobs_system_status ON Jobs (system, status);
+UPDATE Jobs SET status = b.status FROM
+(SELECT Builds.id, Builds.status FROM Jobs
+JOIN Builds ON Jobs.build = Builds.id) b
+WHERE Jobs.build = b.id;
+
+COMMIT;
diff --git a/src/static/css/cuirass.css b/src/static/css/cuirass.css
index 1adfada..0d41349 100644
--- a/src/static/css/cuirass.css
+++ b/src/static/css/cuirass.css
@@ -97,6 +97,22 @@ div.tooltip {
display: none;
}
+.job-per {
+ min-height: 1.5em;
+ min-width: 8em;
+}
+
.job-abs {
display: none;
}
+.progress {
+ position:relative;
+}
+.progress span {
+ position:absolute;
+ top: 0;
+ left:0;
+ width:100%;
+ text-align:center;
+ z-index:2;
+}
diff --git a/tests/database.scm b/tests/database.scm
index ec7d6ca..5385a15 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -254,19 +254,6 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0,
0, 0);")
(assoc-ref build #:status)
(assoc-ref build #:job-name))))
- (test-equal "db-get-specifications-summary"
- '("guix" 0 0 1 0)
- (begin
- (db-set-evaluation-status 2 (evaluation-status succeeded))
- (match (db-get-specifications-summary)
- ((summary)
- (list
- (assq-ref summary #:specification)
- (assq-ref summary #:percentage)
- (assq-ref summary #:succeeded)
- (assq-ref summary #:failed)
- (assq-ref summary #:scheduled))))))
-
(test-assert "db-get-builds"
(let* ((build (match (db-get-builds `((order . build-id)
(status . failed)))
@@ -354,6 +341,12 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0,
0, 0);")
#f
(db-get-evaluations-id-max "foo"))
+ (test-equal "db-get-latest-evaluations"
+ 1
+ (match (db-get-latest-evaluations)
+ ((eval)
+ (assq-ref eval #:evaluation))))
+
(test-equal "db-get-evaluation-summary"
'(2 0 1 1)
(let* ((summary (db-get-evaluation-summary 2))