ui: 'show-what-to-build' colorizes store file names.

* guix/ui.scm (colorize-store-file-name): New procedure.
(show-what-to-build)[colorize-store-item]: New variable.
Use it throughout.
This commit is contained in:
Ludovic Courtès 2019-10-01 10:45:05 +02:00
parent 8e5ffebeaa
commit 8b4615ab54
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 30 additions and 10 deletions

View File

@ -867,6 +867,17 @@ warning."
('profile-hook #t) ('profile-hook #t)
(_ #f))) (_ #f)))
(define (colorize-store-file-name file)
"Colorize FILE, a store file name, such that the hash part is less prominent
that the rest."
(let ((len (string-length file))
(prefix (+ (string-length (%store-prefix)) 32 2)))
(if (< len prefix)
file
(string-append (colorize-string (string-take file prefix)
(color DARK))
(string-drop file prefix)))))
(define* (show-what-to-build store drv (define* (show-what-to-build store drv
#:key dry-run? (use-substitutes? #t) #:key dry-run? (use-substitutes? #t)
(mode (build-mode normal))) (mode (build-mode normal)))
@ -890,6 +901,11 @@ check and report what is prerequisites are available for download."
(substitution-oracle store inputs #:mode mode) (substitution-oracle store inputs #:mode mode)
(const #f))) (const #f)))
(define colorized-store-item
(if (color-output? (current-error-port))
colorize-store-file-name
identity))
(let*-values (((build download) (let*-values (((build download)
(derivation-build-plan store inputs (derivation-build-plan store inputs
#:mode mode #:mode mode
@ -935,7 +951,7 @@ check and report what is prerequisites are available for download."
(N_ "~:[The following derivation would be built:~%~{ ~a~%~}~;~]" (N_ "~:[The following derivation would be built:~%~{ ~a~%~}~;~]"
"~:[The following derivations would be built:~%~{ ~a~%~}~;~]" "~:[The following derivations would be built:~%~{ ~a~%~}~;~]"
(length build)) (length build))
(null? build) build) (null? build) (map colorized-store-item build))
(if display-download-size? (if display-download-size?
(format (current-error-port) (format (current-error-port)
;; TRANSLATORS: "MB" is for "megabyte"; it should be ;; TRANSLATORS: "MB" is for "megabyte"; it should be
@ -943,29 +959,31 @@ check and report what is prerequisites are available for download."
(G_ "~:[~,1h MB would be downloaded:~%~{ ~a~%~}~;~]") (G_ "~:[~,1h MB would be downloaded:~%~{ ~a~%~}~;~]")
(null? download) (null? download)
download-size download-size
(map substitutable-path download)) (map (compose colorized-store-item substitutable-path)
download))
(format (current-error-port) (format (current-error-port)
(N_ "~:[The following file would be downloaded:~%~{ ~a~%~}~;~]" (N_ "~:[The following file would be downloaded:~%~{ ~a~%~}~;~]"
"~:[The following files would be downloaded:~%~{ ~a~%~}~;~]" "~:[The following files would be downloaded:~%~{ ~a~%~}~;~]"
(length download)) (length download))
(null? download) (null? download)
(map substitutable-path download))) (map (compose colorized-store-item substitutable-path)
download)))
(format (current-error-port) (format (current-error-port)
(N_ "~:[The following graft would be made:~%~{ ~a~%~}~;~]" (N_ "~:[The following graft would be made:~%~{ ~a~%~}~;~]"
"~:[The following grafts would be made:~%~{ ~a~%~}~;~]" "~:[The following grafts would be made:~%~{ ~a~%~}~;~]"
(length graft)) (length graft))
(null? graft) graft) (null? graft) (map colorized-store-item graft))
(format (current-error-port) (format (current-error-port)
(N_ "~:[The following profile hook would be built:~%~{ ~a~%~}~;~]" (N_ "~:[The following profile hook would be built:~%~{ ~a~%~}~;~]"
"~:[The following profile hooks would be built:~%~{ ~a~%~}~;~]" "~:[The following profile hooks would be built:~%~{ ~a~%~}~;~]"
(length hook)) (length hook))
(null? hook) hook)) (null? hook) (map colorized-store-item hook)))
(begin (begin
(format (current-error-port) (format (current-error-port)
(N_ "~:[The following derivation will be built:~%~{ ~a~%~}~;~]" (N_ "~:[The following derivation will be built:~%~{ ~a~%~}~;~]"
"~:[The following derivations will be built:~%~{ ~a~%~}~;~]" "~:[The following derivations will be built:~%~{ ~a~%~}~;~]"
(length build)) (length build))
(null? build) build) (null? build) (map colorized-store-item build))
(if display-download-size? (if display-download-size?
(format (current-error-port) (format (current-error-port)
;; TRANSLATORS: "MB" is for "megabyte"; it should be ;; TRANSLATORS: "MB" is for "megabyte"; it should be
@ -973,23 +991,25 @@ check and report what is prerequisites are available for download."
(G_ "~:[~,1h MB will be downloaded:~%~{ ~a~%~}~;~]") (G_ "~:[~,1h MB will be downloaded:~%~{ ~a~%~}~;~]")
(null? download) (null? download)
download-size download-size
(map substitutable-path download)) (map (compose colorized-store-item substitutable-path)
download))
(format (current-error-port) (format (current-error-port)
(N_ "~:[The following file will be downloaded:~%~{ ~a~%~}~;~]" (N_ "~:[The following file will be downloaded:~%~{ ~a~%~}~;~]"
"~:[The following files will be downloaded:~%~{ ~a~%~}~;~]" "~:[The following files will be downloaded:~%~{ ~a~%~}~;~]"
(length download)) (length download))
(null? download) (null? download)
(map substitutable-path download))) (map (compose colorized-store-item substitutable-path)
download)))
(format (current-error-port) (format (current-error-port)
(N_ "~:[The following graft will be made:~%~{ ~a~%~}~;~]" (N_ "~:[The following graft will be made:~%~{ ~a~%~}~;~]"
"~:[The following grafts will be made:~%~{ ~a~%~}~;~]" "~:[The following grafts will be made:~%~{ ~a~%~}~;~]"
(length graft)) (length graft))
(null? graft) graft) (null? graft) (map colorized-store-item graft))
(format (current-error-port) (format (current-error-port)
(N_ "~:[The following profile hook will be built:~%~{ ~a~%~}~;~]" (N_ "~:[The following profile hook will be built:~%~{ ~a~%~}~;~]"
"~:[The following profile hooks will be built:~%~{ ~a~%~}~;~]" "~:[The following profile hooks will be built:~%~{ ~a~%~}~;~]"
(length hook)) (length hook))
(null? hook) hook))) (null? hook) (map colorized-store-item hook))))
(check-available-space installed-size) (check-available-space installed-size)