Skip to content
Snippets Groups Projects
Unverified Commit 50080815 authored by Cam Saul's avatar Cam Saul Committed by GitHub
Browse files

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

parent 7c4ef577
No related branches found
No related tags found
No related merge requests found
......@@ -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#)))))
......@@ -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)))))
......@@ -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))))
......@@ -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)
......
......@@ -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?]
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment