[bug#74888] [PATCH 1/3] packages: Add #:recursive? to ‘package-input-rewriting’.

[Ludovic Courtès]

* 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
---
 doc/guix.texi      |  6 +++++-
 guix/packages.scm  |  9 +++++++--
 tests/packages.scm | 32 +++++++++++++++++++++++++++++++-
 3 files changed, 43 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a2915de954..995ff5ad4e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8653,13 +8653,17 @@ Defining Package Variants
 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
diff --git a/guix/packages.scm b/guix/packages.scm
index 0ce3276051..75271b7a05 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1582,12 +1582,16 @@ (define* (package-mapping proc #:optional (cut? (const 
#f))
 
 (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
@@ -1608,7 +1612,8 @@ (define* (package-input-rewriting replacements
 
   (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?))
diff --git a/tests/packages.scm b/tests/packages.scm
index 7c28e75c45..6417bc79de 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
@@ -1501,6 +1501,36 @@ (define compressors '(("gzip"  . "gz")
       ((("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)))))
-- 
2.46.0