Optimize Jobs table.

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		\

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)
+WITH b AS
-(SELECT " name ", " eval-id ",
+(SELECT id, status FROM Builds WHERE derivation =
-(SELECT id 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
+SELECT build, status, name FROM Jobs
-INNER JOIN Builds ON Jobs.build = Builds.id
 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 Jobs.status > -100 THEN 1 ELSE 0 END) as total,
-SUM(CASE WHEN Builds.status > 0 THEN 1 ELSE 0 END) AS failed,
+SUM(CASE WHEN Jobs.status = 0 THEN 1 ELSE 0 END) AS succeeded,
-SUM(CASE WHEN Builds.status < 0 THEN 1 ELSE 0 END) AS scheduled,
+SUM(CASE WHEN Jobs.status > 0 THEN 1 ELSE 0 END) AS failed,
-Jobs.evaluation FROM Jobs INNER JOIN Builds ON Jobs.build = Builds.id
+SUM(CASE WHEN Jobs.status < 0 THEN 1 ELSE 0 END) AS scheduled,
-WHERE Jobs.evaluation = ANY(" eval-ids ")
+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)))

src/cuirass/http.scm

@@ -763,9 +763,14 @@ into a specification record and return it."
     (('GET)
      (respond-html (html-page
                     "Cuirass"
-                    (specifications-table
+                    (let ((evals (db-get-latest-evaluations)))
-                     (db-get-specifications)
+                      (specifications-table
-                     (db-get-specifications-summary))
+                       (db-get-specifications)
+                       evals
+                       (db-get-evaluations-absolute-summary
+                        (map (lambda (e)
+                               `((#:id . ,(assq-ref e #:evaluation))))
+                             evals))))
                     '())))
 
     (('GET "jobset" name)

src/cuirass/templates.scm

@@ -256,11 +256,22 @@ columnDefs: [
    (else
     "Invalid status")))
 
-(define (specifications-table specs summary)
+(define (specifications-table specs evaluations summaries)
-  (define (spec-summary name)
+  (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
+                      ,(let* ((systems (specification-systems spec))
-                               (spec-summary
+                              (systems*
-                                (specification-name spec))))
+                               (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
+                                 (div (@ (class "progress-bar")
-                                   (assq-ref summary #:percentage))
+                                         (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
+                      ,@(let ((eval (and=> (spec->latest-eval
-                                           (specification-name spec))
+                                            (specification-name spec))
                                           (cut assq-ref <> #:evaluation))))
                           (if eval
                               `((a (@ (href "/eval/" ,eval

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

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;

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

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