diff options
| -rw-r--r-- | doc/guix.texi | 42 | ||||
| -rw-r--r-- | guix/packages.scm | 30 | ||||
| -rw-r--r-- | tests/packages.scm | 25 |
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") |