diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-07-09 18:06:00 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-07-10 18:56:31 +0100 |
| commit | 899bd1387e5517393b86718783ba0fc786fce531 (patch) | |
| tree | 9c49a0b670af1bef421ed7dafddc06231379c0f0 | |
| parent | 7251c7d653de29f36d50b33badf05a5db983b8e7 (diff) | |
| download | data-service-899bd1387e5517393b86718783ba0fc786fce531.tar data-service-899bd1387e5517393b86718783ba0fc786fce531.tar.gz | |
Support getting resource pool stats
| -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 |