packages: Add 'package-input-rewriting'.
* guix/packages.scm (package-input-rewriting): New procedure. * tests/packages.scm ("package-input-rewriting"): New test. * doc/guix.texi (Defining Packages): Document it. (Package Transformation Options): Add cross-reference.
This commit is contained in:
parent
705b971477
commit
2a75b0b63d
|
@ -2574,6 +2574,45 @@ and operating system, such as @code{"mips64el-linux-gnu"}
|
||||||
Configure and Build System}).
|
Configure and Build System}).
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
|
@cindex package transformations
|
||||||
|
@cindex input rewriting
|
||||||
|
@cindex dependency tree rewriting
|
||||||
|
Packages can be manipulated in arbitrary ways. An example of a useful
|
||||||
|
transformation is @dfn{input rewriting}, whereby the dependency tree of
|
||||||
|
a package is rewritten by replacing specific inputs by others:
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} package-input-rewriting @var{replacements} @
|
||||||
|
[@var{rewrite-name}]
|
||||||
|
Return a procedure that, when passed a package, replaces its direct and
|
||||||
|
indirect dependencies (but not its implicit inputs) according to
|
||||||
|
@var{replacements}. @var{replacements} is a list of package pairs; the
|
||||||
|
first element of each pair is the package to replace, and the second one
|
||||||
|
is the replacement.
|
||||||
|
|
||||||
|
Optionally, @var{rewrite-name} is a one-argument procedure that takes
|
||||||
|
the name of a package and returns its new name after rewrite.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@noindent
|
||||||
|
Consider this example:
|
||||||
|
|
||||||
|
@example
|
||||||
|
(define libressl-instead-of-openssl
|
||||||
|
;; This is a procedure to replace OPENSSL by LIBRESSL,
|
||||||
|
;; recursively.
|
||||||
|
(package-input-rewriting `((,openssl . ,libressl))))
|
||||||
|
|
||||||
|
(define git-with-libressl
|
||||||
|
(libressl-instead-of-openssl git))
|
||||||
|
@end example
|
||||||
|
|
||||||
|
@noindent
|
||||||
|
Here we first define a rewriting procedure that replaces @var{openssl}
|
||||||
|
with @var{libressl}. Then we use it to define a @dfn{variant} of the
|
||||||
|
@var{git} package that uses @var{libressl} instead of @var{openssl}.
|
||||||
|
This is exactly what the @option{--with-input} command-line option does
|
||||||
|
(@pxref{Package Transformation Options, @option{--with-input}}).
|
||||||
|
|
||||||
@menu
|
@menu
|
||||||
* package Reference :: The package data type.
|
* package Reference :: The package data type.
|
||||||
* origin Reference:: The origin data type.
|
* origin Reference:: The origin data type.
|
||||||
|
@ -4362,7 +4401,8 @@ This is a recursive, deep replacement. So in this example, both
|
||||||
@code{guix} and its dependency @code{guile-json} (which also depends on
|
@code{guix} and its dependency @code{guile-json} (which also depends on
|
||||||
@code{guile}) get rebuilt against @code{guile-next}.
|
@code{guile}) get rebuilt against @code{guile-next}.
|
||||||
|
|
||||||
However, implicit inputs are left unchanged.
|
This is implemented using the @code{package-input-rewriting} Scheme
|
||||||
|
procedure (@pxref{Defining Packages, @code{package-input-rewriting}}).
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
@node Additional Build Options
|
@node Additional Build Options
|
||||||
|
|
|
@ -94,6 +94,7 @@
|
||||||
package-transitive-propagated-inputs
|
package-transitive-propagated-inputs
|
||||||
package-transitive-native-search-paths
|
package-transitive-native-search-paths
|
||||||
package-transitive-supported-systems
|
package-transitive-supported-systems
|
||||||
|
package-input-rewriting
|
||||||
package-source-derivation
|
package-source-derivation
|
||||||
package-derivation
|
package-derivation
|
||||||
package-cross-derivation
|
package-cross-derivation
|
||||||
|
@ -732,6 +733,35 @@ dependencies are known to build on SYSTEM."
|
||||||
"Return the \"target inputs\" of BAG, recursively."
|
"Return the \"target inputs\" of BAG, recursively."
|
||||||
(transitive-inputs (bag-target-inputs bag)))
|
(transitive-inputs (bag-target-inputs bag)))
|
||||||
|
|
||||||
|
(define* (package-input-rewriting replacements
|
||||||
|
#:optional (rewrite-name identity))
|
||||||
|
"Return a procedure that, when passed a package, replaces its direct and
|
||||||
|
indirect dependencies (but not its implicit inputs) according to REPLACEMENTS.
|
||||||
|
REPLACEMENTS is a list of package pairs; the first element of each pair is the
|
||||||
|
package to replace, and the second one is the replacement.
|
||||||
|
|
||||||
|
Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a
|
||||||
|
package and returns its new name after rewrite."
|
||||||
|
(define (rewrite input)
|
||||||
|
(match input
|
||||||
|
((label (? package? package) outputs ...)
|
||||||
|
(match (assq-ref replacements package)
|
||||||
|
(#f (cons* label (replace package) outputs))
|
||||||
|
(new (cons* label new outputs))))
|
||||||
|
(_
|
||||||
|
input)))
|
||||||
|
|
||||||
|
(define-memoized/v (replace p)
|
||||||
|
"Return a variant of P with its inputs rewritten."
|
||||||
|
(package
|
||||||
|
(inherit p)
|
||||||
|
(name (rewrite-name (package-name p)))
|
||||||
|
(inputs (map rewrite (package-inputs p)))
|
||||||
|
(native-inputs (map rewrite (package-native-inputs p)))
|
||||||
|
(propagated-inputs (map rewrite (package-propagated-inputs p)))))
|
||||||
|
|
||||||
|
replace)
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Package derivations.
|
;;; Package derivations.
|
||||||
|
|
|
@ -742,6 +742,31 @@
|
||||||
(and (build-derivations %store (list drv))
|
(and (build-derivations %store (list drv))
|
||||||
(file-exists? (string-append out "/bin/make")))))))
|
(file-exists? (string-append out "/bin/make")))))))
|
||||||
|
|
||||||
|
(test-assert "package-input-rewriting"
|
||||||
|
(let* ((dep (dummy-package "chbouib"
|
||||||
|
(native-inputs `(("x" ,grep)))))
|
||||||
|
(p0 (dummy-package "example"
|
||||||
|
(inputs `(("foo" ,coreutils)
|
||||||
|
("bar" ,grep)
|
||||||
|
("baz" ,dep)))))
|
||||||
|
(rewrite (package-input-rewriting `((,coreutils . ,sed)
|
||||||
|
(,grep . ,findutils))
|
||||||
|
(cut string-append "r-" <>)))
|
||||||
|
(p1 (rewrite p0))
|
||||||
|
(p2 (rewrite p0)))
|
||||||
|
(and (not (eq? p1 p0))
|
||||||
|
(eq? p1 p2) ;memoization
|
||||||
|
(string=? "r-example" (package-name p1))
|
||||||
|
(match (package-inputs p1)
|
||||||
|
((("foo" dep1) ("bar" dep2) ("baz" dep3))
|
||||||
|
(and (eq? dep1 sed)
|
||||||
|
(eq? dep2 findutils)
|
||||||
|
(string=? (package-name dep3) "r-chbouib")
|
||||||
|
(eq? dep3 (rewrite dep)) ;memoization
|
||||||
|
(match (package-native-inputs dep3)
|
||||||
|
((("x" dep))
|
||||||
|
(eq? dep findutils)))))))))
|
||||||
|
|
||||||
(test-eq "fold-packages" hello
|
(test-eq "fold-packages" hello
|
||||||
(fold-packages (lambda (p r)
|
(fold-packages (lambda (p r)
|
||||||
(if (string=? (package-name p) "hello")
|
(if (string=? (package-name p) "hello")
|
||||||
|
|
Loading…
Reference in New Issue