cbaines/guile-prometheus
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix histogram metrics

Browse source 
Properly write a _sum and _count line, and sort the lines correctly.
This commit is contained in:
Christopher Baines 2020-12-10 09:21:07 +00:00
parent 2549c482fb
commit 875d9994b0
1 changed files with 94 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

139
prometheus.scm
View file

@ -153,6 +153,13 @@ list of label names to be permitted for this metric and
histogram-metric-type?
(buckets histogram-metric-type-buckets))
(define-record-type <histogram-values>
(make-histogram-values buckets sum count)
histogram-values?
(buckets histogram-values-buckets)
(sum histogram-values-sum set-histogram-values-sum!)
(count histogram-values-count set-histogram-values-count!))
(define %default-histogram-buckets
;; The default buckets used in other client libraries
(list 0.005 0.01 0.025 0.05 0.1 0.25 0.5 1 2.5 5 10 (inf)))
@ -316,31 +323,38 @@ values are the values."
(metric-values metric)))
(with-mutex (metric-mutex metric)
(let ((sum-labels
`(,@canonical-labels
(le . "sum"))))
(let* ((buckets
(histogram-metric-type-buckets (metric-type metric)))
(histogram-values-record
(or (hash-ref hash canonical-labels)
(let ((new-record (make-histogram-values (make-vector
(length buckets)
0)
0
0)))
(hash-set! hash canonical-labels new-record)
new-record))))
(hash-set! hash
sum-labels
(set-histogram-values-sum! histogram-values-record
(+ value
(or (hash-ref hash sum-labels)
0))))
(let ((buckets (histogram-metric-type-buckets (metric-type metric))))
(for-each
(lambda (bucket-upper-limit)
(when (<= value bucket-upper-limit)
(let ((bucket-labels
`(,@canonical-labels
(le . ,(if (inf? bucket-upper-limit)
"+Inf"
(number->string bucket-upper-limit))))))
(hash-set! hash
bucket-labels
(histogram-values-sum
histogram-values-record)))
(set-histogram-values-count! histogram-values-record
(+ 1
(or (hash-ref hash bucket-labels)
0))))))
buckets)))))
(histogram-values-count
histogram-values-record)))
(let ((bucket-values-vector (histogram-values-buckets
histogram-values-record)))
(for-each
(lambda (index bucket-upper-limit)
(when (<= value bucket-upper-limit)
(vector-set! bucket-values-vector
index
(+ 1
(vector-ref bucket-values-vector
index)))))
(iota (length buckets))
buckets))))))
(define* (call-with-duration-metric registry metric-name thunk
#:key
@ -379,36 +393,11 @@ the standard text based exposition format.
Usually, this would be in response to a HTTP request from Prometheus
so that it can receive and store the metric values."
(hash-for-each
(lambda (name metric)
(let ((full-name
(string-append
(or (and=> (metrics-registry-namespace registry)
(lambda (namespace)
(string-append namespace "_")))
"")
name)))
(and=> (metric-docstring metric)
(lambda (docstring)
(simple-format
port
"# HELP ~A ~A\n"
full-name
docstring)))
(simple-format port "# TYPE ~A ~A\n"
full-name
(match (metric-type metric)
((? histogram-metric-type? type) 'histogram)
(type type)))
(hash-for-each
(lambda (label-values value)
(define (write-line name label-values value)
(format
port
"~a~a ~f\n"
full-name
name
(if (null? label-values)
""
(string-append
@ -429,7 +418,59 @@ so that it can receive and store the metric values."
",")
"}"))
value))
(hash-for-each
(lambda (name metric)
(let ((full-name
(string-append
(or (and=> (metrics-registry-namespace registry)
(lambda (namespace)
(string-append namespace "_")))
"")
name))
(type (metric-type metric)))
(and=> (metric-docstring metric)
(lambda (docstring)
(simple-format
port
"# HELP ~A ~A\n"
full-name
docstring)))
(simple-format port "# TYPE ~A ~A\n"
full-name
(match type
((? histogram-metric-type? type) 'histogram)
(type type)))
(cond
((histogram-metric-type? type)
(let ((buckets (histogram-metric-type-buckets type)))
(hash-for-each
(lambda (label-values value)
(for-each (lambda (index bucket)
(write-line full-name
`(,@label-values
(le . ,(if (inf? bucket)
"+Inf"
(format #f "~f" bucket))))
(vector-ref (histogram-values-buckets value)
index)))
(iota (length buckets))
buckets)
(write-line (string-append full-name "_sum")
label-values
(histogram-values-sum value))
(write-line (string-append full-name "_count")
label-values
(histogram-values-count value)))
(metric-values metric))))
(else
(hash-for-each
(lambda (label-values value)
(write-line full-name label-values value))
(metric-values metric))))))
(metrics-registry-metrics-hash registry)))
(define (write-textfile registry filename)