Limit the parallelism of fibers-for-each

Since I think that'll help balance the work of submitting builds.

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)