Show pedantic warnings and use profile merging to let deps :tree warn…

… correctly
heliclei · Sep 8, 2014 · c142b24 · c142b24
1 parent 0184e5c
commit c142b24
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 13 deletions.
diff --git a/leiningen-core/src/leiningen/core/classpath.clj b/leiningen-core/src/leiningen/core/classpath.clj
@@ -14,7 +14,7 @@
 (defn- warn [& args]
   ;; TODO: remove me once #1227 is merged
   (require 'leiningen.core.main)
-  ((resolve 'leiningen.core.main/warn) args))
+  (apply (resolve 'leiningen.core.main/warn) args))
 
 ;; Basically just for re-throwing a more comprehensible error.
 (defn- read-dependency-project [root dep]
@@ -280,15 +280,17 @@
   ;; Need to turn everything into a string before calling
   ;; pedantic-print-*, otherwise we can't memoize due to bad equality
   ;; semantics on aether GraphEdge objects.
-  (when (or (true? pedantic-setting) (= (keyword pedantic-setting) :ranges))
-    (pedantic-print-ranges (distinct (map message-for-range ranges))))
-  (when (or (true? pedantic-setting) (= (keyword pedantic-setting) :overrides))
-    (pedantic-print-overrides (map message-for-override overrides)))
-  (when (and (= :abort (keyword pedantic-setting))
-             (not (empty? (concat ranges overrides))))
-    (require 'leiningen.core.main)
-    ((resolve 'leiningen.core.main/abort) ; cyclic dependency =\
-     "Aborting due to version ranges.")))
+  (let [key (keyword pedantic-setting)
+        abort-or-warn (#{:warn :abort} key)]
+    (when (and key (not= key :overrides))
+      (pedantic-print-ranges (distinct (map message-for-range ranges))))
+    (when (and key (not= key :ranges))
+      (pedantic-print-overrides (map message-for-override overrides)))
+    (when (and (= :abort key)
+               (not (empty? (concat ranges overrides))))
+      (require 'leiningen.core.main)
+      ((resolve 'leiningen.core.main/abort) ; cyclic dependency =\
+       "Aborting due to :pedantic? :abort"))))
 
 (defn- pedantic-session [project ranges overrides]
   (if (:pedantic? project)

diff --git a/src/leiningen/deps.clj b/src/leiningen/deps.clj
@@ -118,10 +118,13 @@ force them to be updated, use `lein -U $TASK`."
              (do (print-implicits project :middleware)
                  (print-implicits project :hooks))
              (tree-command command)
-             (let [hierarchy (classpath/dependency-hierarchy
+             (let [project (project/merge-profiles
+                            project
+                            [{:pedantic? (quote ^:displace warn)}])
+                   hierarchy (classpath/dependency-hierarchy
                               (tree-command command)
-                              (assoc project :pedantic?
-                                     (get project :pedantic? :warn)))]
+                              project)]
+               (prn (:pedantic? project))
                (walk-deps hierarchy print-dep))
              (= command ":verify")
              (if (user/gpg-available?)