diff options
Diffstat (limited to 'guix-build-coordinator/metrics.scm')
| -rw-r--r-- | guix-build-coordinator/metrics.scm | 203 |
1 files changed, 137 insertions, 66 deletions
diff --git a/guix-build-coordinator/metrics.scm b/guix-build-coordinator/metrics.scm index 00648d3..8878953 100644 --- a/guix-build-coordinator/metrics.scm +++ b/guix-build-coordinator/metrics.scm @@ -19,75 +19,146 @@ ;;; <http://www.gnu.org/licenses/>. (define-module (guix-build-coordinator metrics) + #:use-module (srfi srfi-9) #:use-module (ice-9 match) + #:use-module (ice-9 exceptions) #:use-module (guix-build-coordinator datastore) - #:export (metrics)) + #:export (make-metrics-registry + write-metrics + + make-gauge-metric + + metric-increment + metric-decrement + metric-set)) (define namespace "guixbuildcoordinator") -(define (format-metric namespace metric labels-and-values value) - (simple-format - #f - "~A_~A~A ~A" - namespace - metric - (if (null? labels-and-values) - "" - (string-append - "{" - (string-join (map - (match-lambda - ((label . value) - (simple-format - #f - "~A=\"~A\"" - label value))) - labels-and-values) - ",") - "}")) - value)) - -(define (metrics datastore) - (string-join - (append (list - (format-metric - namespace - "builds_total" - '() - (datastore-count-builds datastore))) - (map (match-lambda - ((agent-id . count) - (format-metric - namespace - "allocated_builds_total" - `((agent_id . ,agent-id)) - count))) - (datastore-count-allocated-builds datastore)) - (map (match-lambda - (((agent-id result) . count) - (format-metric - namespace - "build_results_total" - `((agent_id . ,agent-id) - (result . ,result)) - count))) - (datastore-count-build-results datastore)) - (map (match-lambda - (((agent-id reason) . count) - (format-metric - namespace - "setup_failures_total" - `((agent_id . ,agent-id) - (reason . ,reason)) - count))) - (datastore-count-setup-failures datastore)) - (map (match-lambda - ((agent-id . count) - (format-metric - namespace - "build_allocation_plan_total" - `((agent_id . ,agent-id)) - count))) - (datastore-count-build-allocation-plan-entries datastore))) - "\n")) +(define-record-type <metrics-registry> + (make-metrics-registry-record metrics-hash) + metrics-registry? + (metrics-hash metrics-registry-metrics-hash)) + +(define (make-metrics-registry) + (make-metrics-registry-record (make-hash-table))) + +(define-record-type <metric> + (make-metric type name values registry docstring labels label-preset-values) + metric? + (type metric-type) + (name metric-name) + (values metric-values) + (registry metric-registry) + (docstring metric-docstring) + (labels metric-labels) + (label-preset-values metric-label-preset-values)) + +(define (metrics-registry-add-metric registry name metric) + (let ((metrics-hash + (metrics-registry-metrics-hash registry))) + (when (hash-ref metrics-hash name) + (raise-exception + (make-exception-with-message + (simple-format #f "metric ~A already exists" + name)))) + + (hash-set! metrics-hash name metric) + + metric)) + +(define* (make-gauge-metric registry name + #:key + docstring + (labels '()) + (label-preset-values '())) + (metrics-registry-add-metric + registry + name + (make-metric 'gauge + name + (make-hash-table) + registry + docstring + labels + label-preset-values))) + +(define (canonicalise-label-values-for-metric metric + label-values) + label-values) + +(define* (metric-increment metric + #:key + (by 1) + (label-values '())) + (unless (memq (metric-type metric) + '(counter gauge)) + (error "can only increment counter and gauge metrics")) + + (unless (positive? by) + (error "can only increment positive values")) + + (let ((canonical-labels + (canonicalise-label-values-for-metric metric label-values)) + (hash + (metric-values metric))) + (hash-set! hash + canonical-labels + (+ by + (or (hash-ref hash canonical-labels) + 0))))) + +(define* (metric-decrement metric + #:key + (by 1) + (label-values '())) + (unless (memq (metric-type metric) + '(gauge)) + (error "can only increment gauge metrics")) + + (let ((canonical-labels + (canonicalise-label-values-for-metric metric label-values)) + (hash + (metric-values metric))) + (hash-set! hash + canonical-labels + (+ (* -1 by) + (or (hash-ref hash canonical-labels) + 0))))) + +(define* (metric-set metric value + #:key (label-values '())) + (unless (memq (metric-type metric) + '(gauge)) + (error "can only set gauge metrics")) + + (hash-set! (metric-values metric) + (canonicalise-label-values-for-metric metric label-values) + value)) + +(define (write-metrics registry port) + (hash-for-each + (lambda (name metric) + (hash-for-each + (lambda (label-values value) + (simple-format + port + "~A~A ~A\n" + name + (if (null? label-values) + "" + (string-append + "{" + (string-join (map + (match-lambda + ((label . value) + (simple-format + #f + "~A=\"~A\"" + label value))) + label-values) + ",") + "}")) + value)) + (metric-values metric))) + (metrics-registry-metrics-hash registry))) |