Subject: bug#63319: [PATCH 2/3] ui: derive parents of profile collision entries from manifest.

From: Ulf Herrman <[email-masked]>
Date: Mon, 8 May 2023 15:33:34 -0500

This fixes <https://issues.guix.gnu.org/63319>.

* guix/ui.scm (display-collision-resolution-hint, call-with-error-handling):
  use manifest-entry->parents and the manifest included with the collision to
  get the parents.
---
 guix/ui.scm | 30 +++++++++++++++++++++++++-----
 1 file changed, 25 insertions(+), 5 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index 5d2ae23c25..71fe5caa72 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -674,9 +674,19 @@ (define unit
 
 (define (display-collision-resolution-hint collision)
   "Display hints on how to resolve COLLISION, a &profile-collistion-error."
+  (define manifest (profile-collision-error-manifest collision))
+
+  (define entry->parents
+    (manifest-entry->parents manifest))
+
+  (define (manifest-entry-parent entry)
+    (match (entry->parents entry)
+      (() #f)
+      ((x . _) x)))
+
   (define (top-most-entry entry)
     (let loop ((entry entry))
-      (match (force (manifest-entry-parent entry))
+      (match (manifest-entry-parent entry)
         (#f entry)
         (parent (loop parent)))))
 
@@ -751,9 +761,19 @@ (define (port-filename* port)
                          (output output)))))
              ((profile-collision-error? c)
               (let ((entry    (profile-collision-error-entry-lowered c))
-                    (conflict (profile-collision-error-conflict-lowered c)))
+                    (conflict (profile-collision-error-conflict-lowered c))
+                    (manifest (profile-collision-error-manifest c)))
+
+                (define entry->parents
+                  (manifest-entry->parents manifest))
+
+                (define (manifest-entry-parent entry)
+                  (match (entry->parents entry)
+                    (() #f)
+                    ((x . rest) x)))
+
                 (define (report-parent-entries entry)
-                  (let ((parent (force (manifest-entry-parent entry))))
+                  (let ((parent (manifest-entry-parent entry)))
                     (when (manifest-entry? parent)
                       (report-error (G_ "   ... propagated from ~a@~a~%")
                                     (manifest-entry-name parent)
@@ -773,13 +793,13 @@ (define (manifest-entry-output* entry)
                               (manifest-entry-version entry)
                               (manifest-entry-output* entry)
                               (manifest-entry-item entry))
-                (report-parent-entries entry)
+                (report-parent-entries (profile-collision-error-entry c))
                 (report-error (G_ "  second entry: ~a@~a~a ~a~%")
                               (manifest-entry-name conflict)
                               (manifest-entry-version conflict)
                               (manifest-entry-output* conflict)
                               (manifest-entry-item conflict))
-                (report-parent-entries conflict)
+                (report-parent-entries (profile-collision-error-conflict c))
                 (display-collision-resolution-hint c)
                 (exit 1)))
              ((nar-error? c)
-- 
2.39.1