substitute: Better abbreviate substitute URL in progress report.

Suggested by Danny Milosavljevic <dannym@scratchpost.org>.

* guix/build/download.scm (nar-uri-abbreviation): New procedure.
* guix/scripts/substitute.scm (process-substitution): Use it instead of
'store-path-abbreviation'.

1 files changed, 12 insertions, 0 deletions

diff --git a/guix/build/download.scm b/guix/build/download.scm
index fe7a453c89..fec4cec3e8 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -42,6 +42,7 @@
             current-terminal-columns
             progress-proc
             uri-abbreviation
+            nar-uri-abbreviation
             store-path-abbreviation))
 
 ;;; Commentary:
@@ -222,6 +223,17 @@ abbreviation of URI showing the scheme, host, and basename of the file."
             uri-as-string))
       uri-as-string))
 
+(define (nar-uri-abbreviation uri)
+  "Abbreviate URI, which is assumed to be the URI of a nar as served by Hydra
+and 'guix publish', something like
+\"http://example.org/nar/1ldrllwbna0aw5z8kpci4fsvbd2w8cw4-texlive-bin-2015\"."
+  (let* ((uri  (if (string? uri) (string->uri uri) uri))
+         (path (basename (uri-path uri))))
+    (if (and (> (string-length path) 33)
+             (char=? (string-ref path 32) #\-))
+        (string-drop path 33)
+        path)))
+
 (define (ftp-fetch uri file)
   "Fetch data from URI and write it to FILE.  Return FILE on success."
   (let* ((conn (ftp-open (uri-host uri)))