diff options
Diffstat (limited to 'guix/scripts')
| -rwxr-xr-x | guix/scripts/substitute.scm | 54 |
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)))) |