From 798648515b77507c242752457b4dc17c155bad6e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= <iyzsong@member.fsf.org>
Date: Sat, 16 Sep 2017 14:10:18 -0600
Subject: download: Don't report the progress too fast.

* guix/utils.scm (<progress-reporter>): New record type.
(call-with-progress-reporter): New procedure.
* guix/build/download.scm (dump-port*, rate-limited, progress-reporter/file):
New procedures.
(ftp-fetch, http-fetch): Use 'dump-port*'.
(progress-proc): Remove procedure.
* guix/scripts/substitute.scm (progress-report-port): Rewrite in terms of
<progress-reporter>.
(process-substitution): Adjust accordingly.
---
 guix/utils.scm | 32 +++++++++++++++++++++++++++++++-
 1 file changed, 31 insertions(+), 1 deletion(-)

(limited to 'guix/utils.scm')

diff --git a/guix/utils.scm b/guix/utils.scm
index 8fbbdc3563..de4aa65319 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -33,6 +33,7 @@
   #:autoload   (rnrs io ports) (make-custom-binary-input-port)
   #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
   #:use-module (guix memoization)
+  #:use-module (guix records)
   #:use-module ((guix build utils) #:select (dump-port mkdir-p))
   #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
   #:use-module (ice-9 format)
@@ -94,7 +95,13 @@
             call-with-decompressed-port
             compressed-output-port
             call-with-compressed-output-port
-            canonical-newline-port))
+            canonical-newline-port
+
+            <progress-reporter>
+            progress-reporter
+            make-progress-reporter
+            progress-reporter?
+            call-with-progress-reporter))
 
 
 ;;;
@@ -747,3 +754,26 @@ a location object."
   `((line     . ,(and=> (location-line loc) 1-))
     (column   . ,(location-column loc))
     (filename . ,(location-file loc))))
+
+
+;;;
+;;; Progress reporter.
+;;;
+
+(define-record-type* <progress-reporter>
+  progress-reporter make-progress-reporter progress-reporter?
+  (start   progress-reporter-start)     ; thunk
+  (report  progress-reporter-report)    ; procedure
+  (stop    progress-reporter-stop))     ; thunk
+
+(define (call-with-progress-reporter reporter proc)
+  "Start REPORTER for progress reporting, and call @code{(@var{proc} report)}
+with the resulting report procedure.  When @var{proc} returns, the REPORTER is
+stopped."
+  (match reporter
+    (($ <progress-reporter> start report stop)
+     (dynamic-wind start (lambda () (proc report)) stop))))
+
+;;; Local Variables:
+;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1)
+;;; End:
-- 
cgit v1.2.3