Rework canceling builds

Previously there were some protections introduced against canceling builds
that were required by other builds, but this change wasn't quite complete as
at least the command line interface wasn't updated to take this in to account.

This commit updates the command line interface, as well as improving the
controller.

1 files changed, 48 insertions, 63 deletions

diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index 8dbe5da..c892fe3 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -269,19 +269,13 @@
                               (cons arg
                                     (or (assq-ref result 'not-systems)
                                         '()))
-                              (alist-delete 'not-systems result))))
-        (option '("ignore-if-build-required-by-another") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'ignore-if-build-required-by-another
-                              (string=? arg "true")
                               (alist-delete 'not-systems result))))))
 
 (define %build-cancel-option-defaults
   `((tags                                . ())
     (not-tags                            . ())
     (systems                             . ())
-    (not-systems                         . ())
-    (ignore-if-build-required-by-another . #t)))
+    (not-systems                         . ())))
 
 (define %build-update-priority-options
   (cons* (option '("new-priority") #t #f
@@ -591,70 +585,61 @@ tags:
                                       %base-option-defaults
                                       %build-cancel-option-defaults)
                               rest)))
-     (define (find-matching-builds)
+     (define (get-batch)
        (define limit 1000)
 
-       (let loop ((after-id #f)
-                  (result '()))
-         (let* ((response (request-builds-list
-                           (assq-ref opts 'coordinator)
-                           #:tags (assq-ref opts 'tags)
-                           #:not-tags (assq-ref opts 'not-tags)
-                           #:systems (assq-ref opts 'systems)
-                           #:not-systems (assq-ref opts 'not-systems)
-                           #:processed #f
-                           #:canceled #f
-                           #:after-id after-id
-                           #:limit 1000))
-                (received-builds
-                 (vector-length (assoc-ref response "builds")))
-                (new-result
-                 (fold
-                  (lambda (build-details result)
-                    (cons (assoc-ref build-details "uuid")
-                          result))
-                  result
-                  (vector->list (assoc-ref response "builds")))))
-           (display "." (current-error-port))
-           (force-output (current-error-port))
-           (if (< received-builds limit)
-               new-result
-               (loop (assoc-ref (vector-ref (assoc-ref response "builds")
-                                            (- received-builds 1))
-                                "uuid")
-                     new-result)))))
+       (simple-format (current-error-port)
+                      "requesting matching builds\n")
+       (force-output (current-error-port))
+       (let* ((response (request-builds-list
+                         (assq-ref opts 'coordinator)
+                         #:tags (assq-ref opts 'tags)
+                         #:not-tags (assq-ref opts 'not-tags)
+                         #:systems (assq-ref opts 'systems)
+                         #:not-systems (assq-ref opts 'not-systems)
+                         #:processed #f
+                         #:canceled #f
+                         #:relationship 'no-dependent-builds
+                         #:limit 1000))
+              (received-builds
+               (vector-length (assoc-ref response "builds"))))
+
+         (fold
+          (lambda (build-details result)
+            (cons (assoc-ref build-details "uuid")
+                  result))
+          '()
+          (vector->list (assoc-ref response "builds")))))
 
      (match (assq-ref opts 'arguments)
        (#f
-        (simple-format (current-error-port)
-                       "requesting matching builds")
-        (force-output (current-error-port))
-        (let* ((matching-builds (find-matching-builds))
-               (count (length matching-builds)))
-          (simple-format (current-error-port)
-                         "\nfound ~A builds matching criteria\n"
-                         count)
-
-          (call-with-progress-reporter (progress-reporter/bar
-                                        count
-                                        (simple-format #f "canceling ~A builds"
-                                                       count)
-                                        (current-error-port))
-            (lambda (report)
-              (for-each (lambda (id)
-                          (send-cancel-build-request
-                           (assq-ref opts 'coordinator)
-                           id
-                           #:ignore-if-build-required-by-another?
-                           (assq-ref opts 'ignore-if-build-required-by-another))
-                          (report))
-                        matching-builds)))))
+        (let loop ((matching-builds (get-batch)))
+          (let ((count (length matching-builds)))
+            (if (= 0 count)
+                (simple-format (current-error-port)
+                               "finished cancelling builds matching criteria\n")
+                (begin
+                  (simple-format (current-error-port)
+                                 "cancelling ~A builds matching criteria\n"
+                                 count)
+
+                  (call-with-progress-reporter (progress-reporter/bar
+                                                count
+                                                (simple-format #f "canceling ~A builds"
+                                                               count)
+                                                (current-error-port))
+                    (lambda (report)
+                      (for-each (lambda (id)
+                                  (send-cancel-build-request
+                                   (assq-ref opts 'coordinator)
+                                   id)
+                                  (report))
+                                matching-builds)))
+                  (loop (get-batch)))))))
        ((build-id)
         (send-cancel-build-request
          (assq-ref opts 'coordinator)
-         build-id
-         #:ignore-if-build-required-by-another?
-         (assq-ref opts 'ignore-if-build-required-by-another))))))
+         build-id)))))
   (("build" "update-priority" rest ...)
    (let ((opts (parse-options (append %client-options
                                       %base-options