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}).
|
||||
@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
|
||||
* package Reference :: The package 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{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
|
||||
|
||||
@node Additional Build Options
|
||||
|
|
|
@ -94,6 +94,7 @@
|
|||
package-transitive-propagated-inputs
|
||||
package-transitive-native-search-paths
|
||||
package-transitive-supported-systems
|
||||
package-input-rewriting
|
||||
package-source-derivation
|
||||
package-derivation
|
||||
package-cross-derivation
|
||||
|
@ -732,6 +733,35 @@ dependencies are known to build on SYSTEM."
|
|||
"Return the \"target inputs\" of BAG, recursively."
|
||||
(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.
|
||||
|
|
|
@ -742,6 +742,31 @@
|
|||
(and (build-derivations %store (list drv))
|
||||
(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
|
||||
(fold-packages (lambda (p r)
|
||||
(if (string=? (package-name p) "hello")
|
||||
|
|
Loading…
Reference in New Issue