guix
/
guix-cuirass
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Optimize Jobs table.

This commit is contained in:
Mathieu Othacehe 2021-04-14 15:05:00 +02:00
parent f97bf6b75f
commit 17e8759efe
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
8 changed files with 134 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile.am
View File

@ -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 \

83
src/cuirass/database.scm
View File

@ -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)))

11
src/cuirass/http.scm
View File

@ -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)

69
src/cuirass/templates.scm
View File

@ -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

4
src/schema.sql
View File

@ -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);

10
src/sql/upgrade-7.sql Normal file
View File

@ -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;

16
src/static/css/cuirass.css
View File

@ -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;
}

19
tests/database.scm
View File

@ -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))