Breaking change: Replace Dispatcher prefer-method with `with-pref…

…ers` (camsaul#105)

* Replace Dispatcher/prefer-method with Dispatcher/with-prefers

* Test fix

src/methodical/core.clj

@@ -36,7 +36,7 @@
   ;; Dispatcher
   default-dispatch-value
   prefers
-  prefer-method
+  with-prefers
   dominates?
   ;; MultiFnImpl
   method-combination
@@ -100,6 +100,7 @@
   add-aux-method-with-unique-key
   remove-aux-method-with-unique-key
   remove-all-methods
+  prefer-method
   ;; destructive ops
   add-primary-method!
   remove-primary-method!
@@ -111,7 +112,8 @@
   add-aux-method-with-unique-key!
   remove-aux-method-with-unique-key!
   remove-all-methods!
-  prefer-method!]
+  prefer-method!
+  with-prefers!]
 
  [methodical.util.trace
   trace])

src/methodical/impl/dispatcher/common.clj

@@ -1,23 +1,6 @@
 (ns methodical.impl.dispatcher.common
   "Utility functions for implementing Dispatchers.")
 
-(defn add-preference
-  "Add a method preference to `prefs` for dispatch value `x` over `y`. Used to implement `prefer-method`. `isa?*` is
-  used to determine whether a relationship between `x` and `y` that precludes this preference already exists; it can
-  be `clojure.core/isa?`, perhaps partially bound with a hierarchy, or some other 2-arg predicate function."
-  [isa?* prefs x y]
-  (when (= x y)
-    (throw (IllegalStateException. (format "Cannot prefer dispatch value %s over itself." x))))
-  (when (contains? (get prefs y) x)
-    (throw (IllegalStateException. (format "Preference conflict in multimethod: %s is already preferred to %s" y x))))
-  ;; this is not actually a restriction that is enforced by vanilla Clojure multimethods, but after thinking about
-  ;; it really doesn't seem to make sense to allow you to define a preference that will never be used
-  (when (isa?* y x)
-    (throw (IllegalStateException.
-            (format "Preference conflict in multimethod: cannot prefer %s over its descendant %s."
-                    x y))))
-  (update prefs x #(conj (set %) y)))
-
 (defn prefers?
   "True if `x` or one of its ancestors is prefered over `y` or one of its ancestors."
   [hierarchy prefs x y]

src/methodical/impl/dispatcher/everything.clj

@@ -54,11 +54,8 @@
   (prefers [_]
     prefs)
 
-  (prefer-method [this x y]
-    (let [new-prefs (dispatcher.common/add-preference (partial isa? (deref hierarchy-var)) prefs x y)]
-      (if (= prefs new-prefs)
-        this
-        (EverythingDispatcher. hierarchy-var new-prefs))))
+  (with-prefers [_this new-prefs]
+    (EverythingDispatcher. hierarchy-var new-prefs))
 
   (dominates? [_ x y]
     (dispatcher.common/dominates? (deref hierarchy-var) prefs x y)))

src/methodical/impl/dispatcher/multi_default.clj

@@ -177,11 +177,8 @@
   (prefers [_]
     prefs)
 
-  (prefer-method [this x y]
-    (let [new-prefs (dispatcher.common/add-preference (partial isa? (deref hierarchy-var)) prefs x y)]
-      (if (= prefs new-prefs)
-        this
-        (MultiDefaultDispatcher. dispatch-fn hierarchy-var default-value new-prefs))))
+  (with-prefers [_this new-prefs]
+    (MultiDefaultDispatcher. dispatch-fn hierarchy-var default-value new-prefs))
 
   (dominates? [_ x y]
     (dispatcher.common/dominates? (deref hierarchy-var) prefs default-value x y)))

src/methodical/impl/dispatcher/standard.clj

@@ -1,7 +1,7 @@
 (ns methodical.impl.dispatcher.standard
   "A single-hierarchy dispatcher that behaves similarly to the way multimethod dispatch is done by vanilla Clojure
   multimethods, but with added support for auxiliary methods."
-  (:refer-clojure :exclude [prefers prefer-method methods])
+  (:refer-clojure :exclude [prefers methods])
   (:require [methodical.impl.dispatcher.common :as dispatcher.common]
             [methodical.interface :as i]
             [potemkin.types :as p.types]
@@ -147,11 +147,8 @@
   (prefers [_]
     prefs)
 
-  (prefer-method [this x y]
-    (let [new-prefs (dispatcher.common/add-preference (partial isa? (deref hierarchy-var)) prefs x y)]
-      (if (= prefs new-prefs)
-        this
-        (StandardDispatcher. dispatch-fn hierarchy-var default-value new-prefs))))
+  (with-prefers [_this new-prefs]
+    (StandardDispatcher. dispatch-fn hierarchy-var default-value new-prefs))
 
   (dominates? [_ x y]
     (dispatcher.common/dominates? (deref hierarchy-var) prefs default-value x y)))

src/methodical/impl/standard.clj

@@ -118,8 +118,8 @@
   (prefers [_]
     (i/prefers (.dispatcher impl)))
 
-  (prefer-method [this dispatch-val-x dispatch-val-y]
-    (i/with-dispatcher this (i/prefer-method (.dispatcher impl) dispatch-val-x dispatch-val-y)))
+  (with-prefers [this new-prefers]
+    (i/with-dispatcher this (i/with-prefers (.dispatcher impl) new-prefers)))
 
   (dominates? [_ dispatch-val-x dispatch-val-y]
     (i/dominates? (.dispatcher impl) dispatch-val-x dispatch-val-y))

src/methodical/interface.clj

@@ -1,5 +1,5 @@
 (ns methodical.interface
-  (:refer-clojure :exclude [isa? prefers prefer-method])
+  (:refer-clojure :exclude [isa? prefers])
   (:require clojure.core))
 
 ;; this is a dummy dependency until Cloverage 1.3.0 is released -- see
@@ -89,8 +89,8 @@
   (prefers [dispatcher]
     "Return a map of preferred dispatch value -> set of other dispatch values.")
 
-  (prefer-method [dispatcher dispatch-val-x dispatch-val-y]
-    "Prefer `dispatch-val-x` over `dispatch-val-y` for dispatch and method combinations.")
+  (with-prefers [dispatcher new-prefs]
+    "Return a copy of `dispatcher` with its preferences map replaced with `new-prefs`.")
 
   (dominates? [dispatcher dispatch-val-x dispatch-val-y]
     "Is `dispatch-val-x` considered more specific than `dispatch-val-y`?"))

src/methodical/util.clj

@@ -187,6 +187,42 @@
   [multifn]
   (-> multifn remove-all-primary-methods remove-all-aux-methods))
 
+(defn add-preference
+  "Add a method preference to `prefs` for dispatch value `x` over `y`. Used to implement `prefer-method`. `isa?*` is
+  used to determine whether a relationship between `x` and `y` that precludes this preference already exists; it can
+  be [[clojure.core/isa?]], perhaps partially bound with a hierarchy, or some other 2-arg predicate function."
+  [isa?* prefs x y]
+  (when (= x y)
+    (throw (IllegalStateException. (format "Cannot prefer dispatch value %s over itself." x))))
+  (when (contains? (get prefs y) x)
+    (throw (IllegalStateException. (format "Preference conflict in multimethod: %s is already preferred to %s" y x))))
+  ;; this is not actually a restriction that is enforced by vanilla Clojure multimethods, but after thinking about
+  ;; it really doesn't seem to make sense to allow you to define a preference that will never be used
+  (when (isa?* y x)
+    (throw (IllegalStateException.
+            (format "Preference conflict in multimethod: cannot prefer %s over its descendant %s."
+                    x y))))
+  (update prefs x #(conj (set %) y)))
+
+(defn prefer-method
+  "Prefer `dispatch-val-x` over `dispatch-val-y` for dispatch and method combinations."
+  [multifn dispatch-val-x dispatch-val-y]
+  {:pre [(some? multifn)]}
+  (when (= dispatch-val-x dispatch-val-y)
+    (throw (IllegalStateException. (format "Cannot prefer dispatch value %s over itself." dispatch-val-x))))
+  (let [prefs (i/prefers multifn)]
+    (when (contains? (get prefs dispatch-val-y) dispatch-val-x)
+      (throw (IllegalStateException. (format "Preference conflict in multimethod: %s is already preferred to %s"
+                                             dispatch-val-y
+                                             dispatch-val-x))))
+    (when (i/dominates? (i/with-prefers multifn nil) dispatch-val-y dispatch-val-x)
+      (throw (IllegalStateException.
+              (format "Preference conflict in multimethod: cannot prefer %s over its descendant %s."
+                      dispatch-val-x
+                      dispatch-val-y))))
+    (let [new-prefs (update prefs dispatch-val-x #(conj (set %) dispatch-val-y))]
+      (i/with-prefers multifn new-prefs))))
+
 
 ;;;; #### Low-level destructive operations
 
@@ -256,6 +292,11 @@
   [multifn-var]
   (alter-var-root+ multifn-var remove-all-methods))
 
+(defn with-prefers!
+  "Destructive version of [[methodical.interface/with-prefers]]. Operates on a var defining a Methodical multifn."
+  [multifn-var new-prefs]
+  (alter-var-root+ multifn-var i/with-prefers new-prefs))
+
 (defn prefer-method!
   "Destructive version of [[prefer-method]]. Operates on a var defining a Methodical multifn.
 
@@ -264,4 +305,4 @@
   operation from our nondestructive [[prefer-method]], which returns a copy of the multifn with an altered dispatch
   table."
   [multifn-var dispatch-val-x dispatch-val-y]
-  (alter-var-root+ multifn-var i/prefer-method dispatch-val-x dispatch-val-y))
+  (alter-var-root+ multifn-var prefer-method dispatch-val-x dispatch-val-y))

test/methodical/clojure_test.clj

@@ -1,16 +1,16 @@
 (ns methodical.clojure-test
   "Tests to ensure we can replicate the basic behavior of vanilla Clojure multimethods."
   (:require [clojure.test :as t]
-            [methodical.impl :as impl]
-            [methodical.interface :as i]))
+            [methodical.core :as m]
+            [methodical.impl :as impl]))
 
 (defn- clojure-multifn [dispatch-fn & options]
   (impl/multifn (apply impl/clojure-multifn-impl dispatch-fn options)))
 
 (defn- add-methods [multifn fns]
   (reduce
    (fn [multifn [dispatch-val f]]
-     (i/add-primary-method multifn dispatch-val f))
+     (m/add-primary-method multifn dispatch-val f))
    multifn
    fns))
 
@@ -157,8 +157,8 @@
 (t/deftest prefer-method-test
   (with-local-vars [hierarchy (make-ambiguous-hierarchy)]
     (let [multifn (-> (ambiguous-hierarchy-multifn hierarchy)
-                      (i/prefer-method :parent-1 :parent-2))]
-      (t/is (= (i/prefers multifn) {:parent-1 #{:parent-2}})
+                      (m/prefer-method :parent-1 :parent-2))]
+      (t/is (= (m/prefers multifn) {:parent-1 #{:parent-2}})
           "Map of prefers should be visible by calling `prefers`")
       (t/is (= (multifn :child) :parent-1)
             "It should be possible to prefer one ambiguous method over another"))))
@@ -168,17 +168,17 @@
     (let [multifn (ambiguous-hierarchy-multifn hierarchy)]
       (t/is (thrown-with-msg? IllegalStateException
                             #"Cannot prefer dispatch value :parent-1 over itself"
-                            (i/prefer-method multifn :parent-1 :parent-1))
+                            (m/prefer-method multifn :parent-1 :parent-1))
             "Trying to prefer a dispatch value over itself should throw an Exception")
       (t/is (thrown-with-msg? IllegalStateException
                             #"Preference conflict in multimethod: :parent-1 is already preferred to :parent-2"
                             (-> multifn
-                                (i/prefer-method :parent-1 :parent-2)
-                                (i/prefer-method :parent-2 :parent-1)))
+                                (m/prefer-method :parent-1 :parent-2)
+                                (m/prefer-method :parent-2 :parent-1)))
             "You should not be able to prefer something if it would conflict with an existing prefer")
       (t/is (thrown-with-msg? IllegalStateException
                             #"Preference conflict in multimethod: cannot prefer :parent-1 over its descendant :child"
-                            (i/prefer-method multifn :parent-1 :child))
+                            (m/prefer-method multifn :parent-1 :child))
             "You should not be able to prefer an ancestor over its descendant."))))
 
 (t/deftest remove-primary-method-test
@@ -187,11 +187,11 @@
         multifn (-> (clojure-multifn keyword)
                     (add-methods {:a a, :default default}))]
     (t/testing "sanity check"
-      (t/is (= (i/primary-methods multifn) {:a a, :default default})
+      (t/is (= (m/primary-methods multifn) {:a a, :default default})
             "You should be able to see a map of dispatch-value -> primary method with `primary-methods`"))
     (t/testing "remove-primary-method"
-      (let [multifn (i/remove-primary-method multifn :a)]
-        (t/is (= (i/primary-methods multifn) {:default default}))
+      (let [multifn (m/remove-primary-method multifn :a)]
+        (t/is (= (m/primary-methods multifn) {:default default}))
         (t/is (= (multifn :a) :default))))))
 
 (t/deftest effective-method-test
@@ -202,13 +202,13 @@
                                          :default default-method}))]
     (t/testing "For Clojure-style multifns, `effective-method` should work just like vanilla `get-method`."
       (t/is (= (a-method :x)
-               ((i/effective-method multifn :a) :x))))
+               ((m/effective-method multifn :a) :x))))
     (t/testing "The default method should be returned if no matching method is found."
       (t/is (= (default-method :x)
-               ((i/effective-method multifn :b) :x))))
-    (let [multifn (i/remove-primary-method multifn :default)]
+               ((m/effective-method multifn :b) :x))))
+    (let [multifn (m/remove-primary-method multifn :default)]
       (t/testing "If no default method exists, `effective-method` should return nil if no methods match."
         (t/is (= nil
-                 (i/effective-method multifn :b)))))))
+                 (m/effective-method multifn :b)))))))
 
 ;; TODO - test other methods not available in vanilla Clojure, e.g. `dominates?` and `aux-methods`

test/methodical/impl/dispatcher/common_test.clj

@@ -2,30 +2,6 @@
   (:require [clojure.test :as t]
             [methodical.impl.dispatcher.common :as dispatcher.common]))
 
-(t/deftest add-preference-test
-  (t/is (= {:x #{:y}}
-           (dispatcher.common/add-preference isa? {} :x :y)))
-  (t/testing "should thrown an Exception if you try to add an illegal preference"
-    (t/is (thrown-with-msg?
-           IllegalStateException
-           (re-pattern "Cannot prefer dispatch value :x over itself.")
-           (dispatcher.common/add-preference isa? {} :x :x)))
-    (t/is (thrown-with-msg?
-           IllegalStateException
-           (re-pattern "Preference conflict in multimethod: :x is already preferred to :y")
-           (dispatcher.common/add-preference isa? {:x #{:y}} :y :x)))
-    (let [h     (-> (make-hierarchy)
-                    (derive :bird :animal)
-                    (derive :toucan :bird))
-          isa?* (partial isa? h)]
-      (doseq [k [:bird :animal]]
-        (t/testing (format "Prefer %s over :toucan" k)
-          (t/is (thrown-with-msg?
-                 IllegalStateException
-                 (re-pattern (format "Preference conflict in multimethod: cannot prefer %s over its descendant :toucan."
-                                     k))
-                 (dispatcher.common/add-preference isa?* {} k :toucan))))))))
-
 (t/deftest prefers-test
   (t/testing "prefers?"
     (let [h (-> (make-hierarchy)

test/methodical/util_test.clj

@@ -397,3 +397,29 @@
 
       (t/is (= nil
                (seq (i/aux-methods remove-all-methods-multifn)))))))
+
+(t/deftest prefer-method-test
+  (let [mf (m/default-multifn :k)]
+    (t/is (= {:x #{:y}}
+             (i/prefers (u/prefer-method mf :x :y))))
+    (t/testing "should thrown an Exception if you try to add an illegal preference"
+      (t/is (thrown-with-msg?
+             IllegalStateException
+             (re-pattern "Cannot prefer dispatch value :x over itself.")
+             (u/prefer-method mf :x :x)))
+      (let [mf (i/with-prefers mf {:x #{:y}})]
+        (t/is (thrown-with-msg?
+               IllegalStateException
+               (re-pattern "Preference conflict in multimethod: :x is already preferred to :y")
+               (u/prefer-method mf :y :x))))
+      (let [h   (-> (make-hierarchy)
+                    (derive :bird :animal)
+                    (derive :toucan :bird))
+            mf2 (m/default-multifn :k :hierarchy (atom h))]
+        (doseq [k [:bird :animal]]
+          (t/testing (format "Prefer %s over :toucan" k)
+            (t/is (thrown-with-msg?
+                   IllegalStateException
+                   (re-pattern (format "Preference conflict in multimethod: cannot prefer %s over its descendant :toucan."
+                                       k))
+                   (u/prefer-method mf2 k :toucan)))))))))