`mu/defn` should include fn name in errors & perf improvements (#33069)

src/metabase/util/malli.cljc

@@ -74,6 +74,12 @@
    (defmacro defmethod
      "Like [[schema.core/defmethod]], but for Malli."
      [multifn dispatch-value & fn-tail]
-     `(.addMethod ~(vary-meta multifn assoc :tag 'clojure.lang.MultiFn)
-                  ~dispatch-value
-                  ~(mu.fn/instrumented-fn-form (mu.fn/parse-fn-tail fn-tail)))))
+     (let [dispatch-value-symb (gensym "dispatch-value-")
+           error-context-symb  (gensym "error-context-")]
+       `(let [~dispatch-value-symb ~dispatch-value
+              ~error-context-symb  {:fn-name        '~multifn
+                                    :dispatch-value ~dispatch-value-symb}
+              f#                   ~(mu.fn/instrumented-fn-form error-context-symb (mu.fn/parse-fn-tail fn-tail))]
+          (.addMethod ~(vary-meta multifn assoc :tag 'clojure.lang.MultiFn)
+                      ~dispatch-value-symb
+                      f#)))))

src/metabase/util/malli/defn.clj

@@ -73,5 +73,6 @@
     `(def ~(vary-meta fn-name merge attr-map)
        ~docstring
        ~(macros/case
-          :clj  (mu.fn/instrumented-fn-form parsed)
+          :clj  (let [error-context {:fn-name (list 'quote (symbol (name (ns-name *ns*)) (name fn-name)))}]
+                  (mu.fn/instrumented-fn-form error-context parsed))
           :cljs (mu.fn/deparameterized-fn-form parsed)))))

src/metabase/util/malli/fn.clj

@@ -103,32 +103,32 @@
   use [[metabase.util.malli/disable-enforcement]] to bind this only in Clojure code."
   true)
 
-(defn- validate [schema value error-type]
+(defn- validate [error-context schema value error-type]
   (when *enforce*
-    ;; `validate` is significantly faster than `explain` if `value` is actually valid.
-    (when-not (mr/validate schema value)
-      (let [error     (mr/explain schema value)
-            humanized (me/humanize error)]
+    (when-let [error (mr/explain schema value)]
+      (let [humanized (me/humanize error)]
         (throw (ex-info (case error-type
                           ::invalid-input  (i18n/tru "Invalid input: {0}" (pr-str humanized))
                           ::invalid-output (i18n/tru "Invalid output: {0}" (pr-str humanized)))
-                        {:type      error-type
-                         :error     error
-                         :humanized humanized
-                         :schema    schema
-                         :value     value}))))))
+                        (merge
+                         {:type      error-type
+                          :error     error
+                          :humanized humanized
+                          :schema    schema
+                          :value     value}
+                         error-context)))))))
 
 (defn validate-input
   "Impl for [[metabase.util.malli.fn/fn]]; validates an input argument with `value` against `schema` using a cached
   explainer and throws an exception if the check fails."
-  [schema value]
-  (validate schema value ::invalid-input))
+  [error-context schema value]
+  (validate error-context schema value ::invalid-input))
 
 (defn validate-output
   "Impl for [[metabase.util.malli.fn/fn]]; validates function output `value` against `schema` using a cached explainer
   and throws an exception if the check fails. Returns validated value."
-  [schema value]
-  (validate schema value ::invalid-output)
+  [error-context schema value]
+  (validate error-context schema value ::invalid-output)
   value)
 
 (defn- varargs-schema? [[_cat & args :as _input-schema]]
@@ -154,7 +154,7 @@
            (concat (butlast arg-names) ['& (last arg-names)])
            arg-names))))
 
-(defn- input-schema->validation-forms [[_cat & schemas :as input-schema]]
+(defn- input-schema->validation-forms [error-context [_cat & schemas :as input-schema]]
   (let [arg-names (input-schema-arg-names input-schema)
         schemas   (if (varargs-schema? input-schema)
                     (concat (butlast schemas) [[:maybe (last schemas)]])
@@ -167,7 +167,7 @@
                 (when-not (= schema (if (= arg-name 'more)
                                       [:maybe [:* :any]]
                                       :any))
-                  `(validate-input ~schema ~arg-name)))
+                  `(validate-input ~error-context ~schema ~arg-name)))
               arg-names
               schemas)
          (filter some?))))
@@ -178,28 +178,29 @@
       (list* `apply '&f arg-names)
       (list* '&f arg-names))))
 
-(defn- instrumented-arity [[_=> input-schema output-schema]]
+(defn- instrumented-arity [error-context [_=> input-schema output-schema]]
   (let [input-schema           (if (= input-schema :cat)
                                  [:cat]
                                  input-schema)
         arglist                (input-schema->arglist input-schema)
-        input-validation-forms (input-schema->validation-forms input-schema)
+        input-validation-forms (input-schema->validation-forms error-context input-schema)
         result-form            (input-schema->application-form input-schema)
         result-form            (if (and output-schema
                                         (not= output-schema :any))
                                  `(->> ~result-form
-                                       (validate-output ~output-schema))
+                                       (validate-output ~error-context ~output-schema))
                                  result-form)]
     `(~arglist ~@input-validation-forms ~result-form)))
 
-(defn- instrumented-fn-tail [[schema-type :as schema]]
+(defn- instrumented-fn-tail [error-context [schema-type :as schema]]
   (case schema-type
     :=>
-    [(instrumented-arity schema)]
+    [(instrumented-arity error-context schema)]
 
     :function
     (let [[_function & schemas] schema]
-      (map instrumented-arity schemas))))
+      (for [schema schemas]
+        (instrumented-arity error-context schema)))))
 
 (defn instrumented-fn-form
   "Given a `fn-tail` like
@@ -212,9 +213,9 @@
 
     (mc/-instrument {:schema [:=> [:cat :int :any] :any]}
                     (fn [x y] (+ 1 2)))"
-  [parsed]
+  [error-context parsed]
   `(let [~'&f ~(deparameterized-fn-form parsed)]
-     (core/fn ~@(instrumented-fn-tail (fn-schema parsed)))))
+     (core/fn ~@(instrumented-fn-tail error-context (fn-schema parsed)))))
 
 (defmacro fn
   "Malli version of [[schema.core/fn]]. A form like
@@ -225,8 +226,17 @@
 
     (let [&f (fn [x] (inc x))]
       (fn [a]
-        (validate-input :int a)
-        (validate-output :int (&f a))))
+        (validate-input {} :int a)
+        (validate-output {} :int (&f a))))
+
+  The map arg here is additional error context; for something like [[metabase.util.malli/defn]], it will be something
+  like
+
+    {:fn-name 'metabase.lib.field/resolve-field-id}
+
+  for [[metabase.util.malli/defmethod]] it will be something like
+
+    {:fn-name 'whatever/my-multimethod, :dispatch-value :field}
 
   Known issue: this version of `fn` does not capture the optional function name and make it available, e.g. you can't
   do
@@ -245,7 +255,7 @@
         ([a]
          (&f a))
         ([a b]
-         (validate-input :int b)
+         (validate-input {} :int b)
          (&f a b))))
 
     ;; skips the `:- :int` check on `y` in the 2-arity
@@ -256,4 +266,7 @@
   problem for another day. The passed function name comes back from [[mc/parse]] as `:name` if we want to attempt to
   fix this later."
   [& fn-tail]
-  (instrumented-fn-form (parse-fn-tail fn-tail)))
+  (let [error-context (if (symbol? (first fn-tail))
+                        {:fn-name (list 'quote (first fn-tail))}
+                        {})]
+    (instrumented-fn-form error-context (parse-fn-tail fn-tail))))

src/metabase/util/malli/registry.cljc

@@ -15,17 +15,6 @@
         (swap! cache assoc-in [k schema] v)
         v)))
 
-(defn explainer
-  "Fetch a cached [[mc/explainer]] for `schema`, creating one if needed. The cache is flushed whenever the registry
-  changes."
-  [schema]
-  (cached :explainer schema #_{:clj-kondo/ignore [:discouraged-var]} #(mc/explainer schema)))
-
-(defn explain
-  "[[mc/explain]], but uses a cached explainer from [[explainer]]."
-  [schema value]
-  ((explainer schema) value))
-
 (defn validator
   "Fetch a cached [[mc/validator]] for `schema`, creating one if needed. The cache is flushed whenever the registry
   changes."
@@ -37,6 +26,26 @@
   [schema value]
   ((validator schema) value))
 
+(defn explainer
+  "Fetch a cached [[mc/explainer]] for `schema`, creating one if needed. The cache is flushed whenever the registry
+  changes."
+  [schema]
+  (letfn [(make-explainer []
+            #_{:clj-kondo/ignore [:discouraged-var]}
+            (let [validator* (mc/validator schema)
+                  explainer* (mc/explainer schema)]
+              ;; for valid values, it's significantly faster to just call the validator. Let's optimize for the 99.9%
+              ;; of calls whose values are valid.
+              (fn schema-explainer [value]
+                (when-not (validator* value)
+                  (explainer* value)))))]
+    (cached :explainer schema make-explainer)))
+
+(defn explain
+  "[[mc/explain]], but uses a cached explainer from [[explainer]]."
+  [schema value]
+  ((explainer schema) value))
+
 (defonce ^:private registry*
   (atom (merge (mc/default-schemas)
                (mut/schemas)

test/metabase/util/malli/fn_test.clj

@@ -57,30 +57,30 @@
 
 (deftest ^:parallel instrumented-fn-form-test
   (are [form expected] (= expected
-                          (walk/macroexpand-all (mu.fn/instrumented-fn-form (mu.fn/parse-fn-tail form))))
+                          (walk/macroexpand-all (mu.fn/instrumented-fn-form {} (mu.fn/parse-fn-tail form))))
     '([x :- :int y])
     '(let* [&f (fn* ([x y]))]
        (fn* ([a b]
-             (metabase.util.malli.fn/validate-input :int a)
+             (metabase.util.malli.fn/validate-input {} :int a)
              (&f a b))))
 
     '(:- :int [x :- :int y])
     '(let* [&f (fn* ([x y]))]
        (fn* ([a b]
-             (metabase.util.malli.fn/validate-input :int a)
-             (metabase.util.malli.fn/validate-output :int (&f a b)))))
+             (metabase.util.malli.fn/validate-input {} :int a)
+             (metabase.util.malli.fn/validate-output {} :int (&f a b)))))
 
     '(:- :int [x :- :int y] (+ x y))
     '(let* [&f (fn* ([x y] (+ x y)))]
        (fn* ([a b]
-             (metabase.util.malli.fn/validate-input :int a)
-             (metabase.util.malli.fn/validate-output :int (&f a b)))))
+             (metabase.util.malli.fn/validate-input {} :int a)
+             (metabase.util.malli.fn/validate-output {} :int (&f a b)))))
 
     '([x :- :int y] {:pre [(int? x)]})
     '(let* [&f (fn* ([x y]
                      {:pre [(int? x)]}))]
        (fn* ([a b]
-             (metabase.util.malli.fn/validate-input :int a)
+             (metabase.util.malli.fn/validate-input {} :int a)
              (&f a b))))
 
     '(:- :int
@@ -92,10 +92,10 @@
                      (+ x y)))]
        (fn*
         ([a]
-         (metabase.util.malli.fn/validate-output :int (&f a)))
+         (metabase.util.malli.fn/validate-output {} :int (&f a)))
         ([a b]
-         (metabase.util.malli.fn/validate-input :int a)
-         (metabase.util.malli.fn/validate-output :int (&f a b)))))))
+         (metabase.util.malli.fn/validate-input {} :int a)
+         (metabase.util.malli.fn/validate-output {} :int (&f a b)))))))
 
 (deftest ^:parallel fn-test
   (let [f (mu.fn/fn :- :int [y] y)]
@@ -126,7 +126,7 @@
          (f 1)))))
 
 (deftest ^:parallel varargs-test
-  (let [form '(metabase.util.malli.fn/fn v2-load-internal!
+  (let [form '(metabase.util.malli.fn/fn my-fn
                 [path
                  opts :- :map
                  & {:keys [token-check?]
@@ -137,14 +137,14 @@
                         (merge {:path path, :token-check? token-check?} opts))]
               (clojure.core/fn
                 ([a b & more]
-                 (metabase.util.malli.fn/validate-input :map b)
+                 (metabase.util.malli.fn/validate-input {:fn-name 'my-fn} :map b)
                  (clojure.core/apply &f a b more))))
            (macroexpand form)))
     (is (= [:=>
             [:cat :any :map [:* :any]]
             :any]
            (mu.fn/fn-schema (mu.fn/parse-fn-tail (rest form))))))
-  (let [f (mu.fn/fn v2-load-internal!
+  (let [f (mu.fn/fn my-fn
             [path
              opts :- :map
              & {:keys [token-check?]