From 993023a28e52c87647fb78a5aa94a524f42ceb71 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 14 Jun 2020 15:06:53 +0200
Subject: lint: Add 'check-for-collisions' checker.

Suggested by Edouard Klein <edk@beaver-labs.com>.

* guix/profiles.scm (check-for-collisions): Export.
* guix/lint.scm (check-profile-collisions): New procedure.
(%local-checkers): Add 'profile-collisions' checker.
* tests/lint.scm ("profile-collisions: no warnings")
("profile-collisions: propagated inputs collide")
("profile-collisions: propagated inputs collide, store items"): New tests.
* doc/guix.texi (Invoking guix lint): Document it.
---
 guix/lint.scm | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

(limited to 'guix/lint.scm')

diff --git a/guix/lint.scm b/guix/lint.scm
index 82861b8a27..fa507546f5 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -41,6 +41,8 @@ (define-module (guix lint)
   #:use-module (guix upstream)
   #:use-module (guix utils)
   #:use-module (guix memoization)
+  #:use-module (guix profiles)
+  #:use-module (guix monads)
   #:use-module (guix scripts)
   #:use-module ((guix ui) #:select (texi->plain-text fill-paragraph))
   #:use-module (guix gnu-maintenance)
@@ -84,6 +86,7 @@ (define-module (guix lint)
             check-for-updates
             check-formatting
             check-archival
+            check-profile-collisions
 
             lint-warning
             lint-warning?
@@ -970,6 +973,38 @@ (define (check-with-store store)
       (with-store store
         (check-with-store store))))
 
+(define* (check-profile-collisions package #:key store)
+  "Check for collisions that would occur when installing PACKAGE as a result
+of the propagated inputs it pulls in."
+  (define (do-check store)
+    (guard (c ((profile-collision-error? c)
+               (let ((first  (profile-collision-error-entry c))
+                     (second (profile-collision-error-conflict c)))
+                 (define format
+                   (if (string=? (manifest-entry-version first)
+                                 (manifest-entry-version second))
+                       manifest-entry-item
+                       (lambda (entry)
+                         (string-append (manifest-entry-name entry) "@"
+                                        (manifest-entry-version entry)))))
+
+                 (list (make-warning package
+                                     (G_ "propagated inputs ~a and ~a collide")
+                                     (list (format first)
+                                           (format second)))))))
+      ;; Disable grafts to avoid building PACKAGE and its dependencies.
+      (parameterize ((%graft? #f))
+        (run-with-store store
+          (mbegin %store-monad
+            (check-for-collisions (packages->manifest (list package))
+                                  (%current-system))
+            (return '()))))))
+
+  (if store
+      (do-check store)
+      (with-store store
+        (do-check store))))
+
 (define (check-license package)
   "Warn about type errors of the 'license' field of PACKAGE."
   (match (package-license package)
@@ -1349,6 +1384,11 @@ (define %local-checkers
      (description     "Report failure to compile a package to a derivation")
      (check           check-derivation)
      (requires-store? #t))
+   (lint-checker
+     (name            'profile-collisions)
+     (description     "Report collisions that would occur due to propagated inputs")
+     (check           check-profile-collisions)
+     (requires-store? #t))
    (lint-checker
     (name        'patch-file-names)
     (description "Validate file names and availability of patches")
-- 
cgit v1.2.3