From mboxrd@z Thu Jan 1 00:00:00 1970 From: iyzsong@member.fsf.org (=?utf-8?B?5a6L5paH5q2m?=) Subject: [WIP][PATCH] download: Don't report the progress too fast Date: Sat, 26 Aug 2017 18:51:21 +0800 Message-ID: <87d17ilhzq.fsf@member.fsf.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:50137) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dlYgf-0007PQ-Pj for guix-devel@gnu.org; Sat, 26 Aug 2017 06:51:35 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dlYgc-00051H-L4 for guix-devel@gnu.org; Sat, 26 Aug 2017 06:51:33 -0400 Received: from rezeros.cc ([2001:19f0:7001:2f3e:5400:ff:fe84:e55d]:38702) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1dlYgc-0004zc-5b for guix-devel@gnu.org; Sat, 26 Aug 2017 06:51:30 -0400 Received: from localhost (183.129.22.138 [183.129.22.138]) by rezeros.cc (OpenSMTPD) with ESMTPSA id 59583271 (TLSv1.2:ECDHE-RSA-AES256-GCM-SHA384:256:NO) for ; Sat, 26 Aug 2017 10:51:22 +0000 (UTC) Received: from gift (localhost [127.0.0.1]) by localhost (OpenSMTPD) with ESMTP id 1a202fb9 for ; Sat, 26 Aug 2017 10:51:21 +0000 (UTC) List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org --=-=-= Content-Type: text/plain 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: --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-download-Don-t-report-the-progress-too-fast.patch >From 70f4d739a9b67f5c169d95b2c26415489932761b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= 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 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 --=-=-=--