From 21538e12981656b566f22128eb81c3d1928fac4d Mon Sep 17 00:00:00 2001 From: Joel Kaasinen Date: Mon, 16 Dec 2024 10:21:07 +0200 Subject: [PATCH] feat: use a custom Tagged record instead of MapEntry in parse output Using a MapEntry was confusing users, because it printed like a vector, but you couldn't give a vector to unparse. The current method of using MapEntry was broken for weird schemas: ``` (def schema [:or [:tuple :string :keyword] [:orn ["any" :keyword]]]) (->> (m/parse schema :any) (m/unparse schema)) ; => ["any" :any] ; should've been :any ``` Changes the parse behaviour for (at least) :orn, :altn and :multi Some place (like the entry parsers) used miu/-tagged to generate MapEntry values. These use sites now use the new miu/-entry. This keeps the surface area of this change a lot smaller since we don't need to touch all the map entry logic. fixes #1123 replaces #1140 --- src/malli/core.cljc | 10 +++--- src/malli/destructure.cljc | 2 +- src/malli/experimental.cljc | 6 ++-- src/malli/impl/regex.cljc | 4 +-- src/malli/impl/util.cljc | 8 +++-- test/malli/core_test.cljc | 20 ++++++----- test/malli/destructure_test.cljc | 59 +++++++++++++++++++++---------- test/malli/distributive_test.cljc | 2 +- test/malli/util_test.cljc | 6 ++-- 9 files changed, 74 insertions(+), 43 deletions(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 5ccb8a397..8adb7661f 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -385,7 +385,7 @@ ;; (defn -simple-entry-parser [keyset children forms] - (let [entries (map (fn [[k p s]] (miu/-tagged k (-val-schema s p))) children)] + (let [entries (map (fn [[k p s]] (miu/-entry k (-val-schema s p))) children)] (reify EntryParser (-entry-keyset [_] keyset) (-entry-children [_] children) @@ -606,7 +606,7 @@ (reify EntryParser (-entry-keyset [_] keyset) (-entry-children [_] @children) - (-entry-entries [_] (-vmap (fn [[k p s]] (miu/-tagged k (-val-schema s p))) @children)) + (-entry-entries [_] (-vmap (fn [[k p s]] (miu/-entry k (-val-schema s p))) @children)) (-entry-forms [_] (->> @children (-vmap (fn [[k p v]] (if p [k p (-form v)] [k (-form v)])))))))) (defn -from-entry-ast [parent ast options] @@ -872,8 +872,8 @@ (let [unparsers (into {} (map (fn [[k _ c]] [k (-unparser c)])) (-children this))] (fn [x] (if (miu/-tagged? x) - (if-some [unparse (get unparsers (key x))] - (unparse (val x)) + (if-some [unparse (get unparsers (:key x))] + (unparse (:value x)) ::invalid) ::invalid)))) (-transformer [this transformer method options] @@ -1650,7 +1650,7 @@ (fn [x] (if-some [parser (find (dispatch x))] (parser x) ::invalid)))) (-unparser [_] (let [unparsers (reduce-kv (fn [acc k s] (assoc acc k (-unparser s))) {} @dispatch-map)] - (fn [x] (if (miu/-tagged? x) (if-some [f (unparsers (key x))] (f (val x)) ::invalid) ::invalid)))) + (fn [x] (if (miu/-tagged? x) (if-some [f (unparsers (:key x))] (f (:value x)) ::invalid) ::invalid)))) (-transformer [this transformer method options] ;; FIXME: Probably should not use `dispatch` ;; Can't use `dispatch` as `x` might not be valid before it has been unparsed: diff --git a/src/malli/destructure.cljc b/src/malli/destructure.cljc index 1fa33c258..dec1fa287 100644 --- a/src/malli/destructure.cljc +++ b/src/malli/destructure.cljc @@ -96,7 +96,7 @@ (cond->> :always (conj [:*]) (not rest) (conj [:schema])))]] schema))) -(defn -transform [{[k v] :arg schema :schema :as all} options rest] +(defn -transform [{{k :key v :value} :arg schema :schema :as all} options rest] (cond (and schema rest) (let [s (-transform all options false)] (if (-any? s) schema s)) schema schema (= :vec k) (-vector v options) diff --git a/src/malli/experimental.cljc b/src/malli/experimental.cljc index dbf7f137c..8e795f9e5 100644 --- a/src/malli/experimental.cljc +++ b/src/malli/experimental.cljc @@ -41,8 +41,8 @@ _ (when (= ::m/invalid parsed) (m/-fail! ::parse-error {:schema schema, :args args})) parse (fn [{:keys [args] :as parsed}] (merge (md/parse args) parsed)) ->schema (fn [{:keys [schema]}] [:=> schema (:schema return :any)]) - single (= :single (key arities)) - parglists (if single (->> arities val parse vector) (->> arities val :arities (map parse))) + single (= :single (:key arities)) + parglists (if single (->> arities :value parse vector) (->> arities :value :arities (map parse))) raw-arglists (map :raw-arglist parglists) schema (as-> (map ->schema parglists) $ (if single (first $) (into [:function] $))) bodies (map (fn [{:keys [arglist prepost body]}] `(~arglist ~prepost ~@body)) parglists) @@ -60,7 +60,7 @@ ~@(some-> doc vector) ~enriched-meta ~@bodies - ~@(when-not single (some->> arities val :meta vector))))] + ~@(when-not single (some->> arities :value :meta vector))))] (m/=> ~name ~schema) defn#))) diff --git a/src/malli/impl/regex.cljc b/src/malli/impl/regex.cljc index b8683aa15..fea36edc9 100644 --- a/src/malli/impl/regex.cljc +++ b/src/malli/impl/regex.cljc @@ -256,8 +256,8 @@ (let [unparsers (into {} unparsers)] (fn [x] (if (miu/-tagged? x) - (if-some [kv (find unparsers (key x))] - ((val kv) (val x)) + (if-some [kv (find unparsers (:key x))] + ((val kv) (:value x)) :malli.core/invalid) :malli.core/invalid)))) diff --git a/src/malli/impl/util.cljc b/src/malli/impl/util.cljc index 84f3b13ab..edb697bbb 100644 --- a/src/malli/impl/util.cljc +++ b/src/malli/impl/util.cljc @@ -5,8 +5,12 @@ (def ^:const +max-size+ #?(:clj Long/MAX_VALUE, :cljs (.-MAX_VALUE js/Number))) -(defn -tagged [k v] #?(:clj (MapEntry. k v), :cljs (MapEntry. k v nil))) -(defn -tagged? [v] (instance? MapEntry v)) +(defn -entry [k v] #?(:clj (MapEntry. k v), :cljs (MapEntry. k v nil))) + +(defrecord Tagged [key value]) + +(defn -tagged [key value] (->Tagged key value)) +(defn -tagged? [x] (instance? Tagged x)) (defn -invalid? [x] #?(:clj (identical? x :malli.core/invalid), :cljs (keyword-identical? x :malli.core/invalid))) (defn -map-valid [f v] (if (-invalid? v) v (f v))) diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index a1f49b579..3a9f18b54 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -257,6 +257,7 @@ (is (= (miu/-tagged :pos 1) (m/parse schema* 1))) (is (= ::m/invalid (m/parse schema* 0))) (is (= 1 (m/unparse schema* (miu/-tagged :pos 1)))) + (is (= ::m/invalid (m/unparse schema* [:pos 1]))) (is (= ::m/invalid (m/unparse schema* (miu/-tagged :pos 0)))) (doseq [schema [schema schema*]] @@ -1169,8 +1170,11 @@ (is (= ::m/invalid (m/parse schema invalid5))) (is (= ::m/invalid (m/parse schema invalid6))) (is (= valid1 (m/unparse schema (m/parse schema valid1)))) + (is (= valid1 (m/unparse schema (miu/-tagged :sized valid1)))) (is (= valid2 (m/unparse schema (m/parse schema valid2)))) + (is (= valid2 (m/unparse schema (miu/-tagged :human valid2)))) (is (= valid3 (m/unparse schema (m/parse schema valid3)))) + (is (= valid3 (m/unparse schema (miu/-tagged :sized valid3)))) (is (= ::m/invalid (m/unparse schema invalid1))) (is (= ::m/invalid (m/unparse schema invalid2))) (is (= ::m/invalid (m/unparse schema invalid3))) @@ -3206,10 +3210,10 @@ ["name" 'str] [::m/default [:map-of 'str 'str]]] valid {:id 1, "name" "tommi", "kikka" "kukka", "abba" "jabba"}] - (is (= {:id [::int 1], - "name" [::str "tommi"] - [::str "kikka"] [::str "kukka"] - [::str "abba"] [::str "jabba"]} + (is (= {:id (miu/-tagged ::int 1) + "name" (miu/-tagged ::str "tommi") + (miu/-tagged ::str "kikka") (miu/-tagged ::str "kukka") + (miu/-tagged ::str "abba") (miu/-tagged ::str "jabba")} (m/parse schema valid))) (is (= valid (->> valid (m/parse schema) (m/unparse schema)))) (is (= ::m/invalid (m/parse schema {"kukka" 42}))))) @@ -3310,7 +3314,7 @@ value [:a]] (is (= true (m/validate schema value))) (is (= nil (m/explain schema value))) - (is (= [[:a :a]] (m/parse schema value))) + (is (= [(miu/-tagged :a :a)] (m/parse schema value))) (is (= value (m/unparse schema (m/parse schema value)))) (is (= value (m/decode schema value nil)))))) @@ -3422,14 +3426,14 @@ parsed (m/parse [:seqable [:orn [:l :int] [:r :boolean]]] original) unparsed (m/unparse [:seqable [:orn [:l :int] [:r :boolean]]] parsed)] (is (= original unparsed)) - (is (= [[:l 0] [:r true] [:l 1] [:r false] [:l 2] [:r true] [:l 3] [:r false] [:l 4] [:r true] [:l 5] - [:r false] [:l 6] [:r true] [:l 7] [:r false] [:l 8] [:r true] [:l 9] [:r false]] + (is (= [(miu/-tagged :l 0) (miu/-tagged :r true) (miu/-tagged :l 1) (miu/-tagged :r false) (miu/-tagged :l 2) (miu/-tagged :r true) (miu/-tagged :l 3) (miu/-tagged :r false) (miu/-tagged :l 4) (miu/-tagged :r true) (miu/-tagged :l 5) + (miu/-tagged :r false) (miu/-tagged :l 6) (miu/-tagged :r true) (miu/-tagged :l 7) (miu/-tagged :r false) (miu/-tagged :l 8) (miu/-tagged :r true) (miu/-tagged :l 9) (miu/-tagged :r false)] parsed))) (let [original (sorted-set 1 2 3) parsed (m/parse [:seqable [:orn [:a :int]]] original) unparsed (m/unparse [:seqable [:orn [:a :int]]] parsed)] (is (= unparsed [1 2 3])) - (is (= parsed [[:a 1] [:a 2] [:a 3]])))) + (is (= parsed [(miu/-tagged :a 1) (miu/-tagged :a 2) (miu/-tagged :a 3)])))) (deftest every-schema-test (is (m/validate [:every :int] nil)) diff --git a/test/malli/destructure_test.cljc b/test/malli/destructure_test.cljc index 147109579..35c38c5b4 100644 --- a/test/malli/destructure_test.cljc +++ b/test/malli/destructure_test.cljc @@ -46,25 +46,48 @@ :schema [:cat :any [:orn - [:map [:map - [:b {:optional true} :any] - ["c" {:optional true} :any] - ['d {:optional true} :any] - ['demo/e {:optional true} :any] - [:demo/f {:optional true}] - [:demo/g {:optional true}] - [123 {:optional true} :any]]] + ;; Unfortunately, the output order is different between clj and cljs, and we use strict equality in the test + [:map #?(:clj + [:map + [:b {:optional true} :any] + ["c" {:optional true} :any] + ['d {:optional true} :any] + ['demo/e {:optional true} :any] + [:demo/f {:optional true}] + [123 {:optional true} :any] + [:demo/g {:optional true}]] + :cljs + [:map + [:b {:optional true} :any] + ["c" {:optional true} :any] + ['d {:optional true} :any] + ['demo/e {:optional true} :any] + [:demo/f {:optional true}] + [:demo/g {:optional true}] + [123 {:optional true} :any]])] [:args [:schema - [:* - [:alt - [:cat [:= :b] :any] - [:cat [:= "c"] :any] - [:cat [:= 'd] :any] - [:cat [:= 'demo/e] :any] - [:cat [:= :demo/f] :demo/f] - [:cat [:= :demo/g] :demo/g] - [:cat [:= 123] :any] - [:cat [:not [:enum :b "c" 'd 'demo/e :demo/f :demo/g 123]] :any]]]]]]] + #?(:clj + [:* + [:alt + [:cat [:= :b] :any] + [:cat [:= "c"] :any] + [:cat [:= 'd] :any] + [:cat [:= 'demo/e] :any] + [:cat [:= :demo/f] :demo/f] + [:cat [:= 123] :any] + [:cat [:= :demo/g] :demo/g] + [:cat [:not [:enum :b "c" 'd 'demo/e :demo/f 123 :demo/g]] :any]]] + :cljs + [:* + [:alt + [:cat [:= :b] :any] + [:cat [:= "c"] :any] + [:cat [:= 'd] :any] + [:cat [:= 'demo/e] :any] + [:cat [:= :demo/f] :demo/f] + [:cat [:= :demo/g] :demo/g] + [:cat [:= 123] :any] + [:cat [:not [:enum :b "c" 'd 'demo/e :demo/f :demo/g 123]] :any]]])]]]] :errors '[[{::keysz [z]}] [{:kikka/keyz [z]}]]} {:name "map destructuring with required-keys" diff --git a/test/malli/distributive_test.cljc b/test/malli/distributive_test.cljc index df84339c0..32ffef7d0 100644 --- a/test/malli/distributive_test.cljc +++ b/test/malli/distributive_test.cljc @@ -139,7 +139,7 @@ [4 [:map [:y [:= 2]] [:z [:= 4]]]]]]]))) (deftest parse-distributive-multi-test - (is (= [1 [3 {:y 1, :z 3}]] + (is (= (miu/-tagged 1 (miu/-tagged 3 {:y 1, :z 3})) (m/parse [:merge [:multi {:dispatch :y} diff --git a/test/malli/util_test.cljc b/test/malli/util_test.cljc index be7e7ac6e..37517e1d5 100644 --- a/test/malli/util_test.cljc +++ b/test/malli/util_test.cljc @@ -878,7 +878,7 @@ [:z {:optional true} :boolean]] (m/form (m/deref s)))) (is (= true (m/validate s {:x "x", :y 1, :z true}))) (is (= false (m/validate s {:x "x", :y "y"}))) - (is (= {:x [:str "x"], :y 1, :z true} (m/parse s {:x "x", :y 1, :z true}))))) + (is (= {:x (miu/-tagged :str "x"), :y 1, :z true} (m/parse s {:x "x", :y 1, :z true}))))) (testing "union" (let [s (->> [:union @@ -891,7 +891,7 @@ (is (= [:map [:x [:or [:orn [:str :string]] :int]]] (m/form (m/deref s)))) (is (= true (m/validate s {:x "x"}) (m/validate s {:x 1}))) (is (= false (m/validate s {:x true}))) - (is (= {:x [:str "x"]} (m/parse s {:x "x"}))) + (is (= {:x (miu/-tagged :str "x")} (m/parse s {:x "x"}))) (is (= {:x 1} (m/parse s {:x 1}))))) (testing "merge vs union" @@ -942,7 +942,7 @@ (m/form (m/deref s)))) (is (= true (m/validate s {:x "x", :z "z"}))) (is (= false (m/validate s {:x "x", :y "y" :z "z"}))) - (is (= {:x [:str "x"], :z "z"} (m/parse s {:x "x", :z "z"}))))))) + (is (= {:x (miu/-tagged :str "x"), :z "z"} (m/parse s {:x "x", :z "z"}))))))) (def Int (m/schema int?))