Support listing resource pool resources

This commit is contained in:
Christopher Baines 2025-04-28 10:08:00 +01:00
parent 838ee6f1e3
commit 8c63ed7b4e

View file

@ -567,6 +567,16 @@
waiters waiters
resources-last-used)) resources-last-used))
(('list-resources reply)
(spawn-fiber
(lambda ()
(put-message reply (list-copy resources))))
(loop resources
available
waiters
resources-last-used))
(('stats reply) (('stats reply)
(let ((stats (let ((stats
`((resources . ,(length resources)) `((resources . ,(length resources))
@ -965,3 +975,8 @@ available. Return the resource once PROC has returned."
(raise-exception (raise-exception
(make-resource-pool-timeout-error pool)))))) (make-resource-pool-timeout-error pool))))))
(define (resource-pool-list-resources pool)
(let ((reply (make-channel)))
(put-message (resource-pool-channel pool)
(list 'list-resources reply))
(get-message reply)))