[WIP][PATCH] download: Don't report the progress too fast

[宋文武]

Hello, our progress report of 'guix download' can refresh too fast.  For
example, it blinks much with this script:

--8<---------------cut here---------------start------------->8---
(use-modules (guix build download))


(let* ((size (expt 2 20))
       (progress (progress-proc "" size)))
  (let loop ((p 0))
    (unless (> p size)
      (progress p (const #t))
      (loop (+ p (random 100)))))
  (newline))
--8<---------------cut here---------------end--------------->8---

I'd like limiting its rate to render every 300ms.  So I write a
higher-order function that does nothing when the previous invocation not
happened some time (the interval) ago.  For lacking a proper name in my
mind, I just call it 'rate-limited'.  Then using it to modify the
'progress-proc', let it render every 300ms.

It seems working as I want, but will lost the last report, the progress
will never finish to 100%...  There is no way to know a report is the
last or not in the 'progress-proc' with only the 'transferred' parameter
when the 'size' of file is unknown.

So, the left step is adding a parameter to the produce that
'progress-proc' returns, and change the produce 'dump-port' in
build/utils.scm to call it trickly like '(progress total #:eof? #t)'
when the file ends.  So I can always render the last one.

This doesn't look good, so help wanted, thanks!

The patch, without the finish:

>From 70f4d739a9b67f5c169d95b2c26415489932761b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= <address@hidden>
Date: Sat, 26 Aug 2017 17:48:48 +0800
Subject: [PATCH] download: Don't report the progress too fast.

* guix/build/download.scm (rate-limited): New procedure.
(progress-proc): Report the progress only when 300ms has been elapsed since
the previous reporting.
---
 guix/build/download.scm | 54 +++++++++++++++++++++++++++++++++++++------------
 1 file changed, 41 insertions(+), 13 deletions(-)

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 6ef623334..b7b7e7d65 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -147,6 +147,24 @@ Otherwise return STORE-PATH."
    (define time-monotonic time-tai))
   (else #t))
 
+(define (rate-limited proc interval)
+  "Return a procedure that will forward the invocation to PROC when the time
+elapsed since the previous forwarded invocation is greater or equal to
+INTERVAL (a time-duration object), otherwise does nothing and returns #f."
+  (let ((lasted-at #f))
+    (lambda args
+      (let ((forward-invocation
+            (lambda ()
+              (set! lasted-at (current-time time-monotonic))
+               (apply proc args))))
+       (if lasted-at
+           (let ((elapsed
+                  (time-difference (current-time time-monotonic) lasted-at)))
+             (if (time>=? elapsed interval)
+                 (forward-invocation)
+                  #f))
+           (forward-invocation))))))
+
 (define* (progress-proc file size
                         #:optional (log-port (current-output-port))
                         #:key (abbreviation basename))
@@ -157,7 +175,11 @@ used to shorten FILE for display."
   ;; XXX: Because of <http://bugs.gnu.org/19939> this procedure is often not
   ;; called as frequently as we'd like too; this is especially bad with Nginx
   ;; on hydra.gnu.org, which returns whole nars as a single chunk.
-  (let ((start-time #f))
+  (let ((start-time #f)
+        ;; Procedure that only runs a thunk when 300ms has been elapsed.
+        (noop-if-too-fast (rate-limited
+                           (lambda (x) (x))
+                           (make-time time-monotonic 300000000 0))))
     (let-syntax ((with-elapsed-time
                      (syntax-rules ()
                        ((_ elapsed body ...)
@@ -182,12 +204,15 @@ used to shorten FILE for display."
                      (right      (format #f "~a/s ~a ~a~6,1f%"
                                          (byte-count->string throughput)
                                          (seconds->string elapsed)
-                                         (progress-bar %) %)))
-                (display "\r\x1b[K" log-port)
-                (display (string-pad-middle left right
-                                            (current-terminal-columns))
-                         log-port)
-                (flush-output-port log-port)
+                                         (progress-bar %) %))
+                     (render     (lambda ()
+                                   (display "\r\x1b[K" log-port)
+                                   (display (string-pad-middle
+                                             left right
+                                             (current-terminal-columns))
+                                            log-port)
+                                   (flush-output-port log-port))))
+                (noop-if-too-fast render)
                 (cont))))
           (lambda (transferred cont)
             (with-elapsed-time elapsed
@@ -199,12 +224,15 @@ used to shorten FILE for display."
                      (right      (format #f "~a/s ~a | ~a transferred"
                                          (byte-count->string throughput)
                                          (seconds->string elapsed)
-                                         (byte-count->string transferred))))
-                (display "\r\x1b[K" log-port)
-                (display (string-pad-middle left right
-                                            (current-terminal-columns))
-                         log-port)
-                (flush-output-port log-port)
+                                         (byte-count->string transferred)))
+                     (render     (lambda ()
+                                   (display "\r\x1b[K" log-port)
+                                   (display (string-pad-middle
+                                             left right
+                                             (current-terminal-columns))
+                                            log-port)
+                                   (flush-output-port log-port))))
+                (noop-if-too-fast render)
                 (cont))))))))
 
 (define* (uri-abbreviation uri #:optional (max-length 42))
-- 
2.13.3