diff options
-rw-r--r-- | bffe/manage-builds.scm | 29 |
1 files changed, 28 insertions, 1 deletions
diff --git a/bffe/manage-builds.scm b/bffe/manage-builds.scm index dd73d1d..8047328 100644 --- a/bffe/manage-builds.scm +++ b/bffe/manage-builds.scm @@ -209,7 +209,34 @@ channels))) (define (fibers-for-each proc . lists) - (apply fibers-map proc lists) + ;; Like split-at, but don't care about the order of the resulting lists, and + ;; don't error if the list is shorter than i elements + (define (split-at* lst i) + (let lp ((l lst) (n i) (acc '())) + (if (or (<= n 0) (null? l)) + (values (reverse! acc) l) + (lp (cdr l) (- n 1) (cons (car l) acc))))) + + ;; As this can be called with lists with tens of thousands of items in them, + ;; batch the + (define batch-size 20) + (define (get-batch lists) + (let ((split-lists + (map (lambda (lst) + (let ((batch rest (split-at* lst batch-size))) + (cons batch rest))) + lists))) + (values (map car split-lists) + (map cdr split-lists)))) + + (let loop ((lists lists)) + (call-with-values + (lambda () + (get-batch lists)) + (lambda (batch rest) + (apply fibers-map proc batch) + (unless (null? (car rest)) + (loop rest))))) *unspecified*) (define (all-repository-ids guix-data-service) |