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
@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
indirect dependencies, including implicit inputs when @var{deep?} is
true, 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.
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
the name of a package and returns its new name after rewrite.
@end deffn

View file

@ -1585,12 +1585,16 @@ (define replace
(define* (package-input-rewriting replacements
#:optional (rewrite-name identity)
#:key (deep? #t))
#:key (deep? #t)
(recursive? #f))
"Return a procedure that, when passed a package, replaces its direct and
indirect dependencies, including implicit inputs when DEEP? is true, 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.
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
package and returns its new name after rewrite."
(define replacement-property
@ -1611,7 +1615,8 @@ (define (rewrite p)
(define (cut? p)
(or (assq-ref (package-properties p) replacement-property)
(assq-ref replacements p)))
(and (not recursive?)
(assq-ref replacements p))))
(package-mapping rewrite cut?
#:deep? deep?))

View file

@ -1501,6 +1501,36 @@ (define right-system?
((("python" 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"
(let* ((dep (dummy-package "chbouib"
(native-inputs `(("x" ,grep)))))