From 01afdab89c6a91f4cd05d3c4f4ff95a0402703eb Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 6 Sep 2016 23:14:07 +0200
Subject: packages: Add 'package-superseded' and associated support.

This provides a way to mark a package as superseded by another one.
Upgrades replace superseded packages with their replacement.

* guix/packages.scm (package-superseded, deprecated-package): New
procedures.
* gnu/packages.scm (%find-package): Check for 'package-superseded'.
* guix/scripts/package.scm (transaction-upgrade-entry)[supersede]: New
procedure.  Call it when 'package-superseded' is true.
* tests/guix-build.sh: Add test for a superseded package.
* tests/packages.scm ("package-superseded")
("transaction-upgrade-entry, superseded package"): New tests.
---
 guix/packages.scm        | 14 ++++++++++++++
 guix/scripts/package.scm | 46 +++++++++++++++++++++++++++++++---------------
 2 files changed, 45 insertions(+), 15 deletions(-)

(limited to 'guix')

diff --git a/guix/packages.scm b/guix/packages.scm
index d544c34cf8..afbafc70a7 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -83,6 +83,8 @@
             package-location
             hidden-package
             hidden-package?
+            package-superseded
+            deprecated-package
             package-field-location
 
             package-direct-sources
@@ -306,6 +308,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."
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index dc5fcba922..b87aee0be9 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -264,25 +264,41 @@ synopsis or description matches all of REGEXPS."
 (define (transaction-upgrade-entry entry transaction)
   "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
 <manifest-entry>."
+  (define (supersede old new)
+    (info (_ "package '~a' has been superseded by '~a'~%")
+          (manifest-entry-name old) (package-name new))
+    (manifest-transaction-install-entry
+     (package->manifest-entry new (manifest-entry-output old))
+     (manifest-transaction-remove-pattern
+      (manifest-pattern
+        (name (manifest-entry-name old))
+        (version (manifest-entry-version old))
+        (output (manifest-entry-output old)))
+      transaction)))
+
   (match entry
     (($ <manifest-entry> name version output (? string? path))
      (match (vhash-assoc name (find-newest-available-packages))
        ((_ candidate-version pkg . rest)
-        (case (version-compare candidate-version version)
-          ((>)
-           (manifest-transaction-install-entry
-            (package->manifest-entry pkg output)
-            transaction))
-          ((<)
-           transaction)
-          ((=)
-           (let ((candidate-path (derivation->output-path
-                                  (package-derivation (%store) pkg))))
-             (if (string=? path candidate-path)
-                 transaction
-                 (manifest-transaction-install-entry
-                  (package->manifest-entry pkg output)
-                  transaction))))))
+        (match (package-superseded pkg)
+          ((? package? new)
+           (supersede entry new))
+          (#f
+           (case (version-compare candidate-version version)
+             ((>)
+              (manifest-transaction-install-entry
+               (package->manifest-entry pkg output)
+               transaction))
+             ((<)
+              transaction)
+             ((=)
+              (let ((candidate-path (derivation->output-path
+                                     (package-derivation (%store) pkg))))
+                (if (string=? path candidate-path)
+                    transaction
+                    (manifest-transaction-install-entry
+                     (package->manifest-entry pkg output)
+                     transaction))))))))
        (#f
         transaction)))))
 
-- 
cgit v1.2.3