diff --git a/CHANGELOG.md b/CHANGELOG.md index 64a26b2c6..ea5432a6c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,18 @@ We use [Break Versioning][breakver]. The version numbers follow a `.` takes optional 3rd child, the guard schema validating vector of arguments and return value `[args ret]`. See [Function Guards](docs/function-schemas.md#function-guards) for more details. + +```clojure +;; function of arg:int -> ret:int, where arg < ret +[:=> + [:cat :int] + :int + [:fn (fn [[[arg] ret]] (< arg ret))]] +``` + ## 0.14.0 (2024-01-16) * Better development-time tooling diff --git a/docs/function-schemas.md b/docs/function-schemas.md index 5ca0ae5b3..10f283040 100644 --- a/docs/function-schemas.md +++ b/docs/function-schemas.md @@ -78,7 +78,10 @@ Examples of function definitions: [:=> [:catn [:x :int] [:xs [:+ :int]]] :int] - + +;; arg:int -> ret:int, arg > ret +[:=> [:cat :int] :int [:fn (fn [[arg] ret] (> arg ret))]] + ;; multi-arity function [:function [:=> [:cat :int] :int] @@ -156,6 +159,65 @@ Smallest failing invocation is `(str 0 0)`, which returns `"00"`, which is not a But, why `mg/function-checker` is not enabled by default? The reason is that it uses generartive testing, which is orders of magnitude slower than normal validation and requires an extra dependency to `test.check`, which would make `malli.core` much heavier. This would be expecially bad for CLJS bundle size. +### Function Guards + +`:=>` accepts optional third child, a guard schema that is used to validate a vector of function arguments and return value. + +```clojure +;; function schema of arg:int -> ret:int, where arg < ret +;; with generative function checking always enabled +(def input + [:cat :int] + :int + [:fn {:error/message "argument should be less than return"} + (fn [[[arg] ret]] (< arg ret))]] + {::m/function-checker mg/function-checker})) + +(m/explain input + :input {:type :cat + :children [{:type :int}]} + :output {:type :int} + :guard {:type :fn + :value (fn [[[arg] ret]] (< arg ret)) + :properties {:error/message "argument should be less than return"}}} + {::m/function-checker mg/function-checker}) +``` + ### Generating Functions We can also generate function implementations based on the function schemas. The generated functions check the function arity and arguments at runtime and return generated values. @@ -620,8 +682,8 @@ It's main entry points is `dev/start!`, taking same options as `mi/instrument!`. (m/=> plus1 [:=> [:cat :int] [:int {:max 6}]]) (dev/start!) -; =prints=> ..instrumented #'user/plus1 -; =prints=> started instrumentation +; malli: instrumented 1 function var +; malli: dev-mode started (plus1 "6") ; =throws=> :malli.core/invalid-input {:input [:cat :int], :args ["6"], :schema [:=> [:cat :int] [:int {:max 6}]]} @@ -636,8 +698,8 @@ It's main entry points is `dev/start!`, taking same options as `mi/instrument!`. ; => 7 (dev/stop!) -; =prints=> ..unstrumented #'user/plus1 -; =prints=> stopped instrumentation +; malli: unstrumented 1 function vars +; malli: dev-mode stopped ``` ## ClojureScript support diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 6027bfe66..0d872620e 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -1752,7 +1752,8 @@ (reify AST (-from-ast [parent {:keys [input output guard properties]} options] - (-into-schema parent properties [(from-ast input options) (from-ast output options) guard] options)) + (-into-schema parent properties (cond-> [(from-ast input options) (from-ast output options)] + guard (conj (from-ast guard))) options)) IntoSchema (-type [_] :=>) (-type-properties [_]) @@ -1781,7 +1782,12 @@ (if (not (fn? x)) (conj acc (miu/-error path in this x)) (if-let [res (checker x)] - (conj acc (assoc (miu/-error path in this x) :check res)) + (let [{::keys [explain-input explain-output explain-guard]} res + res (dissoc res ::explain-input ::explain-output ::explain-guard) + {:keys [path in] :as error} (assoc (miu/-error path in this x) :check res) + -push (fn [acc i e] + (cond-> acc e (into (map #(assoc % :path (conj path i), :in in) (:errors e)))))] + (-> (conj acc error) (-push 0 explain-input) (-push 1 explain-output) (-push 2 explain-guard))) acc))) (let [validator (-validator this)] (fn explain [x in acc] diff --git a/src/malli/dev/pretty.cljc b/src/malli/dev/pretty.cljc index c153eb456..1c54fbd80 100644 --- a/src/malli/dev/pretty.cljc +++ b/src/malli/dev/pretty.cljc @@ -13,7 +13,7 @@ :width 80 :colors v/-dark-colors :unknown (fn [x] (when (m/schema? x) (m/form x))) - :throwing-fn-top-level-ns-names ["malli" "clojure" "malli"] + :throwing-fn-top-level-ns-names ["malli" "clojure" "malli" "nrepl"] ::me/mask-valid-values '...} options)))) @@ -28,7 +28,7 @@ (v/-print-doc printer))) (defn -ref-text [printer] - [:group "Reference should be one of the following:" :break :break + [:group "Reference should be one of the following" :break :break "- a qualified keyword, " (v/-visit [:ref :user/id] printer) :break "- a qualified symbol, " (v/-visit [:ref (symbol "'user" "id")] printer) :break "- a string, " (v/-visit [:ref "user/id"] printer) :break @@ -40,52 +40,63 @@ (defmethod v/-format ::m/explain [_ {:keys [schema] :as explanation} printer] {:body [:group - (v/-block "Value:" (v/-visit (me/error-value explanation printer) printer) printer) :break :break - (v/-block "Errors:" (v/-visit (me/humanize (me/with-spell-checking explanation)) printer) printer) :break :break - (v/-block "Schema:" (v/-visit schema printer) printer) :break :break - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]}) + (v/-block "Value" (v/-visit (me/error-value explanation printer) printer) printer) :break :break + (v/-block "Errors" (v/-visit (me/humanize (me/with-spell-checking explanation)) printer) printer) :break :break + (v/-block "Schema" (v/-visit schema printer) printer) :break :break + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]}) (defmethod v/-format ::m/coercion [_ {:keys [explain]} printer] (v/format (m/-exception ::m/explain explain) printer)) (defmethod v/-format ::m/invalid-input [_ {:keys [args input fn-name]} printer] - {:body [:group - (v/-block "Invalid function arguments:" (v/-visit args printer) printer) :break :break - (v/-block "Function Var:" (v/-visit fn-name printer) printer) :break :break - (v/-block "Input Schema:" (v/-visit input printer) printer) :break :break - (v/-block "Errors:" (-explain input args printer) printer) :break :break - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas" printer) printer)]}) + {:title "Invalid Function Input" + :body [:group + (v/-block "Invalid function arguments" (v/-visit args printer) printer) :break :break + (when fn-name [:span (v/-block "Function Var" (v/-visit fn-name printer) printer) :break :break]) + (v/-block "Input Schema" (v/-visit input printer) printer) :break :break + (v/-block "Errors" (-explain input args printer) printer) :break :break + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas" printer) printer)]}) (defmethod v/-format ::m/invalid-output [_ {:keys [value args output fn-name]} printer] - {:body [:group - (v/-block "Invalid function return value:" (v/-visit value printer) printer) :break :break - (v/-block "Function Var:" (v/-visit fn-name printer) printer) :break :break - (v/-block "Function arguments:" (v/-visit args printer) printer) :break :break - (v/-block "Output Schema:" (v/-visit output printer) printer) :break :break - (v/-block "Errors:" (-explain output value printer) printer) :break :break - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas" printer) printer)]}) + {:title "Invalid Function Output" + :body [:group + (v/-block "Invalid function return value" (v/-visit value printer) printer) :break :break + (when fn-name [:span (v/-block "Function Var" (v/-visit fn-name printer) printer) :break :break]) + (v/-block "Function arguments" (v/-visit args printer) printer) :break :break + (v/-block "Output Schema" (v/-visit output printer) printer) :break :break + (v/-block "Errors" (-explain output value printer) printer) :break :break + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas" printer) printer)]}) + +(defmethod v/-format ::m/invalid-guard [_ {:keys [value args guard fn-name]} printer] + {:title "Function Guard Error" + :body [:group + (when fn-name [:span (v/-block "Function Var" (v/-visit fn-name printer) printer) :break :break]) + (v/-block "Guard arguments" (v/-visit [args value] printer) printer) :break :break + (v/-block "Guard Schema" (v/-visit guard printer) printer) :break :break + (v/-block "Errors" (-explain guard [args value] printer) printer) :break :break + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas" printer) printer)]}) (defmethod v/-format ::m/invalid-arity [_ {:keys [args arity schema fn-name]} printer] {:body [:group - (v/-block (str "Invalid function arity (" arity "):") (v/-visit args printer) printer) :break :break - (v/-block "Function Schema:" (v/-visit schema printer) printer) :break :break - #?(:cljs (v/-block "Function Var:" (v/-visit fn-name printer) printer)) :break :break - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas" printer) printer)]}) + (v/-block (str "Invalid function arity (" arity ")") (v/-visit args printer) printer) :break :break + (v/-block "Function Schema" (v/-visit schema printer) printer) :break :break + #?(:cljs (v/-block "Function Var" (v/-visit fn-name printer) printer)) :break :break + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas" printer) printer)]}) (defmethod v/-format ::m/register-function-schema [_ {:keys [ns name schema _data key _exception]} printer] {:title "Error in registering a Function Schema" :body [:group - (v/-block "Function Var:" [:group - (v/-visit (symbol (str ns) (str name)) printer) - " (" (v/-visit key printer) ")"] printer) :break :break - (v/-block "Function Schema:" (v/-visit schema printer) printer) :break :break - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas" printer) printer)]}) + (v/-block "Function Var" [:group + (v/-visit (symbol (str ns) (str name)) printer) + " (" (v/-visit key printer) ")"] printer) :break :break + (v/-block "Function Schema" (v/-visit schema printer) printer) :break :break + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT/doc/function-schemas" printer) printer)]}) (defmethod v/-format ::m/invalid-ref [_ {:keys [ref]} printer] {:body [:group (v/-block "Invalid Reference" (v/-visit [:ref ref] printer) printer) :break :break (v/-block "Reason" (-ref-text printer) printer) :break :break - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]}) + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]}) (defmethod v/-format ::m/invalid-schema [_ {:keys [schema form]} printer] (let [proposals (seq (me/-most-similar-to #{schema} schema (set (keys (mr/schemas m/default-registry)))))] @@ -95,7 +106,7 @@ (when proposals [:group (v/-block "Did you mean" (->> (for [proposal proposals] (v/-visit proposal printer)) (interpose :break)) printer) :break :break]) - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]})) + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]})) (defmethod v/-format ::m/child-error [_ {:keys [type children properties] :as data} printer] (let [form (m/-raw-form type properties children) @@ -107,7 +118,7 @@ (v/-block "Reason" [:group "Schema has " (v/-visit size printer) (if (= 1 size) " child" " children") ", expected " (v/-visit constraints printer)] printer) :break :break - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]})) + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]})) (defmethod v/-format ::m/invalid-entry [_ {:keys [entry]} printer] (let [wrap (if (sequential? entry) vec vector) @@ -117,14 +128,14 @@ :body [:group (v/-block "Invalid Entry" (v/-visit entry printer) printer) :break :break (v/-block "Did you mean" (v/-visit example printer) printer) :break :break - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]})) + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]})) (defmethod v/-format ::m/duplicate-keys [_ {:keys [arr]} printer] (let [keys (->> arr (vec) (take-nth 2))] {:title "Schema Creation Error" :body [:group (v/-block "Duplicate Keys" (v/-visit keys printer) printer) :break :break - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]})) + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]})) (defmethod v/-format :malli.edn/var-parsing-not-supported [_ {:keys [string var]} printer] (let [parse (fn [string] @@ -144,7 +155,7 @@ ~string {:malli.edn/edamame-options {:regex true, :fn true, :var resolve}}) printer)] printer) :break :break - (v/-block "More information:" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]})) + (v/-block "More information" (v/-link "https://cljdoc.org/d/metosin/malli/CURRENT" printer) printer)]})) ;; ;; public api diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index 77fc0c9cf..16ac6fcbe 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -561,7 +561,7 @@ ([?schema] (function-checker ?schema nil)) ([?schema {::keys [=>iterations] :or {=>iterations 100} :as options}] (let [schema (m/schema ?schema options) - -try (fn [f] (try (f) (catch #?(:clj Exception, :cljs js/Error) e e))) + -try (fn [f] (try [(f) true] (catch #?(:clj Exception, :cljs js/Error) e [e false]))) check (fn [schema] (let [{:keys [input output guard]} (m/-function-info schema) input-generator (generator input options) @@ -574,13 +574,13 @@ smallest (-> shrunk :smallest first)] (when-not (true? result) (let [explain-input (m/explain input smallest) - result (when-not explain-input (-try (fn [] (apply f smallest)))) - explain-output (when-not explain-input (m/explain output result)) - explain-guard (when (and guard (not explain-input)) (m/explain guard [smallest result]))] - (cond-> (assoc shrunk ::result result) - explain-input (assoc ::explain-input explain-input) - explain-output (assoc ::explain-output explain-output) - explain-guard (assoc ::explain-guard explain-guard) + [result success] (when-not explain-input (-try (fn [] (apply f smallest)))) + explain-output (when (and success (not explain-input)) (m/explain output result)) + explain-guard (when (and success guard (not explain-output)) (m/explain guard [smallest result]))] + (cond-> (assoc shrunk ::m/result result) + explain-input (assoc ::m/explain-input explain-input) + explain-output (assoc ::m/explain-output explain-output) + explain-guard (assoc ::m/explain-guard explain-guard) (ex-message result) (-> (update :result ex-message) (dissoc :result-data)))))))))] (condp = (m/type schema) :=> (check schema) diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 10922f15a..38db46708 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -2363,13 +2363,29 @@ (is (false? (m/validate schema2 (fn [x y] (str x y))))) (is (nil? (explain-times function-schema-validation-times schema2 (fn [x y] (unchecked-add x y))))) - (is (results= {:schema [:=> [:cat int? int?] int?] - :value single-arity - :errors [{:path [] - :in [] - :schema [:=> [:cat int? int?] int?] - :value single-arity}]} - (m/explain schema2 single-arity))) + + (testing "exception in execution causes single error to root schema path" + (is (results= {:schema [:=> [:cat int? int?] int?] + :value single-arity + :errors [{:path [] + :in [] + :schema [:=> [:cat int? int?] int?] + :value single-arity}]} + (m/explain schema2 single-arity)))) + + (testing "error in output adds error to child in path 1" + (let [f (fn [x y] (str x y))] + (is (results= {:schema [:=> [:cat int? int?] int?] + :value f + :errors [{:path [] + :in [] + :schema [:=> [:cat int? int?] int?] + :value f} + {:path [1] + :in [] + :schema int? + :value "00"}]} + (m/explain schema2 f))))) (is (= single-arity (m/decode schema2 single-arity mt/string-transformer))) @@ -2465,13 +2481,18 @@ (is (= nil (m/explain schema valid))) - (is (results= {:schema schema, - :value invalid - :errors [{:path [], - :in [], - :schema schema - :value invalid}]} - (m/explain schema invalid))) + (testing "error in guard adds error on path 2" + (is (results= {:schema schema, + :value invalid + :errors [{:path [], + :in [], + :schema schema + :value invalid} + {:path [2] + :in [] + :schema [:fn guard] + :value ['(0 0) 0]}]} + (m/explain schema invalid)))) (testing "instrument" (let [schema [:=> [:cat :int] :int [:fn (fn [[[arg] ret]] (< arg ret))]]