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
resources-last-used))
(('list-resources reply)
(spawn-fiber
(lambda ()
(put-message reply (list-copy resources))))
(loop resources
available
waiters
resources-last-used))
(('stats reply)
(let ((stats
`((resources . ,(length resources))
@ -965,3 +975,8 @@ available. Return the resource once PROC has returned."
(raise-exception
(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)))