Always look at canceling branch builds

1 files changed, 70 insertions, 65 deletions

diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index 179ebf7..da19589 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -289,54 +289,37 @@
 (define (start-submit-branch-builds-thread database
                                            build-coordinator
                                            guix-data-service)
-  (define (submit-builds)
+  (define (cancel-branch-builds branches)
+    (for-each
+     (lambda (branch)
+       (cancel-builds build-coordinator
+                      "branch"
+                      branch)
+       (delete-from-builds-to-cancel-later
+        database
+        "branch"
+        branch))
+     branches))
+
+  (define (submit-builds branches)
     (simple-format #t "submitting branch builds\n")
-    (let* ((branches
-            (take (with-sqlite-cache
-                   database
-                   'list-non-master-branches
-                   list-non-master-branches
-                   #:ttl 0)
-                  2))
-           (branch-names
-            (map car branches)))
-
-      (let* ((branches-with-builds-previously-submitted
-              (select-from-builds-to-cancel-later
-               database
-               "branch"))
-             (branches-with-builds-to-cancel
-              (lset-difference
-               string=?
-               branches-with-builds-previously-submitted
-               branch-names)))
-        (for-each
-         (lambda (branch)
-           (cancel-builds build-coordinator
-                          "branch"
-                          branch)
-           (delete-from-builds-to-cancel-later
-            database
-            "branch"
-            branch))
-         branches-with-builds-to-cancel))
 
-      (for-each
-       (lambda (index branch)
-         (submit-builds-for-branch
-          database
-          build-coordinator
-          guix-data-service
-          branch
-          #:priority
-          (lambda (change)
-            (- (if (member (assoc-ref change "system")
-                           '("x86_64-linux" "aarch64-linux"))
-                   400
-                   350)
-               (* index 100)))))
-       (iota (length branches))
-       branch-names)))
+    (for-each
+     (lambda (index branch)
+       (submit-builds-for-branch
+        database
+        build-coordinator
+        guix-data-service
+        branch
+        #:priority
+        (lambda (change)
+          (- (if (member (assoc-ref change "system")
+                         '("x86_64-linux" "aarch64-linux"))
+                 400
+                 350)
+             (* index 100)))))
+     (iota (length branches))
+     branches))
 
   (call-with-new-thread
    (lambda ()
@@ -355,25 +338,47 @@
          (lambda ()
            (with-throw-handler #t
              (lambda ()
-               (let* ((master-branch-substitute-availability
-                       (with-sqlite-cache
-                        database
-                        'master-branch-data
-                        master-branch-data
-                        #:ttl 6000))
-                      (systems-with-low-substitute-availability
-                       (get-systems-with-low-substitute-availability
-                        master-branch-substitute-availability
-                        (lset-difference
-                         string=?
-                         %systems-to-submit-builds-for
-                         %systems-with-expected-low-substitute-availability))))
-
-                 (if (null? systems-with-low-substitute-availability)
-                     (submit-builds)
-                     (simple-format
-                      (current-error-port)
-                      "waiting for master branch substitutes before submitting branch builds\n"))))
+               (let* ((branches
+                       (take (with-sqlite-cache
+                              database
+                              'list-non-master-branches
+                              list-non-master-branches
+                              #:ttl 0)
+                             2))
+                      (branch-names
+                       (map car branches)))
+
+                 (let* ((branches-with-builds-previously-submitted
+                         (select-from-builds-to-cancel-later
+                          database
+                          "branch"))
+                        (branches-with-builds-to-cancel
+                         (lset-difference
+                          string=?
+                          branches-with-builds-previously-submitted
+                          branch-names)))
+                   (unless (null? branches-with-builds-to-cancel)
+                     (cancel-branch-builds branches-with-builds-to-cancel)))
+
+                 (let* ((master-branch-substitute-availability
+                         (with-sqlite-cache
+                          database
+                          'master-branch-data
+                          master-branch-data
+                          #:ttl 6000))
+                        (systems-with-low-substitute-availability
+                         (get-systems-with-low-substitute-availability
+                          master-branch-substitute-availability
+                          (lset-difference
+                           string=?
+                           %systems-to-submit-builds-for
+                           %systems-with-expected-low-substitute-availability))))
+
+                   (if (null? systems-with-low-substitute-availability)
+                       (submit-builds branch-names)
+                       (simple-format
+                        (current-error-port)
+                        "waiting for master branch substitutes before submitting branch builds\n")))))
              (lambda args
                (display (backtrace) (current-error-port))
                (newline (current-error-port)))))