diff --git a/CHANGELOG.md b/CHANGELOG.md index 30f4ba57d..e2d11c4e0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,8 @@ Malli is in well matured [alpha](README.md#alpha). * Fix ClojureScript [arithmetic warning](https://github.com/metosin/malli/issues/1093) * Distribute `:merge` over `:multi` [#1086](https://github.com/metosin/malli/pull/1086), see [documentation](README.md#distributive-schemas) +* allow `m/-proxy-schema` child to be a `delay` [#1090](https://github.com/metosin/malli/pull/1090) +* `:multi` with keyword `:dispatch` accumulates data to generated values [#1095](https://github.com/metosin/malli/pull/1095) * allow `m/-proxy-schema` child to be a `delay` * Fix `malli.dev.pretty` throws when explaining errors in nested maps [#1094](https://github.com/metosin/malli/issues/1096) diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index bd9a95330..078b4c85e 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -9,6 +9,7 @@ [clojure.test.check.rose-tree :as rose] [malli.core :as m] [malli.registry :as mr] + [malli.util :as mu] [malli.impl.util :refer [-last -merge]] #?(:clj [borkdude.dynaload :as dynaload]))) @@ -163,10 +164,21 @@ (gen-one-of gs) (-never-gen options))) +(defn- -merge-keyword-dispatch-map-into-entries [schema] + (let [dispatch (-> schema m/properties :dispatch)] + (cond-> schema + (keyword? dispatch) + (mu/transform-entries + #(map (fn [[k :as e]] + (cond-> e + (not= ::m/default k) + (update 2 mu/merge [:map [dispatch [:= nil k]]]))) %) + (m/options schema))))) + (defn -multi-gen [schema options] - (if-some [gs (not-empty - (into [] (keep #(-not-unreachable (generator (last %) options))) - (m/entries 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))) diff --git a/test/malli/generator_test.cljc b/test/malli/generator_test.cljc index 5fdcbc5e5..9e23e7909 100644 --- a/test/malli/generator_test.cljc +++ b/test/malli/generator_test.cljc @@ -49,7 +49,7 @@ :symbol :qualified-keyword :qualified-symbol]] - (is (every? (partial m/validate schema) (mg/sample schema {:size 1000}))))) + (is (every? (m/validator schema) (mg/sample schema {:size 1000}))))) (testing "double properties" (let [infinity? #(or (= % ##Inf) @@ -165,16 +165,16 @@ (testing "recursion" (let [schema [:schema {:registry {::cons [:maybe [:tuple int? [:ref ::cons]]]}} ::cons]] - (is (every? (partial m/validate schema) (mg/sample schema {:size 100}))))) + (is (every? (m/validator schema) (mg/sample schema {:size 100}))))) (testing "mutual recursion" (let [schema [:schema {:registry {::ping [:maybe [:tuple [:= "ping"] [:ref ::pong]]] ::pong [:maybe [:tuple [:= "pong"] [:ref ::ping]]]}} ::ping]] - (is (every? (partial m/validate schema) (mg/sample schema {:size 100}))))) + (is (every? (m/validator schema) (mg/sample schema {:size 100}))))) (testing "recursion limiting" (are [schema] - (every? (partial m/validate schema) (mg/sample schema {:size 100})) + (every? (m/validator schema) (mg/sample schema {:size 100})) [:schema {:registry {::rec [:maybe [:ref ::rec]]}} ::rec] [:schema {:registry {::rec [:map [:rec {:optional true} [:ref ::rec]]]}} ::rec] @@ -369,7 +369,7 @@ [:map [:x int?] [:y int?]] [:x]]] :let [schema (m/schema schema {:registry registry})]] - (is (every? (partial m/validate schema) (mg/sample schema {:size 1000})))))) + (is (every? (m/validator schema) (mg/sample schema {:size 1000})))))) #?(:clj (deftest function-schema-test @@ -1095,3 +1095,32 @@ (deftest double-with-long-min-test (is (m/validate :double (shrink [:double {:min 3}]))) (is (= 3.0 (shrink [:double {:min 3}])))) + +(deftest multi-keyword-dispatch-test + (testing "keyword dispatch value accumulates to generated value" + (let [schema [:multi {:dispatch :type} + ["duck" :map] + ["boss" :map]]] + (is (every? #{{:type "duck"} {:type "boss"}} (mg/sample schema))) + (is (every? (m/validator schema) (mg/sample schema))))) + + (testing "non keyword doesn't accumulate data" + (let [schema [:multi {:dispatch (fn [x] (:type x))} + ["duck" :map] + ["boss" :map]]] + (is (every? #{{}} (mg/sample schema))) + (is (not (every? (m/validator schema) (mg/sample schema)))))) + + (testing "::m/default works too" + (let [schema [:multi {:dispatch :type} + ["duck" :map] + [::m/default [:= "boss"]]]] + (is (every? #{{:type "duck"} "boss"} (mg/sample schema))) + (is (every? (m/validator schema) (mg/sample schema))))) + + (testing "works with nil & {} too" + (let [schema [:multi {:dispatch :type} + [nil :map] + [{} :map]]] + (is (every? #{{:type nil} {:type {}}} (mg/sample schema))) + (is (every? (m/validator schema) (mg/sample schema))))))