kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

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

Browse Source 
* 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:
Ludovic Courtès 2015-04-15 22:44:51 +02:00
parent e46d517f6d
commit aa46a028c4
4 changed files with 35 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
guix/profiles.scm
View File

@ -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. (gexp->derivation "info-dir" build
(if (null? (manifest-entries manifest)) #:modules '((guix build utils))))
(gexp->derivation "info-dir" #~(mkdir #$output))
(gexp->derivation "info-dir" build
#: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 (gexp->derivation "ca-certificate-bundle" build
;; nothing to do. #:modules '((guix build utils))
(if (null? (manifest-entries manifest)) #:local-build? #t))
(gexp->derivation "ca-certificate-bundle" #~(mkdir #$output))
(gexp->derivation "ca-certificate-bundle" build (define %default-profile-hooks
#:modules '((guix build utils)) ;; This is the list of derivation-returning procedures that are called by
#:local-build? #t))) ;; 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

6
guix/scripts/package.scm
View File

@ -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?)

4
tests/packages.scm
View File

@ -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"

8
tests/profiles.scm
View File

@ -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")