06/09: progress: Add 'progress-report-port'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 22f06a212879369bd1d7f3aa5b19f8f89a8c6693
Author: Ludovic Courtès <address@hidden>
Date:   Fri Dec 6 00:40:41 2019 +0100

    progress: Add 'progress-report-port'.
    
    * guix/scripts/substitute.scm (progress-report-port): Move to...
    * guix/progress.scm (progress-report-port): ... here.  New procedure.
---
 guix/progress.scm           | 31 +++++++++++++++++++++++++++++++
 guix/scripts/substitute.scm | 29 -----------------------------
 2 files changed, 31 insertions(+), 29 deletions(-)

diff --git a/guix/progress.scm b/guix/progress.scm
index 349637d..c7567a3 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -40,6 +40,7 @@
             progress-reporter/file
             progress-reporter/bar
             progress-reporter/trace
+            progress-report-port
 
             display-download-progress
             erase-current-line
@@ -342,3 +343,33 @@ should be a <progress-reporter> object."
               (put-bytevector out buffer 0 bytes)
               (report total)
               (loop total (get-bytevector-n! in buffer 0 buffer-size))))))))
+
+(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 ()
+                                        ;; XXX: Kludge!  When used through
+                                        ;; 'decompressed-port', this port ends
+                                        ;; up being closed twice: once in a
+                                        ;; child process early on, and at the
+                                        ;; end in the parent process.  Ignore
+                                        ;; the early close so we don't output
+                                        ;; a spurious "download-succeeded"
+                                        ;; trace.
+                                        (unless (zero? total)
+                                          (stop))
+                                        (close-port port)))))))
+
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 4802fbd..7eca2c6 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -823,35 +823,6 @@ was found."
                                 (= (string-length file) 32)))))
               (narinfo-cache-directories directory)))
 
-(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 ()
-                                        ;; XXX: Kludge!  When used through
-                                        ;; 'decompressed-port', this port ends
-                                        ;; up being closed twice: once in a
-                                        ;; child process early on, and at the
-                                        ;; end in the parent process.  Ignore
-                                        ;; the early close so we don't output
-                                        ;; a spurious "download-succeeded"
-                                        ;; trace.
-                                        (unless (zero? total)
-                                          (stop))
-                                        (close-port port)))))))
-
 (define-syntax with-networking
   (syntax-rules ()
     "Catch DNS lookup errors and TLS errors and gracefully exit."