1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com>
3 ;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
4 ;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
5 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
7 ;;; This file is part of GNU Guix.
9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
10 ;;; under the terms of the GNU General Public License as published by
11 ;;; the Free Software Foundation; either version 3 of the License, or (at
12 ;;; your option) any later version.
14 ;;; GNU Guix is distributed in the hope that it will be useful, but
15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;;; GNU General Public License for more details.
19 ;;; You should have received a copy of the GNU General Public License
20 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
22 (define-module (guix progress)
23 #:use-module (guix records)
24 #:use-module (srfi srfi-19)
25 #:use-module (rnrs io ports)
26 #:use-module (rnrs bytevectors)
27 #:use-module (ice-9 format)
28 #:use-module (ice-9 match)
29 #:export (<progress-reporter>
31 make-progress-reporter
33 call-with-progress-reporter
35 start-progress-reporter!
36 stop-progress-reporter!
37 progress-reporter-report!
39 progress-reporter/silent
40 progress-reporter/file
42 progress-reporter/trace
45 display-download-progress
49 current-terminal-columns
55 ;;; Helper to write progress report code for downloads, etc.
59 (define-record-type* <progress-reporter>
60 progress-reporter make-progress-reporter progress-reporter?
61 (start progress-reporter-start) ; thunk
62 (report progress-reporter-report) ; procedure
63 (stop progress-reporter-stop)) ; thunk
65 (define (call-with-progress-reporter reporter proc)
66 "Start REPORTER for progress reporting, and call @code{(@var{proc} report)}
67 with the resulting report procedure. When @var{proc} returns, the REPORTER is
70 (($ <progress-reporter> start report stop)
71 (dynamic-wind start (lambda () (proc report)) stop))))
73 (define (start-progress-reporter! reporter)
74 "Low-level procedure to start REPORTER."
76 (($ <progress-reporter> start report stop)
79 (define (progress-reporter-report! reporter . args)
80 "Low-level procedure to lead REPORTER to emit a report."
82 (($ <progress-reporter> start report stop)
83 (apply report args))))
85 (define (stop-progress-reporter! reporter)
86 "Low-level procedure to stop REPORTER."
88 (($ <progress-reporter> start report stop)
91 (define progress-reporter/silent
92 (make-progress-reporter noop noop noop))
96 ;;; File download progress report.
99 (define (nearest-exact-integer x)
100 "Given a real number X, return the nearest exact integer, with ties going to
101 the nearest exact even integer."
102 (inexact->exact (round x)))
104 (define (duration->seconds duration)
105 "Return the number of seconds represented by DURATION, a 'time-duration'
106 object, as an inexact number."
107 (+ (time-second duration)
108 (/ (time-nanosecond duration) 1e9)))
110 (define (seconds->string duration)
111 "Given DURATION in seconds, return a string representing it in 'mm:ss' or
112 'hh:mm:ss' format, as needed."
113 (if (not (number? duration))
115 (let* ((total-seconds (nearest-exact-integer duration))
116 (extra-seconds (modulo total-seconds 3600))
117 (num-hours (quotient total-seconds 3600))
118 (hours (and (positive? num-hours) num-hours))
119 (mins (quotient extra-seconds 60))
120 (secs (modulo extra-seconds 60)))
121 (format #f "~@[~2,'0d:~]~2,'0d:~2,'0d" hours mins secs))))
123 (define (byte-count->string size)
124 "Given SIZE in bytes, return a string representing it in a human-readable
129 (TiB (expt 1024. 4)))
131 ((< size KiB) (format #f "~dB" (nearest-exact-integer size)))
132 ((< size MiB) (format #f "~dKiB" (nearest-exact-integer (/ size KiB))))
133 ((< size GiB) (format #f "~,1fMiB" (/ size MiB)))
134 ((< size TiB) (format #f "~,2fGiB" (/ size GiB)))
135 (else (format #f "~,3fTiB" (/ size TiB))))))
137 (define (string-pad-middle left right len)
138 "Combine LEFT and RIGHT with enough padding in the middle so that the
139 resulting string has length at least LEN (it may overflow). If the string
140 does not overflow, the last char in RIGHT will be flush with the LEN
142 (let* ((total-used (+ (string-length left)
143 (string-length right)))
144 (num-spaces (max 1 (- len total-used)))
145 (padding (make-string num-spaces #\space)))
146 (string-append left padding right)))
148 (define (rate-limited proc interval)
149 "Return a procedure that will forward the invocation to PROC when the time
150 elapsed since the previous forwarded invocation is greater or equal to
151 INTERVAL (a time-duration object), otherwise does nothing and returns #f."
152 (let ((previous-at #f))
154 (let* ((now (current-time time-monotonic))
155 (forward-invocation (lambda ()
156 (set! previous-at now)
159 (let ((elapsed (time-difference now previous-at)))
160 (if (time>=? elapsed interval)
163 (forward-invocation))))))
165 (define current-terminal-columns
166 ;; Number of columns of the terminal.
169 (define* (progress-bar % #:optional (bar-width 20))
170 "Return % as a string representing an ASCII-art progress bar. The total
171 width of the bar is BAR-WIDTH."
172 (let* ((bar-width (max 3 (- bar-width 2)))
174 (filled (inexact->exact (floor (* fraction bar-width))))
175 (empty (- bar-width filled)))
177 (make-string filled #\#)
178 (make-string empty #\space))))
180 (define (erase-current-line port)
181 "Write an ANSI erase-current-line sequence to PORT to erase the whole line and
182 move the cursor to the beginning of the line."
183 (display "\r\x1b[K" port))
185 (define* (display-download-progress file size
187 start-time (transferred 0)
188 (log-port (current-error-port)))
189 "Write the progress report to LOG-PORT. Use START-TIME (a SRFI-19 time
190 object) and TRANSFERRED (a total number of bytes) to determine the
194 (time-difference (current-time (time-type start-time))
197 (if (and (number? size) (not (zero? size)))
198 (let* ((% (* 100.0 (/ transferred size)))
199 (throughput (/ transferred elapsed))
200 (left (format #f " ~a ~a" file
201 (byte-count->string size)))
202 (right (format #f "~a/s ~a ~a~6,1f%"
203 (byte-count->string throughput)
204 (seconds->string elapsed)
205 (progress-bar %) %)))
206 (erase-current-line log-port)
207 (display (string-pad-middle left right
208 (current-terminal-columns))
210 (force-output log-port))
211 ;; If we don't know the total size, the last transfer will have a 0B
212 ;; size. Don't display it.
213 (unless (zero? transferred)
214 (let* ((throughput (/ transferred elapsed))
215 (left (format #f " ~a" file))
216 (right (format #f "~a/s ~a | ~a transferred"
217 (byte-count->string throughput)
218 (seconds->string elapsed)
219 (byte-count->string transferred))))
220 (erase-current-line log-port)
221 (display (string-pad-middle left right
222 (current-terminal-columns))
224 (force-output log-port)))))
226 (define %progress-interval
227 ;; Default interval between subsequent outputs for rate-limited displays.
228 (make-time time-duration 200000000 0))
230 (define* (progress-reporter/file file size
231 #:optional (log-port (current-output-port))
232 #:key (abbreviation basename))
233 "Return a <progress-reporter> object to show the progress of FILE's download,
234 which is SIZE bytes long. The progress report is written to LOG-PORT, with
235 ABBREVIATION used to shorten FILE for display."
236 (let ((start-time (current-time time-monotonic))
239 (display-download-progress (abbreviation file) size
240 #:start-time start-time
241 #:transferred transferred
242 #:log-port log-port))
246 ;; Report the progress every 300ms or longer.
248 (let ((rate-limited-render (rate-limited render %progress-interval)))
250 (set! transferred value)
251 (rate-limited-render))))
252 ;; Don't miss the last report.
255 (define* (progress-reporter/bar total
258 (port (current-error-port)))
259 "Return a reporter that shows a progress bar every time one of the TOTAL
260 tasks is performed. Write PREFIX at the beginning of the line."
263 (define (report-progress)
264 (set! done (+ 1 done))
265 (unless (> done total)
266 (let* ((ratio (* 100. (/ done total))))
267 (erase-current-line port)
268 (if (string-null? prefix)
269 (display (progress-bar ratio (current-terminal-columns)) port)
270 (let ((width (- (current-terminal-columns)
271 (string-length prefix) 3)))
272 (display prefix port)
274 (display (progress-bar ratio width) port)))
275 (force-output port))))
280 (report report-progress)
282 (erase-current-line port)
283 (unless (string-null? prefix)
284 (display prefix port)
286 (force-output port)))))
288 (define* (progress-reporter/trace file url size
289 #:optional (log-port (current-output-port)))
290 "Like 'progress-reporter/file', but instead of returning human-readable
291 progress reports, write \"build trace\" lines to be processed elsewhere."
292 (define total 0) ;bytes transferred
294 (define (report-progress transferred)
296 (format #f "@ download-progress ~a ~a ~a ~a~%"
297 file url (or size "-") transferred))
299 (display message log-port) ;should be atomic
300 (flush-output-port log-port))
305 (display (format #f "@ download-started ~a ~a ~a~%"
306 file url (or size "-"))
308 (report (let ((report (rate-limited report-progress %progress-interval)))
309 (lambda (transferred)
310 (set! total transferred)
311 (report transferred))))
313 (let ((size (or size total)))
314 (report-progress size)
315 (display (format #f "@ download-succeeded ~a ~a ~a~%"
319 ;; TODO: replace '(@ (guix build utils) dump-port))'.
320 (define* (dump-port* in out
321 #:key (buffer-size 16384)
322 (reporter progress-reporter/silent))
323 "Read as much data as possible from IN and write it to OUT, using chunks of
324 BUFFER-SIZE bytes. After each successful transfer of BUFFER-SIZE bytes or
325 less, report the total number of bytes transferred to the REPORTER, which
326 should be a <progress-reporter> object."
328 (make-bytevector buffer-size))
330 (call-with-progress-reporter reporter
333 (bytes (get-bytevector-n! in buffer 0 buffer-size)))
334 (or (eof-object? bytes)
335 (let ((total (+ total bytes)))
336 (put-bytevector out buffer 0 bytes)
338 (loop total (get-bytevector-n! in buffer 0 buffer-size))))))))
340 (define (progress-report-port reporter port)
341 "Return a port that continuously reports the bytes read from PORT using
342 REPORTER, which should be a <progress-reporter> object."
344 (($ <progress-reporter> start report stop)
346 (read! (lambda (bv start count)
347 (let ((n (match (get-bytevector-n! port bv start count)
350 (set! total (+ total n))
354 (make-custom-binary-input-port "progress-port-proc"
357 ;; XXX: Kludge! When used through
358 ;; 'decompressed-port', this port ends
359 ;; up being closed twice: once in a
360 ;; child process early on, and at the
361 ;; end in the parent process. Ignore
362 ;; the early close so we don't output
363 ;; a spurious "download-succeeded"
365 (unless (zero? total)
367 (close-port port)))))))