From a654dc4bcf7c8e205bdefa1a1d5f23444dd22778 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 7 Jun 2017 09:51:55 +0200
Subject: profiles: Catch and report collisions in the profile.

* guix/profiles.scm (&profile-collision-error): New error condition.
(manifest-transitive-entries, manifest-entry-lookup, lower-manifest-entry)
(check-for-collisions): New procedures.
(profile-derivation): Add call to 'check-for-collisions'.
* guix/ui.scm (call-with-error-handling): Handle '&profile-collision-error'.
* tests/profiles.scm ("collision", "collision of propagated inputs")
("no collision"): New tests.
---
 guix/ui.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

(limited to 'guix/ui.scm')

diff --git a/guix/ui.scm b/guix/ui.scm
index 889c9d0228..c141880316 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -476,6 +476,33 @@ interpreted."
              (leave (G_ "generation ~a of profile '~a' does not exist~%")
                     (missing-generation-error-generation c)
                     (profile-error-profile c)))
+            ((profile-collision-error? c)
+             (let ((entry    (profile-collision-error-entry c))
+                   (conflict (profile-collision-error-conflict c)))
+               (define (report-parent-entries entry)
+                 (let ((parent (force (manifest-entry-parent entry))))
+                   (when (manifest-entry? parent)
+                     (report-error (G_ "   ... propagated from ~a@~a~%")
+                                   (manifest-entry-name parent)
+                                   (manifest-entry-version parent))
+                     (report-parent-entries parent))))
+
+               (report-error (G_ "profile contains conflicting entries for ~a:~a~%")
+                             (manifest-entry-name entry)
+                             (manifest-entry-output entry))
+               (report-error (G_ "  first entry: ~a@~a:~a ~a~%")
+                             (manifest-entry-name entry)
+                             (manifest-entry-version entry)
+                             (manifest-entry-output entry)
+                             (manifest-entry-item entry))
+               (report-parent-entries entry)
+               (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)
+               (exit 1)))
             ((nar-error? c)
              (let ((file (nar-error-file c))
                    (port (nar-error-port c)))
-- 
cgit v1.2.3