From a13b760f804ba0140285df45882621ecb8b29b16 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Tue, 25 Apr 2023 16:36:37 +0100 Subject: Split call-with-time-tracking So that you can observe a duration directly. --- guix-build-coordinator/datastore/sqlite.scm | 33 +++++++++++++++++------------ 1 file changed, 19 insertions(+), 14 deletions(-) (limited to 'guix-build-coordinator/datastore/sqlite.scm') diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index 974f538..ec52cb4 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -453,24 +453,29 @@ PRAGMA optimize;") #t) (define (call-with-time-tracking datastore thing thunk) + (let* ((start-time (get-internal-real-time))) + (call-with-values + thunk + (lambda vals + (metric-observe-duration + datastore + thing + (/ (- (get-internal-real-time) start-time) + internal-time-units-per-second)) + (apply values vals))))) + +(define (metric-observe-duration datastore + thing + duration-seconds) (define registry (slot-ref datastore 'metrics-registry)) (define metric-name (string-append "datastore_" thing "_duration_seconds")) - (if registry - (let* ((metric - (or (metrics-registry-fetch-metric registry metric-name) - (make-histogram-metric registry - metric-name))) - (start-time (get-internal-real-time))) - (call-with-values - thunk - (lambda vals - (metric-observe metric - (/ (- (get-internal-real-time) start-time) - internal-time-units-per-second)) - (apply values vals)))) - (thunk))) + (let ((metric + (or (metrics-registry-fetch-metric registry metric-name) + (make-histogram-metric registry + metric-name)))) + (metric-observe metric duration-seconds))) (define (call-with-worker-thread/delay-logging channel proc) (call-with-worker-thread channel -- cgit v1.2.3