ui: Report profile hooks separately.

* guix/ui.scm (profile-hook-derivation?): New procedure.
(show-what-to-build): Distinguish among BUILD derivations that match
'profile-hook-derivation?'.  Report them separately.
* guix/status.scm (hook-message): New procedure.
(print-build-event): Display profile hooks with readable hook name.
* guix/profiles.scm (info-dir-file, ghc-package-cache-file,
ca-certificate-bundle, glib-schemas, gtk-icon-themes, gtk-im-modules,
xdg-desktop-database, xdg-mime-database, fonts-dir-file, manual-database):
Augment derivation with "type" and "hook" properties.
This commit is contained in:
Ricardo Wurmus 2018-12-19 14:36:29 +01:00 committed by Ricardo Wurmus
parent 0485717ee9
commit 80eebee9f7
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
3 changed files with 114 additions and 17 deletions

View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -289,6 +290,31 @@ on."
("^(.*)(warning)([[:blank:]]*)(:)(.*)"
RESET MAGENTA BOLD BOLD BOLD)))
(define (hook-message hook-type)
"Return a human-readable string for the profile hook type HOOK-TYPE."
(match hook-type
('info-dir
(G_ "building directory of Info manuals..."))
('ghc-package-cache
(G_ "building GHC package cache..."))
('ca-certificate-bundle
(G_ "building CA certificate bundle..."))
('glib-schemas
(G_ "generating GLib schema cache..."))
('gtk-icon-themes
(G_ "creating GTK+ icon theme cache..."))
('gtk-im-modules
(G_ "building cache files for GTK+ input methods..."))
('xdg-desktop-database
(G_ "building XDG desktop file cache..."))
('xdg-mime-database
(G_ "building XDG MIME database..."))
('fonts-dir
(G_ "building fonts directory..."))
('manual-database
(G_ "building database for manual pages..."))
(_ #f)))
(define* (print-build-event event old-status status
#:optional (port (current-error-port))
#:key
@ -336,6 +362,13 @@ addition to build events."
"applying ~a grafts for ~a..."
count))
count drv)))
('profile-hook
(let ((hook-type (assq-ref properties 'hook)))
(or (and=> (hook-message hook-type)
(lambda (msg)
(format port (info msg))))
(format port (info (G_ "running profile hook of type '~a'..."))
hook-type))))
(_
(format port (info (G_ "building ~a...")) drv))))
(newline port))