summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts')
-rwxr-xr-xguix/scripts/substitute.scm54
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))))