cbaines pushed a commit to branch master
in repository data-service.
commit e2e158e33b14c28d0994ee91de3c08209aaca629
Author: Christopher Baines <[email protected]>
AuthorDate: Wed Aug 14 19:56:37 2024 +0100
Make resource pools a record
So that the name is known when requesting a resource from the pool.
---
guix-data-service/utils.scm | 30 +++++++++++++++++++++---------
1 file changed, 21 insertions(+), 9 deletions(-)
diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm
index 0320497..0f9d4c8 100644
--- a/guix-data-service/utils.scm
+++ b/guix-data-service/utils.scm
@@ -97,6 +97,12 @@
(define-syntax-rule (prevent-inlining-for-tests var)
(set! var var))
+(define-record-type <resource-pool>
+ (make-resource-pool-record name channel)
+ resource-pool?
+ (name resource-pool-name)
+ (channel resource-pool-channel))
+
(define* (make-resource-pool initializer max-size
#:key (min-size max-size)
(idle-seconds #f)
@@ -338,11 +344,12 @@
resources-last-used)))))
#:unwind? #t))))
- channel))
+ (make-resource-pool-record name channel)))
(define (destroy-resource-pool pool)
(let ((reply (make-channel)))
- (put-message pool (list 'destroy reply))
+ (put-message (resource-pool-channel pool)
+ (list 'destroy reply))
(let ((msg (get-message reply)))
(unless (eq? msg 'destroy-success)
(error msg)))))
@@ -381,7 +388,8 @@ available. Return the resource once PROC has returned."
(perform-operation
(choice-operation
(wrap-operation
- (put-operation pool `(checkout ,reply))
+ (put-operation (resource-pool-channel pool)
+ `(checkout ,reply))
(const #t))
(wrap-operation (sleep-operation timeout-or-default)
(const #f))))
@@ -410,7 +418,8 @@ available. Return the resource once PROC has returned."
response))
#f)))
(let loop ()
- (put-message pool `(checkout ,reply))
+ (put-message (resource-pool-channel pool)
+ `(checkout ,reply))
(let ((response (get-message reply)))
(if (eq? response 'resource-pool-retry-checkout)
(loop)
@@ -426,7 +435,8 @@ available. Return the resource once PROC has returned."
(with-exception-handler
(lambda (exception)
- (put-message pool `(return ,resource))
+ (put-message (resource-pool-channel pool)
+ `(return ,resource))
(raise-exception exception))
(lambda ()
(call-with-values
@@ -437,14 +447,15 @@ available. Return the resource once PROC has returned."
(lambda _
(backtrace))))
(lambda vals
- (put-message pool `(return ,resource))
+ (put-message (resource-pool-channel pool)
+ `(return ,resource))
(apply values vals))))
#:unwind? #t)))
(define-syntax-rule (with-resource-from-pool pool resource exp ...)
(call-with-resource-from-pool
- pool
- (lambda (resource) exp ...)))
+ pool
+ (lambda (resource) exp ...)))
(define* (resource-pool-stats pool #:key (timeout 5))
(let ((reply (make-channel))
@@ -452,7 +463,8 @@ available. Return the resource once PROC has returned."
(perform-operation
(choice-operation
(wrap-operation
- (put-operation pool `(stats ,reply))
+ (put-operation (resource-pool-channel pool)
+ `(stats ,reply))
(const #t))
(wrap-operation (sleep-operation timeout)
(lambda _
