diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-08-14 19:56:37 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2024-08-14 19:56:37 +0100 |
| commit | e2e158e33b14c28d0994ee91de3c08209aaca629 (patch) | |
| tree | 2a7013c3025b0c68ce5a480bbb6454339ccbe60a | |
| parent | eeda1bf33b42a81a8a295c9e498f3bb44e95d6f1 (diff) | |
| download | data-service-e2e158e33b14c28d0994ee91de3c08209aaca629.tar data-service-e2e158e33b14c28d0994ee91de3c08209aaca629.tar.gz | |
Make resource pools a record
So that the name is known when requesting a resource from the pool.
| -rw-r--r-- | guix-data-service/utils.scm | 30 |
1 files 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 _ |