Skip to content

Commit

Permalink
finish it
Browse files Browse the repository at this point in the history
  • Loading branch information
@ikitommi
ikitommi committed Jan 27, 2024
1 parent a644bfa commit e34e1fb
Show file tree
Hide file tree
Showing 6 changed files with 175 additions and 63 deletions.
12 changes: 12 additions & 0 deletions CHANGELOG.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,18 @@ We use [Break Versioning][breakver]. The version numbers follow a `<major>.<mino

Malli is in well matured [alpha](README.md#alpha).

## Unreleased

* `:=>` 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
Expand Down
72 changes: 67 additions & 5 deletions docs/function-schemas.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down Expand Up @@ -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<output
(m/schema
[:=>
[: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<output (fn [x] (inc x)))
; nil

(m/explain input<output (fn [x] x))
;{:schema ...
; :value #object[user$eval19073$fn__19074],
; :errors ({:path [],
; :in [],
; :schema ...,
; :value #object[user$eval19073$fn__19074],
; :check {:total-nodes-visited 1,
; :result false,
; :result-data nil,
; :smallest [(0)],
; :time-shrinking-ms 0,
; :pass? false,
; :depth 0,
; :malli.core/result 0}},
; {:path [2],
; :in [],
; :schema [:fn
; #:error{:message "argument should be less than return"}
; (fn [[[arg] ret]] (< arg ret))],
; :value [(0) 0]})}

(me/humanize *1)
; ["invalid function" "argument should be less than return"]
```

Idetical schema using the Schema AST syntax:

```clojure
(m/from-ast
{:type :=>
: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.
Expand Down Expand Up @@ -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}]]}
Expand All @@ -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
Expand Down
10 changes: 8 additions & 2 deletions src/malli/core.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 [_])
Expand Down Expand Up @@ -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]
Expand Down
79 changes: 45 additions & 34 deletions src/malli/dev/pretty.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))))

Expand All @@ -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
Expand All @@ -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)))))]
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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]
Expand All @@ -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
Expand Down
16 changes: 8 additions & 8 deletions src/malli/generator.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand Down
Loading

0 comments on commit e34e1fb

Please sign in to comment.