Adjust make-worker-thread-channel to take an initializer.

While this is a generic method, and initializer function will give the
flexibility required to create multiple worker threads for performing SQLite
queries, each with it's own database connection (as a result of calling the
initializer once for each thread). Without this change, they'd all have to use
the same connection, which would not work.

* src/cuirass/utils.scm (make-worker-thread-channel): Change procedure to take
an initializer, rather than arguments directly.
* src/cuirass/database.scm (with-database): Adjust to call
make-worker-thread-channel with an initializer.
* tests/database.scm (db-init): Change to use make-worker-thread-channel
initializer.
* tests/http.scm (db-init): Change to use make-worker-thread-channel
initializer.

1 files changed, 10 insertions, 9 deletions

diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index 514899e..dfed4a9 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -99,19 +99,20 @@ delimited continuations and fibers."
 (define %worker-thread-args
   (make-parameter #f))
 
-(define (make-worker-thread-channel . args)
+(define (make-worker-thread-channel initializer)
   "Return a channel used to offload work to a dedicated thread.  ARGS are the
 arguments of the worker thread procedure."
   (parameterize (((@@ (fibers internal) current-fiber) #f))
     (let ((channel (make-channel)))
-      (call-with-new-thread
-       (lambda ()
-         (parameterize ((%worker-thread-args args))
-           (let loop ()
-             (match (get-message channel)
-               (((? channel? reply) . (? procedure? proc))
-                (put-message reply (apply proc args))))
-             (loop)))))
+      (let ((args (initializer)))
+        (call-with-new-thread
+         (lambda ()
+           (parameterize ((%worker-thread-args args))
+             (let loop ()
+               (match (get-message channel)
+                 (((? channel? reply) . (? procedure? proc))
+                  (put-message reply (apply proc args))))
+               (loop))))))
       channel)))
 
 (define (call-with-worker-thread channel proc)