diff options
Diffstat (limited to 'guix-data-service/utils.scm')
| -rw-r--r-- | guix-data-service/utils.scm | 23 |
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 |