status: Print a progress bar for on-going builds when possible.

* guix/status.scm (print-build-event)[report-build-progress]: New
procedure.
[print-log-line]: Add ID parameter.  Call 'report-build-progress' when
appropriate.
Adjust callers.
master
Ludovic Courtès 2019-01-27 22:44:34 +01:00
parent 73a8681a16
commit 3854c6429c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 21 additions and 6 deletions

View File

@ -441,14 +441,29 @@ addition to build events."
(cut colorize-string <> 'RED 'BOLD) (cut colorize-string <> 'RED 'BOLD)
identity)) identity))
(define (report-build-progress %)
(let ((% (min (max % 0) 100))) ;sanitize
(erase-current-line port)
(format port "~3d% " (inexact->exact (round %)))
(display (progress-bar % (- (current-terminal-columns) 5))
port)
(force-output port)))
(define print-log-line (define print-log-line
(if print-log? (if print-log?
(if colorize? (if colorize?
(lambda (line) (lambda (id line)
(display (colorize-log-line line) port)) (display (colorize-log-line line) port))
(cut display <> port)) (lambda (id line)
(lambda (line) (display line port)))
(spin! port)))) (lambda (id line)
(match (build-status-building status)
((build) ;single job
(match (build-completion build)
((? number? %) (report-build-progress %))
(_ (spin! port))))
(_
(spin! port))))))
(unless print-log? (unless print-log?
(display "\r" port)) ;erase the spinner (display "\r" port)) ;erase the spinner
@ -552,7 +567,7 @@ addition to build events."
;; through. ;; through.
(display line port) (display line port)
(force-output port)) (force-output port))
(print-log-line line)) (print-log-line pid line))
(cond ((string-prefix? "substitute: " line) (cond ((string-prefix? "substitute: " line)
;; The daemon prefixes early messages coming with 'guix ;; The daemon prefixes early messages coming with 'guix
;; substitute' with "substitute:". These are useful ("updating ;; substitute' with "substitute:". These are useful ("updating
@ -565,7 +580,7 @@ addition to build events."
(display (info (string-trim-right line)) port) (display (info (string-trim-right line)) port)
(newline)) (newline))
(else (else
(print-log-line line))))) (print-log-line pid line)))))
(_ (_
event))) event)))