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.
This commit is contained in:
parent
e46d517f6d
commit
aa46a028c4
@ -78,6 +78,7 @@
|
|||||||
|
|
||||||
profile-manifest
|
profile-manifest
|
||||||
package->manifest-entry
|
package->manifest-entry
|
||||||
|
%default-profile-hooks
|
||||||
profile-derivation
|
profile-derivation
|
||||||
generation-number
|
generation-number
|
||||||
generation-numbers
|
generation-numbers
|
||||||
@ -398,15 +399,12 @@ MANIFEST."
|
|||||||
(append-map info-files
|
(append-map info-files
|
||||||
'#$(manifest-inputs manifest)))))
|
'#$(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
|
(gexp->derivation "info-dir" build
|
||||||
#:modules '((guix build utils)))))
|
#:modules '((guix build utils))))
|
||||||
|
|
||||||
(define (ghc-package-cache-file manifest)
|
(define (ghc-package-cache-file manifest)
|
||||||
"Return a derivation that builds the GHC 'package.cache' file for all the
|
"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
|
(define ghc ;lazy reference
|
||||||
(module-ref (resolve-interface '(gnu packages haskell)) 'ghc))
|
(module-ref (resolve-interface '(gnu packages haskell)) 'ghc))
|
||||||
|
|
||||||
@ -446,12 +444,11 @@ entries of MANIFEST."
|
|||||||
success)))
|
success)))
|
||||||
|
|
||||||
;; Don't depend on GHC when there's nothing to do.
|
;; Don't depend on GHC when there's nothing to do.
|
||||||
(if (any (cut string-prefix? "ghc" <>)
|
(and (any (cut string-prefix? "ghc" <>)
|
||||||
(map manifest-entry-name (manifest-entries manifest)))
|
(map manifest-entry-name (manifest-entries manifest)))
|
||||||
(gexp->derivation "ghc-package-cache" build
|
(gexp->derivation "ghc-package-cache" build
|
||||||
#:modules '((guix build utils))
|
#:modules '((guix build utils))
|
||||||
#:local-build? #t)
|
#:local-build? #t)))
|
||||||
(gexp->derivation "ghc-package-cache" #~(mkdir #$output))))
|
|
||||||
|
|
||||||
(define (ca-certificate-bundle manifest)
|
(define (ca-certificate-bundle manifest)
|
||||||
"Return a derivation that builds a single-file bundle containing the CA
|
"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
|
(string-append result
|
||||||
"/ca-certificates.crt")))))
|
"/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
|
(gexp->derivation "ca-certificate-bundle" build
|
||||||
#:modules '((guix build utils))
|
#:modules '((guix build utils))
|
||||||
#:local-build? #t)))
|
#: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
|
(define* (profile-derivation manifest
|
||||||
#:key
|
#:key
|
||||||
(info-dir? #t)
|
(hooks %default-profile-hooks))
|
||||||
(ghc-package-cache? #t)
|
|
||||||
(ca-certificate-bundle? #t))
|
|
||||||
"Return a derivation that builds a profile (aka. 'user environment') with
|
"Return a derivation that builds a profile (aka. 'user environment') with
|
||||||
the given MANIFEST. The profile includes a top-level Info 'dir' file unless
|
the given MANIFEST. The profile includes additional derivations returned by
|
||||||
INFO-DIR? is #f, a GHC 'package.cache' file unless GHC-PACKAGE-CACHE? is #f
|
the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
|
||||||
and a single-file CA certificate bundle unless CA-CERTIFICATE-BUNDLE? is #f."
|
(mlet %store-monad ((extras (if (null? (manifest-entries manifest))
|
||||||
(mlet %store-monad ((info-dir (if info-dir?
|
(return '())
|
||||||
(info-dir-file manifest)
|
(sequence %store-monad
|
||||||
(return #f)))
|
(filter-map (lambda (hook)
|
||||||
(ghc-package-cache (if ghc-package-cache?
|
(hook manifest))
|
||||||
(ghc-package-cache-file manifest)
|
hooks)))))
|
||||||
(return #f)))
|
|
||||||
(ca-cert-bundle (if ca-certificate-bundle?
|
|
||||||
(ca-certificate-bundle manifest)
|
|
||||||
(return #f))))
|
|
||||||
(define inputs
|
(define inputs
|
||||||
(append (if info-dir
|
(append (map gexp-input extras)
|
||||||
(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))
|
|
||||||
'())
|
|
||||||
(manifest-inputs manifest)))
|
(manifest-inputs manifest)))
|
||||||
|
|
||||||
(define builder
|
(define builder
|
||||||
|
@ -855,9 +855,9 @@ more information.~%"))
|
|||||||
(let* ((prof-drv (run-with-store (%store)
|
(let* ((prof-drv (run-with-store (%store)
|
||||||
(profile-derivation
|
(profile-derivation
|
||||||
new
|
new
|
||||||
#:info-dir? (not bootstrap?)
|
#:hooks (if bootstrap?
|
||||||
#:ghc-package-cache? (not bootstrap?)
|
'()
|
||||||
#:ca-certificate-bundle? (not bootstrap?))))
|
%default-profile-hooks))))
|
||||||
(prof (derivation->output-path prof-drv)))
|
(prof (derivation->output-path prof-drv)))
|
||||||
(show-manifest-transaction (%store) manifest transaction
|
(show-manifest-transaction (%store) manifest transaction
|
||||||
#:dry-run? dry-run?)
|
#:dry-run? dry-run?)
|
||||||
|
@ -599,9 +599,7 @@
|
|||||||
(profile-derivation
|
(profile-derivation
|
||||||
(manifest (map package->manifest-entry
|
(manifest (map package->manifest-entry
|
||||||
(list p1 p2)))
|
(list p1 p2)))
|
||||||
#:info-dir? #f
|
#:hooks '())
|
||||||
#:ghc-package-cache? #f
|
|
||||||
#:ca-certificate-bundle? #f)
|
|
||||||
#:guile-for-build (%guile-for-build))))
|
#:guile-for-build (%guile-for-build))))
|
||||||
(build-derivations %store (list prof))
|
(build-derivations %store (list prof))
|
||||||
(string-match (format #f "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n"
|
(string-match (format #f "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n"
|
||||||
|
@ -183,9 +183,7 @@
|
|||||||
((entry -> (package->manifest-entry %bootstrap-guile))
|
((entry -> (package->manifest-entry %bootstrap-guile))
|
||||||
(guile (package->derivation %bootstrap-guile))
|
(guile (package->derivation %bootstrap-guile))
|
||||||
(drv (profile-derivation (manifest (list entry))
|
(drv (profile-derivation (manifest (list entry))
|
||||||
#:info-dir? #f
|
#:hooks '()))
|
||||||
#:ghc-package-cache? #f
|
|
||||||
#:ca-certificate-bundle? #f))
|
|
||||||
(profile -> (derivation->output-path drv))
|
(profile -> (derivation->output-path drv))
|
||||||
(bindir -> (string-append profile "/bin"))
|
(bindir -> (string-append profile "/bin"))
|
||||||
(_ (built-derivations (list drv))))
|
(_ (built-derivations (list drv))))
|
||||||
@ -197,9 +195,7 @@
|
|||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((entry -> (package->manifest-entry packages:glibc "debug"))
|
((entry -> (package->manifest-entry packages:glibc "debug"))
|
||||||
(drv (profile-derivation (manifest (list entry))
|
(drv (profile-derivation (manifest (list entry))
|
||||||
#:info-dir? #f
|
#:hooks '())))
|
||||||
#:ghc-package-cache? #f
|
|
||||||
#:ca-certificate-bundle? #f)))
|
|
||||||
(return (derivation-inputs drv))))
|
(return (derivation-inputs drv))))
|
||||||
|
|
||||||
(test-end "profiles")
|
(test-end "profiles")
|
||||||
|
Loading…
Reference in New Issue
Block a user