Add make-queueing-channel

From the build coordinator.

1 files changed, 26 insertions, 1 deletions

diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm
index 48f9c88..5f70f38 100644
--- a/guix-data-service/utils.scm
+++ b/guix-data-service/utils.scm
@@ -20,6 +20,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-71)
+  #:use-module (ice-9 q)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 atomic)
@@ -80,7 +81,9 @@
             call-with-sigint
             run-server/patched
 
-            spawn-port-monitoring-fiber))
+            spawn-port-monitoring-fiber
+
+            make-queueing-channel))
 
 (define (call-with-time-logging action thunk)
   (simple-format #t "debug: Starting ~A\n" action)
@@ -1188,3 +1191,25 @@ If already in the worker thread, call PROC immediately."
             (sigaction SIGINT (car handler) (cdr handler))
             ;; restore original C handler.
             (sigaction SIGINT #f))))))
+
+(define (make-queueing-channel channel)
+  (define queue (make-q))
+
+  (let ((queue-channel (make-channel)))
+    (spawn-fiber
+     (lambda ()
+       (while #t
+         (if (q-empty? queue)
+             (enq! queue
+                   (perform-operation
+                    (get-operation queue-channel)))
+             (let ((front (q-front queue)))
+               (perform-operation
+                (choice-operation
+                 (wrap-operation (get-operation queue-channel)
+                                 (lambda (val)
+                                   (enq! queue val)))
+                 (wrap-operation (put-operation channel front)
+                                 (lambda _
+                                   (q-pop! queue))))))))))
+    queue-channel))