gnu: Properly credit Konrad Hinsen.

[jackhill/guix/guix.git] / guix / progress.scm

diff --git a/guix/progress.scm b/guix/progress.scm
index 349637d..fec65b4 100644 (file)
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
-;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -40,6 +40,7 @@
             progress-reporter/file
             progress-reporter/bar
             progress-reporter/trace
+            progress-report-port
 
             display-download-progress
             erase-current-line
@@ -95,13 +96,6 @@ stopped."
 ;;; File download progress report.
 ;;;
 
-(cond-expand
-  (guile-2.2
-   ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
-   ;; nanoseconds swapped (fixed in Guile commit 886ac3e).  Work around it.
-   (define time-monotonic time-tai))
-  (else #t))
-
 (define (nearest-exact-integer x)
   "Given a real number X, return the nearest exact integer, with ties going to
 the nearest exact even integer."
@@ -342,3 +336,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)))))))
+