Implement more processing on metric labels and values

This helps where symbols and strings are mixed.

1 files changed, 37 insertions, 9 deletions

diff --git a/guix-build-coordinator/metrics.scm b/guix-build-coordinator/metrics.scm
index 2a3e0db..b44458b 100644
--- a/guix-build-coordinator/metrics.scm
+++ b/guix-build-coordinator/metrics.scm
@@ -110,8 +110,8 @@
                 (make-hash-table)
                 registry
                 docstring
-                labels
-                label-preset-values
+                (map canonicalise-label labels)
+                (canonicalise-label-values label-preset-values)
                 (make-mutex))))
 
 (define-record-type <histogram-metric-type>
@@ -143,9 +143,37 @@
                 label-preset-values
                 (make-mutex))))
 
-(define (canonicalise-label-values-for-metric metric
-                                              label-values)
-  label-values)
+(define (canonicalise-label label)
+  (call-with-output-string
+    (lambda (port)
+      (display label port))))
+
+(define (canonicalise-label-value value)
+  (call-with-output-string
+    (lambda (port)
+      (display value port))))
+
+(define (canonicalise-label-values label-values)
+  (let ((canonical-label-values
+         (map (match-lambda
+                ((k . v)
+                 (cons (canonicalise-label k)
+                       (canonicalise-label-value v))))
+              label-values)))
+    (let loop ((lst (map car canonical-label-values)))
+      (unless (null? lst)
+        (let ((element (car lst))
+              (rest    (cdr lst)))
+          (when (member element rest string=?)
+            (raise-exception
+             (make-exception-with-message
+              (simple-format
+               #f "label value specified multiple times: ~A"
+               element))))
+
+          (loop rest))))
+
+    canonical-label-values))
 
 (define* (metric-increment metric
                            #:key
@@ -159,7 +187,7 @@
     (error "can only increment positive values"))
 
   (let ((canonical-labels
-         (canonicalise-label-values-for-metric metric label-values))
+         (canonicalise-label-values label-values))
         (hash
          (metric-values metric)))
     (with-mutex (metric-mutex metric)
@@ -178,7 +206,7 @@
     (error "can only increment gauge metrics"))
 
   (let ((canonical-labels
-         (canonicalise-label-values-for-metric metric label-values))
+         (canonicalise-label-values label-values))
         (hash
          (metric-values metric)))
     (with-mutex (metric-mutex metric)
@@ -196,7 +224,7 @@
 
   (with-mutex (metric-mutex metric)
     (hash-set! (metric-values metric)
-               (canonicalise-label-values-for-metric metric label-values)
+               (canonicalise-label-values label-values)
                value)))
 
 (define* (metric-observe metric value
@@ -205,7 +233,7 @@
     (error "can only observe histogram metrics"))
 
   (let ((canonical-labels
-         (canonicalise-label-values-for-metric metric label-values))
+         (canonicalise-label-values label-values))
         (hash
          (metric-values metric)))