From 190ddfe21e3d87719733d12fb9b5eb176125a49f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 30 Mar 2020 21:48:51 +0200
Subject: guix package: 'transaction-upgrade-entry' uses
 'lower-manifest-entry'.

* guix/profiles.scm (lower-manifest-entry): Export.
* guix/scripts/package.scm (transaction-upgrade-entry)[lower-manifest-entry*]
[upgrade]: New procedures.
Use 'lower-manifest-entry*' instead of 'package-derivation' to compute
the output file name of PKG.
---
 guix/profiles.scm        |  2 ++
 guix/scripts/package.scm | 73 ++++++++++++++++++++++++++----------------------
 2 files changed, 41 insertions(+), 34 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index ad9878f370..1362c4092a 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -87,6 +87,7 @@
             manifest-entry-search-paths
             manifest-entry-parent
             manifest-entry-properties
+            lower-manifest-entry
 
             manifest-pattern
             manifest-pattern?
@@ -272,6 +273,7 @@ file name."
                             (output -> (manifest-entry-output entry)))
           (return (manifest-entry
                     (inherit entry)
+                    ;; TODO: Lower dependencies, recursively.
                     (item (derivation->output-path drv output))))))))
 
 (define* (check-for-collisions manifest system #:key target)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index c7908ece6c..be2e67997e 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -199,6 +199,10 @@ non-zero relevance score."
 (define (transaction-upgrade-entry store entry transaction)
   "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
 <manifest-entry>."
+  (define (lower-manifest-entry* entry)
+    (run-with-store store
+      (lower-manifest-entry entry (%current-system))))
+
   (define (supersede old new)
     (info (G_ "package '~a' has been superseded by '~a'~%")
           (manifest-entry-name old) (package-name new))
@@ -211,40 +215,41 @@ non-zero relevance score."
         (output (manifest-entry-output old)))
       transaction)))
 
-  (match (if (manifest-transaction-removal-candidate? entry transaction)
-             'dismiss
-             entry)
-    ('dismiss
-     transaction)
-    (($ <manifest-entry> name version output (? string? path))
-     (match (find-best-packages-by-name name #f)
-       ((pkg . rest)
-        (let ((candidate-version (package-version pkg)))
-          (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))))
-                  ;; XXX: When there are propagated inputs, assume we need to
-                  ;; upgrade the whole entry.
-                  (if (and (string=? path candidate-path)
-                           (null? (package-propagated-inputs pkg)))
-                      transaction
-                      (manifest-transaction-install-entry
-                       (package->manifest-entry* pkg output)
-                       transaction)))))))))
-       (()
-        (warning (G_ "package '~a' no longer exists~%") name)
-        transaction)))))
+  (define (upgrade entry)
+    (match entry
+      (($ <manifest-entry> name version output (? string? path))
+       (match (find-best-packages-by-name name #f)
+         ((pkg . rest)
+          (let ((candidate-version (package-version pkg)))
+            (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* ((new (package->manifest-entry* pkg output)))
+                    ;; XXX: When there are propagated inputs, assume we need to
+                    ;; upgrade the whole entry.
+                    (if (and (string=? (manifest-entry-item
+                                        (lower-manifest-entry* new))
+                                       (manifest-entry-item entry))
+                             (null? (package-propagated-inputs pkg)))
+                        transaction
+                        (manifest-transaction-install-entry
+                         new transaction)))))))))
+         (()
+          (warning (G_ "package '~a' no longer exists~%") name)
+          transaction)))))
+
+  (if (manifest-transaction-removal-candidate? entry transaction)
+      transaction
+      (upgrade entry)))
 
 
 ;;;
-- 
cgit v1.2.3