Fix cancel-builds-not-for-revision

To actually cancel all the builds.

1 files changed, 35 insertions, 38 deletions

diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index 7d93285..495fb13 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -489,16 +489,6 @@
    #:times 30
    #:delay 30))
 
-(define (for-each-build build-coordinator proc . criteria)
-  (apply
-   fold-builds
-   build-coordinator
-   (lambda (build-details _)
-     (proc build-details)
-     #f)
-   #f
-   criteria))
-
 (define* (cancel-builds build-coordinator
                         category-name
                         category-value
@@ -525,7 +515,6 @@
   (with-fibers-port-timeouts
    (lambda ()
      (let loop ((uuids-batch (fetch-build-uuids)))
-
        (for-each
         (lambda (uuid)
           (retry-on-error
@@ -556,6 +545,24 @@
                                         category-value
                                         revision
                                         build-ids-to-keep-set)
+  (define (fetch-build-uuids)
+    (fold-builds
+     build-coordinator
+     (lambda (build-details result)
+       (cons (assoc-ref build-details "uuid") result))
+     '()
+     #:tags
+     `(((key . category)
+        (value . package))
+       ((key . ,category-name)
+        (value . ,category-value)))
+     #:not-tags
+     `(((key . revision)
+        (value . ,revision)))
+     #:canceled #f
+     #:processed #f
+     #:relationship 'no-dependent-builds))
+
   (simple-format (current-error-port)
                  "canceling builds for ~A ~A and not revision ~A\n"
                  category-name
@@ -563,33 +570,23 @@
                  revision)
   (with-fibers-port-timeouts
    (lambda ()
-     (for-each-build
-      build-coordinator
-      (lambda (build-details)
-        (unless (set-contains?
-                 build-ids-to-keep-set
-                 (assoc-ref build-details "uuid"))
-          (retry-on-error
-           (lambda ()
-             (send-cancel-build-request build-coordinator
-                                        (assoc-ref build-details "uuid")
-                                        #:skip-updating-derived-priorities? #t))
-           #:times 6
-           #:delay 15)
-          (simple-format (current-error-port)
-                         "canceled ~A\n"
-                         (assoc-ref build-details "uuid"))))
-      #:tags
-      `(((key . category)
-         (value . package))
-        ((key . ,category-name)
-         (value . ,category-value)))
-      #:not-tags
-      `(((key . revision)
-         (value . ,revision)))
-      #:canceled #f
-      #:processed #f
-      #:relationship 'no-dependent-builds))
+     (let loop ((uuids-batch (fetch-build-uuids)))
+       (for-each
+        (lambda (uuid)
+          (unless (set-contains? build-ids-to-keep-set uuid)
+            (retry-on-error
+             (lambda ()
+               (send-cancel-build-request build-coordinator
+                                          uuid
+                                          #:skip-updating-derived-priorities? #t))
+             #:times 6
+             #:delay 15)
+            (simple-format (current-error-port)
+                           "canceled ~A\n" uuid)))
+        uuids-batch)
+
+       (unless (null? uuids-batch)
+         (loop (fetch-build-uuids)))))
    #:timeout 60)
   (simple-format (current-error-port)
                  "finished canceling builds for ~A ~A and not revision ~A\n"