07/08: download: Measure and display the throughput.

[Ludovic Courtès]

civodul pushed a commit to branch core-updates
in repository guix.

commit 9fbe6f1920f0c16be3d1e7a216c164837e31f0fe
Author: Ludovic Courtès <address@hidden>
Date:   Fri Feb 27 15:00:38 2015 +0100

    download: Measure and display the throughput.
    
    * guix/build/download.scm (duration->seconds, throughput->string): New
      procedures.
      (progress-proc): Measure and display the throughput.
---
 guix/build/download.scm |   68 +++++++++++++++++++++++++++++++++++++---------
 1 files changed, 54 insertions(+), 14 deletions(-)

diff --git a/guix/build/download.scm b/guix/build/download.scm
index c439f6b..6c94fa0 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -26,6 +26,7 @@
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
@@ -46,24 +47,59 @@
   ;; Size of the HTTP receive buffer.
   65536)
 
+(define (duration->seconds duration)
+  "Return the number of seconds represented by DURATION, a 'time-duration'
+object, as an inexact number."
+  (+ (time-second duration)
+     (/ (time-nanosecond duration) 1e9)))
+
+(define (throughput->string throughput)
+  "Given THROUGHPUT, measured in bytes per second, return a string
+representing it in a human-readable way."
+  (if (> throughput 3e6)
+      (format #f "~,2f MiB/s" (/ throughput (expt 2. 20)))
+      (format #f "~,0f KiB/s" (/ throughput 1024.0))))
+
 (define* (progress-proc file size #:optional (log-port (current-output-port)))
   "Return a procedure to show the progress of FILE's download, which is
 SIZE byte long.  The returned procedure is suitable for use as an
 argument to `dump-port'.  The progress report is written to LOG-PORT."
-  (if (number? size)
-      (lambda (transferred cont)
-        (let ((% (* 100.0 (/ transferred size))))
-          (display #\cr log-port)
-          (format log-port "~a\t~5,1f% of ~,1f KiB"
-                  file % (/ size 1024.0))
-          (flush-output-port log-port)
-          (cont)))
-      (lambda (transferred cont)
-        (display #\cr log-port)
-        (format log-port "~a\t~6,1f KiB transferred"
-                file (/ transferred 1024.0))
-        (flush-output-port log-port)
-        (cont))))
+  (let ((start-time #f))
+    (let-syntax ((with-elapsed-time
+                     (syntax-rules ()
+                       ((_ elapsed body ...)
+                        (let* ((now     (current-time time-monotonic))
+                               (elapsed (and start-time
+                                             (duration->seconds
+                                              (time-difference now
+                                                               start-time)))))
+                          (unless start-time
+                            (set! start-time now))
+                          body ...)))))
+      (if (number? size)
+          (lambda (transferred cont)
+            (with-elapsed-time elapsed
+              (let ((%          (* 100.0 (/ transferred size)))
+                    (throughput (if elapsed
+                                    (/ transferred elapsed)
+                                    0)))
+                (display #\cr log-port)
+                (format log-port "~a\t~5,1f% of ~,1f KiB (~a)"
+                        file % (/ size 1024.0)
+                        (throughput->string throughput))
+                (flush-output-port log-port)
+                (cont))))
+          (lambda (transferred cont)
+            (with-elapsed-time elapsed
+              (let ((throughput (if elapsed
+                                    (/ transferred elapsed)
+                                    0)))
+                (display #\cr log-port)
+                (format log-port "~a\t~6,1f KiB transferred (~a)"
+                        file (/ transferred 1024.0)
+                        (throughput->string throughput))
+                (flush-output-port log-port)
+                (cont))))))))
 
 (define* (uri-abbreviation uri #:optional (max-length 42))
   "If URI's string representation is larger than MAX-LENGTH, return an
@@ -427,4 +463,8 @@ on success."
                file url)
        #f))))
 
+;;; Local Variables:
+;;; eval: (put 'with-elapsed-time 'scheme-indent-function 1)
+;;; End:
+
 ;;; download.scm ends here