Add dispatch function util functions (#132)

docs/dispatch-functions.md

@@ -0,0 +1,47 @@
+# Dispatch function utilities
+
+Methodical ships with a few of helper functions for creating common dispatch functions:
+
+* [[methodical.util.dispatch/dispatch-on-first-arg]]
+* [[methodical.util.dispatch/dispatch-on-first-two-args]]
+* [[methodical.util.dispatch/dispatch-on-first-three-args]]
+* [[methodical.util.dispatch/dispatch-on-first-four-args]]
+
+For your convenience, these are also aliased in [[methodical.core]].
+
+These methods all take a `dispatch-fn` argument and return a new function that will call `(dispatch-fn x)` with each
+of the first `n` arguments, and ignore all other arguments, for example:
+
+```clj
+(def dispatch-fn (m/dispatch-on-first-arg keyword))
+
+(dispatch-fn "a")
+;; => (keyword a)
+;; => :a
+(dispatch-fn "a" "b")
+;; => :a
+(dispatch-fn "a" "b" "c")
+;; => :a
+
+(def dispatch-fn-2 (m/dispatch-on-first-two-args keyword))
+
+(dispatch-fn "a" "b")
+;; => [(keyword "a") (keyword "b")]
+;; => [:a :b]
+(dispatch-fn "a" "b" "c")
+;; => [:a :b]
+```
+
+[[methodical.util.dispatch/dispatch-on-first-two-args]], [[methodical.util.dispatch/dispatch-on-first-three-args]],
+and [[methodical.util.dispatch/dispatch-on-first-four-args]] all support an additional arity that allows you to pass a
+separate function to use for each argument, e.g.
+
+```clj
+(def dispatch-fn (m/dispatch-on-first-two-args keyword str))
+
+(dispatch-fn "a" "b")
+;; => [(keyword "a") (str "b")]
+;; => [:a "b"]
+(dispatch-fn "a" "b" "c")
+;; => [:a "b"]
+```

src/methodical/core.clj

@@ -7,6 +7,7 @@
             methodical.macros
             methodical.util
             methodical.util.describe
+            methodical.util.dispatch
             methodical.util.trace
             [potemkin :as p]))
 
@@ -16,6 +17,7 @@
   methodical.interface/keep-me
   methodical.macros/keep-me
   methodical.util.describe/keep-me
+  methodical.util.dispatch/keep-me
   methodical.util.trace/keep-me
   methodical.util/keep-me)
 
@@ -120,5 +122,11 @@
  [methodical.util.describe
   describe]
 
+ [methodical.util.dispatch
+  dispatch-on-first-arg
+  dispatch-on-first-two-args
+  dispatch-on-first-three-args
+  dispatch-on-first-four-args]
+
  [methodical.util.trace
   trace])

src/methodical/util/dispatch.clj

@@ -0,0 +1,91 @@
+(ns methodical.util.dispatch
+  "Common dispatch function definitions.")
+
+(defn dispatch-on-first-arg
+  "Create a dispatch function this will dispatch on the value of
+
+  ```clj
+  (dispatch-fn <first-arg>)
+  ```
+
+  and ignore all other args."
+  [dispatch-fn]
+  (fn dispatch-on-first-arg*
+    ([a]
+     (dispatch-fn a))
+    ([a _b]
+     (dispatch-fn a))
+    ([a _b _c]
+     (dispatch-fn a))
+    ([a _b _c _d]
+     (dispatch-fn a))
+    ([a _b _c _d _e]
+     (dispatch-fn a))
+    ([a _b _c _d _e & _more]
+     (dispatch-fn a))))
+
+(defn dispatch-on-first-two-args
+  "Create a dispatch function this will dispatch on the value of
+
+  ```clj
+  [(dispatch-fn <first-arg>) (dispatch-fn <second-arg>)]
+  ```
+
+  and ignore all other args."
+  ([dispatch-fn]
+   (dispatch-on-first-two-args dispatch-fn dispatch-fn))
+
+  ([dispatch-fn-a dispatch-fn-b]
+   (fn dispatch-on-first-two-args*
+     ([a b]
+      [(dispatch-fn-a a) (dispatch-fn-b b)])
+     ([a b _c]
+      (dispatch-on-first-two-args* a b))
+     ([a b _c _d]
+      (dispatch-on-first-two-args* a b))
+     ([a b _c _d _e]
+      (dispatch-on-first-two-args* a b))
+     ([a b _c _d _e & _more]
+      (dispatch-on-first-two-args* a b)))))
+
+(defn dispatch-on-first-three-args
+  "Create a dispatch function this will dispatch on the value of
+
+  ```clj
+  [(dispatch-fn <first-arg>) (dispatch-fn <second-arg>) (dispatch-fn <third-arg>)]
+  ```
+
+  and ignore all other args."
+  ([dispatch-fn]
+   (dispatch-on-first-three-args dispatch-fn dispatch-fn dispatch-fn))
+
+  ([dispatch-fn-a dispatch-fn-b dispatch-fn-c]
+   (fn dispatch-on-first-three-args*
+     ([a b c]
+      [(dispatch-fn-a a) (dispatch-fn-b b) (dispatch-fn-c c)])
+     ([a b c _d]
+      (dispatch-on-first-three-args* a b c))
+     ([a b c _d _e]
+      (dispatch-on-first-three-args* a b c))
+     ([a b c _d _e & _more]
+      (dispatch-on-first-three-args* a b c)))))
+
+(defn dispatch-on-first-four-args
+  "Create a dispatch function this will dispatch on the value of
+
+  ```clj
+  [(dispatch-fn <first-arg>) (dispatch-fn <second-arg>) (dispatch-fn <third-arg>) (dispatch-fn <fourth-arg>)]
+  ```
+
+  and ignore all other args."
+  ([dispatch-fn]
+   (dispatch-on-first-four-args dispatch-fn dispatch-fn dispatch-fn dispatch-fn))
+
+  ([dispatch-fn-a dispatch-fn-b dispatch-fn-c dispatch-fn-d]
+   (fn dispatch-on-first-four-args*
+     ([a b c d]
+      [(dispatch-fn-a a) (dispatch-fn-b b) (dispatch-fn-c c) (dispatch-fn-d d)])
+     ([a b c d _e]
+      (dispatch-on-first-four-args* a b c d))
+     ([a b c d _e & _more]
+      (dispatch-on-first-four-args* a b c d)))))

test/methodical/util/dispatch_test.clj

@@ -0,0 +1,67 @@
+(ns methodical.util.dispatch-test
+  (:require
+   [clojure.string :as str]
+   [clojure.test :as t]
+   [methodical.core :as m]))
+
+(t/deftest dispatch-on-first-arg-test
+  (let [df (m/dispatch-on-first-arg keyword)]
+    (t/are [args] (= :a
+                     (apply df args))
+      ["a"]
+      ["a" "b"]
+      ["a" "b" "c"]
+      ["a" "b" "c" "d"]
+      ["a" "b" "c" "d" "e"]
+      ["a" "b" "c" "d" "e" "f"])))
+
+(t/deftest dispatch-on-first-two-args-test
+  (let [df (m/dispatch-on-first-two-args keyword)]
+    (t/are [args] (= [:a :b]
+                     (apply df args))
+      ["a" "b"]
+      ["a" "b" "c"]
+      ["a" "b" "c" "d"]
+      ["a" "b" "c" "d" "e"]
+      ["a" "b" "c" "d" "e" "f"]))
+  (t/testing "different dispatch functions"
+    (let [df (m/dispatch-on-first-two-args keyword str)]
+      (t/are [args] (= [:a "b"]
+                       (apply df args))
+        ["a" "b"]
+        ["a" "b" "c"]
+        ["a" "b" "c" "d"]
+        ["a" "b" "c" "d" "e"]
+        ["a" "b" "c" "d" "e" "f"]))))
+
+(t/deftest dispatch-on-first-three-args-test
+  (let [df (m/dispatch-on-first-three-args keyword)]
+    (t/are [args] (= [:a :b :c]
+                     (apply df args))
+      ["a" "b" "c"]
+      ["a" "b" "c" "d"]
+      ["a" "b" "c" "d" "e"]
+      ["a" "b" "c" "d" "e" "f"]))
+  (t/testing "different dispatch functions"
+    (let [df (m/dispatch-on-first-three-args keyword str some?)]
+      (t/are [args] (= [:a "b" true]
+                       (apply df args))
+        ["a" "b" "c"]
+        ["a" "b" "c" "d"]
+        ["a" "b" "c" "d" "e"]
+        ["a" "b" "c" "d" "e" "f"]))))
+
+(t/deftest dispatch-on-first-four-args-test
+  (let [df (m/dispatch-on-first-four-args keyword)]
+    (t/are [args] (= [:a :b :c :d]
+                     (apply df args))
+      ["a" "b" "c" "d"]
+      ["a" "b" "c" "d" "e"]
+      ["a" "b" "c" "d" "e" "f"]))
+  (t/testing "Different dispatch functions"
+    (let [df (m/dispatch-on-first-four-args keyword str some? str/upper-case)]
+      (t/are [args] (= [:a "b" true "D"]
+                       (apply df args))
+        ["a" "b" "c" "d"]
+        ["a" "b" "c" "d" "e"]
+        ["a" "b" "c" "d" "e" "f"]))))