Detect variadic arities of :error interceptors

modules/reitit-pedestal/src/reitit/pedestal.clj

@@ -5,18 +5,58 @@
             [reitit.exception :as ex]
             [reitit.http]
             [reitit.interceptor])
-  (:import (java.lang.reflect Method)))
+  (:import (clojure.lang RestFn)
+           (java.lang.reflect Method)))
 
-;; TODO: variadic
-(defn- arities [f]
+(defn- required-arity
+  "Number of positional parameters in an `:arglists` signature, ignoring any
+   variadic tail: `[context ex]` -> 2, `[context & args]` -> 1."
+  [arglist]
+  (count (take-while #(not= '& %) arglist)))
+
+(defn- variadic-arglist? [arglist]
+  (boolean (some #(= '& %) arglist)))
+
+(defn- declared-invoke-arities
+  "Arities of the `invoke` methods declared on `f`'s class. Fns compiled by
+   Clojure on the JVM only declare the arities they actually define, so this
+   is a good approximation there. It says nothing about variadic arities,
+   which are compiled to `doInvoke` instead."
+  [f]
   (->> (class f)
        .getDeclaredMethods
        (filter (fn [^Method m] (= "invoke" (.getName m))))
        (map #(alength (.getParameterTypes ^Method %)))
        (set)))
 
+(defn- signatures
+  "Signatures `f` accepts, as `{:arity n, :variadic? bool}`, where `:arity` is
+   the number of required positional parameters.
+
+   `:arglists` metadata is preferred when present: it is the portable way to
+   describe a fn's signatures, and unlike class reflection it is also correct
+   on runtimes that represent every fn with a single shared class."
+  [f]
+  (if-let [arglists (:arglists (meta f))]
+    (into #{} (map (fn [arglist]
+                     {:arity (required-arity arglist)
+                      :variadic? (variadic-arglist? arglist)}))
+          arglists)
+    (cond-> (into #{} (map (fn [n] {:arity n, :variadic? false}))
+                  (declared-invoke-arities f))
+      (instance? RestFn f) (conj {:arity (.getRequiredArity ^RestFn f)
+                                  :variadic? true}))))
+
+(defn- accepts-arity?
+  "Whether `f` can be called with `n` arguments. Variadic signatures accept
+   their required arity or more."
+  [f n]
+  (boolean (some (fn [{:keys [arity variadic?]}]
+                   (if variadic? (<= arity n) (= arity n)))
+                 (signatures f))))
+
 (defn- error-without-arity-2? [{error-fn :error}]
-  (and error-fn (not (contains? (arities error-fn) 2))))
+  (and error-fn (not (accepts-arity? error-fn 2))))
 
 (defn- error-arity-2->1 [error]
   (fn [context ex]

test/clj/reitit/pedestal_test.clj

@@ -6,10 +6,39 @@
             [reitit.http.interceptors.exception :as exception]
             [reitit.pedestal :as pedestal]))
 
-(deftest arities-test
-  (is (= #{0} (#'pedestal/arities (fn []))))
-  (is (= #{1} (#'pedestal/arities (fn [_]))))
-  (is (= #{0 1 2} (#'pedestal/arities (fn ([]) ([_]) ([_ _]))))))
+(deftest signatures-test
+  (is (= #{{:arity 0, :variadic? false}} (#'pedestal/signatures (fn []))))
+  (is (= #{{:arity 1, :variadic? false}} (#'pedestal/signatures (fn [_]))))
+  (is (= #{{:arity 0, :variadic? false}
+           {:arity 1, :variadic? false}
+           {:arity 2, :variadic? false}}
+         (#'pedestal/signatures (fn ([]) ([_]) ([_ _])))))
+  (testing "variadic fns report their required arity"
+    (is (= #{{:arity 0, :variadic? true}} (#'pedestal/signatures (fn [& _]))))
+    (is (= #{{:arity 1, :variadic? true}} (#'pedestal/signatures (fn [_ & _]))))
+    (is (= #{{:arity 1, :variadic? false}
+             {:arity 2, :variadic? true}}
+           (#'pedestal/signatures (fn ([_]) ([_ _ & _]))))))
+  (testing ":arglists metadata is preferred over reflection"
+    (is (= #{{:arity 2, :variadic? false}}
+           (#'pedestal/signatures (with-meta (fn [& _]) {:arglists '([_ _])}))))
+    (is (= #{{:arity 0, :variadic? false}
+             {:arity 1, :variadic? false}}
+           (#'pedestal/signatures (with-meta (fn [& _]) {:arglists '([] [_])}))))))
+
+(deftest accepts-arity?-test
+  (testing "fixed arities"
+    (is (#'pedestal/accepts-arity? (fn [_ _]) 2))
+    (is (not (#'pedestal/accepts-arity? (fn [_]) 2)))
+    (is (not (#'pedestal/accepts-arity? (fn [_ _ _]) 2))))
+  (testing "variadic arities accept their required arity or more"
+    (is (#'pedestal/accepts-arity? (fn [& _]) 2))
+    (is (#'pedestal/accepts-arity? (fn [_ & _]) 2))
+    (is (not (#'pedestal/accepts-arity? (fn [_ _ _ & _]) 2))))
+  (testing ":arglists metadata is preferred over reflection"
+    (is (#'pedestal/accepts-arity? (with-meta (fn [& _]) {:arglists '([_ _])}) 2))
+    (is (#'pedestal/accepts-arity? (with-meta (fn [& _]) {:arglists '([_ & _])}) 2))
+    (is (not (#'pedestal/accepts-arity? (with-meta (fn [& _]) {:arglists '([_])}) 2)))))
 
 (deftest interceptor-test
   (testing "without :enter, :leave or :error are stripped"
@@ -19,8 +48,7 @@
                                (-> interceptor
                                    (pedestal/->interceptor)
                                    (:error)
-                                   (#'pedestal/arities)
-                                   (contains? 2)))]
+                                   (#'pedestal/accepts-arity? 2)))]
       (is (has-2-arity-error? {:error (fn [_])}))
       (is (has-2-arity-error? {:error (fn [_ _])}))
       (is (has-2-arity-error? {:error (fn [_ _ _])}))