substitute: Improve readability of download progress report.

* guix/build/download.scm
  (string-pad-middle, store-url-abbreviation, store-path-abbreviation):
  New procedures.
  (progress-proc): Add #:abbreviation parameter and use it.  Generate a
  better indeterminate progress string.
* guix/scripts/substitute.scm (assert-valid-narinfo): Add newlines to output.
  (process-substitution): Use byte-count->string and store-path-abbreviation.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>

2 files changed, 53 insertions, 25 deletions

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 31d60fbcda..9b72e8f795 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -36,8 +36,10 @@
             resolve-uri-reference
             maybe-expand-mirrors
             url-fetch
+            byte-count->string
             progress-proc
-            uri-abbreviation))
+            uri-abbreviation
+            store-path-abbreviation))
 
 ;;; Commentary:
 ;;;
@@ -96,10 +98,33 @@ width of the bar is BAR-WIDTH."
             (make-string filled #\#)
             (make-string empty #\space))))
 
-(define* (progress-proc file size #:optional (log-port (current-output-port)))
+(define (string-pad-middle left right len)
+  "Combine LEFT and RIGHT with enough padding in the middle so that the
+resulting string has length at least LEN.  This right justifies RIGHT."
+  (string-append left
+                 (string-pad right (max 0 (- len (string-length left))))))
+
+(define (store-url-abbreviation url)
+  "Return a friendlier version of URL for display."
+  (let ((store-path (string-append (%store-directory) "/" (basename url))))
+    ;; Take advantage of the implementation for store paths.
+    (store-path-abbreviation store-path)))
+
+(define* (store-path-abbreviation store-path #:optional (prefix-length 6))
+  "Return an abbreviation of STORE-PATH for display, showing PREFIX-LENGTH
+characters of the hash."
+  (let ((base (basename store-path)))
+    (string-append (string-take base prefix-length)
+                   "…"
+                   (string-drop base 32))))
+
+(define* (progress-proc file size
+                        #:optional (log-port (current-output-port))
+                        #:key (abbreviation identity))
   "Return a procedure to show the progress of FILE's download, which is SIZE
 bytes long.  The returned procedure is suitable for use as an argument to
-`dump-port'.  The progress report is written to LOG-PORT."
+`dump-port'.  The progress report is written to LOG-PORT, with ABBREVIATION
+used to shorten FILE for display."
   ;; 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
   ;; on hydra.gnu.org, which returns whole nars as a single chunk.
@@ -123,31 +148,31 @@ bytes long.  The returned procedure is suitable for use as an argument to
                                      (/ transferred elapsed)
                                      0))
                      (left       (format #f " ~a  ~a"
-                                         (basename file)
+                                         (abbreviation 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)
+                                         (progress-bar %) %)))
+                ;; TODO: Make this adapt to the actual terminal width.
+                (display (string-pad-middle left right 80) log-port)
                 (display #\cr log-port)
                 (flush-output-port log-port)
                 (cont))))
           (lambda (transferred cont)
             (with-elapsed-time elapsed
-              (let ((throughput (if elapsed
-                                    (/ transferred elapsed)
-                                    0)))
+              (let* ((throughput (if elapsed
+                                     (/ transferred elapsed)
+                                     0))
+                     (left       (format #f " ~a"
+                                         (abbreviation file)))
+                     (right      (format #f "~a/s ~a | ~a transferred"
+                                         (byte-count->string throughput)
+                                         (seconds->string elapsed)
+                                         (byte-count->string transferred))))
+                ;; TODO: Make this adapt to the actual terminal width.
+                (display (string-pad-middle left right 80) log-port)
                 (display #\cr log-port)
-                (format log-port "~a\t~a transferred (~a/s)"
-                        file
-                        (byte-count->string transferred)
-                        (byte-count->string throughput))
                 (flush-output-port log-port)
                 (cont))))))))
 
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index e908bc997e..ec8e6244af 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -31,7 +31,8 @@
   #:use-module (guix pki)
   #:use-module ((guix build utils) #:select (mkdir-p dump-port))
   #:use-module ((guix build download)
-                #:select (progress-proc uri-abbreviation))
+                #:select (progress-proc uri-abbreviation
+                          store-path-abbreviation byte-count->string))
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
@@ -337,8 +338,9 @@ or is signed by an unauthorized key."
           (unless %allow-unauthenticated-substitutes?
             (assert-valid-signature narinfo signature hash acl)
             (when verbose?
+              ;; Visually separate substitutions with a newline.
               (format (current-error-port)
-                      "found valid signature for '~a', from '~a'~%"
+                      "~%Found valid signature for ~a~%From ~a~%"
                       (narinfo-path narinfo)
                       (uri->string (narinfo-uri narinfo)))))
           narinfo))))
@@ -753,13 +755,12 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
     ;; Tell the daemon what the expected hash of the Nar itself is.
     (format #t "~a~%" (narinfo-hash narinfo))
 
-    (format (current-error-port) "downloading `~a'~:[~*~; (~,1f MiB installed)~]...~%"
-            store-item
-
+    (format (current-error-port) "Downloading ~a~:[~*~; (~a installed)~]...~%"
+            (store-path-abbreviation store-item)
             ;; Use the Nar size as an estimate of the installed size.
             (narinfo-size narinfo)
             (and=> (narinfo-size narinfo)
-                   (cute / <> (expt 2. 20))))
+                   (cute byte-count->string <>)))
     (let*-values (((raw download-size)
                    ;; Note that Hydra currently generates Nars on the fly
                    ;; and doesn't specify a Content-Length, so
@@ -772,7 +773,9 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
                                              (narinfo-size narinfo))))
                           (progress (progress-proc (uri-abbreviation uri)
                                                    dl-size
-                                                   (current-error-port))))
+                                                   (current-error-port)
+                                                   #:abbreviation
+                                                   store-path-abbreviation)))
                      (progress-report-port progress raw)))
                   ((input pids)
                    (decompressed-port (and=> (narinfo-compression narinfo)