From: "Ludovic Courtès" <ludo@gnu.org>
To: 38518@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#38518] [PATCH 5/7] progress: Add 'progress-report-port'.
Date: Sun, 8 Dec 2019 12:26:35 +0100 [thread overview]
Message-ID: <20191208112637.5534-5-ludo@gnu.org> (raw)
In-Reply-To: <20191208112637.5534-1-ludo@gnu.org>
* 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 349637dbcf..c7567a35fd 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 4802fbd1fe..7eca2c6874 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."
--
2.24.0
next prev parent reply other threads:[~2019-12-08 11:28 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-12-07 21:42 [bug#38518] [PATCH 0/7] 'guix challenge' can diff archives directly Ludovic Courtès
2019-12-08 11:20 ` zimoun
2019-12-08 11:34 ` Ludovic Courtès
2019-12-08 11:48 ` zimoun
2019-12-08 11:26 ` [bug#38518] [PATCH 1/7] serialization: Add 'fold-archive' Ludovic Courtès
2019-12-08 11:26 ` [bug#38518] [PATCH 2/7] guix archive: Add '--list' Ludovic Courtès
2019-12-08 11:26 ` [bug#38518] [PATCH 3/7] challenge: Report the best narinfo URI Ludovic Courtès
2019-12-08 11:26 ` [bug#38518] [PATCH 4/7] serialization: Remove unused procedure Ludovic Courtès
2019-12-08 11:26 ` Ludovic Courtès [this message]
2019-12-08 11:26 ` [bug#38518] [PATCH 6/7] challenge: Add "--diff" Ludovic Courtès
2019-12-08 11:26 ` [bug#38518] [PATCH 7/7] challenge: Support "--diff=diffoscope" Ludovic Courtès
2019-12-12 17:21 ` bug#38518: [PATCH 0/7] 'guix challenge' can diff archives directly Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20191208112637.5534-5-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=38518@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).