Merge branch 'master' into core-updates

[jackhill/guix/guix.git] / guix / packages.scm

diff --git a/guix/packages.scm b/guix/packages.scm
index 728b3af..beb958f 100644 (file)
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -84,6 +84,8 @@
             package-location
             hidden-package
             hidden-package?
+            package-superseded
+            deprecated-package
             package-field-location
 
             package-direct-sources
@@ -95,6 +97,7 @@
             package-transitive-propagated-inputs
             package-transitive-native-search-paths
             package-transitive-supported-systems
+            package-input-rewriting
             package-source-derivation
             package-derivation
             package-cross-derivation
@@ -306,6 +309,18 @@ user interfaces, ignores."
 interfaces."
   (assoc-ref (package-properties p) 'hidden?))
 
+(define (package-superseded p)
+  "Return the package the supersedes P, or #f if P is still current."
+  (assoc-ref (package-properties p) 'superseded))
+
+(define (deprecated-package old-name p)
+  "Return a package called OLD-NAME and marked as superseded by P, a package
+object."
+  (package
+    (inherit p)
+    (name old-name)
+    (properties `((superseded . ,p)))))
+
 (define (package-field-location package field)
   "Return the source code location of the definition of FIELD for PACKAGE, or
 #f if it could not be determined."
@@ -735,6 +750,35 @@ dependencies are known to build on SYSTEM."
   "Return the \"target inputs\" of BAG, recursively."
   (transitive-inputs (bag-target-inputs bag)))
 
+(define* (package-input-rewriting replacements
+                                  #:optional (rewrite-name identity))
+  "Return a procedure that, when passed a package, replaces its direct and
+indirect dependencies (but not its implicit inputs) 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.
+
+Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a
+package and returns its new name after rewrite."
+  (define (rewrite input)
+    (match input
+      ((label (? package? package) outputs ...)
+       (match (assq-ref replacements package)
+         (#f  (cons* label (replace package) outputs))
+         (new (cons* label new outputs))))
+      (_
+       input)))
+
+  (define-memoized/v (replace p)
+    "Return a variant of P with its inputs rewritten."
+    (package
+      (inherit p)
+      (name (rewrite-name (package-name p)))
+      (inputs (map rewrite (package-inputs p)))
+      (native-inputs (map rewrite (package-native-inputs p)))
+      (propagated-inputs (map rewrite (package-propagated-inputs p)))))
+
+  replace)
+
 \f
 ;;;
 ;;; Package derivations.
@@ -875,7 +919,8 @@ and return it."
             (cached (=> %graft-cache) package system
                     (let ((orig (package-derivation store package system
                                                     #:graft? #f))
-                          (new  (package-derivation store replacement system)))
+                          (new  (package-derivation store replacement system
+                                                    #:graft? #t)))
                       (graft
                         (origin orig)
                         (replacement new)))))))
@@ -891,7 +936,8 @@ and return it."
            (let ((orig (package-cross-derivation store package target system
                                                  #:graft? #f))
                  (new  (package-cross-derivation store replacement
-                                                 target system)))
+                                                 target system
+                                                 #:graft? #t)))
              (graft
                (origin orig)
                (replacement new))))))
@@ -1138,7 +1184,7 @@ cross-compilation target triplet."
 (define package->cross-derivation
   (store-lift package-cross-derivation))
 
-(define-gexp-compiler (package-compiler (package package?) system target)
+(define-gexp-compiler (package-compiler (package <package>) system target)
   ;; Compile PACKAGE to a derivation for SYSTEM, optionally cross-compiled for
   ;; TARGET.  This is used when referring to a package from within a gexp.
   (if target
@@ -1169,7 +1215,7 @@ cross-compilation target triplet."
                          #:modules modules
                          #:guile-for-build guile)))))
 
-(define-gexp-compiler (origin-compiler (origin origin?) system target)
+(define-gexp-compiler (origin-compiler (origin <origin>) system target)
   ;; Compile ORIGIN to a derivation for SYSTEM.  This is used when referring
   ;; to an origin from within a gexp.
   (origin->derivation origin system))