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.
master
Ludovic Courtès 2016-09-01 22:35:35 +02:00
parent 705b971477
commit 2a75b0b63d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 96 additions and 1 deletions

View File

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

View File

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

View File

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