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?= <iyzs...@member.fsf.org>
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
