aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi42
-rw-r--r--guix/packages.scm30
-rw-r--r--tests/packages.scm25
3 files changed, 96 insertions, 1 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 5448c66664..2a7fd4d041 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
diff --git a/guix/packages.scm b/guix/packages.scm
index 3646b9ba13..d544c34cf8 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -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.
diff --git a/tests/packages.scm b/tests/packages.scm
index e9c8690730..daceea5d62 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -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")