From aadbee0d0e452670719d030e5a40ff115ba10c68 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 4 Feb 2025 11:13:15 +0000
Subject: [PATCH] Improve handling of idle resources in the resource pool

---
 knots/resource-pool.scm | 34 +++++++++++++++++++++++-----------
 1 file changed, 23 insertions(+), 11 deletions(-)

diff --git a/knots/resource-pool.scm b/knots/resource-pool.scm
index de03f50..fddbb60 100644
--- a/knots/resource-pool.scm
+++ b/knots/resource-pool.scm
@@ -79,7 +79,7 @@
     port)))
 
 (define* (make-resource-pool return-new-resource max-size
-                             #:key (min-size max-size)
+                             #:key (min-size 0)
                              (idle-seconds #f)
                              (delay-logger (const #f))
                              (duration-logger (const #f))
@@ -375,7 +375,7 @@
                     (/ (- (get-internal-real-time) internal-time)
                        internal-time-units-per-second))
                   resources-last-used))
-                (resources-to-destroy
+                (candidate-resources-to-destroy
                  (filter-map
                   (lambda (resource last-used-seconds)
                     (if (and (member resource available)
@@ -385,16 +385,28 @@
                   resources
                   resources-last-used-seconds)))
 
-           (when destructor
-             (for-each
-              (lambda (resource)
-                (spawn-fiber-to-destroy-resource resource))
-              resources-to-destroy))
+           (let* ((available-resources-to-destroy
+                   (lset-intersection eq?
+                                      available
+                                      candidate-resources-to-destroy))
+                  (max-resources-to-destroy
+                   (max 0
+                        (- (length resources)
+                           min-size)))
+                  (resources-to-destroy
+                   (take available-resources-to-destroy
+                         (min max-resources-to-destroy
+                              (length available-resources-to-destroy)))))
+             (when destructor
+               (for-each
+                (lambda (resource)
+                  (spawn-fiber-to-destroy-resource resource))
+                resources-to-destroy))
 
-           (loop resources
-                 (lset-difference eq? available resources-to-destroy)
-                 waiters
-                 resources-last-used)))
+             (loop resources
+                   (lset-difference eq? available resources-to-destroy)
+                   waiters
+                   resources-last-used))))
 
         (('destroy reply)
          (if (null? resources)