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.

1 files changed, 28 insertions, 26 deletions

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 61eff18869..3dcf42d0d1 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -34,7 +34,8 @@
   #:use-module ((guix build utils) #:select (mkdir-p dump-port))
   #:use-module ((guix build download)
                 #:select (current-terminal-columns
-                          progress-proc uri-abbreviation nar-uri-abbreviation
+                          progress-reporter/file
+                          uri-abbreviation nar-uri-abbreviation
                           (open-connection-for-uri
                            . guix:open-connection-for-uri)
                           close-connection
@@ -814,23 +815,25 @@ was found."
                                 (= (string-length file) 32)))))
               (narinfo-cache-directories directory)))
 
-(define (progress-report-port report-progress port)
-  "Return a port that calls REPORT-PROGRESS every time something is read from
-PORT.  REPORT-PROGRESS is a two-argument procedure such as that returned by
-`progress-proc'."
-  (define total 0)
-  (define (read! bv start count)
-    (let ((n (match (get-bytevector-n! port bv start count)
-               ((? eof-object?) 0)
-               (x x))))
-      (set! total (+ total n))
-      (report-progress total (const n))
-      ;; XXX: We're not in control, so we always return anyway.
-      n))
-
-  (make-custom-binary-input-port "progress-port-proc"
-                                 read! #f #f
-                                 (cut close-connection port)))
+(define (progress-report-port reporter port)
+  "Return a port that continuously reports the bytes read from PORT using
+REPORTER, which should be a <progress-reporter> object."
+  (match reporter
+    (($ <progress-reporter> start report stop)
+     (let* ((total 0)
+            (read! (lambda (bv start count)
+                     (let ((n (match (get-bytevector-n! port bv start count)
+                                ((? eof-object?) 0)
+                                (x x))))
+                       (set! total (+ total n))
+                       (report total)
+                       n))))
+       (start)
+       (make-custom-binary-input-port "progress-port-proc"
+                                      read! #f #f
+                                      (lambda ()
+                                        (close-connection port)
+                                        (stop)))))))
 
 (define-syntax with-networking
   (syntax-rules ()
@@ -947,12 +950,11 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
                           (dl-size  (or download-size
                                         (and (equal? comp "none")
                                              (narinfo-size narinfo))))
-                          (progress (progress-proc (uri->string uri)
-                                                   dl-size
-                                                   (current-error-port)
-                                                   #:abbreviation
-                                                   nar-uri-abbreviation)))
-                     (progress-report-port progress raw)))
+                          (reporter (progress-reporter/file
+                                     (uri->string uri) dl-size
+                                     (current-error-port)
+                                     #:abbreviation nar-uri-abbreviation)))
+                     (progress-report-port reporter raw)))
                   ((input pids)
                    (decompressed-port (and=> (narinfo-compression narinfo)
                                              string->symbol)
@@ -961,8 +963,8 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
       (restore-file input destination)
       (close-port input)
 
-      ;; Skip a line after what 'progress-proc' printed, and another one to
-      ;; visually separate substitutions.
+      ;; Skip a line after what 'progress-reporter/file' printed, and another
+      ;; one to visually separate substitutions.
       (display "\n\n" (current-error-port))
 
       (every (compose zero? cdr waitpid) pids))))