~ruther/guix-local

5316e84e1b52cb96bf580552e654fe5b56720c47 — Ludovic Courtès 1 year, 10 months ago 2767b4e
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
3 files changed, 42 insertions(+), 3 deletions(-)

M doc/guix.texi
M guix/packages.scm
M tests/packages.scm
M doc/guix.texi => doc/guix.texi +5 -1
@@ 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

M guix/packages.scm => guix/packages.scm +7 -2
@@ 1585,12 1585,16 @@ applied to implicit inputs as well."

(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 @@ package and returns its new name after rewrite."

  (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?))

M tests/packages.scm => tests/packages.scm +30 -0
@@ 1501,6 1501,36 @@
      ((("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)))))