diff options
Diffstat (limited to 'guix-qa-frontpage/manage-builds.scm')
| -rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 51 |
1 files changed, 20 insertions, 31 deletions
diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index cb235b7..1487c77 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -2,6 +2,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-71) #:use-module (ice-9 match) + #:use-module (ice-9 streams) #:use-module (ice-9 threads) #:use-module (guix sets) #:use-module (guix-build-coordinator utils) @@ -282,26 +283,19 @@ #:delay 30)) (define (for-each-build build-coordinator proc . criteria) - (define (builds-after id) - (vector->list - (assoc-ref - (apply request-builds-list - build-coordinator - (append criteria - `(#:limit 1000 - #:after-id ,id))) - "builds"))) - - (let loop ((builds (builds-after #f))) - (for-each proc builds) - (unless (null? builds) - (let ((next-builds - (builds-after - (assoc-ref (last builds) "uuid")))) - (loop - (if (null? next-builds) - (builds-after #f) - next-builds)))))) + (define (process-batch) + (stream-for-each + (lambda (build result) + (proc build) + (+1 result)) + 0 + (apply request-builds-list + build-coordinator + criteria))) + + (let loop ((batch-size (process-batch))) + (unless (= 0 batch-size) + (loop (process-batch))))) (define (cancel-builds-not-for-revision build-coordinator category-name @@ -395,17 +389,12 @@ submit-single build-details)) - ;; TODO Don't currently cancel builds - ;; I think this approach has some problems and needs more thinking about. - ;; - ;; (cancel-builds-not-for-revision - ;; build-coordinator - ;; category-name - ;; category-value - ;; target-commit - ;; build-ids-to-keep-set) - - ) + (cancel-builds-not-for-revision + build-coordinator + category-name + category-value + target-commit + build-ids-to-keep-set)) (let loop ((changes (append-map! (lambda (package) |