profiles: Generalize "hooks" for 'profile-derivation'.

* guix/profiles.scm (info-dir-file): Remove (null? (manifest-entries
  manifest)) test.
  (ca-certificate-bundle): Likewise.
  (ghc-package-cache-file): Turn 'if' into 'and', and remove second
  arm.
  (%default-profile-hooks): New variable.
  (profile-derivation): Remove #:info-dir?, #:ghc-package-cache?, and
  #:ca-certificate-bundle?.  Add #:hooks.  Iterate over HOOKS.  Adjust
  'inputs' accordingly.
* guix/scripts/package.scm (guix-package): Adjust 'profile-derivation'
  call accordingly.
* tests/packages.scm ("--search-paths with pattern"): Likewise.
* tests/profiles.scm ("profile-derivation",
  "profile-derivation, inputs"): Likewise.

4 files changed, 35 insertions, 55 deletions

diff --git a/guix/profiles.scm b/guix/profiles.scm
index a2f63d1cca..620feff97e 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -78,6 +78,7 @@
 
             profile-manifest
             package->manifest-entry
+            %default-profile-hooks
             profile-derivation
             generation-number
             generation-numbers
@@ -398,15 +399,12 @@ MANIFEST."
                (append-map info-files
                            '#$(manifest-inputs manifest)))))
 
-  ;; Don't depend on Texinfo when there's nothing to do.
-  (if (null? (manifest-entries manifest))
-      (gexp->derivation "info-dir" #~(mkdir #$output))
-      (gexp->derivation "info-dir" build
-                        #:modules '((guix build utils)))))
+  (gexp->derivation "info-dir" build
+                    #:modules '((guix build utils))))
 
 (define (ghc-package-cache-file manifest)
   "Return a derivation that builds the GHC 'package.cache' file for all the
-entries of MANIFEST."
+entries of MANIFEST, or #f if MANIFEST does not have any GHC packages."
   (define ghc                                 ;lazy reference
     (module-ref (resolve-interface '(gnu packages haskell)) 'ghc))
 
@@ -446,12 +444,11 @@ entries of MANIFEST."
           success)))
 
   ;; 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
-                        #:modules '((guix build utils))
-                        #:local-build? #t)
-      (gexp->derivation "ghc-package-cache" #~(mkdir #$output))))
+  (and (any (cut string-prefix? "ghc" <>)
+            (map manifest-entry-name (manifest-entries manifest)))
+       (gexp->derivation "ghc-package-cache" build
+                         #:modules '((guix build utils))
+                         #:local-build? #t)))
 
 (define (ca-certificate-bundle manifest)
   "Return a derivation that builds a single-file bundle containing the CA
@@ -503,42 +500,31 @@ MANIFEST.  Single-file bundles are required by programs such as Git and Lynx."
                              (string-append result
                                             "/ca-certificates.crt")))))
 
-  ;; Don't depend on 'glibc-utf8-locales' and its dependencies when there's
-  ;; nothing to do.
-  (if (null? (manifest-entries manifest))
-      (gexp->derivation "ca-certificate-bundle" #~(mkdir #$output))
-      (gexp->derivation "ca-certificate-bundle" build
-                        #:modules '((guix build utils))
-                        #:local-build? #t)))
+  (gexp->derivation "ca-certificate-bundle" build
+                    #:modules '((guix build utils))
+                    #:local-build? #t))
+
+(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
+        ghc-package-cache-file
+        ca-certificate-bundle))
 
 (define* (profile-derivation manifest
                              #:key
-                             (info-dir? #t)
-                             (ghc-package-cache? #t)
-                             (ca-certificate-bundle? #t))
+                             (hooks %default-profile-hooks))
   "Return a derivation that builds a profile (aka. 'user environment') with
-the given MANIFEST.  The profile includes a top-level Info 'dir' file unless
-INFO-DIR? is #f, a GHC 'package.cache' file unless GHC-PACKAGE-CACHE? is #f
-and a single-file CA certificate bundle unless CA-CERTIFICATE-BUNDLE? is #f."
-  (mlet %store-monad ((info-dir (if info-dir?
-                                    (info-dir-file manifest)
-                                    (return #f)))
-                      (ghc-package-cache (if ghc-package-cache?
-                                             (ghc-package-cache-file manifest)
-                                             (return #f)))
-                      (ca-cert-bundle (if ca-certificate-bundle?
-                                          (ca-certificate-bundle manifest)
-                                          (return #f))))
+the given MANIFEST.  The profile includes additional derivations returned by
+the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
+  (mlet %store-monad ((extras (if (null? (manifest-entries manifest))
+                                  (return '())
+                                  (sequence %store-monad
+                                            (filter-map (lambda (hook)
+                                                          (hook manifest))
+                                                        hooks)))))
     (define inputs
-      (append (if info-dir
-                  (list (gexp-input info-dir))
-                  '())
-              (if ghc-package-cache
-                  (list (gexp-input ghc-package-cache))
-                  '())
-              (if ca-cert-bundle
-                  (list (gexp-input ca-cert-bundle))
-                  '())
+      (append (map gexp-input extras)
               (manifest-inputs manifest)))
 
     (define builder
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 53813c14ab..5ee3a89ba6 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -855,9 +855,9 @@ more information.~%"))
                (let* ((prof-drv (run-with-store (%store)
                                   (profile-derivation
                                    new
-                                   #:info-dir? (not bootstrap?)
-                                   #:ghc-package-cache? (not bootstrap?)
-                                   #:ca-certificate-bundle? (not bootstrap?))))
+                                   #:hooks (if bootstrap?
+                                               '()
+                                               %default-profile-hooks))))
                       (prof     (derivation->output-path prof-drv)))
                  (show-manifest-transaction (%store) manifest transaction
                                             #:dry-run? dry-run?)
diff --git a/tests/packages.scm b/tests/packages.scm
index 4e3a116cb8..d7c169a585 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -599,9 +599,7 @@
                  (profile-derivation
                   (manifest (map package->manifest-entry
                                  (list p1 p2)))
-                  #:info-dir? #f
-                  #:ghc-package-cache? #f
-                  #:ca-certificate-bundle? #f)
+                  #:hooks '())
                  #:guile-for-build (%guile-for-build))))
     (build-derivations %store (list prof))
     (string-match (format #f "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n"
diff --git a/tests/profiles.scm b/tests/profiles.scm
index d20cb9d808..54fbaea864 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -183,9 +183,7 @@
       ((entry ->   (package->manifest-entry %bootstrap-guile))
        (guile      (package->derivation %bootstrap-guile))
        (drv        (profile-derivation (manifest (list entry))
-                                       #:info-dir? #f
-                                       #:ghc-package-cache? #f
-                                       #:ca-certificate-bundle? #f))
+                                       #:hooks '()))
        (profile -> (derivation->output-path drv))
        (bindir ->  (string-append profile "/bin"))
        (_          (built-derivations (list drv))))
@@ -197,9 +195,7 @@
   (mlet* %store-monad
       ((entry ->   (package->manifest-entry packages:glibc "debug"))
        (drv        (profile-derivation (manifest (list entry))
-                                       #:info-dir? #f
-                                       #:ghc-package-cache? #f
-                                       #:ca-certificate-bundle? #f)))
+                                       #:hooks '())))
     (return (derivation-inputs drv))))
 
 (test-end "profiles")