From 15b56d0f9fdde198fb3e966f70068cc580cc56dd Mon Sep 17 00:00:00 2001 From: Dmitry Dzhus Date: Mon, 25 Nov 2024 18:56:42 +0000 Subject: [PATCH 01/12] Failing test --- test/malli/core_test.cljc | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 8c4641381..1b4219eec 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -997,6 +997,18 @@ (mt/key-transformer {:decode #(-> % name (str "_key") keyword)})))) + (testing "JSON transformer decodes map schema keys" + (let [schema [:map + [:a :uuid] + [:b [:enum :x :y :z]]] + value {"a" "b699671c-d34d-b33f-1337-dbdbfd337e73" + "b" "x"} + decoded-value (m/decode schema value mt/json-transformer)] + (is (= {:a #uuid "b699671c-d34d-b33f-1337-dbdbfd337e73" + :b :x} + decoded-value)) + (is (m/validate schema decoded-value)))) + (is (= {:x 32} (m/decode [:map {:decode/string '{:enter #(update % :x inc), :leave #(update % :x (partial * 2))}} From 1abc8e3b42514313c6c4a41f255613de5fef228c Mon Sep 17 00:00:00 2001 From: Dmitry Dzhus Date: Mon, 25 Nov 2024 18:58:48 +0000 Subject: [PATCH 02/12] Direct fix --- src/malli/transform.cljc | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/malli/transform.cljc b/src/malli/transform.cljc index 5cc6e7877..0dc410bdf 100644 --- a/src/malli/transform.cljc +++ b/src/malli/transform.cljc @@ -415,6 +415,8 @@ (-transform-if-valid key-schema) (-transform-map-keys)) (-transform-map-keys m/-keyword->string))))}) + (assoc :map {:compile (fn [_ _] + (-transform-map-keys -string->keyword))}) (cond-> json-vectors (assoc :vector -sequential->vector))) :encoders (-json-encoders)}))) From 7d44b1c10c1484eb0439cbf6068350c708065f17 Mon Sep 17 00:00:00 2001 From: Dmitry Dzhus Date: Mon, 25 Nov 2024 19:02:39 +0000 Subject: [PATCH 03/12] CHANGELOG --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 92a344374..5866e876e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,6 +19,7 @@ Malli is in well matured [alpha](README.md#alpha). * **BREAKING**: `:gen/fmap` property requires its schema to create a generator. * previous behavior defaulted to a `nil`-returning generator, even if the schema doesn't accept `nil` * use `:gen/return nil` property to restore this behavior + * Decode map keys into keywords for `[:map` schemas in `json-transformer` [#1135](https://github.com/metosin/malli/issues/1135) * FIX: `malli.registry/{mode,type}` not respected in Babashka [#1124](https://github.com/metosin/malli/issues/1124) * Updated dependencies: From cb8e7f73106c8cfc6dad570c1d119b39b57c4fe5 Mon Sep 17 00:00:00 2001 From: Dmitry Dzhus Date: Tue, 26 Nov 2024 16:28:02 +0000 Subject: [PATCH 04/12] Unnest changelog entry --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5866e876e..c74a8f150 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,7 +19,7 @@ Malli is in well matured [alpha](README.md#alpha). * **BREAKING**: `:gen/fmap` property requires its schema to create a generator. * previous behavior defaulted to a `nil`-returning generator, even if the schema doesn't accept `nil` * use `:gen/return nil` property to restore this behavior - * Decode map keys into keywords for `[:map` schemas in `json-transformer` [#1135](https://github.com/metosin/malli/issues/1135) +* **BREAKING**: Decode map keys into keywords for `[:map` schemas in `json-transformer` [#1135](https://github.com/metosin/malli/issues/1135) * FIX: `malli.registry/{mode,type}` not respected in Babashka [#1124](https://github.com/metosin/malli/issues/1124) * Updated dependencies: From 761d62f6fd66c0c52b7c3825c03186ac0665f2b1 Mon Sep 17 00:00:00 2001 From: Dmitry Dzhus Date: Tue, 26 Nov 2024 16:29:49 +0000 Subject: [PATCH 05/12] Update test --- test/malli/core_test.cljc | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 1b4219eec..a1f49b579 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -997,16 +997,22 @@ (mt/key-transformer {:decode #(-> % name (str "_key") keyword)})))) - (testing "JSON transformer decodes map schema keys" - (let [schema [:map - [:a :uuid] - [:b [:enum :x :y :z]]] - value {"a" "b699671c-d34d-b33f-1337-dbdbfd337e73" - "b" "x"} - decoded-value (m/decode schema value mt/json-transformer)] - (is (= {:a #uuid "b699671c-d34d-b33f-1337-dbdbfd337e73" - :b :x} - decoded-value)) + (testing "JSON transformer can decode map schema keys" + (let [schema + [:map + [:a :uuid] + [:b [:enum :x :y :z]] + ["s" :boolean [:enum :f1 :f2]]] + value + {"a" "b699671c-d34d-b33f-1337-dbdbfd337e73" + "b" "x" + "s" "f1"} + expected-decoded-value + {:a #uuid "b699671c-d34d-b33f-1337-dbdbfd337e73" + :b :x + "s" :f1} + decoded-value (m/decode schema value (mt/json-transformer {::mt/keywordize-map-keys true}))] + (is (= expected-decoded-value decoded-value)) (is (m/validate schema decoded-value)))) (is (= {:x 32} From 5b1dbaf5fdafbe5661fc311feb8cdcab9d435bc9 Mon Sep 17 00:00:00 2001 From: Dmitry Dzhus Date: Tue, 26 Nov 2024 16:32:22 +0000 Subject: [PATCH 06/12] Opt-in, do not touch non-keyword schema keys --- src/malli/transform.cljc | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/malli/transform.cljc b/src/malli/transform.cljc index 0dc410bdf..c15dee72b 100644 --- a/src/malli/transform.cljc +++ b/src/malli/transform.cljc @@ -1,6 +1,7 @@ (ns malli.transform #?(:cljs (:refer-clojure :exclude [Inst Keyword UUID])) (:require [malli.core :as m] + [malli.util :as mu] [clojure.math :as math] #?(:cljs [goog.date.UtcDateTime]) #?(:cljs [goog.date.Date])) @@ -191,8 +192,11 @@ (catch #?(:clj Exception, :cljs js/Error) _ x)) x)) -(defn -transform-map-keys [f] - #(cond->> % (map? %) (into {} (map (fn [[k v]] [(f k) v]))))) +(defn -transform-map-keys + ([f] + #(cond->> % (map? %) (into {} (map (fn [[k v]] [(f k) v]))))) + ([ks f] + #(cond->> % (map? %) (into {} (map (fn [[k v]] [(cond-> k (contains? ks k) f) v])))))) (defn -transform-if-valid [f schema] (let [validator (m/-validator schema)] @@ -403,7 +407,9 @@ (defn json-transformer ([] (json-transformer nil)) - ([{::keys [json-vectors map-of-key-decoders] :or {map-of-key-decoders (-string-decoders)}}] + ([{::keys [json-vectors + keywordize-map-keys + map-of-key-decoders] :or {map-of-key-decoders (-string-decoders)}}] (transformer {:name :json :decoders (-> (-json-decoders) @@ -415,8 +421,13 @@ (-transform-if-valid key-schema) (-transform-map-keys)) (-transform-map-keys m/-keyword->string))))}) - (assoc :map {:compile (fn [_ _] - (-transform-map-keys -string->keyword))}) + (cond-> keywordize-map-keys + (assoc :map {:compile (fn [schema _] + (let [keyword-keys (->> (mu/keys schema) + (filter keyword?) + (map name) + set)] + (-transform-map-keys keyword-keys -string->keyword)))})) (cond-> json-vectors (assoc :vector -sequential->vector))) :encoders (-json-encoders)}))) From 6a1f515f772ca23d7cc106659ade96522b2875da Mon Sep 17 00:00:00 2001 From: Dmitry Dzhus Date: Tue, 26 Nov 2024 16:30:48 +0000 Subject: [PATCH 07/12] This is no longer a breaking change --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c74a8f150..678bf4470 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,7 +19,7 @@ Malli is in well matured [alpha](README.md#alpha). * **BREAKING**: `:gen/fmap` property requires its schema to create a generator. * previous behavior defaulted to a `nil`-returning generator, even if the schema doesn't accept `nil` * use `:gen/return nil` property to restore this behavior -* **BREAKING**: Decode map keys into keywords for `[:map` schemas in `json-transformer` [#1135](https://github.com/metosin/malli/issues/1135) +* Support decoding map keys into keywords for `[:map` schemas in `json-transformer` [#1135](https://github.com/metosin/malli/issues/1135) * FIX: `malli.registry/{mode,type}` not respected in Babashka [#1124](https://github.com/metosin/malli/issues/1124) * Updated dependencies: From 7a44cf64217963921385fae7c56bd3a37121f80f Mon Sep 17 00:00:00 2001 From: Ambrose Bonnaire-Sergeant Date: Tue, 26 Nov 2024 16:16:48 -0600 Subject: [PATCH 08/12] :not humanizer --- README.md | 45 +++++++++++- src/malli/error.cljc | 96 +++++++++++++++++-------- test/malli/error_test.cljc | 143 ++++++++++++++++++++++++++++++++++++- 3 files changed, 251 insertions(+), 33 deletions(-) diff --git a/README.md b/README.md index 1db306442..cd9d685ab 100644 --- a/README.md +++ b/README.md @@ -817,7 +817,50 @@ Or if you already have a malli validation exception (e.g. in a catch form): ## Custom error messages -Error messages can be customized with `:error/message` and `:error/fn` properties: +Error messages can be customized with `:error/message` and `:error/fn` properties. + +If `:error/message` is of a predictable structure, it will automatically support custom `[:not schema]` failures for the following locales: +- `:en` if message starts with `should` or `should not` then they will be swapped automatically. Otherwise, message is ignored. +```clojure +;; e.g., +(me/humanize + (m/explain + [:not + [:fn {:error/message {:en "should be a multiple of 3"}} + #(= 0 (mod % 3))]] + 3)) +; => ["should not be a multiple of 3"] +``` + +The first argument to `:error/fn` is a map with keys: +- `:schema`, the schema to explain +- `:value` (optional), the value to explain +- `:negated` (optional), a function returning the explanation of `(m/explain [:not schema] value)`. + If provided, then we are explaining the failure of negating this schema via `(m/explain [:not schema] value)`. + Note in this scenario, `(m/validate schema value)` is true. + If returning a string, + the resulting error message will be negated by the `:error/fn` caller in the same way as `:error/message`. + Returning `(negated string)` disables this behavior and `string` is used as the negated error message. +```clojure +;; automatic negation +(me/humanize + (m/explain + [:not [:fn {:error/fn {:en (fn [_ _] "should not be a multiple of 3")}} + #(not= 0 (mod % 3))]] + 1)) +; => ["should be a multiple of 3"] + +;; manual negation +(me/humanize + (m/explain [:not [:fn {:error/fn {:en (fn [{:keys [negated]} _] + (if negated + (negated "should not avoid being a multiple of 3") + "should not be a multiple of 3"))}} + #(not= 0 (mod % 3))]] 1)) +; => ["should not avoid being a multiple of 3"] +``` + +Here are some basic examples of `:error/message` and `:error/fn`: ```clojure (-> [:map diff --git a/src/malli/error.cljc b/src/malli/error.cljc index 6cc2a4313..3bd165b6b 100644 --- a/src/malli/error.cljc +++ b/src/malli/error.cljc @@ -3,16 +3,43 @@ [malli.core :as m] [malli.util :as mu])) +(declare default-errors error-message) + (defn -pr-str [v] #?(:clj (pr-str v), :cljs (str v))) (defn -pred-min-max-error-fn [{:keys [pred message]}] - (fn [{:keys [schema value]} _] + (fn [{:keys [schema value negated]} _] (let [{:keys [min max]} (m/properties schema)] (cond (not (pred value)) message (and min (= min max)) (str "should be " min) - (and min (< value min)) (str "should be at least " min) - max (str "should be at most " max))))) + (and min ((if negated >= <) value min)) (str "should be at least " min) + max (str "should be at most " max) + negated message)))) + +(let [prefix (str "-en-humanize-negation-" (random-uuid))] + (defn- -en-humanize-negation [{:keys [schema negated] :as error} options] + (if negated + (negated (error-message (dissoc error :negated) options)) + (let [remove-prefix #(str/replace-first % prefix "") + negated? #(str/starts-with? % prefix)] + (loop [schema schema] + (or (when-some [s (error-message (assoc error :negated #(some->> % (str prefix))) options)] + (if (negated? s) + (remove-prefix s) + (or (when (and (string? s) + (str/starts-with? s "should not ")) + (str/replace-first s "should not" "should")) + (when (and (string? s) + (str/starts-with? s "should ")) + (str/replace-first s "should" "should not"))))) + (let [dschema (m/deref schema)] + (when-not (identical? schema dschema) + (recur dschema))))))))) + +(defn- -forward-negation [?schema {:keys [negated] :as error} options] + (let [schema (m/schema ?schema options)] + (negated (error-message (-> error (dissoc :negated) (assoc :schema schema)) options)))) (def default-errors {::unknown {:error/message {:en "unknown error"}} @@ -64,8 +91,8 @@ 'uri? {:error/message {:en "should be a uri"}} #?@(:clj ['decimal? {:error/message {:en "should be a decimal"}}]) 'inst? {:error/message {:en "should be an inst"}} - 'seqable? {:error/message {:en "should be a seqable"}} - 'indexed? {:error/message {:en "should be an indexed"}} + 'seqable? {:error/message {:en "should be seqable"}} + 'indexed? {:error/message {:en "should be indexed"}} 'map? {:error/message {:en "should be a map"}} 'vector? {:error/message {:en "should be a vector"}} 'list? {:error/message {:en "should be a list"}} @@ -79,30 +106,33 @@ #?@(:clj ['rational? {:error/message {:en "should be a rational"}}]) 'coll? {:error/message {:en "should be a coll"}} 'empty? {:error/message {:en "should be empty"}} - 'associative? {:error/message {:en "should be an associative"}} - 'sequential? {:error/message {:en "should be a sequential"}} + 'associative? {:error/message {:en "should be associative"}} + 'sequential? {:error/message {:en "should be sequential"}} #?@(:clj ['ratio? {:error/message {:en "should be a ratio"}}]) #?@(:clj ['bytes? {:error/message {:en "should be bytes"}}]) :re {:error/message {:en "should match regex"}} - :=> {:error/message {:en "invalid function"}} + :=> {:error/message {:en "should be a valid function"}} 'ifn? {:error/message {:en "should be an ifn"}} - 'fn? {:error/message {:en "should be an fn"}} + 'fn? {:error/message {:en "should be a fn"}} :enum {:error/fn {:en (fn [{:keys [schema]} _] (str "should be " (if (= 1 (count (m/children schema))) (-pr-str (first (m/children schema))) (str "either " (->> (m/children schema) butlast (map -pr-str) (str/join ", ")) " or " (-pr-str (last (m/children schema)))))))}} + :not {:error/fn {:en (fn [{:keys [schema] :as error} options] + (-en-humanize-negation (assoc error :schema (-> schema m/children first)) options))}} :any {:error/message {:en "should be any"}} :nil {:error/message {:en "should be nil"}} - :string {:error/fn {:en (fn [{:keys [schema value]} _] + :string {:error/fn {:en (fn [{:keys [schema value negated]} _] (let [{:keys [min max]} (m/properties schema)] (cond (not (string? value)) "should be a string" (and min (= min max)) (str "should be " min " character" (when (not= 1 min) "s")) - (and min (< (count value) min)) (str "should be at least " min " character" - (when (not= 1 min) "s")) - max (str "should be at most " max " character" (when (not= 1 max) "s")))))}} + (and min ((if negated >= <) (count value) min)) (str "should be at least " min " character" + (when (not= 1 min) "s")) + max (str "should be at most " max " character" (when (not= 1 max) "s")) + negated "should be a string")))}} :int {:error/fn {:en (-pred-min-max-error-fn {:pred int?, :message "should be an integer"})}} :double {:error/fn {:en (-pred-min-max-error-fn {:pred double?, :message "should be a double"})}} :boolean {:error/message {:en "should be a boolean"}} @@ -111,22 +141,30 @@ :qualified-keyword {:error/message {:en "should be a qualified keyword"}} :qualified-symbol {:error/message {:en "should be a qualified symbol"}} :uuid {:error/message {:en "should be a uuid"}} - :> {:error/fn {:en (fn [{:keys [schema value]} _] - (if (number? value) - (str "should be larger than " (first (m/children schema))) - "should be a number"))}} - :>= {:error/fn {:en (fn [{:keys [schema value]} _] - (if (number? value) - (str "should be at least " (first (m/children schema))) - "should be a number"))}} - :< {:error/fn {:en (fn [{:keys [schema value]} _] - (if (number? value) - (str "should be smaller than " (first (m/children schema))) - "should be a number"))}} - :<= {:error/fn {:en (fn [{:keys [schema value]} _] - (if (number? value) - (str "should be at most " (first (m/children schema))) - "should be a number"))}} + :> {:error/fn {:en (fn [{:keys [schema value negated] :as error} options] + (if negated + (-forward-negation [:<= (first (m/children schema))] error options) + (if (number? value) + (str "should be larger than " (first (m/children schema))) + "should be a number")))}} + :>= {:error/fn {:en (fn [{:keys [schema value negated] :as error} options] + (if negated + (-forward-negation [:< (first (m/children schema))] error options) + (if (number? value) + (str "should be at least " (first (m/children schema))) + "should be a number")))}} + :< {:error/fn {:en (fn [{:keys [schema value negated] :as error} options] + (if negated + (-forward-negation [:>= (first (m/children schema))] error options) + (if (number? value) + (str "should be smaller than " (first (m/children schema))) + "should be a number")))}} + :<= {:error/fn {:en (fn [{:keys [schema value negated] :as error} options] + (if negated + (-forward-negation [:> (first (m/children schema))] error options) + (if (number? value) + (str "should be at most " (first (m/children schema))) + "should be a number")))}} := {:error/fn {:en (fn [{:keys [schema]} _] (str "should be " (-pr-str (first (m/children schema)))))}} :not= {:error/fn {:en (fn [{:keys [schema]} _] diff --git a/test/malli/error_test.cljc b/test/malli/error_test.cljc index bcd55480e..64f41dfc4 100644 --- a/test/malli/error_test.cljc +++ b/test/malli/error_test.cljc @@ -6,7 +6,8 @@ [malli.generator :as mg] [malli.util :as mu] #?(:clj [malli.test-macros :refer [when-env]])) - #?(:cljs (:require-macros [malli.test-macros :refer [when-env]]))) + #?(:cljs (:require-macros [malli.test-macros :refer [when-env]])) + #?(:cljs (:import (goog Uri)))) (deftest error-message-test (let [msg "should be an int" @@ -457,11 +458,11 @@ (me/humanize)))))) (deftest function-test - (is (= ["invalid function"] + (is (= ["should be a valid function"] (-> [:=> [:cat int? int?] int?] (m/explain malli.core-test/single-arity {::m/function-checker mg/function-checker}) (me/humanize)))) - (is (= ["invalid function"] + (is (= ["should be a valid function"] (-> [:=> [:cat int? int?] int?] (m/explain 123) (me/humanize))))) @@ -793,3 +794,139 @@ (is (= ["should be a"] (me/humanize (m/explain [:= 'a] 1)))) (is (= ["should not be \"a\""] (me/humanize (m/explain [:not= "a"] "a")))) (is (= ["should not be a"] (me/humanize (m/explain [:not= 'a] 'a)))))) + +(deftest not-humanize-test + (is (= ["should not be any"] (me/humanize (m/explain [:not any?] true)))) + (is (= ["should not be some"] (me/humanize (m/explain [:not some?] true)))) + (is (= ["should not be a number"] (me/humanize (m/explain [:not number?] 1)))) + (is (= ["should not be an integer"] (me/humanize (m/explain [:not integer?] 1)))) + (is (= ["should not be an int"] (me/humanize (m/explain [:not int?] 1)))) + (is (= ["should not be a positive int"] (me/humanize (m/explain [:not pos-int?] 1)))) + (is (= ["should not be a negative int"] (me/humanize (m/explain [:not neg-int?] -1)))) + (is (= ["should not be a non-negative int"] (me/humanize (m/explain [:not nat-int?] 1)))) + (is (= ["should not be positive"] (me/humanize (m/explain [:not pos?] 1)))) + (is (= ["should not be negative"] (me/humanize (m/explain [:not neg?] -1)))) + (is (= ["should not be a float"] (me/humanize (m/explain [:not float?] 1.23)))) + (is (= ["should not be a double"] (me/humanize (m/explain [:not double?] 1.23)))) + (is (= ["should not be a boolean"] (me/humanize (m/explain [:not boolean?] true)))) + (is (= ["should not be a string"] (me/humanize (m/explain [:not string?] "")))) + (is (= ["should not be an ident"] (me/humanize (m/explain [:not ident?] 'a)))) + (is (= ["should not be a simple ident"] (me/humanize (m/explain [:not simple-ident?] 'a)))) + (is (= ["should not be a qualified ident"] (me/humanize (m/explain [:not qualified-ident?] ::a)))) + (is (= ["should not be a keyword"] (me/humanize (m/explain [:not keyword?] :a)))) + (is (= ["should not be a simple keyword"] (me/humanize (m/explain [:not simple-keyword?] :a)))) + (is (= ["should not be a qualified keyword"] (me/humanize (m/explain [:not qualified-keyword?] ::a)))) + (is (= ["should not be a symbol"] (me/humanize (m/explain [:not symbol?] 'a)))) + (is (= ["should not be a simple symbol"] (me/humanize (m/explain [:not simple-symbol?] 'a)))) + (is (= ["should not be a qualified symbol"] (me/humanize (m/explain [:not qualified-symbol?] `a)))) + (is (= ["should not be a uuid"] (me/humanize (m/explain [:not uuid?] (random-uuid))))) + (is (= ["should not be a uri"] (me/humanize (m/explain [:not uri?] (#?(:clj java.net.URI. + :cljs Uri. + :default (throw (ex-info "Create URI" {}))) + "http://asdf.com"))))) + #?(:clj (is (= ["should not be a decimal"] (me/humanize (m/explain [:not decimal?] 1M))))) + (is (= ["should not be an inst"] (me/humanize (m/explain [:not inst?] #inst "2018-04-27T18:25:37Z")))) + (is (= ["should not be seqable"] (me/humanize (m/explain [:not seqable?] nil)))) + (is (= ["should not be indexed"] (me/humanize (m/explain [:not indexed?] [])))) + (is (= ["should not be a map"] (me/humanize (m/explain [:not map?] {})))) + (is (= ["should not be a vector"] (me/humanize (m/explain [:not vector?] [])))) + (is (= ["should not be a list"] (me/humanize (m/explain [:not list?] (list))))) + (is (= ["should not be a seq"] (me/humanize (m/explain [:not seq?] (list))))) + (is (= ["should not be a char"] (me/humanize (m/explain [:not char?] \a)))) + (is (= ["should not be a set"] (me/humanize (m/explain [:not set?] #{})))) + (is (= ["should not be nil"] (me/humanize (m/explain [:not nil?] nil)))) + (is (= ["should not be false"] (me/humanize (m/explain [:not false?] false)))) + (is (= ["should not be true"] (me/humanize (m/explain [:not true?] true)))) + (is (= ["should not be zero"] (me/humanize (m/explain [:not zero?] 0)))) + #?(:clj (is (= ["should not be a rational"] (me/humanize (m/explain [:not rational?] 1/2))))) + (is (= ["should not be a coll"] (me/humanize (m/explain [:not coll?] [])))) + (is (= ["should not be empty"] (me/humanize (m/explain [:not empty?] [])))) + (is (= ["should not be associative"] (me/humanize (m/explain [:not associative?] [])))) + (is (= ["should not be sequential"] (me/humanize (m/explain [:not sequential?] [])))) + #?(:clj (is (= ["should not be a ratio"] (me/humanize (m/explain [:not ratio?] 1/2))))) + #?(:clj (is (= ["should not be bytes"] (me/humanize (m/explain [:not bytes?] (byte-array 0)))))) + (is (= ["should not match regex"] (me/humanize (m/explain [:not [:re #""]] "")))) + (is (= ["should not be a valid function"] (me/humanize (m/explain [:not [:=> :cat :any]] (fn []))))) + (is (= ["should not be an ifn"] (me/humanize (m/explain [:not ifn?] (fn []))))) + (is (= ["should not be a fn"] (me/humanize (m/explain [:not fn?] (fn []))))) + (is (= ["should not be 1"] (me/humanize (m/explain [:not [:enum 1]] 1)))) + (is (= ["should not be either 1, 2 or 3"] (me/humanize (m/explain [:not [:enum 1 2 3]] 1)))) + (is (= ["should not be any"] (me/humanize (m/explain [:not :any] 1)))) + (is (= ["should not be nil"] (me/humanize (m/explain [:not :nil] nil)))) + (is (= ["should not be a string"] (me/humanize (m/explain [:not :string] "a")))) + (is (= ["should not be at least 1 character"] (me/humanize (m/explain [:not [:string {:min 1}]] "a")))) + (is (= ["should not be at most 1 character"] (me/humanize (m/explain [:not [:string {:max 1}]] "a")))) + (is (= ["should not be 1 character"] (me/humanize (m/explain [:not [:string {:min 1 :max 1}]] "a")))) + (is (= ["should not be an integer"] (me/humanize (m/explain [:not :int] 1)))) + (is (= ["should not be at least 1"] (me/humanize (m/explain [:not [:int {:min 1}]] 1)))) + (is (= ["should not be at most 1"] (me/humanize (m/explain [:not [:int {:max 1}]] 1)))) + (is (= ["should not be 1"] (me/humanize (m/explain [:not [:int {:min 1 :max 1}]] 1)))) + (is (= ["should not be a double"] (me/humanize (m/explain [:not :double] 1.5)))) + (is (= ["should not be at least 1.5"] (me/humanize (m/explain [:not [:double {:min 1.5}]] 1.5)))) + (is (= ["should not be at most 1.5"] (me/humanize (m/explain [:not [:double {:max 1.5}]] 1.5)))) + (is (= ["should not be 1.5"] (me/humanize (m/explain [:not [:double {:min 1.5 :max 1.5}]] 1.5)))) + (is (= ["should not be a boolean"] (me/humanize (m/explain [:not :boolean] true)))) + (is (= ["should not be a keyword"] (me/humanize (m/explain [:not :keyword] :a)))) + (is (= ["should not be a symbol"] (me/humanize (m/explain [:not :symbol] 'a)))) + (is (= ["should not be a qualified keyword"] (me/humanize (m/explain [:not :qualified-keyword] ::a)))) + (is (= ["should not be a qualified symbol"] (me/humanize (m/explain [:not :qualified-symbol] `a)))) + (is (= ["should not be a uuid"] (me/humanize (m/explain [:not :uuid] (random-uuid))))) + (is (= ["should be at most 1"] (me/humanize (m/explain [:not [:> 1]] 2)))) + (is (= ["should be smaller than 1"] (me/humanize (m/explain [:not [:>= 1]] 2)))) + (is (= ["should be at least 1"] (me/humanize (m/explain [:not [:< 1]] 0)))) + (is (= ["should be larger than 1"] (me/humanize (m/explain [:not [:<= 1]] 0)))) + (is (= ["should not be 1"] (me/humanize (m/explain [:not [:= 1]] 1)))) + (is (= ["should be 1"] (me/humanize (m/explain [:not [:not= 1]] nil))))) + +(deftest nested-not-humanize-test + (testing ":=" + (is (= ["should be 1"] (me/humanize (m/explain [:= 1] nil)))) + (is (= ["should not be 1"] (me/humanize (m/explain [:not [:= 1]] 1)))) + (is (= ["should be 1"] (me/humanize (m/explain [:not [:not [:= 1]]] nil)))) + (is (= ["should not be 1"] (me/humanize (m/explain [:not [:not [:not [:= 1]]]] 1)))) + (is (= ["should be 1"] (me/humanize (m/explain [:not [:not [:not [:not [:= 1]]]]] nil))))) + (testing ":>" + (is (= ["should be larger than 1"] (me/humanize (m/explain [:> 1] 0)))) + (is (= ["should be at most 1"] (me/humanize (m/explain [:not [:> 1]] 2)))) + (is (= ["should be larger than 1"] (me/humanize (m/explain [:not [:not [:> 1]]] 0)))) + (is (= ["should be at most 1"] (me/humanize (m/explain [:not [:not [:not [:> 1]]]] 2)))) + (is (= ["should be larger than 1"] (me/humanize (m/explain [:not [:not [:not [:not [:> 1]]]]] 0))))) + (testing ":>=" + (is (= ["should be at least 1"] (me/humanize (m/explain [:>= 1] 0)))) + (is (= ["should be smaller than 1"] (me/humanize (m/explain [:not [:>= 1]] 2)))) + (is (= ["should be at least 1"] (me/humanize (m/explain [:not [:not [:>= 1]]] 0)))) + (is (= ["should be smaller than 1"] (me/humanize (m/explain [:not [:not [:not [:>= 1]]]] 2)))) + (is (= ["should be at least 1"] (me/humanize (m/explain [:not [:not [:not [:not [:>= 1]]]]] 0))))) + (testing ":<" + (is (= ["should be smaller than 1"] (me/humanize (m/explain [:< 1] 2)))) + (is (= ["should be at least 1"] (me/humanize (m/explain [:not [:< 1]] 0)))) + (is (= ["should be smaller than 1"] (me/humanize (m/explain [:not [:not [:< 1]]] 2)))) + (is (= ["should be at least 1"] (me/humanize (m/explain [:not [:not [:not [:< 1]]]] 0)))) + (is (= ["should be smaller than 1"] (me/humanize (m/explain [:not [:not [:not [:not [:< 1]]]]] 2))))) + (testing ":<=" + (is (= ["should be at most 1"] (me/humanize (m/explain [:<= 1] 2)))) + (is (= ["should be larger than 1"] (me/humanize (m/explain [:not [:<= 1]] 0)))) + (is (= ["should be at most 1"] (me/humanize (m/explain [:not [:not [:<= 1]]] 2)))) + (is (= ["should be larger than 1"] (me/humanize (m/explain [:not [:not [:not [:<= 1]]]] 0)))) + (is (= ["should be at most 1"] (me/humanize (m/explain [:not [:not [:not [:not [:<= 1]]]]] 2)))))) + +(deftest custom-negating-test + (is (= ["should be a multiple of 3"] + (me/humanize (m/explain [:fn {:error/message {:en "should be a multiple of 3"}} #(= 0 (mod % 3))] 2)))) + (is (= ["should not be a multiple of 3"] + (me/humanize (m/explain [:not [:fn {:error/message {:en "should be a multiple of 3"}} #(= 0 (mod % 3))]] 3)))) + (is (= ["should not be a multiple of 3 negated=false"] + (me/humanize (m/explain [:fn {:error/fn {:en (fn [{:keys [negated]} _] (str "should not be a multiple of 3 negated=" + (boolean negated)))}} + #(not= 0 (mod % 3))] 0)))) + (is (= ["should be a multiple of 3 negating=true"] + (me/humanize (m/explain [:not [:fn {:error/fn {:en (fn [{:keys [negated]} _] (str "should not be a multiple of 3 negating=" + (boolean negated)))}} + #(not= 0 (mod % 3))]] 1)))) + (testing ":negated disables implicit negation" + (is (= ["should not avoid being a multiple of 3"] + (me/humanize (m/explain [:not [:fn {:error/fn {:en (fn [{:keys [negated]} _] + (if negated + (negated "should not avoid being a multiple of 3") + "should not be a multiple of 3"))}} + #(not= 0 (mod % 3))]] 1)))))) From bae2e70081d94a19613bfe336420663eac2e67f3 Mon Sep 17 00:00:00 2001 From: Ambrose Bonnaire-Sergeant Date: Sun, 1 Dec 2024 22:34:55 -0600 Subject: [PATCH 09/12] Close #1121: don't generate nil if :seqable is non-empty --- src/malli/generator.cljc | 8 ++++++-- test/malli/generator_test.cljc | 6 ++++++ 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index 140ad94c5..abdc1bf0f 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -145,9 +145,13 @@ (gen/one-of gs))) (defn- -seqable-gen [schema options] - (let [el (-> schema m/children first)] + (let [{:keys [min]} (-min-max schema options) + el (-> schema m/children first)] (gen-one-of - (-> [nil-gen] + (-> [] + (cond-> + (or (nil? min) (zero? min)) + (conj nil-gen)) (into (map #(-coll-gen schema % options)) [identity vec eduction #(into-array #?(:clj Object) %)]) (conj (-coll-distinct-gen schema set options)) diff --git a/test/malli/generator_test.cljc b/test/malli/generator_test.cljc index 73e6fe078..e8c7d90f4 100644 --- a/test/malli/generator_test.cljc +++ b/test/malli/generator_test.cljc @@ -1137,3 +1137,9 @@ [{} :map]]] (is (every? #{{:type nil} {:type {}}} (mg/sample schema))) (is (every? (m/validator schema) (mg/sample schema)))))) + +(deftest seqable-generates-non-empty-with-positive-min-test + (is (seq (mg/generate [:seqable {:min 4 :max 4} :int] {:seed 0}))) + (doseq [_ (range 100) + v (mg/sample [:seqable {:min 1} :any])] + (is (seq v)))) From f3816b90392ea943f844f78b9e4d1665048d9675 Mon Sep 17 00:00:00 2001 From: Ambrose Bonnaire-Sergeant Date: Tue, 3 Dec 2024 22:07:11 -0600 Subject: [PATCH 10/12] add :float humanizer --- CHANGELOG.md | 1 + src/malli/error.cljc | 1 + test/malli/error_test.cljc | 45 +++++++++++++++++++------------------- 3 files changed, 25 insertions(+), 22 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e98e7f895..b031414f9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,6 +21,7 @@ Malli is in well matured [alpha](README.md#alpha). * previous behavior defaulted to a `nil`-returning generator, even if the schema doesn't accept `nil` * use `:gen/return nil` property to restore this behavior * FIX: `malli.registry/{mode,type}` not respected in Babashka [#1124](https://github.com/metosin/malli/issues/1124) +* FIX: `:float` missing humanizer [#1122](https://github.com/metosin/malli/issues/1122) * Updated dependencies: ``` diff --git a/src/malli/error.cljc b/src/malli/error.cljc index 6cc2a4313..5eb40bcba 100644 --- a/src/malli/error.cljc +++ b/src/malli/error.cljc @@ -105,6 +105,7 @@ max (str "should be at most " max " character" (when (not= 1 max) "s")))))}} :int {:error/fn {:en (-pred-min-max-error-fn {:pred int?, :message "should be an integer"})}} :double {:error/fn {:en (-pred-min-max-error-fn {:pred double?, :message "should be a double"})}} + :float {:error/fn {:en (-pred-min-max-error-fn {:pred float?, :message "should be a float"})}} :boolean {:error/message {:en "should be a boolean"}} :keyword {:error/message {:en "should be a keyword"}} :symbol {:error/message {:en "should be a symbol"}} diff --git a/test/malli/error_test.cljc b/test/malli/error_test.cljc index bcd55480e..a748c5a02 100644 --- a/test/malli/error_test.cljc +++ b/test/malli/error_test.cljc @@ -372,28 +372,29 @@ (me/humanize))))) (deftest double-test - (is (= {:a ["should be a double"] - :b ["should be at least 1"] - :c ["should be at most 4"] - :d [["should be at least 1"] - ["should be at most 4"]] - :e ["should be a double"] - :f ["should be 4"]} - (-> [:map - [:a :double] - [:b [:double {:min 1}]] - [:c [:double {:max 4}]] - [:d [:vector [:double {:min 1, :max 4}]]] - [:e [:double {:min 1, :max 4}]] - [:f [:double {:min 4, :max 4}]]] - (m/explain - {:a "123" - :b 0.0 - :c 5.0 - :d [0.0 5.0] - :e "123" - :f 5.0}) - (me/humanize))))) + (doseq [t [:double :float]] + (is (= {:a [(str "should be a " (name t))] + :b ["should be at least 1"] + :c ["should be at most 4"] + :d [["should be at least 1"] + ["should be at most 4"]] + :e [(str "should be a " (name t))] + :f ["should be 4"]} + (-> [:map + [:a t] + [:b [t {:min 1}]] + [:c [t {:max 4}]] + [:d [:vector [t {:min 1, :max 4}]]] + [:e [t {:min 1, :max 4}]] + [:f [t {:min 4, :max 4}]]] + (m/explain + {:a "123" + :b 0.0 + :c 5.0 + :d [0.0 5.0] + :e "123" + :f 5.0}) + (me/humanize)))))) (deftest any-test (testing "success" From d5feb085c0188b2cc1c3a984388799a3f09336ab Mon Sep 17 00:00:00 2001 From: Ambrose Bonnaire-Sergeant Date: Thu, 28 Nov 2024 16:06:03 -0600 Subject: [PATCH 11/12] refactor generator ns with -never-gen helpers --- src/malli/generator.cljc | 270 +++++++++++---------------------- test/malli/generator_test.cljc | 13 +- 2 files changed, 96 insertions(+), 187 deletions(-) diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index 140ad94c5..c3456ce8b 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -1,6 +1,7 @@ ;; See also `malli.generator-ast` for viewing generators as data (ns malli.generator - (:require [clojure.spec.gen.alpha :as ga] + (:require [clojure.set :as set] + [clojure.spec.gen.alpha :as ga] [clojure.string :as str] [clojure.test.check :as check] [clojure.test.check.generators :as gen] @@ -13,7 +14,7 @@ [malli.impl.util :refer [-last -merge]] #?(:clj [borkdude.dynaload :as dynaload]))) -(declare generator generate -create) +(declare generator generate -create gen-one-of gen-double) (defprotocol Generator (-generator [this options] "returns generator for schema")) @@ -51,11 +52,14 @@ (def nil-gen (gen/return nil)) +(defn- -child [schema options] (first (m/children schema options))) +(defn- -child-gen [schema options] (generator (-child schema options) options)) + (defn -never-gen "Return a generator of no values that is compatible with -unreachable-gen?." [{::keys [original-generator-schema] :as _options}] (with-meta (gen/sized (fn [_] - (m/-fail! ::infinitely-expanding-schema + (m/-fail! ::unsatisfiable-schema (cond-> {} original-generator-schema (assoc :schema original-generator-schema))))) {::never-gen true @@ -66,17 +70,10 @@ [g] (-> (meta g) ::never-gen boolean)) (defn -not-unreachable [g] (when-not (-unreachable-gen? g) g)) +(defn -unreachable [g] (when (-unreachable-gen? g) g)) (defn- -random [seed] (if seed (random/make-random seed) (random/make-random))) -(defn ^:deprecated -recur [_schema options] - (println (str `-recur " is deprecated, please update your generators. See instructions in malli.generator.")) - [true options]) - -(defn ^:deprecated -maybe-recur [_schema options] - (println (str `-maybe-recur " is deprecated, please update your generators. See instructions in malli.generator.")) - options) - (defn -min-max [schema options] (let [{:keys [min max] gen-min :gen/min gen-max :gen/max} (m/properties schema options)] (when (and min gen-min (< gen-min min)) @@ -86,67 +83,62 @@ {:min (or gen-min min) :max (or gen-max max)})) -(defn- -double-gen [options] (gen/double* (merge {:infinite? false, :NaN? false} options))) - -(defn- gen-vector-min [gen min options] - (cond-> (gen/sized #(gen/vector gen min (+ min %))) - (::generator-ast options) (vary-meta assoc ::generator-ast - {:op :vector-min - :generator gen - :min min}))) +(defn- inf-nan [schema options] + (let [{:gen/keys [infinite? NaN?]} (m/properties schema)] + {:infinite? infinite? :NaN? NaN?})) + +(defn- -double-gen [schema options] (gen-double (into (inf-nan schema options) (-min-max schema options)))) + +(defn- gen-fmap [f gen] (or (-unreachable gen) (gen/fmap f gen))) +(defn- gen-fcat [gen] (gen-fmap #(apply concat %) gen)) +(defn- gen-tuple [gens] (or (some -unreachable gens) (apply gen/tuple gens))) +(defn- gen-maybe [g] (if (-unreachable-gen? g) nil-gen (gen/one-of [nil-gen g]))) +(def ^:private double-default {:infinite? false, :NaN? false}) +(defn- gen-double [opts] (gen/double* (-> (into double-default opts) (update :min #(some-> % double)) (update :max #(some-> % double))))) + +(defn- gen-vector [{:keys [min max]} g] + (cond + (-unreachable-gen? g) (if (zero? (or min 0)) (gen/return []) g) + (and min (= min max)) (gen/vector g min) + (and min max) (gen/vector g min max) + min (vary-meta (gen/sized #(gen/vector g min (+ min %))) assoc ::generator-ast {:op :vector-min :generator g :min min}) + max (gen/vector g 0 max) + :else (gen/vector g))) + +(defn- gen-vector-distinct-by [schema {:keys [min] :as m} f g] + (if (-unreachable-gen? g) + (if (= 0 (or min 0)) (gen/return []) g) + (gen/vector-distinct-by f g (-> (assoc (if (and min (= min max)) + {:num-elements min} + (set/rename-keys m {:min :min-elements :max :max-elements})) + :ex-fn #(m/-exception ::distinct-generator-failure (assoc % :schema schema))))))) (defn- -string-gen [schema options] - (let [{:keys [min max]} (-min-max schema options)] - (cond - (and min (= min max)) (gen/fmap str/join (gen/vector gen/char-alphanumeric min)) - (and min max) (gen/fmap str/join (gen/vector gen/char-alphanumeric min max)) - min (gen/fmap str/join (gen-vector-min gen/char-alphanumeric min options)) - max (gen/fmap str/join (gen/vector gen/char-alphanumeric 0 max)) - :else gen/string-alphanumeric))) - -(defn- -coll-gen [schema f options] - (let [{:keys [min max]} (-min-max schema options) - child (-> schema m/children first) - gen (generator child options)] - (if (-unreachable-gen? gen) - (if (= 0 (or min 0)) - (gen/fmap f (gen/return [])) - (-never-gen options)) - (gen/fmap f (cond - (and min (= min max)) (gen/vector gen min) - (and min max) (gen/vector gen min max) - min (gen-vector-min gen min options) - max (gen/vector gen 0 max) - :else (gen/vector gen)))))) + (gen-fmap str/join (gen-vector (-min-max schema options) gen/char-alphanumeric))) + +(defn- -coll-gen + ([schema options] (-coll-gen schema identity options)) + ([schema f options] (gen-fmap f (gen-vector (-min-max schema options) (-child-gen schema options))))) + +(defn- gen-vector-distinct [schema m g] (gen-vector-distinct-by schema m identity g)) (defn- -coll-distinct-gen [schema f options] - (let [{:keys [min max]} (-min-max schema options) - child (-> schema m/children first) - gen (generator child options)] - (if (-unreachable-gen? gen) - (if (= 0 (or min 0)) - (gen/return (f [])) - (-never-gen options)) - (gen/fmap f (gen/vector-distinct gen {:min-elements min, :max-elements max, :max-tries 100 - :ex-fn #(m/-exception ::distinct-generator-failure - (assoc % :schema schema))}))))) + (gen-fmap f (gen-vector-distinct schema (-min-max schema options) (-child-gen schema options)))) + +(defn- ->such-that-opts [schema] {:max-tries 100 :ex-fn #(m/-exception ::such-that-failure (assoc % :schema schema))}) +(defn- gen-such-that [schema pred gen] (or (-unreachable gen) (gen/such-that pred gen (->such-that-opts schema)))) (defn -and-gen [schema options] - (if-some [gen (-not-unreachable (-> schema (m/children options) first (generator options)))] - (gen/such-that (m/validator schema options) gen - {:max-tries 100 - :ex-fn #(m/-exception ::and-generator-failure - (assoc % :schema schema))}) - (-never-gen options))) + (gen-such-that schema (m/validator schema options) (-child-gen schema options))) -(defn- gen-one-of [gs] - (if (= 1 (count gs)) - (first gs) - (gen/one-of gs))) +(defn- gen-one-of [options gs] + (if-some [gs (not-empty (into [] (keep -not-unreachable) gs))] + (if (= 1 (count gs)) (nth gs 0) (gen/one-of gs)) + (-never-gen options))) (defn- -seqable-gen [schema options] - (let [el (-> schema m/children first)] - (gen-one-of + (let [el (-child schema options)] + (gen-one-of options (-> [nil-gen] (into (map #(-coll-gen schema % options)) [identity vec eduction #(into-array #?(:clj Object) %)]) @@ -158,11 +150,7 @@ (generator [:map-of (or (m/properties schema) {}) k v] options)))))))) (defn -or-gen [schema options] - (if-some [gs (not-empty - (into [] (keep #(-not-unreachable (generator % options))) - (m/children schema options)))] - (gen-one-of gs) - (-never-gen options))) + (gen-one-of options (map #(generator % options) (m/children schema options)))) (defn- -merge-keyword-dispatch-map-into-entries [schema] (let [dispatch (-> schema m/properties :dispatch)] @@ -176,11 +164,7 @@ (m/options schema))))) (defn -multi-gen [schema options] - (if-some [gs (->> (m/entries (-merge-keyword-dispatch-map-into-entries schema) options) - (into [] (keep #(-not-unreachable (generator (last %) options)))) - (not-empty))] - (gen-one-of gs) - (-never-gen options))) + (gen-one-of options (map #(generator (last %) options) (m/entries (-merge-keyword-dispatch-map-into-entries schema) options)))) (defn- -build-map [kvs] (persistent! @@ -191,43 +175,16 @@ :else (assoc! acc k v))) (transient {}) kvs))) -(defn- -value-gen [k s options] - (let [g (generator s options)] - (cond->> g (-not-unreachable g) (gen/fmap (fn [v] [k v]))))) +(defn- -entry-gen [[k s] options] + (cond->> (gen-fmap #(do [k %]) (generator s options)) (-> s m/properties :optional) gen-maybe)) (defn -map-gen [schema options] - (loop [[[k s :as e] & entries] (m/entries schema) - gens []] - (if (nil? e) - (gen/fmap -build-map (apply gen/tuple gens)) - (if (-> e -last m/properties :optional) - ;; opt - (recur - entries - (conj gens - (if-let [g (-not-unreachable (-value-gen k s options))] - (gen-one-of [nil-gen g]) - nil-gen))) - ;;; req - (let [g (-value-gen k s options)] - (if (-unreachable-gen? g) - (-never-gen options) - (recur entries (conj gens g)))))))) + (->> schema m/entries (map #(-entry-gen % options)) gen-tuple (gen-fmap -build-map))) (defn -map-of-gen [schema options] - (let [{:keys [min max]} (-min-max schema options) - [k-gen v-gen :as gs] (map #(generator % options) (m/children schema options))] - (if (some -unreachable-gen? gs) - (if (= 0 (or min 0)) - (gen/return {}) - (-never-gen options)) - (let [opts (-> (cond - (and min (= min max)) {:num-elements min} - (and min max) {:min-elements min :max-elements max} - min {:min-elements min} - max {:max-elements max}) - (assoc :ex-fn #(m/-exception ::distinct-generator-failure (assoc % :schema schema))))] - (gen/fmap #(into {} %) (gen/vector-distinct-by first (gen/tuple k-gen v-gen) opts)))))) + (->> (gen-tuple (map #(generator % options) (m/children schema options))) + (gen-vector-distinct-by schema (-min-max schema options) #(nth % 0)) + (gen-fmap #(into {} %)))) #?(:clj (defn -re-gen [schema options] @@ -355,32 +312,18 @@ (gen/return (m/-instrument {:schema schema, :gen #(generate % options)} nil options))) (defn -regex-generator [schema options] - (if (m/-regex-op? schema) - (generator schema options) - (let [g (generator schema options)] - (cond-> g - (-not-unreachable g) gen/tuple)))) + (cond-> (generator schema options) (not (m/-regex-op? schema)) (-> vector gen-tuple))) -(defn- entry->schema [e] (if (vector? e) (get e 2) e)) +(defn- -re-entry-gen [e options] (-regex-generator (if (vector? e) (get e 2) e) options)) (defn -cat-gen [schema options] - (let [gs (->> (m/children schema options) - (map #(-regex-generator (entry->schema %) options)))] - (if (some -unreachable-gen? gs) - (-never-gen options) - (->> gs - (apply gen/tuple) - (gen/fmap #(apply concat %)))))) + (->> (m/children schema options) (map #(-re-entry-gen % options)) gen-tuple gen-fcat)) (defn -alt-gen [schema options] - (let [gs (->> (m/children schema options) - (keep #(-regex-generator (entry->schema %) options)))] - (if (every? -unreachable-gen? gs) - (-never-gen options) - (gen-one-of (into [] (keep -not-unreachable) gs))))) + (->> (m/children schema options) (map #(-re-entry-gen % options)) (gen-one-of options))) (defn -?-gen [schema options] - (let [child (m/-get schema 0 nil)] + (let [child (-child schema options)] (if-some [g (-not-unreachable (generator child options))] (if (m/-regex-op? child) (gen/one-of [g (gen/return ())]) @@ -388,34 +331,21 @@ (gen/return ())))) (defn -*-gen [schema options] - (let [child (m/-get schema 0 nil) - mode (::-*-gen-mode options :*) - options (dissoc options ::-*-gen-mode)] - (if-some [g (-not-unreachable (generator child options))] - (cond->> (case mode - :* (gen/vector g) - :+ (gen-vector-min g 1 options)) - (m/-regex-op? child) - (gen/fmap #(apply concat %))) - (case mode - :* (gen/return ()) - :+ (-never-gen options))))) + (let [child (-child schema options)] + (cond->> (gen-vector (when (= :+ (::-*-gen-mode options)) {:min 1}) (generator child (dissoc options ::-*-gen-mode))) + (m/-regex-op? child) gen-fcat))) (defn -+-gen [schema options] (-*-gen schema (assoc options ::-*-gen-mode :+))) (defn -repeat-gen [schema options] - (let [child (m/-get schema 0 nil)] - (if-some [g (-not-unreachable (-coll-gen schema identity options))] - (cond->> g - (m/-regex-op? child) - (gen/fmap #(apply concat %))) - (gen/return ())))) + (or (some-> (-coll-gen schema options) -not-unreachable (cond-> (m/-regex-op? (-child schema options)) gen-fcat)) + (gen/return ()))) (defn -qualified-ident-gen [schema mk-value-with-ns value-with-ns-gen-size pred gen] (if-let [namespace-unparsed (:namespace (m/properties schema))] - (gen/fmap (fn [k] (mk-value-with-ns (name namespace-unparsed) (name k))) value-with-ns-gen-size) - (gen/such-that pred gen {:ex-fn #(m/-exception ::qualified-ident-gen-failure (assoc % :schema schema))}))) + (gen-fmap (fn [k] (mk-value-with-ns (name namespace-unparsed) (name k))) value-with-ns-gen-size) + (gen-such-that schema pred gen))) (defn -qualified-keyword-gen [schema] (-qualified-ident-gen schema keyword gen/keyword qualified-keyword? gen/keyword-ns)) @@ -432,57 +362,37 @@ (defmethod -schema-generator ::default [schema options] (ga/gen-for-pred (m/validator schema options))) -(defmethod -schema-generator :> [schema options] (-double-gen {:min (-> schema (m/children options) first inc)})) -(defmethod -schema-generator :>= [schema options] (-double-gen {:min (-> schema (m/children options) first)})) -(defmethod -schema-generator :< [schema options] (-double-gen {:max (-> schema (m/children options) first dec)})) -(defmethod -schema-generator :<= [schema options] (-double-gen {:max (-> schema (m/children options) first)})) -(defmethod -schema-generator := [schema options] (gen/return (first (m/children schema options)))) -(defmethod -schema-generator :not= [schema options] (gen/such-that #(not= % (-> schema (m/children options) first)) gen/any-printable - {:max-tries 100 - :ex-fn #(m/-exception ::not=-generator-failure (assoc % :schema schema))})) -(defmethod -schema-generator 'pos? [_ _] (gen/one-of [(-double-gen {:min 0.00001}) (gen/fmap inc gen/nat)])) -(defmethod -schema-generator 'neg? [_ _] (gen/one-of [(-double-gen {:max -0.0001}) (gen/fmap (comp dec -) gen/nat)])) - -(defmethod -schema-generator :not [schema options] (gen/such-that (m/validator schema options) (ga/gen-for-pred any?) - {:max-tries 100 - :ex-fn #(m/-exception ::not-generator-failure (assoc % :schema schema))})) +(defmethod -schema-generator :> [schema options] (gen-double {:min (inc (-child schema options))})) +(defmethod -schema-generator :>= [schema options] (gen-double {:min (-child schema options)})) +(defmethod -schema-generator :< [schema options] (gen-double {:max (dec (-child schema options))})) +(defmethod -schema-generator :<= [schema options] (gen-double {:max (-child schema options)})) +(defmethod -schema-generator := [schema options] (gen/return (-child schema options))) +(defmethod -schema-generator :not= [schema options] (gen-such-that schema #(not= % (-child schema options)) gen/any-printable)) +(defmethod -schema-generator 'pos? [_ options] (gen/one-of [(gen-double {:min 0.00001}) (gen-fmap inc gen/nat)])) +(defmethod -schema-generator 'neg? [_ options] (gen/one-of [(gen-double {:max -0.00001}) (gen-fmap (comp dec -) gen/nat)])) +(defmethod -schema-generator :not [schema options] (gen-such-that schema (m/validator schema options) (ga/gen-for-pred any?))) (defmethod -schema-generator :and [schema options] (-and-gen schema options)) (defmethod -schema-generator :or [schema options] (-or-gen schema options)) (defmethod -schema-generator :orn [schema options] (-or-gen (m/into-schema :or (m/properties schema) (map last (m/children schema)) (m/options schema)) options)) -(defmethod -schema-generator ::m/val [schema options] (generator (first (m/children schema)) options)) +(defmethod -schema-generator ::m/val [schema options] (-child-gen schema options)) (defmethod -schema-generator :map [schema options] (-map-gen schema options)) (defmethod -schema-generator :map-of [schema options] (-map-of-gen schema options)) (defmethod -schema-generator :multi [schema options] (-multi-gen schema options)) -(defmethod -schema-generator :vector [schema options] (-coll-gen schema identity options)) -(defmethod -schema-generator :sequential [schema options] (-coll-gen schema identity options)) +(defmethod -schema-generator :vector [schema options] (-coll-gen schema options)) +(defmethod -schema-generator :sequential [schema options] (-coll-gen schema options)) (defmethod -schema-generator :set [schema options] (-coll-distinct-gen schema set options)) (defmethod -schema-generator :enum [schema options] (gen-elements (m/children schema options))) (defmethod -schema-generator :seqable [schema options] (-seqable-gen schema options)) (defmethod -schema-generator :every [schema options] (-seqable-gen schema options)) ;;infinite seqs? - -(defmethod -schema-generator :maybe [schema options] - (let [g (-> schema (m/children options) first (generator options) -not-unreachable)] - (gen-one-of (cond-> [nil-gen] - g (conj g))))) - -(defmethod -schema-generator :tuple [schema options] - (let [gs (map #(generator % options) (m/children schema options))] - (if (not-any? -unreachable-gen? gs) - (apply gen/tuple gs) - (-never-gen options)))) +(defmethod -schema-generator :maybe [schema options] (gen-maybe (-child-gen schema options))) +(defmethod -schema-generator :tuple [schema options] (gen-tuple (map #(generator % options) (m/children schema options)))) #?(:clj (defmethod -schema-generator :re [schema options] (-re-gen schema options))) (defmethod -schema-generator :any [_ _] (ga/gen-for-pred any?)) (defmethod -schema-generator :some [_ _] gen/any-printable) (defmethod -schema-generator :nil [_ _] nil-gen) (defmethod -schema-generator :string [schema options] (-string-gen schema options)) (defmethod -schema-generator :int [schema options] (gen/large-integer* (-min-max schema options))) -(defmethod -schema-generator :double [schema options] - (gen/double* (merge (let [props (m/properties schema options)] - {:infinite? (get props :gen/infinite? false) - :NaN? (get props :gen/NaN? false)}) - (-> (-min-max schema options) - (update :min #(some-> % double)) - (update :max #(some-> % double)))))) +(defmethod -schema-generator :double [schema options] (-double-gen schema options)) (defmethod -schema-generator :float [schema options] (let [max-float #?(:clj Float/MAX_VALUE :cljs (.-MAX_VALUE js/Number)) min-float (- max-float) diff --git a/test/malli/generator_test.cljc b/test/malli/generator_test.cljc index 73e6fe078..637e15b35 100644 --- a/test/malli/generator_test.cljc +++ b/test/malli/generator_test.cljc @@ -708,8 +708,8 @@ (fn [formula] (gen/one-of [gen/boolean (gen/tuple (gen/return :not) gen/boolean) - (gen/tuple (gen/return :and) (#'mg/gen-vector-min formula 1 {})) - (gen/tuple (gen/return :or) (#'mg/gen-vector-min formula 1 {}))])) + (gen/tuple (gen/return :and) (#'mg/gen-vector {:min 1} formula)) + (gen/tuple (gen/return :or) (#'mg/gen-vector {:min 1} formula))])) (gen/one-of [gen/boolean (gen/tuple (gen/return :not) gen/boolean)])) {:seed 0})))) @@ -900,10 +900,9 @@ {:seed 0}) (is false) (catch #?(:clj Exception, :cljs js/Error) e - (is (re-find #":malli\.generator/infinitely-expanding-schema" + (is (re-find #":malli\.generator/unsatisfiable-schema" (ex-message e))) - (is (= [:map-of {:min 1} [:ref :malli.generator-test/rec] [:ref :malli.generator-test/rec]] - (-> e ex-data :data :schema m/form)))))) + (is (= [:ref :malli.generator-test/rec] (-> e ex-data :data :schema m/form)))))) (testing "can generate empty regardless of :max" (is (= '({{} {}} {{} {}} {{} {}} {{} {}} {} {{} {}} {} {{} {}} {{} {}} {{{} {}} {{} {}}, {} {}}) (mg/sample [:schema {:registry {::rec [:map-of {:max 3} [:ref ::rec] [:ref ::rec]]}} [:ref ::rec]] @@ -1069,7 +1068,7 @@ (deftest such-that-generator-failure-test (is (thrown-with-msg? #?(:clj Exception, :cljs js/Error) - #":malli\.generator/not-generator-failure" + #":malli\.generator/such-that-failure" (mg/generate [:not :any]))) (is (thrown-with-msg? #?(:clj Exception, :cljs js/Error) @@ -1081,7 +1080,7 @@ (mg/generate [:map-of {:min 2} [:= 1] :any]))) (is (thrown-with-msg? #?(:clj Exception, :cljs js/Error) - #":malli\.generator/and-generator-failure" + #":malli\.generator/such-that-failure" (mg/generate [:and pos? neg?])))) (deftest seqable-every-generator-test From affa1f3a83ad3b1c65ae54c75b0e1ca9d7f8a250 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 8 Dec 2024 14:47:33 +0200 Subject: [PATCH 12/12] Update generator.cljc --- src/malli/generator.cljc | 1 + 1 file changed, 1 insertion(+) diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index e111e3ad7..29d0be4a8 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -140,6 +140,7 @@ (let [{:keys [min]} (-min-max schema options) el (-child schema options)] (gen-one-of + options (-> [] (cond-> (or (nil? min) (zero? min))