progress: Add 'progress-report-port'.
* guix/scripts/substitute.scm (progress-report-port): Move to... * guix/progress.scm (progress-report-port): ... here. New procedure.
This commit is contained in:
parent
1d9a4456a8
commit
22f06a2128
2 changed files with 31 additions and 29 deletions
|
@ -40,6 +40,7 @@
|
||||||
progress-reporter/file
|
progress-reporter/file
|
||||||
progress-reporter/bar
|
progress-reporter/bar
|
||||||
progress-reporter/trace
|
progress-reporter/trace
|
||||||
|
progress-report-port
|
||||||
|
|
||||||
display-download-progress
|
display-download-progress
|
||||||
erase-current-line
|
erase-current-line
|
||||||
|
@ -342,3 +343,33 @@ should be a <progress-reporter> object."
|
||||||
(put-bytevector out buffer 0 bytes)
|
(put-bytevector out buffer 0 bytes)
|
||||||
(report total)
|
(report total)
|
||||||
(loop total (get-bytevector-n! in buffer 0 buffer-size))))))))
|
(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)))))))
|
||||||
|
|
||||||
|
|
|
@ -823,35 +823,6 @@ was found."
|
||||||
(= (string-length file) 32)))))
|
(= (string-length file) 32)))))
|
||||||
(narinfo-cache-directories directory)))
|
(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
|
(define-syntax with-networking
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
"Catch DNS lookup errors and TLS errors and gracefully exit."
|
"Catch DNS lookup errors and TLS errors and gracefully exit."
|
||||||
|
|
Reference in a new issue