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.

1 files changed, 21 insertions, 6 deletions

diff --git a/guix/status.scm b/guix/status.scm
index 0435d14d6a..e3375816c5 100644
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -441,14 +441,29 @@ addition to build events."
         (cut colorize-string <> 'RED 'BOLD)
         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
     (if print-log?
         (if colorize?
-            (lambda (line)
+            (lambda (id line)
               (display (colorize-log-line line) port))
-            (cut display <> port))
-        (lambda (line)
-          (spin! port))))
+            (lambda (id line)
+              (display line 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?
     (display "\r" port))                          ;erase the spinner
@@ -552,7 +567,7 @@ addition to build events."
                ;; through.
                (display line port)
                (force-output port))
-             (print-log-line line))
+             (print-log-line pid line))
          (cond ((string-prefix? "substitute: " line)
                 ;; The daemon prefixes early messages coming with 'guix
                 ;; substitute' with "substitute:".  These are useful ("updating
@@ -565,7 +580,7 @@ addition to build events."
                 (display (info (string-trim-right line)) port)
                 (newline))
                (else
-                (print-log-line line)))))
+                (print-log-line pid line)))))
     (_
      event)))