aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-07-09 18:06:00 +0100
committerChristopher Baines <mail@cbaines.net>2023-07-10 18:56:31 +0100
commit899bd1387e5517393b86718783ba0fc786fce531 (patch)
tree9c49a0b670af1bef421ed7dafddc06231379c0f0 /guix-data-service
parent7251c7d653de29f36d50b33badf05a5db983b8e7 (diff)
downloaddata-service-899bd1387e5517393b86718783ba0fc786fce531.tar
data-service-899bd1387e5517393b86718783ba0fc786fce531.tar.gz
Support getting resource pool stats
Diffstat (limited to 'guix-data-service')
-rw-r--r--guix-data-service/utils.scm23
1 files changed, 23 insertions, 0 deletions
diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm
index ec974e3..7212e9b 100644
--- a/guix-data-service/utils.scm
+++ b/guix-data-service/utils.scm
@@ -35,6 +35,7 @@
make-resource-pool
call-with-resource-from-pool
with-resource-from-pool
+ resource-pool-stats
parallel-via-fibers
par-map&
@@ -158,6 +159,23 @@
(cons resource available)
;; clear waiters, as they've been notified
'()))
+ (('stats reply)
+ (let ((stats
+ `((resources . ,(length resources))
+ (available . ,(length available))
+ (waiters . ,(length waiters)))))
+
+ (perform-operation
+ (choice-operation
+ (wrap-operation
+ (put-operation reply stats)
+ (const #t))
+ (wrap-operation (sleep-operation 0.2)
+ (const #f)))))
+
+ (loop resources
+ available
+ waiters))
(unknown
(simple-format
(current-error-port)
@@ -255,6 +273,11 @@ available. Return the resource once PROC has returned."
pool
(lambda (resource) exp ...)))
+(define (resource-pool-stats pool)
+ (let ((reply (make-channel)))
+ (put-message pool `(stats ,reply))
+ (get-message reply)))
+
(define (defer-to-parallel-fiber thunk)
(let ((reply (make-channel)))
(spawn-fiber