guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]


From: Ludovic Courtès
Date: Fri, 26 Jan 2018 09:24:04 -0500 (EST)

branch: master
commit 5d559f8021b2f245aaba5bb184cb4a6b07a5e744
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 26 14:17:18 2018 +0100

    logging: Add 'with-time-logging' and use it.
    
    * src/cuirass/logging.scm (call-with-time-logging): New procedure.
    (with-time-logging): New macro.
    * src/cuirass/http.scm (handle-builds-request): Use it.
---
 src/cuirass/http.scm    |  3 ++-
 src/cuirass/logging.scm | 17 ++++++++++++++++-
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 9eeb9e2..73f2b8b 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -62,7 +62,8 @@
 (define (handle-builds-request db filters)
   "Retrieve all builds matched by FILTERS in DB and convert them to hydra
   format."
-  (let ((builds (db-get-builds db filters)))
+  (let ((builds (with-time-logging "builds request"
+                                   (db-get-builds db filters))))
     (map build->hydra-build builds)))
 
 (define (request-parameters request)
diff --git a/src/cuirass/logging.scm b/src/cuirass/logging.scm
index bd1eed3..9574b23 100644
--- a/src/cuirass/logging.scm
+++ b/src/cuirass/logging.scm
@@ -21,7 +21,8 @@
   #:use-module (ice-9 format)
   #:export (current-logging-port
             current-logging-procedure
-            log-message))
+            log-message
+            with-time-logging))
 
 (define current-logging-port
   (make-parameter (current-error-port)))
@@ -46,3 +47,17 @@
   ;; Note: Use '@' to make sure -Wformat detects this use of 'format'.
   ((current-logging-procedure)
    ((@ (ice-9 format) format) #f fmt args ...)))
+
+(define (call-with-time-logging name thunk)
+  (let* ((start   (current-time time-utc))
+         (result  (thunk))
+         (end     (current-time time-utc))
+         (elapsed (time-difference end start)))
+    (log-message "~a took ~a seconds" name
+                 (+ (time-second elapsed)
+                    (/ (time-nanosecond elapsed) 1e9)))
+    result))
+
+(define-syntax-rule (with-time-logging name exp ...)
+  "Log under NAME the time taken to evaluate EXP."
+  (call-with-time-logging name (lambda () exp ...)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]