[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#63319: [PATCH 2/3] ui: derive parents of profile collision entries f
From: |
Ulf Herrman |
Subject: |
bug#63319: [PATCH 2/3] ui: derive parents of profile collision entries from manifest. |
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