cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make resource pools a record

Browse source 
So that the name is known when requesting a resource from the pool.
This commit is contained in:
Christopher Baines 2024-08-14 19:56:37 +01:00
parent eeda1bf33b
commit e2e158e33b
1 changed files with 21 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

26
guix-data-service/utils.scm
View file

@ -97,6 +97,12 @@
(define-syntax-rule (prevent-inlining-for-tests var) (define-syntax-rule (prevent-inlining-for-tests var)
(set! var 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 (define* (make-resource-pool initializer max-size
#:key (min-size max-size) #:key (min-size max-size)
(idle-seconds #f) (idle-seconds #f)
@ -338,11 +344,12 @@
resources-last-used))))) resources-last-used)))))
#:unwind? #t)))) #:unwind? #t))))
channel)) (make-resource-pool-record name channel)))
(define (destroy-resource-pool pool) (define (destroy-resource-pool pool)
(let ((reply (make-channel))) (let ((reply (make-channel)))
(put-message pool (list 'destroy reply)) (put-message (resource-pool-channel pool)
(list 'destroy reply))
(let ((msg (get-message reply))) (let ((msg (get-message reply)))
(unless (eq? msg 'destroy-success) (unless (eq? msg 'destroy-success)
(error msg))))) (error msg)))))
@ -381,7 +388,8 @@ available. Return the resource once PROC has returned."
(perform-operation (perform-operation
(choice-operation (choice-operation
(wrap-operation (wrap-operation
(put-operation pool `(checkout ,reply)) (put-operation (resource-pool-channel pool)
`(checkout ,reply))
(const #t)) (const #t))
(wrap-operation (sleep-operation timeout-or-default) (wrap-operation (sleep-operation timeout-or-default)
(const #f)))) (const #f))))
@ -410,7 +418,8 @@ available. Return the resource once PROC has returned."
response)) response))
#f))) #f)))
(let loop () (let loop ()
(put-message pool `(checkout ,reply)) (put-message (resource-pool-channel pool)
`(checkout ,reply))
(let ((response (get-message reply))) (let ((response (get-message reply)))
(if (eq? response 'resource-pool-retry-checkout) (if (eq? response 'resource-pool-retry-checkout)
(loop) (loop)
@ -426,7 +435,8 @@ available. Return the resource once PROC has returned."
(with-exception-handler (with-exception-handler
(lambda (exception) (lambda (exception)
(put-message pool `(return ,resource)) (put-message (resource-pool-channel pool)
`(return ,resource))
(raise-exception exception)) (raise-exception exception))
(lambda () (lambda ()
(call-with-values (call-with-values
@ -437,7 +447,8 @@ available. Return the resource once PROC has returned."
(lambda _ (lambda _
(backtrace)))) (backtrace))))
(lambda vals (lambda vals
(put-message pool `(return ,resource)) (put-message (resource-pool-channel pool)
`(return ,resource))
(apply values vals)))) (apply values vals))))
#:unwind? #t))) #:unwind? #t)))
@ -452,7 +463,8 @@ available. Return the resource once PROC has returned."
(perform-operation (perform-operation
(choice-operation (choice-operation
(wrap-operation (wrap-operation
(put-operation pool `(stats ,reply)) (put-operation (resource-pool-channel pool)
`(stats ,reply))
(const #t)) (const #t))
(wrap-operation (sleep-operation timeout) (wrap-operation (sleep-operation timeout)
(lambda _ (lambda _