From fabc7392f31f3fe907e42933a3d209c0b54d2f0e Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Mon, 31 Aug 2020 08:13:54 +0300 Subject: [PATCH] ::m/entry => ::m/val, m/entries returns MapEntry, cleanup --- CHANGELOG.md | 2 +- src/malli/core.cljc | 86 +++++++++++++++++----------------- src/malli/generator.cljc | 2 +- src/malli/json_schema.cljc | 4 +- src/malli/swagger.cljc | 2 +- test/malli/core_test.cljc | 36 +++++++++----- test/malli/transform_test.cljc | 16 +++---- test/malli/util_test.cljc | 14 +++--- 8 files changed, 86 insertions(+), 76 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cc83253a8..1b79bef52 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,7 +16,7 @@ We use [Break Versioning][breakver]. The version numbers follow a `.string [x] (if (keyword? x) @@ -99,7 +99,7 @@ (mapv (fn [[k s]] [k (-properties s) (-inner walker s (conj path k) options)]) entries)) (defn -get-entries [schema key default] - (or (if (and (vector? key) (= ::entry (nth key 0))) + (or (if (and (vector? key) (= ::val (nth key 0))) (some (fn [[k s]] (if (= k (nth key 1)) s)) (-entries schema)) (some (fn [[k _ s]] (if (= k key) s)) (-children schema))) default)) @@ -112,6 +112,24 @@ :always (->> (filter (fn [e] (-> e last some?)))))] (into-schema (-type schema) (-properties schema) children))) +(defn -parse-entries [children naked-keys options] + (let [-entry (fn [k v] #?(:clj (MapEntry. k v), :cljs (MapEntry. k v nil))) + -parse (fn [e] (let [[[k ?p ?v] f] (cond + (qualified-keyword? e) (if naked-keys [[e nil e] e]) + (and (= 2 (count e)) (qualified-keyword? (first e)) (map? (last e))) (if naked-keys [(conj e (first e)) e]) + :else [e (->> (update (vec e) (dec (count e)) (comp -form #(schema % options))) (keep identity) (vec))]) + _ (when (nil? k) (-fail! ::naked-keys-not-supported)) + [p ?s] (if (or (nil? ?p) (map? ?p)) [?p ?v] [nil ?p]) + e [k p (schema (or ?s (if (qualified-keyword? k) f)) options)]] + {:children [e] + :entries [(-entry k (-val-schema (last e) p))] + :forms [f]})) + es (reduce (partial merge-with into) (mapv -parse children)) + keys (->> es :entries (map first))] + (when-not (= keys (distinct keys)) + (-fail! ::non-distinct-entry-keys {:keys keys})) + es)) + (defn -guard [pred tf] (if tf (fn [x] (if (pred x) (tf x) x)))) @@ -168,6 +186,17 @@ [(assoc properties :registry (-property-registry r options f)) options]) [properties options])) +(defn -min-max-pred [f] + (fn [{:keys [min max]}] + (cond + (not (or min max)) nil + (and (and min max) f) (fn [x] (let [size (f x)] (<= min size max))) + (and min max) (fn [x] (<= min x max)) + (and min f) (fn [x] (<= min (f x))) + min (fn [x] (<= min x)) + (and max f) (fn [x] (<= (f x) max)) + max (fn [x] (<= x max))))) + ;; ;; Schemas ;; @@ -322,23 +351,25 @@ (-get [_ key default] (get children key default)) (-set [_ key value] (into-schema :or properties (assoc children key value)))))))) -(defn -entry-schema +(defn -val-schema + ([schema properties] + (-into-schema (-val-schema) properties [schema] (-options schema))) ([] ^{:type ::into-schema} (reify IntoSchema (-into-schema [_ properties children options] - (-check-children! ::entry properties children {:min 1, :max 1}) + (-check-children! ::val properties children {:min 1, :max 1}) (let [[schema :as children] (map #(schema % options) children) - form (-create-form ::entry properties (map -form children))] + form (-create-form ::val properties (map -form children))] ^{:type ::schema} (reify Schema - (-type [_] ::entry) + (-type [_] ::val) (-validator [_] (-validator schema)) (-explainer [_ path] (-explainer schema path)) (-transformer [this transformer method options] (-parent-children-transformer this children transformer method options)) (-walk [this walker path options] - (if (::walk-entries options) + (if (::walk-entry-vals options) (if (-accept walker this path options) (-outer walker this path [(-inner walker schema path options)] options)) (-walk schema walker path options))) @@ -349,29 +380,10 @@ LensSchema (-keep [_]) (-get [_ key default] (if (= 0 key) schema default)) - (-set [_ key value] (if (= 0 key) (-entry-schema value properties))) + (-set [_ key value] (if (= 0 key) (-val-schema value properties))) RefSchema (-ref [_]) - (-deref [_] schema)))))) - ([schema properties] - (-into-schema (-entry-schema) properties [schema] (-options schema)))) - -(defn -parse-entry-syntax [children naked-keys options] - (let [-parse (fn [e] (let [[[k ?p ?v] f] (cond - (qualified-keyword? e) (if naked-keys [[e nil e] e]) - (and (= 2 (count e)) (qualified-keyword? (first e)) (map? (last e))) (if naked-keys [(conj e (first e)) e]) - :else [e (->> (update (vec e) (dec (count e)) (comp -form #(schema % options))) (keep identity) (vec))]) - _ (when (nil? k) (-fail! ::naked-keys-not-supported)) - [p ?s] (if (or (nil? ?p) (map? ?p)) [?p ?v] [nil ?p]) - e [k p (schema (or ?s (if (qualified-keyword? k) f)) options)]] - {:children [e] - :entries [[k (-entry-schema (last e) p)]] - :forms [f]})) - es (reduce (partial merge-with into) (mapv -parse children)) - keys (->> es :entries (map first))] - (when-not (= keys (distinct keys)) - (-fail! ::non-distinct-entry-keys {:keys keys})) - es)) + (-deref [_] schema))))))) (defn -map-schema ([] @@ -380,7 +392,7 @@ ^{:type ::into-schema} (reify IntoSchema (-into-schema [_ {:keys [closed] :as properties} children options] - (let [{:keys [children entries forms]} (-parse-entry-syntax children naked-keys options) + (let [{:keys [children entries forms]} (-parse-entries children naked-keys options) form (-create-form :map properties forms) keyset (->> entries (map first) (set))] ^{:type ::schema} @@ -785,7 +797,7 @@ ^{:type ::into-schema} (reify IntoSchema (-into-schema [_ properties children options] - (let [{:keys [children entries forms]} (-parse-entry-syntax children false options) + (let [{:keys [children entries forms]} (-parse-entries children false options) form (-create-form :multi properties forms) dispatch (eval (:dispatch properties)) dispatch-map (->> (for [[k s] entries] [k s]) (into {}))] @@ -922,17 +934,6 @@ (-ref [_] id) (-deref [_] child))))))) -(defn -min-max-pred [f] - (fn [{:keys [min max]}] - (cond - (not (or min max)) nil - (and (and min max) f) (fn [x] (let [size (f x)] (<= min size max))) - (and min max) (fn [x] (<= min x max)) - (and min f) (fn [x] (<= min (f x))) - min (fn [x] (<= min x)) - (and max f) (fn [x] (<= (f x) max)) - max (fn [x] (<= x max))))) - (defn -simple-schema [{:keys [type pred property-pred]}] ^{:type ::into-schema} (reify IntoSchema @@ -977,7 +978,6 @@ ;; public api ;; - (defn schema? [x] (satisfies? Schema x)) diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index 7de35f883..1bc7e9c24 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -117,7 +117,7 @@ (defmethod -schema-generator :and [schema options] (gen/such-that (m/validator schema options) (-> schema (m/children options) first (generator options)) 100)) (defmethod -schema-generator :or [schema options] (-or-gen schema options)) -(defmethod -schema-generator ::m/entry [schema options] (generator (first (m/children schema)) options)) +(defmethod -schema-generator ::m/val [schema options] (generator (first (m/children 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)) diff --git a/src/malli/json_schema.cljc b/src/malli/json_schema.cljc index 128dade11..4bbfd1aed 100644 --- a/src/malli/json_schema.cljc +++ b/src/malli/json_schema.cljc @@ -74,7 +74,7 @@ (defmethod accept :and [_ _ children _] {:allOf children}) (defmethod accept :or [_ _ children _] {:anyOf children}) -(defmethod accept ::m/entry [_ _ children _] (first children)) +(defmethod accept ::m/val [_ _ children _] (first children)) (defmethod accept :map [_ _ children _] (let [required (->> children (filter (comp not :optional second)) (mapv first))] {:type "object" @@ -126,4 +126,4 @@ ([?schema] (transform ?schema nil)) ([?schema options] - (m/walk ?schema -json-schema-walker (assoc options ::m/walk-entries true)))) + (m/walk ?schema -json-schema-walker (assoc options ::m/walk-entry-vals true)))) diff --git a/src/malli/swagger.cljc b/src/malli/swagger.cljc index a5c2aee6b..23b2a2e67 100644 --- a/src/malli/swagger.cljc +++ b/src/malli/swagger.cljc @@ -41,4 +41,4 @@ ([?schema] (transform ?schema nil)) ([?schema options] - (m/walk ?schema -swagger-walker (assoc options ::m/walk-entries true)))) + (m/walk ?schema -swagger-walker (assoc options ::m/walk-entry-vals true)))) diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 3a1be3265..57985d5d9 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -34,8 +34,8 @@ (is (= "jabba/abba" (m/-keyword->string :jabba/abba))) (is (= "abba" (m/-keyword->string "abba")))) -(deftest parse-entry-syntax-test - (let [{:keys [children entries forms]} (m/-parse-entry-syntax +(deftest parse-entries-test + (let [{:keys [children entries forms]} (m/-parse-entries [[:x int?] ::x [::y {:optional true}] @@ -48,10 +48,10 @@ [:y {:optional true, :title "boolean"} 'boolean?]] forms))) (testing "entries" - (is (schema= [[:x [::m/entry 'int?]] - [::x [::m/entry ::x]] - [::y [::m/entry {:optional true} ::y]] - [:y [::m/entry {:optional true :title "boolean"} 'boolean?]]] + (is (schema= [[:x [::m/val 'int?]] + [::x [::m/val ::x]] + [::y [::m/val {:optional true} ::y]] + [:y [::m/val {:optional true :title "boolean"} 'boolean?]]] entries))) (testing "children" (is (= [[:x nil 'int?] @@ -61,12 +61,12 @@ (map #(update % 2 m/form) children))))) (testing "duplicate keys" (is (thrown? #?(:clj Exception, :cljs js/Error) - (m/-parse-entry-syntax + (m/-parse-entries [[:x int?] [:x boolean?]] true nil)))) (testing "naked keys fails when not supported" (is (thrown? #?(:clj Exception, :cljs js/Error) - (m/-parse-entry-syntax + (m/-parse-entries [::x] false nil))))) (deftest eval-test @@ -79,13 +79,9 @@ (is (= {:district 9} (m/eval "(m/properties [int? {:district 9}])"))) (is (= :maybe (m/eval "(m/type [:maybe int?])"))) (is (= ['int? 'string?] (map m/form (m/eval "(m/children [:or {:some \"props\"} int? string?])")))) - (is (schema= [[:x [::m/entry 'int?]] [:y [::m/entry 'string?]]] (m/eval "(m/entries [:map [:x int?] [:y string?]])"))) + (is (schema= [[:x [::m/val 'int?]] [:y [::m/val 'string?]]] (m/eval "(m/entries [:map [:x int?] [:y string?]])"))) (is (schema= [[:x nil 'int?] [:y nil 'string?]] (m/eval "(m/children [:map [:x int?] [:y string?]])")))) ; -(m/eval "(m/entries [:map [:x int?] [:y string?]])") - -(m/eval "(m/entries [:map [:x int?] [:y string?]])") - (deftest into-schema-test (is (form= [:map {:closed true} [:x int?]] (m/into-schema :map {:closed true} [[:x int?]])))) @@ -543,6 +539,14 @@ [:z {:optional false} 'string?]] (m/children schema))) + (is (true? (every? map-entry? (m/entries schema)))) + (is (= [:x :y :z] (map key (m/entries schema)))) + + (is (schema= [[:x [::m/val 'boolean?]] + [:y [::m/val {:optional true} 'int?]] + [:z [::m/val {:optional false} 'string?]]] + (m/entries schema))) + (is (results= {:schema schema :value {:y "invalid" :z "kikka"} :errors @@ -1355,3 +1359,9 @@ (testing "map-syntax" (is (= map-syntax (mu/to-map-syntax schema)))))))) + +(m/entries + [:map + [:x boolean?] + [:y {:optional true} int?] + [:z {:optional false} string?]]) diff --git a/test/malli/transform_test.cljc b/test/malli/transform_test.cljc index ae8ccc645..fa02bd0c8 100644 --- a/test/malli/transform_test.cljc +++ b/test/malli/transform_test.cljc @@ -454,12 +454,12 @@ (reset! state nil) (m/decode schema {:x 1, :y "2"} transformer) (is (= [[:decode :enter :map {:x 1, :y "2"}] - [:decode :enter ::m/entry 1] - [:decode :enter ::m/entry "2"] + [:decode :enter ::m/val 1] + [:decode :enter ::m/val "2"] [:decode :enter 'string? "2"] - [:decode :leave ::m/entry 1] + [:decode :leave ::m/val 1] [:decode :leave 'string? "2"] - [:decode :leave ::m/entry "2"] + [:decode :leave ::m/val "2"] [:decode :leave :map {:x 1, :y "2"}]] @state))) @@ -467,12 +467,12 @@ (reset! state nil) (m/encode schema {:x 1, :y "2"} transformer) (is (= [[:encode :enter :map {:x 1, :y "2"}] - [:encode :enter ::m/entry 1] - [:encode :enter ::m/entry "2"] + [:encode :enter ::m/val 1] + [:encode :enter ::m/val "2"] [:encode :enter 'string? "2"] - [:encode :leave ::m/entry 1] + [:encode :leave ::m/val 1] [:encode :leave 'string? "2"] - [:encode :leave ::m/entry "2"] + [:encode :leave ::m/val "2"] [:encode :leave :map {:x 1, :y "2"}]] @state))))) diff --git a/test/malli/util_test.cljc b/test/malli/util_test.cljc index 849527ccf..6fb3acc7d 100644 --- a/test/malli/util_test.cljc +++ b/test/malli/util_test.cljc @@ -574,22 +574,22 @@ (testing "walking entries" (is (= {:type :map, :properties {:registry {::size [:enum "S" "M" "L"]}} - :children [[:id nil {:type ::m/entry + :children [[:id nil {:type ::m/val :children [{:type 'string?}]}] - [:tags {:title "tag"} {:type ::m/entry + [:tags {:title "tag"} {:type ::m/val :properties {:title "tag"} :children [{:type :set :children [{:type 'keyword?}]}]}] - [:size nil {:type ::m/entry + [:size nil {:type ::m/val :children [{:type ::m/schema :children [::size]}]}] - [:address nil {:type ::m/entry + [:address nil {:type ::m/val :children [{:type :vector, :children [{:type :map, - :children [[:street nil {:type ::m/entry + :children [[:street nil {:type ::m/val :children [{:type 'string?}]}] - [:lonlat nil {:type ::m/entry + [:lonlat nil {:type ::m/val :children [{:type :tuple :children [{:type 'double?} {:type 'double?}]}]}]]}]}]}]]} - (mu/to-map-syntax schema {::m/walk-entries true})))))) + (mu/to-map-syntax schema {::m/walk-entry-vals true}))))))