progress: Add 'progress-reporter/bar'.

* guix/progress.scm (progress-reporter/bar): New procedure.
This commit is contained in:
Ludovic Courtès 2017-11-22 14:39:00 +01:00
parent 5ed534ccc3
commit 4cdb27af48
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 35 additions and 0 deletions

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com> ;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -32,6 +33,7 @@
progress-reporter/silent progress-reporter/silent
progress-reporter/file progress-reporter/file
progress-reporter/bar
byte-count->string byte-count->string
current-terminal-columns current-terminal-columns
@ -212,6 +214,39 @@ ABBREVIATION used to shorten FILE for display."
;; Don't miss the last report. ;; Don't miss the last report.
(stop render)))) (stop render))))
(define* (progress-reporter/bar total
#:optional
(prefix "")
(port (current-error-port)))
"Return a reporter that shows a progress bar every time one of the TOTAL
tasks is performed. Write PREFIX at the beginning of the line."
(define done 0)
(define (report-progress)
(set! done (+ 1 done))
(unless (> done total)
(let* ((ratio (* 100. (/ done total))))
(erase-in-line port)
(if (string-null? prefix)
(display (progress-bar ratio (current-terminal-columns)) port)
(let ((width (- (current-terminal-columns)
(string-length prefix) 3)))
(display prefix port)
(display " " port)
(display (progress-bar ratio width) port)))
(force-output port))))
(progress-reporter
(start (lambda ()
(set! done 0)))
(report report-progress)
(stop (lambda ()
(erase-in-line port)
(unless (string-null? prefix)
(display prefix port)
(newline port))
(force-output port)))))
;; TODO: replace '(@ (guix build utils) dump-port))'. ;; TODO: replace '(@ (guix build utils) dump-port))'.
(define* (dump-port* in out (define* (dump-port* in out
#:key (buffer-size 16384) #:key (buffer-size 16384)