From f258d8862852db9779945658b3a3f2b8a2a4c217 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 12 Mar 2019 21:39:48 +0100
Subject: packages: Add 'package-input-rewriting/spec'.

* guix/packages.scm (package-input-rewriting/spec): New procedure.
* tests/packages.scm ("package-input-rewriting/spec")
("package-input-rewriting/spec, partial match"): New tests.
* doc/guix.texi (Defining Packages): Document it.
---
 guix/packages.scm | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

(limited to 'guix')

diff --git a/guix/packages.scm b/guix/packages.scm
index f191327718..d20a2562c3 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -102,6 +102,7 @@ (define-module (guix packages)
             package-transitive-supported-systems
             package-mapping
             package-input-rewriting
+            package-input-rewriting/spec
             package-source-derivation
             package-derivation
             package-cross-derivation
@@ -869,6 +870,43 @@ (define (rewrite p)
 
   (package-mapping rewrite (cut assq <> replacements)))
 
+(define (package-input-rewriting/spec replacements)
+  "Return a procedure that, given a package, applies the given REPLACEMENTS to
+all the package graph (excluding implicit inputs).  REPLACEMENTS is a list of
+spec/procedures pair; each spec is a package specification such as \"gcc\" or
+\"guile@2\", and each procedure takes a matching package and returns a
+replacement for that package."
+  (define table
+    (fold (lambda (replacement table)
+            (match replacement
+              ((spec . proc)
+               (let-values (((name version)
+                             (package-name->name+version spec)))
+                 (vhash-cons name (list version proc) table)))))
+          vlist-null
+          replacements))
+
+  (define (find-replacement package)
+    (vhash-fold* (lambda (item proc)
+                   (or proc
+                       (match item
+                         ((#f proc)
+                          proc)
+                         ((version proc)
+                          (and (version-prefix? version
+                                                (package-version package))
+                               proc)))))
+                 #f
+                 (package-name package)
+                 table))
+
+  (define (rewrite package)
+    (match (find-replacement package)
+      (#f package)
+      (proc (proc package))))
+
+  (package-mapping rewrite find-replacement))
+
 (define-syntax-rule (package/inherit p overrides ...)
   "Like (package (inherit P) OVERRIDES ...), except that the same
 transformation is done to the package replacement, if any.  P must be a bare
-- 
cgit v1.2.3