Subject: [bug#75647] [PATCH v2 2/2] rofiles: Filter out unwanted manifest entries for profile hooks.

From: [email-masked]
Date: Sat, 18 Jan 2025 20:07:01 +0800

From: 宋文武 <[email-masked]>

Before we run profile hooks for all manifest inputs, so if you install a new
package to your profile, all profile hooks will be run again, even if the new
package doesn't provide info manuals, man pages, etc.

After this commit every profile hook will be run with its hook related inputs,
avoid unneccessary reruns.

* guix/profiles.scm (manifest-lookup-package): Remove procedure.
(find-entry): New procedure.
(profile-derivation): Build manifest entries before running hooks.
(manual-database/optional): Remove procedure.
(%default-profile-hooks): Replace 'manual-database/optional' with 'manual-database'.
(info-dir-file, manual-database, fonts-dir-file, ghc-package-cache-file)
(ca-certificate-bundle, emacs-subdir, gdk-pixbuf-loaders-cache-file)
(glib-schemas, gtk-icon-themes, gtk-im-modules, texlive-font-maps)
(xdg-desktop-database, xdg-mime-database): Only run the hook with entries that
contains hook related files.

Change-Id: I6ee8c44cb1e625ced711cd0fc75d1762daa0dc72
---
 guix/profiles.scm | 543 +++++++++++++++++++++++++---------------------
 1 file changed, 295 insertions(+), 248 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0f47268541..eeec76bf22 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -958,55 +958,18 @@ (define (manifest-inputs manifest)
 
   (append-map entry->input (manifest-entries manifest)))
 
-(define* (manifest-lookup-package manifest name #:optional version)
-  "Return as a monadic value the first package or store path referenced by
-MANIFEST that is named NAME and optionally has the given VERSION prefix, or #f
-if not found."
-  ;; Return as a monadic value the package or store path referenced by the
-  ;; manifest ENTRY, or #f if not referenced.
-  (define (entry-lookup-package entry)
-    (define (find-among-inputs inputs)
-      (find (lambda (input)
-              (and (package? input)
-                   (equal? name (package-name input))
-                   (if version
-                       (string-prefix? version (package-version input))
-                       #t)))
-            inputs))
-    (define (find-among-store-items items)
-      (find (lambda (item)
-              (let-values (((name* version*)
-                            (package-name->name+version
-                             (store-path-package-name item))))
-                (and (string=? name name*)
-                     (if version
-                         (string-prefix? version version*)
-                         #t))))
-            items))
-
-    (with-monad %store-monad
-      (match (manifest-entry-item entry)
-        ((? package? package)
-         (match (cons (list (package-name package) package)
-                      (package-transitive-inputs package))
-           (((labels inputs . _) ...)
-            (return (find-among-inputs inputs)))))
-        ((? string? item)
-         (mlet %store-monad ((refs (references* item)))
-           (return (find-among-store-items refs))))
-        (item
-         ;; XXX: ITEM might be a 'computed-file' or anything like that, in
-         ;; which case we don't know what to do.  The fix may be to check
-         ;; references once ITEM is compiled, as proposed at
-         ;; <https://bugs.gnu.org/29927>.
-         (return #f)))))
-
-  (anym %store-monad
-        entry-lookup-package (manifest-entries manifest)))
-
-(define* (info-dir-file manifest #:optional system)
-  "Return a derivation that builds the 'dir' file for all the entries of
-MANIFEST."
+(define* (find-entry entries name #:optional version)
+  "Return the first manifest entry from ENTRIES that is named NAME and
+optionally has the given VERSION prefix, or #f if not found."
+  (find (lambda (entry)
+          (and (equal? name (manifest-entry-name entry))
+               (if version
+                   (string-prefix? version (manifest-entry-version entry))
+                   #t)))
+        entries))
+
+(define* (info-dir-file entries #:optional system)
+  "Return a derivation that builds the 'dir' file for all the manifest ENTRIES."
   (define texinfo                                 ;lazy reference
     (module-ref (resolve-interface '(gnu packages texinfo)) 'texinfo))
   (define gzip                                    ;lazy reference
@@ -1015,7 +978,7 @@ (define* (info-dir-file manifest #:optional system)
     (module-ref (resolve-interface '(gnu packages base))
                 'libc-utf8-locales-for-target))
 
-  (define build
+  (define (build items)
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils)
@@ -1060,24 +1023,33 @@ (define* (info-dir-file manifest #:optional system)
 
           (mkdir-p (string-append #$output "/share/info"))
           (exit (every install-info
-                       (append-map info-files
-                                   '#$(manifest-inputs manifest)))))))
-
-  (gexp->derivation "info-dir" build
-                    #:system system
-                    #:local-build? #t
-                    #:substitutable? #f
-                    #:properties
-                    `((type . profile-hook)
-                      (hook . info-dir))))
+                       (append-map info-files '#$items))))))
+
+  (mlet %store-monad
+      ;; Only run this hook for entries which contains info files.
+      ((interested -> (filter (lambda (entry)
+                                (file-exists?
+                                 (string-append (manifest-entry-item entry)
+                                                "/share/info")))
+                              entries)))
+    (if (null? interested)
+        (return #f)
+        (gexp->derivation "info-dir"
+                          (build (map manifest-entry-item interested))
+                          #:system system
+                          #:local-build? #t
+                          #:substitutable? #f
+                          #:properties
+                          `((type . profile-hook)
+                            (hook . info-dir))))))
 
-(define* (ghc-package-cache-file manifest #:optional system)
+(define* (ghc-package-cache-file entries #:optional system)
   "Return a derivation that builds the GHC 'package.cache' file for all the
-entries of MANIFEST, or #f if MANIFEST does not have any GHC packages."
+ENTRIES of manifest, or #f if ENTRIES does not have any GHC packages."
   (define ghc                                     ;lazy reference
     (module-ref (resolve-interface '(gnu packages haskell)) 'ghc))
 
-  (define build
+  (define (build items)
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils)
@@ -1108,8 +1080,7 @@ (define* (ghc-package-cache-file manifest #:optional system)
           (system* (string-append #+ghc "/bin/ghc-pkg") "init" db-dir)
           (for-each copy-conf-file
                     (append-map conf-files
-                                (delete-duplicates
-                                 '#$(manifest-inputs manifest))))
+                                (delete-duplicates '#$items)))
           (let ((success
                  (zero?
                   (system* (string-append #+ghc "/bin/ghc-pkg") "recache"
@@ -1117,26 +1088,32 @@ (define* (ghc-package-cache-file manifest #:optional system)
             (for-each delete-file (find-files db-dir "\\.conf$"))
             (exit success)))))
 
-  (with-monad %store-monad
-    ;; Don't depend on GHC when there's nothing to do.
-    (if (any (cut string-prefix? "ghc" <>)
-             (map manifest-entry-name (manifest-entries manifest)))
-        (gexp->derivation "ghc-package-cache" build
+  (mlet %store-monad
+      ;; Don't depend on GHC when there's nothing to do.
+      ((interested -> (filter (lambda (entry)
+                                (file-exists?
+                                 (string-append (manifest-entry-item entry)
+                                                "/lib/ghc-"
+                                                (package-version ghc))))
+                              entries)))
+    (if (null? interested)
+        (return #f)
+        (gexp->derivation "ghc-package-cache"
+                          (build (map manifest-entry-item interested))
                           #:system system
                           #:local-build? #t
                           #:substitutable? #f
                           #:properties
                           `((type . profile-hook)
-                            (hook . ghc-package-cache)))
-        (return #f))))
+                            (hook . ghc-package-cache))))))
 
-(define* (ca-certificate-bundle manifest #:optional system)
+(define* (ca-certificate-bundle entries #:optional system)
   "Return a derivation that builds a single-file bundle containing the CA
-certificates in the /etc/ssl/certs sub-directories of the packages in
-MANIFEST.  Single-file bundles are required by programs such as Git and Lynx."
+certificates in the /etc/ssl/certs sub-directories of the packages for manifest
+ENTRIES.  Single-file bundles are required by programs such as Git and Lynx."
   ;; See <http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00429.html>
   ;; for a discussion.
-  (define build
+  (define (build items)
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils)
@@ -1169,7 +1146,7 @@ (define* (ca-certificate-bundle manifest #:optional system)
           ;; install a UTF-8 locale.
           (setlocale LC_ALL "C.UTF-8")
 
-          (match (append-map ca-files '#$(manifest-inputs manifest))
+          (match (append-map ca-files '#$items)
             (()
              ;; Since there are no CA files, just create an empty directory.  Do
              ;; not create the etc/ssl/certs sub-directory, since that would
@@ -1185,16 +1162,26 @@ (define* (ca-certificate-bundle manifest #:optional system)
                                                  "/ca-certificates.crt"))
                #t))))))
 
-  (gexp->derivation "ca-certificate-bundle" build
+  (mlet %store-monad
+      ((interested -> (filter
+                       (lambda (entry)
+                         (file-exists?
+                          (string-append (manifest-entry-item entry)
+                                         "/etc/ssl/certs")))
+                       entries)))
+    (if (null? interested)
+        (return #f)
+        (gexp->derivation "ca-certificate-bundle"
+                          (build (map manifest-entry-item interested))
                     #:system system
                     #:local-build? #t
                     #:substitutable? #f
                     #:properties
                     `((type . profile-hook)
-                      (hook . ca-certificate-bundle))))
+                      (hook . ca-certificate-bundle))))))
 
-(define* (emacs-subdirs manifest #:optional system)
-  (define build
+(define* (emacs-subdirs entries #:optional system)
+  (define (build items)
     (with-imported-modules (source-module-closure
                             '((guix build profiles)
                               (guix build utils)))
@@ -1213,9 +1200,8 @@ (define* (emacs-subdirs manifest #:optional system)
                      file-is-directory?
                      (map (cute string-append dir "/" <>)
                           (scandir dir (negate (cute member <> '("." "..")))))))
-                  (filter file-exists?
-                          (map (cute string-append <> "/share/emacs/site-lisp")
-                               '#$(manifest-inputs manifest))))))
+                  (map (cute string-append <> "/share/emacs/site-lisp")
+                       '#$items))))
             (mkdir-p destdir)
             (with-directory-excursion destdir
               (call-with-output-file "subdirs.el"
@@ -1226,77 +1212,82 @@ (define* (emacs-subdirs manifest #:optional system)
                    port)
                   (newline port)
                   #t)))))))
-  (gexp->derivation "emacs-subdirs" build
-                    #:system system
-                    #:local-build? #t
-                    #:substitutable? #f
-                    #:properties
-                    `((type . profile-hook)
-                      (hook . emacs-subdirs))))
 
-(define* (gdk-pixbuf-loaders-cache-file manifest #:optional system)
+  (mlet %store-monad
+      ((interested -> (filter
+                       (lambda (entry)
+                         (file-exists?
+                          (string-append (manifest-entry-item entry)
+                                         "/share/emacs/site-lisp")))
+                       entries)))
+    (if (null? interested)
+        (return #f)
+        (gexp->derivation "emacs-subdirs"
+                          (build (map manifest-entry-item interested))
+                          #:system system
+                          #:local-build? #t
+                          #:substitutable? #f
+                          #:properties
+                          `((type . profile-hook)
+                            (hook . emacs-subdirs))))))
+
+(define* (gdk-pixbuf-loaders-cache-file entries #:optional system)
   "Return a derivation that produces a loaders cache file for every gdk-pixbuf
-loaders discovered in MANIFEST."
+loaders discovered in manifest ENTRIES."
   (define gdk-pixbuf                    ;lazy reference
     (module-ref (resolve-interface '(gnu packages gtk)) 'gdk-pixbuf))
 
   (mlet* %store-monad
-      ((gdk-pixbuf (manifest-lookup-package manifest "gdk-pixbuf"))
-       (librsvg (manifest-lookup-package manifest "librsvg"))
-       (gdk-pixbuf-bin -> (if (string? gdk-pixbuf)
-                              (string-append gdk-pixbuf "/bin")
-                              (file-append gdk-pixbuf "/bin"))))
-
-    (define build
+      ((interested -> (filter
+                       (lambda (entry)
+                         (file-exists?
+                          (string-append (manifest-entry-item entry)
+                                         "/lib/gdk-pixbuf-2.0")))
+                       entries))
+       (gdk-pixbuf -> (or (and=> (find-entry entries "gdk-pixbuf")
+                                 manifest-entry-item)
+                          (file-append gdk-pixbuf))))
+
+    (define (build items)
       (with-imported-modules (source-module-closure
                               '((guix build glib-or-gtk-build-system)))
         #~(begin
             (use-modules (guix build glib-or-gtk-build-system))
-            (setenv "PATH" (string-append #$gdk-pixbuf-bin ":" (getenv "PATH")))
+            (setenv "PATH" (string-append #$gdk-pixbuf "/bin:" (getenv "PATH")))
 
             (generate-gdk-pixbuf-loaders-cache
-             ;; XXX: MANIFEST-LOOKUP-PACKAGE transitively searches through
-             ;; every input referenced by the manifest, while MANIFEST-INPUTS
-             ;; only retrieves the immediate inputs as well as their
-             ;; propagated inputs; to avoid causing an empty output derivation
-             ;; we must ensure that the inputs contain at least one
-             ;; loaders.cache file.  This is why we include gdk-pixbuf or
-             ;; librsvg when they are transitively found.
-             (list #$@(if gdk-pixbuf
-                          (list gdk-pixbuf)
-                          '())
-                   #$@(if librsvg
-                          (list librsvg)
-                          '())
-                   #$@(manifest-inputs manifest))
+             (list #$gdk-pixbuf #$@items)
              (list #$output)))))
 
-    (if gdk-pixbuf
-        (gexp->derivation "gdk-pixbuf-loaders-cache-file" build
+    (if (null? interested)
+        (return #f)
+        (gexp->derivation "gdk-pixbuf-loaders-cache-file"
+                          (build (map manifest-entry-item interested))
                           #:system system
                           #:local-build? #t
                           #:substitutable? #f
                           #:properties
                           '((type . profile-hook)
-                            (hook . gdk-pixbuf-loaders-cache-file)))
-        (return #f))))
+                            (hook . gdk-pixbuf-loaders-cache-file))))))
 
-(define* (glib-schemas manifest #:optional system)
-  "Return a derivation that unions all schemas from manifest entries and
+(define* (glib-schemas entries #:optional system)
+  "Return a derivation that unions all schemas from manifest ENTRIES and
 creates the Glib 'gschemas.compiled' file."
   (define glib  ; lazy reference
     (module-ref (resolve-interface '(gnu packages glib)) 'glib))
 
-  (mlet %store-monad ((%glib (manifest-lookup-package manifest "glib"))
-                      ;; XXX: Can't use glib-compile-schemas corresponding
-                      ;; to the glib referenced by 'manifest'.  Because
-                      ;; '%glib' can be either a package or store path, and
-                      ;; there's no way to get the "bin" output for the later.
-                      (glib-compile-schemas
+  (mlet %store-monad ((glib-compile-schemas
                        -> #~(string-append #+glib:bin
-                                           "/bin/glib-compile-schemas")))
-
-    (define build
+                                           "/bin/glib-compile-schemas"))
+                      (interested
+                       -> (filter
+                           (lambda (entry)
+                             (file-exists?
+                              (string-append (manifest-entry-item entry)
+                                             "/share/glib-2.0/schemas")))
+                           entries)))
+
+    (define (build items)
       (with-imported-modules '((guix build utils)
                                (guix build union)
                                (guix build profiles)
@@ -1309,9 +1300,8 @@ (define* (glib-schemas manifest #:optional system)
                          (srfi srfi-26))
 
             (let* ((destdir  (string-append #$output "/share/glib-2.0/schemas"))
-                   (schemadirs (filter file-exists?
-                                     (map (cut string-append <> "/share/glib-2.0/schemas")
-                                          '#$(manifest-inputs manifest)))))
+                   (schemadirs (map (cut string-append <> "/share/glib-2.0/schemas")
+                                    '#$items)))
 
               ;; Union all the schemas.
               (mkdir-p (string-append #$output "/share/glib-2.0"))
@@ -1326,32 +1316,35 @@ (define* (glib-schemas manifest #:optional system)
                            dir)))))))
 
     ;; Don't run the hook when there's nothing to do.
-    (if %glib
-        (gexp->derivation "glib-schemas" build
+    (if (null? interested)
+        (return #f)
+        (gexp->derivation "glib-schemas"
+                          (build (map manifest-entry-item interested))
                           #:system system
                           #:local-build? #t
                           #:substitutable? #f
                           #:properties
                           `((type . profile-hook)
-                            (hook . glib-schemas)))
-        (return #f))))
+                            (hook . glib-schemas))))))
 
-(define* (gtk-icon-themes manifest #:optional system)
-  "Return a derivation that unions all icon themes from manifest entries and
+(define* (gtk-icon-themes entries #:optional system)
+  "Return a derivation that unions all icon themes from manifest ENTRIES and
 creates the GTK+ 'icon-theme.cache' file for each theme."
   (define gtk+  ; lazy reference
     (module-ref (resolve-interface '(gnu packages gtk)) 'gtk+))
 
-  (mlet %store-monad ((%gtk+ (manifest-lookup-package manifest "gtk+"))
-                      ;; XXX: Can't use gtk-update-icon-cache corresponding
-                      ;; to the gtk+ referenced by 'manifest'.  Because
-                      ;; '%gtk+' can be either a package or store path, and
-                      ;; there's no way to get the "bin" output for the later.
-                      (gtk-update-icon-cache
+  (mlet %store-monad ((gtk-update-icon-cache
                        -> #~(string-append #+gtk+:bin
-                                           "/bin/gtk-update-icon-cache")))
-
-    (define build
+                                           "/bin/gtk-update-icon-cache"))
+                      (interested
+                       -> (filter
+                           (lambda (entry)
+                             (file-exists?
+                              (string-append (manifest-entry-item entry)
+                                             "/share/icons")))
+                           entries)))
+
+    (define (build items)
       (with-imported-modules '((guix build utils)
                                (guix build union)
                                (guix build profiles)
@@ -1365,9 +1358,8 @@ (define* (gtk-icon-themes manifest #:optional system)
                          (ice-9 ftw))
 
             (let* ((destdir  (string-append #$output "/share/icons"))
-                   (icondirs (filter file-exists?
-                                     (map (cut string-append <> "/share/icons")
-                                          '#$(manifest-inputs manifest)))))
+                   (icondirs (map (cut string-append <> "/share/icons")
+                                  '#$items)))
 
               ;; Union all the icons.
               (mkdir-p (string-append #$output "/share"))
@@ -1386,24 +1378,49 @@ (define* (gtk-icon-themes manifest #:optional system)
                (scandir destdir (negate (cut member <> '("." "..")))))))))
 
     ;; Don't run the hook when there's nothing to do.
-    (if %gtk+
-        (gexp->derivation "gtk-icon-themes" build
+    (if (null? interested)
+        (return #f)
+        (gexp->derivation "gtk-icon-themes"
+                          (build (map manifest-entry-item interested))
                           #:system system
                           #:local-build? #t
                           #:substitutable? #f
                           #:properties
                           `((type . profile-hook)
-                            (hook . gtk-icon-themes)))
-        (return #f))))
+                            (hook . gtk-icon-themes))))))
 
-(define* (gtk-im-modules manifest #:optional system)
+(define* (gtk-im-modules entries #:optional system)
   "Return a derivation that builds the cache files for input method modules
 for both major versions of GTK+."
+  (define pkg-gtk2                     ; lazy reference
+    (module-ref (resolve-interface '(gnu packages gtk)) 'gtk+-2))
+  (define pkg-gtk3                     ; lazy reference
+    (module-ref (resolve-interface '(gnu packages gtk)) 'gtk+))
 
-  (mlet %store-monad ((gtk+   (manifest-lookup-package manifest "gtk+" "3"))
-                      (gtk+-2 (manifest-lookup-package manifest "gtk+" "2")))
-
-    (define (build gtk gtk-version query)
+  (mlet %store-monad ((gtk2
+                       -> (or (and=> (find-entry entries "gtk+" "2")
+                                     manifest-entry-item)
+                              pkg-gtk2))
+                      (gtk3
+                       -> (or (and=> (find-entry entries "gtk+" "3")
+                                     manifest-entry-item)
+                              pkg-gtk3))
+                      (gtk2-entries
+                       -> (filter
+                           (lambda (entry)
+                             (file-exists?
+                              (string-append (manifest-entry-item entry)
+                                             "/lib/gtk-2.0/2.10.0/immodules")))
+                           entries))
+                      (gtk3-entries
+                       -> (filter
+                           (lambda (entry)
+                             (file-exists?
+                              (string-append (manifest-entry-item entry)
+                                             "/lib/gtk-3.0/3.0.0/immodules")))
+                           entries)))
+
+    (define (build gtk gtk-version query items)
       (let ((major (string-take gtk-version 1)))
         (with-imported-modules '((guix build utils)
                                  (guix build union)
@@ -1424,10 +1441,12 @@ (define* (gtk-im-modules manifest #:optional system)
                      (moddirs (cons (string-append #$gtk prefix "/immodules")
                                     (filter file-exists?
                                             (map (cut string-append <> prefix "/immodules")
-                                                 '#$(manifest-inputs manifest)))))
+                                                 '#$items))))
                      (modules (append-map (cut find-files <> "\\.so$")
                                           moddirs)))
 
+
+
                 ;; Generate a new immodules cache file.
                 (mkdir-p (string-append #$output prefix))
                 (let ((pipe    (apply open-pipe* OPEN_READ #$query modules))
@@ -1445,34 +1464,32 @@ (define* (gtk-im-modules manifest #:optional system)
                       (close-pipe pipe)))))))))
 
     ;; Don't run the hook when there's nothing to do.
-    (let* ((pkg-gtk+ (module-ref        ; lazy reference
-                      (resolve-interface '(gnu packages gtk)) 'gtk+))
-           (pkg-gtk+2 (module-ref        ; lazy reference
-                       (resolve-interface '(gnu packages gtk)) 'gtk+-2))
-           (gexp #~(begin
-                     #$(if gtk+
+    (let* ((gexp #~(begin
+                     #$(if (not (null? gtk3-entries))
                            (build
-                            gtk+ "3.0.0"
+                            gtk3 "3.0.0"
                             ;; Use 'gtk-query-immodules-3.0' from the 'bin'
                             ;; output of latest gtk+ package.
                             #~(string-append
-                               #$pkg-gtk+:bin "/bin/gtk-query-immodules-3.0"))
+                               #$pkg-gtk3:bin "/bin/gtk-query-immodules-3.0")
+                            (map manifest-entry-item gtk3-entries))
                            #t)
-                     #$(if gtk+-2
+                     #$(if (not (null? gtk2-entries))
                            (build
-                            gtk+-2 "2.10.0"
+                            gtk2 "2.10.0"
                             #~(string-append
-                               #$pkg-gtk+2:bin "/bin/gtk-query-immodules-2.0"))
+                               #$pkg-gtk2:bin "/bin/gtk-query-immodules-2.0")
+                            (map manifest-entry-item gtk2-entries))
                            #t))))
-      (if (or gtk+ gtk+-2)
+      (if (and (null? gtk2-entries) (null? gtk3-entries))
+          (return #f)
           (gexp->derivation "gtk-im-modules" gexp
                             #:system system
                             #:local-build? #t
                             #:substitutable? #f
                             #:properties
                             `((type . profile-hook)
-                              (hook . gtk-im-modules)))
-          (return #f)))))
+                              (hook . gtk-im-modules)))))))
 
 (define* (linux-module-database manifest #:optional system)
   "Return a derivation that unites all the kernel modules of the manifest
@@ -1534,7 +1551,7 @@ (define* (linux-module-database manifest #:optional system)
                     `((type . profile-hook)
                       (hook . linux-module-database))))
 
-(define* (xdg-desktop-database manifest #:optional system)
+(define* (xdg-desktop-database entries #:optional system)
   "Return a derivation that builds the @file{mimeinfo.cache} database from
 desktop files.  It's used to query what applications can handle a given
 MIME type."
@@ -1542,10 +1559,14 @@ (define* (xdg-desktop-database manifest #:optional system)
     (module-ref (resolve-interface '(gnu packages freedesktop))
                 'desktop-file-utils))
 
-  (mlet %store-monad ((glib
-                       (manifest-lookup-package
-                        manifest "glib")))
-    (define build
+  (mlet %store-monad ((interested
+                       -> (filter
+                           (lambda (entry)
+                             (file-exists?
+                              (string-append (manifest-entry-item entry)
+                                             "/share/applications")))
+                           entries)))
+    (define (build items)
       (with-imported-modules '((guix build utils)
                                (guix build union))
         #~(begin
@@ -1553,10 +1574,9 @@ (define* (xdg-desktop-database manifest #:optional system)
                          (guix build utils)
                          (guix build union))
             (let* ((destdir (string-append #$output "/share/applications"))
-                   (appdirs (filter file-exists?
-                                    (map (cut string-append <>
-                                              "/share/applications")
-                                         '#$(manifest-inputs manifest))))
+                   (appdirs (map (cut string-append <>
+                                      "/share/applications")
+                                 '#$items))
                    (update-desktop-database (string-append
                                              #+desktop-file-utils
                                              "/bin/update-desktop-database")))
@@ -1565,25 +1585,32 @@ (define* (xdg-desktop-database manifest #:optional system)
                            #:log-port (%make-void-port "w"))
               (exit (zero? (system* update-desktop-database destdir)))))))
 
-    ;; Don't run the hook when 'glib' is not referenced.
-    (if glib
-        (gexp->derivation "xdg-desktop-database" build
+    ;; Don't run the hook when there's nothing to do.
+    (if (null? interested)
+        (return #f)
+        (gexp->derivation "xdg-desktop-database"
+                          (build (map manifest-entry-item interested))
                           #:system system
                           #:local-build? #t
                           #:substitutable? #f
                           #:properties
                           `((type . profile-hook)
-                            (hook . xdg-desktop-database)))
-        (return #f))))
+                            (hook . xdg-desktop-database))))))
 
-(define* (xdg-mime-database manifest #:optional system)
+(define* (xdg-mime-database entries #:optional system)
   "Return a derivation that builds the @file{mime.cache} database from manifest
-entries.  It's used to query the MIME type of a given file."
+ENTRIES.  It's used to query the MIME type of a given file."
   (define shared-mime-info  ; lazy reference
     (module-ref (resolve-interface '(gnu packages freedesktop)) 'shared-mime-info))
 
-  (mlet %store-monad ((glib (manifest-lookup-package manifest "glib")))
-    (define build
+  (mlet %store-monad
+      ((interested -> (filter
+                       (lambda (entry)
+                         (file-exists?
+                          (string-append (manifest-entry-item entry)
+                                         "/share/mime/packages")))
+                       entries)))
+    (define (build items)
       (with-imported-modules  '((guix build utils)
                                 (guix build union))
         #~(begin
@@ -1594,11 +1621,10 @@ (define* (xdg-mime-database manifest #:optional system)
 
             (let* ((datadir (string-append #$output "/share"))
                    (destdir (string-append datadir "/mime"))
-                   (pkgdirs (filter file-exists?
-                                    (map (cut string-append <>
-                                              "/share/mime/packages")
-                                         (cons #+shared-mime-info
-                                               '#$(manifest-inputs manifest))))))
+                   (pkgdirs (map (cut string-append <>
+                                      "/share/mime/packages")
+                                 (cons #+shared-mime-info
+                                       '#$items))))
 
               (match pkgdirs
                 ((shared-mime-info)
@@ -1620,38 +1646,38 @@ (define* (xdg-mime-database manifest #:optional system)
                                         "/bin/update-mime-database")
                          destdir)))))))
 
-    ;; Don't run the hook when there are no GLib based applications.
-    (if glib
-        (gexp->derivation "xdg-mime-database" build
+    ;; Don't run the hook when there's nothing to do.
+    (if (null? interested)
+        (return #f)
+        (gexp->derivation "xdg-mime-database"
+                          (build (map manifest-entry-item interested))
                           #:system system
                           #:local-build? #t
                           #:substitutable? #f
                           #:properties
                           `((type . profile-hook)
-                            (hook . xdg-mime-database)))
-        (return #f))))
+                            (hook . xdg-mime-database))))))
 
 ;; Several font packages may install font files into same directory, so
 ;; fonts.dir and fonts.scale file should be generated here, instead of in
 ;; packages.
-(define* (fonts-dir-file manifest #:optional system)
+(define* (fonts-dir-file entries #:optional system)
   "Return a derivation that builds the @file{fonts.dir} and @file{fonts.scale}
-files for the fonts of the @var{manifest} entries."
+files for the fonts of the manifest @var{entries}."
   (define mkfontscale
     (module-ref (resolve-interface '(gnu packages xorg)) 'mkfontscale))
 
   (define mkfontdir
     (module-ref (resolve-interface '(gnu packages xorg)) 'mkfontdir))
 
-  (define build
+  (define (build items)
     #~(begin
         (use-modules (srfi srfi-26)
                      (guix build utils)
                      (guix build union))
-        (let ((fonts-dirs (filter file-exists?
-                                  (map (cut string-append <>
-                                            "/share/fonts")
-                                       '#$(manifest-inputs manifest)))))
+        (let ((fonts-dirs (map (cut string-append <>
+                                    "/share/fonts")
+                               '#$items)))
           (mkdir #$output)
           (if (null? fonts-dirs)
               (exit #t)
@@ -1694,20 +1720,31 @@ (define* (fonts-dir-file manifest #:optional system)
                                   (delete-file fonts-dir-file))))
                             directories)))))))
 
-  (gexp->derivation "fonts-dir" build
-                    #:system system
-                    #:modules '((guix build utils)
-                                (guix build union)
-                                (srfi srfi-26))
-                    #:local-build? #t
-                    #:substitutable? #f
-                    #:properties
-                    `((type . profile-hook)
-                      (hook . fonts-dir))))
+  (mlet %store-monad
+      ;; Only run this hook for entries which contains fonts.
+      ((interested -> (filter (lambda (entry)
+                                (file-exists?
+                                 (string-append (manifest-entry-item entry)
+                                                "/share/fonts")))
+                              entries)))
+    (if (null? interested)
+        (return #f)
+        (gexp->derivation "fonts-dir"
+                          (build (map manifest-entry-item interested))
+                          #:system system
+                          #:modules '((guix build utils)
+                                      (guix build union)
+                                      (srfi srfi-26))
+                          #:local-build? #t
+                          #:substitutable? #f
+                          #:properties
+                          `((type . profile-hook)
+                            (hook . fonts-dir))))))
 
-(define* (manual-database manifest #:optional system)
-  "Return a derivation that builds the manual page database (\"mandb\") for
-the entries in MANIFEST."
+(define* (manual-database entries #:optional system)
+  "Return a derivation that builds the manual page database (\"mandb\") for the
+manifest ENTRIES, but only if entries contains the \"man-db\" package.
+Otherwise, return #f."
   (define gdbm-ffi
     (module-ref (resolve-interface '(gnu packages guile))
                 'guile-gdbm-ffi))
@@ -1723,7 +1760,7 @@ (define* (manual-database manifest #:optional system)
             (source-module-closure `((guix build utils)
                                      (guix man-db)))))
 
-  (define build
+  (define (build items)
     (with-imported-modules modules
       (with-extensions (list gdbm-ffi           ;for (guix man-db)
                              guile-zlib
@@ -1756,7 +1793,7 @@ (define* (manual-database manifest #:optional system)
               ;; decompression), so report progress as we traverse INPUTS.
               ;; Cap at 4 threads because we don't see any speedup beyond that
               ;; on an SSD laptop.
-              (let* ((inputs  '#$(manifest-inputs manifest))
+              (let* ((inputs  '#$items)
                      (total   (length inputs))
                      (threads (min (parallel-job-count) 4)))
                 (concatenate
@@ -1784,27 +1821,27 @@ (define* (manual-database manifest #:optional system)
                          (* (time-nanosecond duration) (expt 10 -9))))
               (force-output))))))
 
-  (gexp->derivation "manual-database" build
-                    #:system system
-                    #:substitutable? #f
-                    #:local-build? #t
-                    #:properties
-                    `((type . profile-hook)
-                      (hook . manual-database))))
-
-(define* (manual-database/optional manifest #:optional system)
-  "Return a derivation to build the manual database of MANIFEST, but only if
-MANIFEST contains the \"man-db\" package.  Otherwise, return #f."
-  ;; Building the man database (for "man -k") is expensive and rarely used.
-  ;; Build it only if the profile also contains "man-db".
-  (mlet %store-monad ((man-db (manifest-lookup-package manifest "man-db")))
-    (if man-db
-        (manual-database manifest system)
+  (mlet %store-monad
+      ;; Only run this hook for entries which contains manual pages.
+      ((interested -> (filter (lambda (entry)
+                                (file-exists?
+                                 (string-append (manifest-entry-item entry)
+                                                "/share/man")))
+                              entries)))
+    (if (and (find-entry entries "man-db") (not (null? interested)))
+        (gexp->derivation "manual-database"
+                          (build (map manifest-entry-item interested))
+                          #:system system
+                          #:substitutable? #f
+                          #:local-build? #t
+                          #:properties
+                          `((type . profile-hook)
+                            (hook . manual-database)))
         (return #f))))
 
-(define* (texlive-font-maps manifest #:optional system)
-  "Return a derivation that builds the TeX Live font maps for the entries in
-MANIFEST."
+(define* (texlive-font-maps entries #:optional system)
+  "Return a derivation that builds the TeX Live font maps for the manifest
+ENTRIES."
   (define entry->texlive-input
     (match-lambda
       (($ <manifest-entry> name version output thing deps)
@@ -1818,7 +1855,7 @@ (define* (texlive-font-maps manifest #:optional system)
        (or (string=? "texlive-scripts" name)
            (any texlive-scripts-entry? deps)))))
   (define texlive-inputs
-    (append-map entry->texlive-input (manifest-entries manifest)))
+    (append-map entry->texlive-input entries))
   (define texlive-scripts
     (module-ref (resolve-interface '(gnu packages tex)) 'texlive-scripts))
   (define texlive-libkpathsea
@@ -1921,7 +1958,7 @@ (define* (texlive-font-maps manifest #:optional system)
     ;; `texlive-scripts' brings essential files to generate font maps.
     ;; Therefore, it must be present in the profile.  This check prevents
     ;; incomplete modular TeX Live installations to generate errors.
-    (if (any texlive-scripts-entry? (manifest-entries manifest))
+    (if (any texlive-scripts-entry? entries)
         (gexp->derivation "texlive-font-maps" build
                           #:system system
                           #:substitutable? #f
@@ -1935,7 +1972,7 @@ (define %default-profile-hooks
   ;; This is the list of derivation-returning procedures that are called by
   ;; default when making a non-empty profile.
   (list info-dir-file
-        manual-database/optional
+        manual-database
         fonts-dir-file
         ghc-package-cache-file
         ca-certificate-bundle
@@ -1999,10 +2036,20 @@ (define* (profile-derivation manifest
                                    (return #t)
                                    (check-for-collisions manifest system
                                                          #:target target)))
+                       ;; Build all the entries before running hooks.
+                       (entries (mapm/accumulate-builds
+                                 (lambda (entry)
+                                   (lower-manifest-entry entry system #:target target
+                                                         #:build? #t))
+                                 (manifest-transitive-entries manifest)))
+                       (entries -> (sort entries ;order can cause hook reruns
+                                         (lambda (e1 e2)
+                                           (string< (manifest-entry-item e1)
+                                                    (manifest-entry-item e2)))))
                        (extras (if (null? (manifest-entries manifest))
                                    (return '())
                                    (mapm/accumulate-builds (lambda (hook)
-                                                             (hook manifest
+                                                             (hook entries
                                                                    system))
                                                            hooks))))
     (define extra-inputs
-- 
2.47.1