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)
(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,7 +447,8 @@ 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)))
@ -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 _