~ruther/guix-local

4cdb27af48c83b7d036c4d8cccb792a51d766790 — Ludovic Courtès 8 years ago 5ed534c
progress: Add 'progress-reporter/bar'.

* guix/progress.scm (progress-reporter/bar): New procedure.
1 files changed, 35 insertions(+), 0 deletions(-)

M guix/progress.scm
M guix/progress.scm => guix/progress.scm +35 -0
@@ 1,6 1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 32,6 33,7 @@

            progress-reporter/silent
            progress-reporter/file
            progress-reporter/bar

            byte-count->string
            current-terminal-columns


@@ 212,6 214,39 @@ ABBREVIATION used to shorten FILE for display."
     ;; Don't miss the last report.
     (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))'.
(define* (dump-port* in out
                     #:key (buffer-size 16384)