Add unprefer-method, remove-all-preferences, unprefer-method!, …

…and `remove-all-preferences!` (#135)

* Add `unprefer-method`

* Add `remove-all-preferences`

* Add dox

* Add `remove-all-preferences!` and `unprefer-method!`

docs/preferences.md

@@ -0,0 +1,43 @@
+# Preferences
+
+Like normal Clojure multimethods, Methodical multimethods support specifying preferences for one dispatch value over
+another so it knows which method to use in situation where neither of two dispatch values is considered more specific
+than another (e.g., neither one `isa?` the other).
+
+## Adding Preferences
+
+[[methodical.core/prefer-method]] works just like `clojure.core/prefer-method`, with one important difference: it is
+non-destructive. [[methodical.core/prefer-method]] will return a copy of the original multimethod with an updated
+preferences table.
+
+To destructively add a preference to a methodical multimethod, use [[methodical.core/prefer-method!]] and the var
+you'd like to update:
+
+```clj
+;;; add a preference of :x over y
+(m/prefer-method! #'my-multimethod :x :y)
+```
+
+You can also non-destructively replace the entire preferences table with a new one using the low-level method
+[[methodical.core/with-prefers]], but you should use caution in doing so. [[methodical.core/prefer-method]] will check
+to make sure any preferences you add are valid (e.g., no conflicts between preferences), but
+[[methodical.core/with-prefers]] will not.
+
+[[methodical.core/with-prefers!]] is a destructive version of [[methodical.core/with-prefers]] for use on multimethod
+vars.
+
+## Inspecting Preferences
+
+[[methodical.core/prefers]] works just like `clojure.core/prefers` and can be used to get the preferences map for a
+multimethod.
+
+## Removing Preferences
+
+Unlike normal Clojure multimethods, Methodical also supports removing preferences. [[methodical.core/unprefer-method]]
+undoes a preference added by [[methodical.core/prefer-method]]. Like [[methodical.core/prefer-method]], this is a
+non-destructive function that returns a copy of the original multimethod with an updated preferences map; you can use
+[[methodical.core/unprefer-method!]] to destructively update a multimethod var.
+
+[[methodical.core/remove-all-preferences]] non-destructively removes all preferences for a multimethod by replacing
+its preferences map with an empty one. [[methodical.core/remove-all-preferences!]] is a destructive version for doing
+the same operation on a multimethod var.

src/methodical/core.clj

@@ -105,8 +105,10 @@
   remove-all-aux-methods
   remove-all-aux-methods-for-dispatch-val
   remove-all-methods
+  remove-all-preferences
   remove-all-primary-methods
   remove-aux-method-with-unique-key
+  unprefer-method
   ;; destructive ops
   add-aux-method!
   add-aux-method-with-unique-key!
@@ -115,10 +117,12 @@
   remove-all-aux-methods!
   remove-all-aux-methods-for-dispatch-val!
   remove-all-methods!
+  remove-all-preferences!
   remove-all-primary-methods!
   remove-aux-method!
   remove-aux-method-with-unique-key!
   remove-primary-method!
+  unprefer-method!
   with-prefers!]
 
  [methodical.util.describe

src/methodical/util.clj

@@ -208,7 +208,8 @@
   (update prefs x #(conj (set %) y)))
 
 (defn prefer-method
-  "Prefer `dispatch-val-x` over `dispatch-val-y` for dispatch and method combinations."
+  "Prefer `dispatch-val-x` over `dispatch-val-y` for dispatch and method combinations. You can undo this preference
+  with [[unprefer-method]]."
   [multifn dispatch-val-x dispatch-val-y]
   {:pre [(some? multifn)]}
   (when (= dispatch-val-x dispatch-val-y)
@@ -226,6 +227,37 @@
     (let [new-prefs (update prefs dispatch-val-x #(conj (set %) dispatch-val-y))]
       (i/with-prefers multifn new-prefs))))
 
+(defn- remove-preference [preferences dispatch-value-x dispatch-value-y]
+  (let [updated-preferences (update preferences dispatch-value-x (fn [x-preferences]
+                                                                   (disj (set x-preferences) dispatch-value-y)))]
+    (if (empty? (get updated-preferences dispatch-value-x))
+      (dissoc updated-preferences dispatch-value-x)
+      updated-preferences)))
+
+(defn unprefer-method
+  "Return a copy of `multifn` with any preferences of `dispatch-val-x` over `dispatch-val-y` removed. If no such
+  preference exists, this returns `multifn` as-is. Opposite of [[prefer-method]].
+
+  To destructively remove a dispatch value preference, use [[unprefer-method!]]."
+  [multifn dispatch-val-x dispatch-val-y]
+  {:pre [(some? multifn)]}
+  (let [preferences         (i/prefers multifn)
+        updated-preferences (remove-preference preferences dispatch-val-x dispatch-val-y)]
+    (if (= preferences updated-preferences)
+      ;; return multifn as is if nothing has changed.
+      multifn
+      (i/with-prefers multifn updated-preferences))))
+
+(defn remove-all-preferences
+  "Return a copy of `multifn` with all of its preferences for all dispatch values removed.
+
+  To destructively remove all preferences, use [[remove-all-preferences!]]."
+  [multifn]
+  {:pre [(some? multifn)]}
+  (if (empty? (i/prefers multifn))
+    multifn
+    (i/with-prefers multifn {})))
+
 (defn is-default-effective-method?
   "When `multifn` is invoked with args that have `dispatch-val`, will we end up using the default effective
   method (assuming one exists)?"
@@ -348,3 +380,13 @@
   table."
   [multifn-var dispatch-val-x dispatch-val-y]
   (alter-var-root+ multifn-var prefer-method dispatch-val-x dispatch-val-y))
+
+(defn unprefer-method!
+  "Destructive version of [[unprefer-method]]. Operates on a var defining a Methodical multifn."
+  [multifn-var dispatch-val-x dispatch-val-y]
+  (alter-var-root+ multifn-var unprefer-method dispatch-val-x dispatch-val-y))
+
+(defn remove-all-preferences!
+  "Destructive version of [[remove-all-preferences]]. Operates on a var defining a Methodical multifn."
+  [multifn-var]
+  (alter-var-root+ multifn-var remove-all-preferences))

test/methodical/util_test.clj

@@ -431,6 +431,79 @@
                                        k))
                    (u/prefer-method mf2 k :toucan)))))))))
 
+(t/deftest unprefer-method-test
+  (let [m (-> (m/default-multifn :k)
+              (u/prefer-method :x :y)
+              (u/prefer-method :x :z))]
+    (t/is (= {:x #{:y :z}}
+             (i/prefers m)))
+    (t/testing "Should be able to remove a preference from a multifn"
+      (let [m2 (u/unprefer-method m :x :y)]
+        (t/is (= {:x #{:z}}
+                 (i/prefers m2)))
+        (t/testing "Original multimethod should be unaffected"
+          (t/is (= {:x #{:y :z}}
+                   (i/prefers m))))
+        (t/testing "If this was the last preference for x, remove the entry for x"
+          (let [m3 (u/unprefer-method m2 :x :z)]
+            (t/is (= {}
+                     (i/prefers m3)))))))
+    (t/testing "Should no-op if preference does not exist"
+      (let [m2 (u/unprefer-method m :y :x)]
+        (t/is (= {:x #{:y :z}}
+                 (i/prefers m2)))
+        (t/testing "Original multifn should have been returned"
+          (t/is (identical? m m2)))))))
+
+(t/deftest unprefer-method!-test
+  (def unprefer-method-mf nil)
+  (m/defmulti unprefer-method-mf :k)
+  (m/prefer-method! #'unprefer-method-mf :x :y)
+  (m/prefer-method! #'unprefer-method-mf :x :z)
+  (t/is (= {:x #{:y :z}}
+           (i/prefers unprefer-method-mf)))
+  (t/testing "No-op if no such preference exists"
+    (u/unprefer-method! #'unprefer-method-mf :y :x)
+    (t/is (= {:x #{:y :z}}
+             (i/prefers unprefer-method-mf))))
+  (t/testing "Destructively remove a preference"
+    (u/unprefer-method! #'unprefer-method-mf :x :y)
+    (t/is (= {:x #{:z}}
+             (i/prefers unprefer-method-mf)))))
+
+(t/deftest remove-all-preferences-test
+  (let [m (-> (m/default-multifn :k)
+              (u/prefer-method :x :y)
+              (u/prefer-method :x :z))]
+    (t/is (= {:x #{:y :z}}
+             (i/prefers m)))
+    (let [m2 (u/remove-all-preferences m)]
+      (t/is (= {}
+               (i/prefers m2)))
+      (t/testing "Original multifn should be unaffected"
+        (t/is (= {:x #{:y :z}}
+                 (i/prefers m))))))
+  (t/testing "Should no-op if there are no preferences"
+    (let [m (m/default-multifn :k)]
+      (t/is (= {}
+               (i/prefers m)))
+      (let [m2 (u/remove-all-preferences m)]
+        (t/is (= {}
+                 (i/prefers m2)))
+        (t/is (identical? m m2))))))
+
+(t/deftest remove-all-preferences!-test
+  (def remove-all-preferences-mf nil)
+  (m/defmulti remove-all-preferences-mf :k)
+  (m/prefer-method! #'remove-all-preferences-mf :x :y)
+  (m/prefer-method! #'remove-all-preferences-mf :x :z)
+  (t/is (= {:x #{:y :z}}
+           (i/prefers remove-all-preferences-mf)))
+  (t/testing "Destructively remove all preferences"
+    (u/remove-all-preferences! #'remove-all-preferences-mf)
+    (t/is (= {}
+             (i/prefers remove-all-preferences-mf)))))
+
 (t/deftest is-default-effective-method?-test
   (doseq [with-default-method? [true false]]
     (t/testing (format "with-default-method? => %s" with-default-method?)