build: Improve information density and appearance of download progress output.
* guix/build/download.scm (seconds->string): New function. (byte-count->string): New function. (progress-bar): New function. (throughput->string): Remove function. (progress-proc): Display base file name, elapsed time, and progress bar. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
parent
1cd4027cfd
commit
0c0a1f22ce
|
@ -1,6 +1,7 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
||||||
|
;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -54,17 +55,46 @@ object, as an inexact number."
|
||||||
(+ (time-second duration)
|
(+ (time-second duration)
|
||||||
(/ (time-nanosecond duration) 1e9)))
|
(/ (time-nanosecond duration) 1e9)))
|
||||||
|
|
||||||
(define (throughput->string throughput)
|
(define (seconds->string duration)
|
||||||
"Given THROUGHPUT, measured in bytes per second, return a string
|
"Given DURATION in seconds, return a string representing it in 'hh:mm:ss'
|
||||||
representing it in a human-readable way."
|
format."
|
||||||
(if (> throughput 3e6)
|
(if (not (number? duration))
|
||||||
(format #f "~,2f MiB/s" (/ throughput (expt 2. 20)))
|
"00:00:00"
|
||||||
(format #f "~,0f KiB/s" (/ throughput 1024.0))))
|
(let* ((total-seconds (inexact->exact (round duration)))
|
||||||
|
(extra-seconds (modulo total-seconds 3600))
|
||||||
|
(hours (quotient total-seconds 3600))
|
||||||
|
(mins (quotient extra-seconds 60))
|
||||||
|
(secs (modulo extra-seconds 60)))
|
||||||
|
(format #f "~2,'0d:~2,'0d:~2,'0d" hours mins secs))))
|
||||||
|
|
||||||
|
(define (byte-count->string size)
|
||||||
|
"Given SIZE in bytes, return a string representing it in a human-readable
|
||||||
|
way."
|
||||||
|
(let ((KiB 1024.)
|
||||||
|
(MiB (expt 1024. 2))
|
||||||
|
(GiB (expt 1024. 3))
|
||||||
|
(TiB (expt 1024. 4)))
|
||||||
|
(cond
|
||||||
|
((< size KiB) (format #f "~dB" (inexact->exact size)))
|
||||||
|
((< size MiB) (format #f "~dKiB" (inexact->exact (round (/ size KiB)))))
|
||||||
|
((< size GiB) (format #f "~,1fMiB" (/ size MiB)))
|
||||||
|
((< size TiB) (format #f "~,2fGiB" (/ size GiB)))
|
||||||
|
(else (format #f "~,3fTiB" (/ size TiB))))))
|
||||||
|
|
||||||
|
(define* (progress-bar % #:optional (bar-width 20))
|
||||||
|
"Return % as a string representing an ASCII-art progress bar. The total
|
||||||
|
width of the bar is BAR-WIDTH."
|
||||||
|
(let* ((fraction (/ % 100))
|
||||||
|
(filled (inexact->exact (floor (* fraction bar-width))))
|
||||||
|
(empty (- bar-width filled)))
|
||||||
|
(format #f "[~a~a]"
|
||||||
|
(make-string filled #\#)
|
||||||
|
(make-string empty #\space))))
|
||||||
|
|
||||||
(define* (progress-proc file size #:optional (log-port (current-output-port)))
|
(define* (progress-proc file size #:optional (log-port (current-output-port)))
|
||||||
"Return a procedure to show the progress of FILE's download, which is
|
"Return a procedure to show the progress of FILE's download, which is SIZE
|
||||||
SIZE byte long. The returned procedure is suitable for use as an
|
bytes long. The returned procedure is suitable for use as an argument to
|
||||||
argument to `dump-port'. The progress report is written to LOG-PORT."
|
`dump-port'. The progress report is written to LOG-PORT."
|
||||||
;; XXX: Because of <http://bugs.gnu.org/19939> this procedure is often not
|
;; XXX: Because of <http://bugs.gnu.org/19939> this procedure is often not
|
||||||
;; called as frequently as we'd like too; this is especially bad with Nginx
|
;; called as frequently as we'd like too; this is especially bad with Nginx
|
||||||
;; on hydra.gnu.org, which returns whole nars as a single chunk.
|
;; on hydra.gnu.org, which returns whole nars as a single chunk.
|
||||||
|
@ -83,14 +113,24 @@ argument to `dump-port'. The progress report is written to LOG-PORT."
|
||||||
(if (number? size)
|
(if (number? size)
|
||||||
(lambda (transferred cont)
|
(lambda (transferred cont)
|
||||||
(with-elapsed-time elapsed
|
(with-elapsed-time elapsed
|
||||||
(let ((% (* 100.0 (/ transferred size)))
|
(let* ((% (* 100.0 (/ transferred size)))
|
||||||
(throughput (if elapsed
|
(throughput (if elapsed
|
||||||
(/ transferred elapsed)
|
(/ transferred elapsed)
|
||||||
0)))
|
0))
|
||||||
|
(left (format #f " ~a ~a"
|
||||||
|
(basename file)
|
||||||
|
(byte-count->string size)))
|
||||||
|
(right (format #f "~a/s ~a ~a~6,1f%"
|
||||||
|
(byte-count->string throughput)
|
||||||
|
(seconds->string elapsed)
|
||||||
|
(progress-bar %) %))
|
||||||
|
;; TODO: Make this adapt to the actual terminal width.
|
||||||
|
(cols 80)
|
||||||
|
(num-spaces (max 1 (- cols (+ (string-length left)
|
||||||
|
(string-length right)))))
|
||||||
|
(gap (make-string num-spaces #\space)))
|
||||||
|
(format log-port "~a~a~a" left gap right)
|
||||||
(display #\cr log-port)
|
(display #\cr log-port)
|
||||||
(format log-port "~a\t~5,1f% of ~,1f KiB (~a)"
|
|
||||||
file % (/ size 1024.0)
|
|
||||||
(throughput->string throughput))
|
|
||||||
(flush-output-port log-port)
|
(flush-output-port log-port)
|
||||||
(cont))))
|
(cont))))
|
||||||
(lambda (transferred cont)
|
(lambda (transferred cont)
|
||||||
|
@ -99,9 +139,10 @@ argument to `dump-port'. The progress report is written to LOG-PORT."
|
||||||
(/ transferred elapsed)
|
(/ transferred elapsed)
|
||||||
0)))
|
0)))
|
||||||
(display #\cr log-port)
|
(display #\cr log-port)
|
||||||
(format log-port "~a\t~6,1f KiB transferred (~a)"
|
(format log-port "~a\t~a transferred (~a/s)"
|
||||||
file (/ transferred 1024.0)
|
file
|
||||||
(throughput->string throughput))
|
(byte-count->string transferred)
|
||||||
|
(byte-count->string throughput))
|
||||||
(flush-output-port log-port)
|
(flush-output-port log-port)
|
||||||
(cont))))))))
|
(cont))))))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue