packages: Move grafting parameter to (guix derivations).

* guix/packages.scm (%graft?, set-grafting): Move to...
* guix/derivations.scm: ... here.
This commit is contained in:
Ludovic Courtès 2015-03-17 21:46:00 +01:00
parent bcb1328763
commit 9d8100f4c7
2 changed files with 16 additions and 13 deletions

View File

@ -97,6 +97,9 @@
build-derivations build-derivations
built-derivations built-derivations
%graft?
set-grafting
build-expression->derivation) build-expression->derivation)
;; Re-export it from here for backward compatibility. ;; Re-export it from here for backward compatibility.
@ -1287,3 +1290,16 @@ ALLOWED-REFERENCES, and LOCAL-BUILD?."
(define built-derivations (define built-derivations
(store-lift build-derivations)) (store-lift build-derivations))
;; The following might feel more at home in (guix packages) but since (guix
;; gexp), which is a lower level, needs them, we put them here.
(define %graft?
;; Whether to honor package grafts by default.
(make-parameter #t))
(define (set-grafting enable?)
"This monadic procedure enables grafting when ENABLE? is true, and disables
it otherwise. It returns the previous setting."
(lambda (store)
(values (%graft? enable?) store)))

View File

@ -103,7 +103,6 @@
&package-cross-build-system-error &package-cross-build-system-error
package-cross-build-system-error? package-cross-build-system-error?
%graft?
package->bag package->bag
bag->derivation bag->derivation
bag-transitive-inputs bag-transitive-inputs
@ -112,9 +111,7 @@
bag-transitive-target-inputs bag-transitive-target-inputs
default-guile default-guile
set-guile-for-build set-guile-for-build
set-grafting
package-file package-file
package->derivation package->derivation
package->cross-derivation package->cross-derivation
@ -678,10 +675,6 @@ information in exceptions."
(package package) (package package)
(input x))))))) (input x)))))))
(define %graft?
;; Whether to honor package grafts by default.
(make-parameter #t))
(define* (package->bag package #:optional (define* (package->bag package #:optional
(system (%current-system)) (system (%current-system))
(target (%current-target-system)) (target (%current-target-system))
@ -918,12 +911,6 @@ code of derivations to GUILE, a package object."
(let ((guile (package-derivation store guile))) (let ((guile (package-derivation store guile)))
(values (%guile-for-build guile) store)))) (values (%guile-for-build guile) store))))
(define (set-grafting enable?)
"This monadic procedure enables grafting when ENABLE? is true, and disables
it otherwise. It returns the previous setting."
(lambda (store)
(values (%graft? enable?) store)))
(define* (package-file package (define* (package-file package
#:optional file #:optional file
#:key #:key