packages: Add #:recursive? to ‘package-input-rewriting’.

* guix/packages.scm (package-input-rewriting): Add #:recursive?
[cut?]: Honor it.
* tests/packages.scm ("package-input-rewriting, recursive"): New test.
* doc/guix.texi (Defining Package Variants): Document it.

Change-Id: Ie82f35ae0ae873dc68f8b1c0dd6616f552772e65
This commit is contained in:
Ludovic Courtès 2024-12-14 23:07:26 +01:00
parent 2767b4ef03
commit 5316e84e1b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 42 additions and 3 deletions

View file

@ -8665,13 +8665,17 @@ Dependency graph rewriting, for the purposes of swapping packages in the
graph, is what the @code{package-input-rewriting} procedure in graph, is what the @code{package-input-rewriting} procedure in
@code{(guix packages)} implements. @code{(guix packages)} implements.
@deffn {Procedure} package-input-rewriting replacements [rewrite-name] [#:deep? #t] @deffn {Procedure} package-input-rewriting replacements [rewrite-name] @
[#:deep? #t] [#:recursive? #f]
Return a procedure that, when passed a package, replaces its direct and Return a procedure that, when passed a package, replaces its direct and
indirect dependencies, including implicit inputs when @var{deep?} is indirect dependencies, including implicit inputs when @var{deep?} is
true, according to @var{replacements}. @var{replacements} is a list of true, according to @var{replacements}. @var{replacements} is a list of
package pairs; the first element of each pair is the package to replace, package pairs; the first element of each pair is the package to replace,
and the second one is the replacement. and the second one is the replacement.
When @var{recursive?} is true, apply replacements to the right-hand sides of
@var{replacements} as well, recursively.
Optionally, @var{rewrite-name} is a one-argument procedure that takes Optionally, @var{rewrite-name} is a one-argument procedure that takes
the name of a package and returns its new name after rewrite. the name of a package and returns its new name after rewrite.
@end deffn @end deffn

View file

@ -1585,12 +1585,16 @@ (define replace
(define* (package-input-rewriting replacements (define* (package-input-rewriting replacements
#:optional (rewrite-name identity) #:optional (rewrite-name identity)
#:key (deep? #t)) #:key (deep? #t)
(recursive? #f))
"Return a procedure that, when passed a package, replaces its direct and "Return a procedure that, when passed a package, replaces its direct and
indirect dependencies, including implicit inputs when DEEP? is true, according indirect dependencies, including implicit inputs when DEEP? is true, according
to REPLACEMENTS. REPLACEMENTS is a list of package pairs; the first element 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. of each pair is the package to replace, and the second one is the replacement.
When RECURSIVE? is true, apply replacements to the right-hand sides of
REPLACEMENTS as well, recursively.
Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a
package and returns its new name after rewrite." package and returns its new name after rewrite."
(define replacement-property (define replacement-property
@ -1611,7 +1615,8 @@ (define (rewrite p)
(define (cut? p) (define (cut? p)
(or (assq-ref (package-properties p) replacement-property) (or (assq-ref (package-properties p) replacement-property)
(assq-ref replacements p))) (and (not recursive?)
(assq-ref replacements p))))
(package-mapping rewrite cut? (package-mapping rewrite cut?
#:deep? deep?)) #:deep? deep?))

View file

@ -1501,6 +1501,36 @@ (define right-system?
((("python" python) _ ...) ((("python" python) _ ...)
(derivation-file-name (package-derivation %store python)))))) (derivation-file-name (package-derivation %store python))))))
(test-assert "package-input-rewriting, recursive"
(let* ((dep (dummy-package "dep" (native-inputs (list grep))))
(p0 (dummy-package "example1" (inputs (list dep grep))))
(p1 (dummy-package "example2" (inputs (list dep grep))))
(replacements `((,grep . ,findutils) (,p0 . ,p1)))
(rewrite (package-input-rewriting replacements))
(rewrite/recursive (package-input-rewriting replacements
#:recursive? #t))
(p2 (rewrite p0))
(p3 (rewrite/recursive p0)))
(and (string=? (package-name p2) "example2")
;; Here P0 is replaced by P1, but P1 itself is kept unchanged.
(match (package-inputs p2)
((("dep" dep1) ("grep" dep2))
(and (match (package-native-inputs dep1)
((("grep" x)) (eq? x grep)))
(eq? dep2 grep))))
;; Here P0 is replaced by P1, and in addition references to GREP in
;; P1 and its dependencies are also replaced by FINDUTILS.
(string=? (package-name p3) "example2")
(match (package-inputs p3)
((("dep" dep1) ("grep" dep2))
(and (match (package-native-inputs dep1)
((("grep" x))
(string=? (package-full-name x)
(package-full-name findutils))))
(string=? (package-full-name dep2)
(package-full-name findutils))))))))
(test-assert "package-input-rewriting/spec" (test-assert "package-input-rewriting/spec"
(let* ((dep (dummy-package "chbouib" (let* ((dep (dummy-package "chbouib"
(native-inputs `(("x" ,grep))))) (native-inputs `(("x" ,grep)))))