From 80eebee9f7578ed096fed4cb6adfcbae3cfefc58 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>
Date: Wed, 19 Dec 2018 14:36:29 +0100
Subject: 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.
---
 guix/status.scm | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

(limited to 'guix/status.scm')

diff --git a/guix/status.scm b/guix/status.scm
index 868bfdca21..d4fc4ca16e 100644
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -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))
-- 
cgit v1.2.3