Close postgresql connections when the thread pool thread is idle

I think the idle connections associated with idle threads are still taking up
memory, so especially now that you can configure an arbitrary number of
threads (and thus connections), I think it's good to close them regularly.

guix-data-service/utils.scm

@@ -23,6 +23,8 @@
   #:use-module (ice-9 threads)
   #:use-module (fibers)
   #:use-module (fibers channels)
+  #:use-module (fibers operations)
+  #:use-module (fibers timers)
   #:use-module (fibers conditions)
   #:use-module (prometheus)
   #:export (call-with-time-logging
@@ -30,6 +32,8 @@
             prevent-inlining-for-tests
 
             %thread-pool-threads
+            %thread-pool-idle-seconds
+            %thread-pool-idle-thunk
             parallel-via-thread-pool-channel
             par-map&
             letpar&
@@ -62,6 +66,12 @@
 (define %thread-pool-threads
   (make-parameter 8))
 
+(define %thread-pool-idle-seconds
+  (make-parameter #f))
+
+(define %thread-pool-idle-thunk
+  (make-parameter #f))
+
 (define* (make-thread-pool-channel threads)
   (define (delay-logger seconds-delayed)
     (when (> seconds-delayed 1)
@@ -70,13 +80,37 @@
        "warning: thread pool delayed by ~1,2f seconds~%"
        seconds-delayed)))
 
+  (define idle-thunk
+    (%thread-pool-idle-thunk))
+
+  (define idle-seconds
+    (%thread-pool-idle-seconds))
+
   (let ((channel (make-channel)))
     (for-each
      (lambda _
        (call-with-new-thread
         (lambda ()
           (let loop ()
-            (match (get-message channel)
+            (match (if idle-seconds
+                       (perform-operation
+                        (choice-operation
+                         (get-operation channel)
+                         (wrap-operation (sleep-operation idle-seconds)
+                                         (const 'timeout))))
+                       (get-message channel))
+              ('timeout
+               (when idle-thunk
+                 (with-exception-handler
+                     (lambda (exn)
+                       (simple-format (current-error-port)
+                                      "worker thread idle thunk exception: ~A\n"
+                                      exn))
+                   idle-thunk
+                   #:unwind? #t))
+
+               (loop))
+
               (((? channel? reply) sent-time (? procedure? proc))
                (let ((time-delay
                       (- (get-internal-real-time)