From 21538e12981656b566f22128eb81c3d1928fac4d Mon Sep 17 00:00:00 2001 From: Joel Kaasinen Date: Mon, 16 Dec 2024 10:21:07 +0200 Subject: [PATCH 1/6] 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?)) From 92e16350a05c260a44270d349debb520019a1df3 Mon Sep 17 00:00:00 2001 From: Joel Kaasinen Date: Tue, 7 Jan 2025 09:53:52 +0200 Subject: [PATCH 2/6] feat: use a custom Tags record for :catn parse results This avoids a problem where the map output from :catn could be confused with an actual map value. For example: ``` (def Schema [:or [:vector [:map [:s :string] [:a :any]]] [:* [:catn [:s :string] [:a :any]]]]) (m/parse Schema ["kikka" {:a 1}]) ; => [{:s "kikka", :a {:a 1}}] (m/unparse Schema *1) ; => [{:s "kikka", :a {:a 1}}] ; should've been the original value, ["kikka" {:a 1}] ``` fixes #1153 --- src/malli/destructure.cljc | 14 +++++++------- src/malli/experimental.cljc | 7 ++++--- src/malli/impl/regex.cljc | 8 ++++---- src/malli/impl/util.cljc | 5 +++++ test/malli/core_test.cljc | 16 +++++++++------- test/malli/experimental_test.clj | 3 ++- 6 files changed, 31 insertions(+), 22 deletions(-) diff --git a/src/malli/destructure.cljc b/src/malli/destructure.cljc index dec1fa287..9772a6ee4 100644 --- a/src/malli/destructure.cljc +++ b/src/malli/destructure.cljc @@ -62,10 +62,10 @@ (defn -any? [x] (= :any x)) (defn -maybe? [x] (and (vector? x) (= :maybe (first x)))) -(defn -vector [{:keys [as elems rest]} options] - (or (some->> as :schema :schema (conj [:schema])) +(defn -vector [{{:keys [as elems rest]} :values} options] + (or (some->> as :values :schema :values :schema (conj [:schema])) (let [ess (map #(let [s (-transform % options false)] (cond->> s (not (-maybe? s)) (conj [:?]))) elems) - rs (if rest (-transform (:arg rest) options true) [:* :any])] + rs (if rest (-transform (:arg (:values rest)) options true) [:* :any])] [:maybe (if (seq ess) (-> [:cat] (into ess) (conj rs)) [:cat rs])]))) (defn -qualified-keys [m] @@ -78,7 +78,7 @@ (let [any (fn [f ks] (map (fn [k] [(f k) :any]) ks))] (->> (concat (any keyword keys) (any str strs) (any identity syms) (map (fn [k] [k (if (and references (qualified-keyword? k)) k :any)]) (-qualified-keys arg)) - (map (fn [[k v]] [v (-transform {:arg k} options false)]) (filter #(miu/-tagged? (key %)) arg))) + (map (fn [[k v]] [v (-transform (miu/-tags {:arg k}) options false)]) (filter #(miu/-tagged? (key %)) arg))) (distinct)))) (defn -map [arg {:keys [::references ::required-keys ::closed-maps ::sequential-maps] @@ -96,7 +96,7 @@ (cond->> :always (conj [:*]) (not rest) (conj [:schema])))]] schema))) -(defn -transform [{{k :key v :value} :arg schema :schema :as all} options rest] +(defn -transform [{{{k :key v :value} :arg schema :schema :as all} :values} options rest] (cond (and schema rest) (let [s (-transform all options false)] (if (-any? s) schema s)) schema schema (= :vec k) (-vector v options) @@ -104,11 +104,11 @@ rest [:* :any] :else :any)) -(defn -schema [{:keys [elems rest]} options] +(defn -schema [{{:keys [elems rest]} :values} options] (cond-> :cat (or (seq elems) rest) (vector) (seq elems) (into (map #(-transform % options false) elems)) - rest (conj (-transform (:arg rest) options true)))) + rest (conj (-transform (:arg (:values rest)) options true)))) (defn -unschematize [x] (walk/prewalk #(cond-> % (and (map? %) (:- %)) (dissoc :- :schema)) x)) diff --git a/src/malli/experimental.cljc b/src/malli/experimental.cljc index 8e795f9e5..a38548bc7 100644 --- a/src/malli/experimental.cljc +++ b/src/malli/experimental.cljc @@ -36,13 +36,14 @@ (def Params (-schema false)) (c/defn -defn [schema args] - (let [{:keys [name return doc arities] body-meta :meta :as parsed} (m/parse schema args) + (let [{:keys [name return doc arities] body-meta :meta :as parsed} (:values (m/parse schema args)) + return (:values return) var-meta (meta name) _ (when (= ::m/invalid parsed) (m/-fail! ::parse-error {:schema schema, :args args})) - parse (fn [{:keys [args] :as parsed}] (merge (md/parse args) parsed)) + parse (fn [parsed] (merge (md/parse (-> parsed :values :args)) (:values parsed))) ->schema (fn [{:keys [schema]}] [:=> schema (:schema return :any)]) single (= :single (:key arities)) - parglists (if single (->> arities :value parse vector) (->> arities :value :arities (map parse))) + parglists (if single (->> arities :value parse vector) (->> arities :value :values :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) diff --git a/src/malli/impl/regex.cljc b/src/malli/impl/regex.cljc index fea36edc9..638aa4993 100644 --- a/src/malli/impl/regex.cljc +++ b/src/malli/impl/regex.cljc @@ -173,13 +173,13 @@ (fn [driver regs pos coll k] (sp driver regs [] pos coll k))))) (defn catn-parser - ([] (fn [_ _ pos coll k] (k {} pos coll))) + ([] (fn [_ _ pos coll k] (k (miu/-tags {}) pos coll))) ([kr & krs] (let [sp (reduce (fn [acc [tag r]] (fn [driver regs m pos coll k] (r driver regs pos coll (fn [v pos coll] (acc driver regs (assoc m tag v) pos coll k))))) - (fn [_ _ m pos coll k] (k m pos coll)) + (fn [_ _ m pos coll k] (k (miu/-tags m) pos coll)) (reverse (cons kr krs)))] (fn [driver regs pos coll k] (sp driver regs {} pos coll k))))) @@ -194,9 +194,9 @@ (defn catn-unparser [& unparsers] (let [unparsers (apply array-map (mapcat identity unparsers))] (fn [m] - (if (and (map? m) (= (count m) (count unparsers))) + (if (and (miu/-tags? m) (= (count (:values m)) (count unparsers))) (miu/-reduce-kv-valid (fn [coll tag unparser] - (if-some [kv (find m tag)] + (if-some [kv (find (:values m) tag)] (miu/-map-valid #(into coll %) (unparser (val kv))) :malli.core/invalid)) ;; `m` is in hash order, so have to iterate over `unparsers` to restore seq order: diff --git a/src/malli/impl/util.cljc b/src/malli/impl/util.cljc index edb697bbb..ac923e908 100644 --- a/src/malli/impl/util.cljc +++ b/src/malli/impl/util.cljc @@ -12,6 +12,11 @@ (defn -tagged [key value] (->Tagged key value)) (defn -tagged? [x] (instance? Tagged x)) +(defrecord Tags [values]) + +(defn -tags [values] (->Tags values)) +(defn -tags? [x] (instance? Tags 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))) (defn -map-invalid [f v] (if (-invalid? v) (f v) v)) diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 3a9f18b54..780a35585 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -1622,7 +1622,7 @@ 0 nil [{:path [], :in [], :schema s, :value 0, :type ::m/invalid-type}] "foo" nil [{:path [], :in [], :schema s, :value "foo", :type ::m/invalid-type}] nil nil [{:path [], :in [], :schema s, :value nil, :type ::m/invalid-type}] - [] {} nil + [] (miu/-tags {}) nil [0] nil [{:path [], :in [0], :schema s, :value 0, :type ::m/input-remaining}]))) (testing "single" @@ -1638,7 +1638,7 @@ "foo" nil [{:path [], :in [], :schema s, :value "foo", :type ::m/invalid-type}] nil nil [{:path [], :in [], :schema s, :value nil, :type ::m/invalid-type}] [] nil [{:path [(case typ :catn :s 0)], :in [0], :schema string?, :value nil, :type ::m/end-of-input}] - ["foo"] {:s "foo"} nil + ["foo"] (miu/-tags {:s "foo"}) nil [0] nil [{:path [(case typ :catn :s 0)], :in [0], :schema string?, :value 0}] ["foo" "bar"] nil [{:path [], :in [1], :schema s, :value "bar", :type ::m/input-remaining}]))) @@ -1656,7 +1656,7 @@ nil nil [{:path [], :in [], :schema s, :value nil, :type ::m/invalid-type}] [] nil [{:path [(case typ :catn :s 0)], :in [0], :schema string?, :value nil, :type ::m/end-of-input}] ["foo"] nil [{:path [(case typ :catn :n 1)], :in [1], :schema int?, :value nil, :type ::m/end-of-input}] - ["foo" 0] {:s "foo", :n 0} nil + ["foo" 0] (miu/-tags {:s "foo", :n 0}) nil ["foo" "bar"] nil [{:path [(case typ :catn :n 1)], :in [1], :schema int?, :value "bar"}] [1 2] nil [{:path [(case typ :catn :s 0)], :in [0], :schema string?, :value 1}] ["foo" 0 1] nil [{:path [], :in [2], :schema s, :value 1, :type ::m/input-remaining}]))) @@ -1677,7 +1677,7 @@ [] nil [{:path [(case typ :catn :s 0)], :in [0], :schema string?, :value nil, :type ::m/end-of-input}] ["foo"] nil [{:path [(case typ :catn :n 1)], :in [1], :schema int?, :value nil, :type ::m/end-of-input}] ["foo" 0] nil [{:path [(case typ :catn :k 2)], :in [2], :schema keyword?, :value nil, :type ::m/end-of-input}] - ["foo" 0 :bar] {:s "foo", :n 0, :k :bar} nil + ["foo" 0 :bar] (miu/-tags {:s "foo", :n 0, :k :bar}) nil ["foo" 0 "bar"] nil [{:path [(case typ :catn :k 2)], :in [2], :schema keyword?, :value "bar"}] ["foo" 0 :bar 0] nil [{:path [], :in [3], :schema s, :value 0, :type ::m/input-remaining}]))) @@ -1688,9 +1688,9 @@ (is (m/validate s v)) (is (= [[4 4 4] 4] (m/parse s v))) - (is (= {:pos [4 4 4], :four 4} (m/parse s* v))) + (is (= (miu/-tags {:pos [4 4 4], :four 4}) (m/parse s* v))) (is (= v (m/unparse s [[4 4 4] 4]))) - (is (= v (m/unparse s* {:pos [4 4 4], :four 4}))))))) + (is (= v (m/unparse s* (miu/-tags {:pos [4 4 4], :four 4})))))))) (doseq [typ [:alt :altn]] (testing typ @@ -3013,8 +3013,10 @@ (is (m/schema? (via-ast 'my/bigger-than-5)))))) (deftest cat-catn-unparse-test + (is (= ["1" 2 "3"] (m/unparse [:cat string? int? string?] ["1" 2 "3"]))) (is (= ::m/invalid (m/unparse [:cat string? int? string?] [1 2 3]))) - (is (= ::m/invalid (m/unparse [:catn [:a string?] [:b int?] [:c string?]] {:a 1 :b 2 :c 3})))) + (is (= ["1" 2 "3"] (m/unparse [:catn [:a string?] [:b int?] [:c string?]] (miu/-tags {:a "1" :b 2 :c "3"})))) + (is (= ::m/invalid (m/unparse [:catn [:a string?] [:b int?] [:c string?]] (miu/-tags {:a 1 :b 2 :c 3}))))) (deftest repeat-unparse-test (is (m/validate [:repeat {:min 1 :max 2} [:cat :int :int]] [1 2 3 4])) diff --git a/test/malli/experimental_test.clj b/test/malli/experimental_test.clj index a1fc3d63d..b66d00520 100644 --- a/test/malli/experimental_test.clj +++ b/test/malli/experimental_test.clj @@ -150,7 +150,8 @@ (when-let [m (:meta e)] (testing "meta" (doseq [[k v] m] - (is (= v (k (meta var))))))) + (is (= v (k (meta var))) + (str k))))) (when instrumented (testing "instrumented calls" From 0f57a337cdb95127966b4dd4d67963418b536455 Mon Sep 17 00:00:00 2001 From: Joel Kaasinen Date: Tue, 7 Jan 2025 14:46:25 +0200 Subject: [PATCH 3/6] fix: prevent unparsing miu/-tagged and miu/-tags as maps --- src/malli/core.cljc | 4 +++- test/malli/core_test.cljc | 20 ++++++++++++++++++++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 8adb7661f..2b5e0825f 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -1011,6 +1011,8 @@ ->parser (fn [this f] (let [keyset (-entry-keyset (-entry-parser this)) default-parser (some-> @default-schema (f)) + ;; prevent unparsing :catn/:orn/etc parse results as maps + ok? #(and (pred? %) (not (miu/-tagged? %)) (not (miu/-tags? %))) parsers (cond->> (-vmap (fn [[key {:keys [optional]} schema]] (let [parser (f schema)] @@ -1035,7 +1037,7 @@ (reduce (fn [m k] (if (contains? keyset k) m (reduced (reduced ::invalid)))) m (keys m)))))] - (fn [x] (if (pred? x) (reduce (fn [m parser] (parser m)) x parsers) ::invalid))))] + (fn [x] (if (ok? x) (reduce (fn [m parser] (parser m)) x parsers) ::invalid))))] ^{:type ::schema} (reify AST diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 780a35585..3d96cd49a 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -3018,6 +3018,26 @@ (is (= ["1" 2 "3"] (m/unparse [:catn [:a string?] [:b int?] [:c string?]] (miu/-tags {:a "1" :b 2 :c "3"})))) (is (= ::m/invalid (m/unparse [:catn [:a string?] [:b int?] [:c string?]] (miu/-tags {:a 1 :b 2 :c 3}))))) +(deftest unparse-confusion-test + ;; parse-unparse should roundtrip even for weird situations where + ;; the schema tries to match on the result of unparse. See #1150 #1153. + (let [s [:or + [:tuple :string :keyword] + [:orn ["any" :keyword]]]] + (is (= :k (m/unparse s (m/parse s :k))))) + (let [s [:or + [:map [:key :string] [:value :keyword]] + [:orn ["any" :keyword]]]] + (is (= :k (m/unparse s (m/parse s :k))))) + (let [s [:or + [:map [:s :string]] + [:catn [:s :string]]]] + (is (= ["k"] (m/unparse s (m/parse s ["k"]))))) + (let [s [:or + [:map [:values [:map [:s :string]]]] + [:catn [:s :string]]]] + (is (= ["k"] (m/unparse s (m/parse s ["k"])))))) + (deftest repeat-unparse-test (is (m/validate [:repeat {:min 1 :max 2} [:cat :int :int]] [1 2 3 4])) (is (= [[1 2] [3 4]] (m/parse [:repeat {:min 1 :max 2} [:cat :int :int]] [1 2 3 4]))) From 17ff517a377fdcc6bcf9b8bf310d06d070f80522 Mon Sep 17 00:00:00 2001 From: Joel Kaasinen Date: Tue, 7 Jan 2025 15:08:20 +0200 Subject: [PATCH 4/6] refactor: move Tag and Tags records to malli.core ... and rename Tagged to Tag --- src/malli/core.cljc | 39 ++++++++++++++---- src/malli/destructure.cljc | 5 +-- src/malli/impl/regex.cljc | 28 +++++++------ src/malli/impl/util.cljc | 10 ----- test/malli/core_test.cljc | 68 +++++++++++++++---------------- test/malli/distributive_test.cljc | 7 +--- test/malli/util_test.cljc | 6 +-- 7 files changed, 87 insertions(+), 76 deletions(-) diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 2b5e0825f..b5d7720c7 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -148,6 +148,27 @@ #?(:clj (defmethod print-method ::into-schema [v ^java.io.Writer w] (.write w (str "#IntoSchema{:type " (pr-str (-type ^IntoSchema v)) "}")))) #?(:clj (defmethod print-method ::schema [v ^java.io.Writer w] (.write w (pr-str (-form ^Schema v))))) +(defrecord Tag [key value]) + +(defn tag + "A tagged value, used eg. for results of `parse` for `:orn` schemas." + [key value] (->Tag key value)) + +(defn tag? + "Is this a value constructed with `tag`?" + [x] (instance? Tag x)) + +(defrecord Tags [values]) + +(defn tags + "A collection of tagged values. `values` should be a map from tag to value. + Used eg. for results of `parse` for `:catn` schemas." + [values] (->Tags values)) + +(defn tags? + "Is this a value constructed with `tags`?" + [x] (instance? Tags x)) + ;; ;; impl ;; @@ -865,13 +886,13 @@ (-parser [this] (let [parsers (-vmap (fn [[k _ c]] (let [c (-parser c)] - (fn [x] (miu/-map-valid #(reduced (miu/-tagged k %)) (c x))))) + (fn [x] (miu/-map-valid #(reduced (tag k %)) (c x))))) (-children this))] (fn [x] (reduce (fn [_ parser] (parser x)) x parsers)))) (-unparser [this] (let [unparsers (into {} (map (fn [[k _ c]] [k (-unparser c)])) (-children this))] (fn [x] - (if (miu/-tagged? x) + (if (tag? x) (if-some [unparse (get unparsers (:key x))] (unparse (:value x)) ::invalid) @@ -1012,7 +1033,7 @@ (let [keyset (-entry-keyset (-entry-parser this)) default-parser (some-> @default-schema (f)) ;; prevent unparsing :catn/:orn/etc parse results as maps - ok? #(and (pred? %) (not (miu/-tagged? %)) (not (miu/-tags? %))) + ok? #(and (pred? %) (not (tag? %)) (not (tags? %))) parsers (cond->> (-vmap (fn [[key {:keys [optional]} schema]] (let [parser (f schema)] @@ -1647,12 +1668,12 @@ (let [->path (if (and (map? x) (keyword? dispatch)) #(conj % dispatch) identity)] (conj acc (miu/-error (->path path) (->path in) this x ::invalid-dispatch-value))))))) (-parser [_] - (let [parse (fn [k s] (let [p (-parser s)] (fn [x] (miu/-map-valid #(miu/-tagged k %) (p x))))) + (let [parse (fn [k s] (let [p (-parser s)] (fn [x] (miu/-map-valid #(tag k %) (p x))))) find (finder (reduce-kv (fn [acc k s] (assoc acc k (parse k s))) {} @dispatch-map))] (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 (:value x)) ::invalid) ::invalid)))) + (fn [x] (if (tag? 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: @@ -2685,15 +2706,15 @@ :catn (-sequence-entry-schema {:type :catn, :child-bounds {}, :keep false :re-validator (fn [_ children] (apply re/cat-validator children)) :re-explainer (fn [_ children] (apply re/cat-explainer children)) - :re-parser (fn [_ children] (apply re/catn-parser children)) - :re-unparser (fn [_ children] (apply re/catn-unparser children)) + :re-parser (fn [_ children] (apply re/catn-parser tags children)) + :re-unparser (fn [_ children] (apply re/catn-unparser tags? children)) :re-transformer (fn [_ children] (apply re/cat-transformer children)) :re-min-max (fn [_ children] (reduce (partial -re-min-max +) {:min 0, :max 0} (-vmap last children)))}) :altn (-sequence-entry-schema {:type :altn, :child-bounds {:min 1}, :keep false :re-validator (fn [_ children] (apply re/alt-validator children)) :re-explainer (fn [_ children] (apply re/alt-explainer children)) - :re-parser (fn [_ children] (apply re/altn-parser children)) - :re-unparser (fn [_ children] (apply re/altn-unparser children)) + :re-parser (fn [_ children] (apply re/altn-parser tag children)) + :re-unparser (fn [_ children] (apply re/altn-unparser tag? children)) :re-transformer (fn [_ children] (apply re/alt-transformer children)) :re-min-max (fn [_ children] (reduce -re-alt-min-max {:max 0} (-vmap last children)))})}) diff --git a/src/malli/destructure.cljc b/src/malli/destructure.cljc index 9772a6ee4..7c4aa5307 100644 --- a/src/malli/destructure.cljc +++ b/src/malli/destructure.cljc @@ -1,7 +1,6 @@ (ns malli.destructure (:require [clojure.walk :as walk] - [malli.core :as m] - [malli.impl.util :as miu])) + [malli.core :as m])) (defn -map-like? [x] (or (map? x) (and (seqable? x) (every? (fn [e] (and (vector? e) (= 2 (count e)))) x)))) (defn -qualified-key? [k] (and (qualified-keyword? k) (-> k name #{"keys" "syms"}))) @@ -78,7 +77,7 @@ (let [any (fn [f ks] (map (fn [k] [(f k) :any]) ks))] (->> (concat (any keyword keys) (any str strs) (any identity syms) (map (fn [k] [k (if (and references (qualified-keyword? k)) k :any)]) (-qualified-keys arg)) - (map (fn [[k v]] [v (-transform (miu/-tags {:arg k}) options false)]) (filter #(miu/-tagged? (key %)) arg))) + (map (fn [[k v]] [v (-transform (m/tags {:arg k}) options false)]) (filter #(m/tag? (key %)) arg))) (distinct)))) (defn -map [arg {:keys [::references ::required-keys ::closed-maps ::sequential-maps] diff --git a/src/malli/impl/regex.cljc b/src/malli/impl/regex.cljc index 638aa4993..03d9f476f 100644 --- a/src/malli/impl/regex.cljc +++ b/src/malli/impl/regex.cljc @@ -172,14 +172,15 @@ (reverse (cons r rs)))] (fn [driver regs pos coll k] (sp driver regs [] pos coll k))))) +;; we need to pass in the malli.core/tags function as an arg to avoid a cyclic reference (defn catn-parser - ([] (fn [_ _ pos coll k] (k (miu/-tags {}) pos coll))) - ([kr & krs] + ([tags] (fn [_ _ pos coll k] (k (tags {}) pos coll))) + ([tags kr & krs] (let [sp (reduce (fn [acc [tag r]] (fn [driver regs m pos coll k] (r driver regs pos coll (fn [v pos coll] (acc driver regs (assoc m tag v) pos coll k))))) - (fn [_ _ m pos coll k] (k (miu/-tags m) pos coll)) + (fn [_ _ m pos coll k] (k (tags m) pos coll)) (reverse (cons kr krs)))] (fn [driver regs pos coll k] (sp driver regs {} pos coll k))))) @@ -191,10 +192,11 @@ [] unparsers) :malli.core/invalid)))) -(defn catn-unparser [& unparsers] +;; cyclic ref avoidance here as well for malli.core/tags? +(defn catn-unparser [tags? & unparsers] (let [unparsers (apply array-map (mapcat identity unparsers))] (fn [m] - (if (and (miu/-tags? m) (= (count (:values m)) (count unparsers))) + (if (and (tags? m) (= (count (:values m)) (count unparsers))) (miu/-reduce-kv-valid (fn [coll tag unparser] (if-some [kv (find (:values m) tag)] (miu/-map-valid #(into coll %) (unparser (val kv))) @@ -237,14 +239,15 @@ (park-validator! driver r regs pos coll k))) rs)) -(defn altn-parser [kr & krs] - (reduce (fn [r [tag r*]] - (let [r* (fmap-parser (fn [v] (miu/-tagged tag v)) r*)] +;; cyclic ref avoidance for malli.core/tag +(defn altn-parser [tag kr & krs] + (reduce (fn [r [t r*]] + (let [r* (fmap-parser (fn [v] (tag t v)) r*)] (fn [driver regs pos coll k] (park-validator! driver r* regs pos coll k) ; remember fallback (park-validator! driver r regs pos coll k)))) - (let [[tag r] kr] - (fmap-parser (fn [v] (miu/-tagged tag v)) r)) + (let [[t r] kr] + (fmap-parser (fn [v] (tag t v)) r)) krs)) (defn alt-unparser [& unparsers] @@ -252,10 +255,11 @@ (reduce (fn [_ unparse] (miu/-map-valid reduced (unparse x))) :malli.core/invalid unparsers))) -(defn altn-unparser [& unparsers] +;; cyclic ref avoidance for malli.core/tag? +(defn altn-unparser [tag? & unparsers] (let [unparsers (into {} unparsers)] (fn [x] - (if (miu/-tagged? x) + (if (tag? x) (if-some [kv (find unparsers (:key x))] ((val kv) (:value x)) :malli.core/invalid) diff --git a/src/malli/impl/util.cljc b/src/malli/impl/util.cljc index ac923e908..ef57df787 100644 --- a/src/malli/impl/util.cljc +++ b/src/malli/impl/util.cljc @@ -7,16 +7,6 @@ (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)) - -(defrecord Tags [values]) - -(defn -tags [values] (->Tags values)) -(defn -tags? [x] (instance? Tags 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))) (defn -map-invalid [f v] (if (-invalid? v) (f v) v)) diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 3d96cd49a..28a627db3 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -254,11 +254,11 @@ (is (= 1 (m/unparse schema 1))) (is (= ::m/invalid (m/unparse schema 0))) - (is (= (miu/-tagged :pos 1) (m/parse schema* 1))) + (is (= (m/tag :pos 1) (m/parse schema* 1))) (is (= ::m/invalid (m/parse schema* 0))) - (is (= 1 (m/unparse schema* (miu/-tagged :pos 1)))) + (is (= 1 (m/unparse schema* (m/tag :pos 1)))) (is (= ::m/invalid (m/unparse schema* [:pos 1]))) - (is (= ::m/invalid (m/unparse schema* (miu/-tagged :pos 0)))) + (is (= ::m/invalid (m/unparse schema* (m/tag :pos 0)))) (doseq [schema [schema schema*]] (testing (m/form schema) @@ -1160,9 +1160,9 @@ :type :malli.core/invalid-dispatch-value}]} (m/explain schema invalid6))) - (is (= (miu/-tagged :sized valid1) (m/parse schema valid1))) - (is (= (miu/-tagged :human valid2) (m/parse schema valid2))) - (is (= (miu/-tagged :sized valid3) (m/parse schema valid3))) + (is (= (m/tag :sized valid1) (m/parse schema valid1))) + (is (= (m/tag :human valid2) (m/parse schema valid2))) + (is (= (m/tag :sized valid3) (m/parse schema valid3))) (is (= ::m/invalid (m/parse schema invalid1))) (is (= ::m/invalid (m/parse schema invalid2))) (is (= ::m/invalid (m/parse schema invalid3))) @@ -1170,11 +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 (= valid1 (m/unparse schema (m/tag :sized valid1)))) (is (= valid2 (m/unparse schema (m/parse schema valid2)))) - (is (= valid2 (m/unparse schema (miu/-tagged :human valid2)))) + (is (= valid2 (m/unparse schema (m/tag :human valid2)))) (is (= valid3 (m/unparse schema (m/parse schema valid3)))) - (is (= valid3 (m/unparse schema (miu/-tagged :sized valid3)))) + (is (= valid3 (m/unparse schema (m/tag :sized valid3)))) (is (= ::m/invalid (m/unparse schema invalid1))) (is (= ::m/invalid (m/unparse schema invalid2))) (is (= ::m/invalid (m/unparse schema invalid3))) @@ -1271,9 +1271,9 @@ (is (schema= [:tuple :string :string] (m/default-schema schema)))) (testing "parser" - (is (= (miu/-tagged :human [:human]) (m/parse schema [:human]))) - (is (= (miu/-tagged :bear [:bear [1 2 3]]) (m/parse schema [:bear 1 2 3]))) - (is (= (miu/-tagged ::m/default ["defaultit" "toimii"]) (m/parse schema ["defaultit" "toimii"]))) + (is (= (m/tag :human [:human]) (m/parse schema [:human]))) + (is (= (m/tag :bear [:bear [1 2 3]]) (m/parse schema [:bear 1 2 3]))) + (is (= (m/tag ::m/default ["defaultit" "toimii"]) (m/parse schema ["defaultit" "toimii"]))) (is (= ::m/invalid (m/parse schema [:so :invalid])))))) (testing "map-of schema" @@ -1622,7 +1622,7 @@ 0 nil [{:path [], :in [], :schema s, :value 0, :type ::m/invalid-type}] "foo" nil [{:path [], :in [], :schema s, :value "foo", :type ::m/invalid-type}] nil nil [{:path [], :in [], :schema s, :value nil, :type ::m/invalid-type}] - [] (miu/-tags {}) nil + [] (m/tags {}) nil [0] nil [{:path [], :in [0], :schema s, :value 0, :type ::m/input-remaining}]))) (testing "single" @@ -1638,7 +1638,7 @@ "foo" nil [{:path [], :in [], :schema s, :value "foo", :type ::m/invalid-type}] nil nil [{:path [], :in [], :schema s, :value nil, :type ::m/invalid-type}] [] nil [{:path [(case typ :catn :s 0)], :in [0], :schema string?, :value nil, :type ::m/end-of-input}] - ["foo"] (miu/-tags {:s "foo"}) nil + ["foo"] (m/tags {:s "foo"}) nil [0] nil [{:path [(case typ :catn :s 0)], :in [0], :schema string?, :value 0}] ["foo" "bar"] nil [{:path [], :in [1], :schema s, :value "bar", :type ::m/input-remaining}]))) @@ -1656,7 +1656,7 @@ nil nil [{:path [], :in [], :schema s, :value nil, :type ::m/invalid-type}] [] nil [{:path [(case typ :catn :s 0)], :in [0], :schema string?, :value nil, :type ::m/end-of-input}] ["foo"] nil [{:path [(case typ :catn :n 1)], :in [1], :schema int?, :value nil, :type ::m/end-of-input}] - ["foo" 0] (miu/-tags {:s "foo", :n 0}) nil + ["foo" 0] (m/tags {:s "foo", :n 0}) nil ["foo" "bar"] nil [{:path [(case typ :catn :n 1)], :in [1], :schema int?, :value "bar"}] [1 2] nil [{:path [(case typ :catn :s 0)], :in [0], :schema string?, :value 1}] ["foo" 0 1] nil [{:path [], :in [2], :schema s, :value 1, :type ::m/input-remaining}]))) @@ -1677,7 +1677,7 @@ [] nil [{:path [(case typ :catn :s 0)], :in [0], :schema string?, :value nil, :type ::m/end-of-input}] ["foo"] nil [{:path [(case typ :catn :n 1)], :in [1], :schema int?, :value nil, :type ::m/end-of-input}] ["foo" 0] nil [{:path [(case typ :catn :k 2)], :in [2], :schema keyword?, :value nil, :type ::m/end-of-input}] - ["foo" 0 :bar] (miu/-tags {:s "foo", :n 0, :k :bar}) nil + ["foo" 0 :bar] (m/tags {:s "foo", :n 0, :k :bar}) nil ["foo" 0 "bar"] nil [{:path [(case typ :catn :k 2)], :in [2], :schema keyword?, :value "bar"}] ["foo" 0 :bar 0] nil [{:path [], :in [3], :schema s, :value 0, :type ::m/input-remaining}]))) @@ -1688,9 +1688,9 @@ (is (m/validate s v)) (is (= [[4 4 4] 4] (m/parse s v))) - (is (= (miu/-tags {:pos [4 4 4], :four 4}) (m/parse s* v))) + (is (= (m/tags {:pos [4 4 4], :four 4}) (m/parse s* v))) (is (= v (m/unparse s [[4 4 4] 4]))) - (is (= v (m/unparse s* (miu/-tags {:pos [4 4 4], :four 4})))))))) + (is (= v (m/unparse s* (m/tags {:pos [4 4 4], :four 4})))))))) (doseq [typ [:alt :altn]] (testing typ @@ -1710,7 +1710,7 @@ 0 nil [{:path [], :in [], :schema s, :value 0, :type ::m/invalid-type}] "foo" nil [{:path [], :in [], :schema s, :value "foo", :type ::m/invalid-type}] nil nil [{:path [], :in [], :schema s, :value nil, :type ::m/invalid-type}] - ["foo"] ["foo" (miu/-tagged :s "foo")] nil + ["foo"] ["foo" (m/tag :s "foo")] nil [0] nil [{:path [(case typ :altn :s 0)], :in [0], :schema string?, :value 0}] ["foo" 0] nil [{:path [], :in [1], :schema s, :value 0, :type ::m/input-remaining}]))) @@ -1727,8 +1727,8 @@ 0 nil [{:path [], :in [], :schema s, :value 0, :type ::m/invalid-type}] "foo" nil [{:path [], :in [], :schema s, :value "foo", :type ::m/invalid-type}] nil nil [{:path [], :in [], :schema s, :value nil, :type ::m/invalid-type}] - ["foo"] ["foo" (miu/-tagged :s "foo")] nil - [0] [0 (miu/-tagged :n 0)] nil + ["foo"] ["foo" (m/tag :s "foo")] nil + [0] [0 (m/tag :n 0)] nil ["foo" 0] nil [{:path [], :in [1], :schema s, :value 0, :type ::m/input-remaining}] [0 "foo"] nil [{:path [], :in [1], :schema s, :value "foo", :type ::m/input-remaining}]))) @@ -1746,9 +1746,9 @@ 0 nil [{:path [], :in [], :schema s, :value 0, :type ::m/invalid-type}] "foo" nil [{:path [], :in [], :schema s, :value "foo", :type ::m/invalid-type}] nil nil [{:path [], :in [], :schema s, :value nil, :type ::m/invalid-type}] - ["foo"] ["foo" (miu/-tagged :s "foo")] nil - [0] [0 (miu/-tagged :n 0)] nil - [:foo] [:foo (miu/-tagged :k :foo)] nil + ["foo"] ["foo" (m/tag :s "foo")] nil + [0] [0 (m/tag :n 0)] nil + [:foo] [:foo (m/tag :k :foo)] nil ["foo" 0] nil [{:path [], :in [1], :schema s, :value 0, :type ::m/input-remaining}] [0 "foo"] nil [{:path [], :in [1], :schema s, :value "foo", :type ::m/input-remaining}] [:foo 0] nil [{:path [], :in [1], :schema s, :value 0, :type ::m/input-remaining}]))))) @@ -3015,8 +3015,8 @@ (deftest cat-catn-unparse-test (is (= ["1" 2 "3"] (m/unparse [:cat string? int? string?] ["1" 2 "3"]))) (is (= ::m/invalid (m/unparse [:cat string? int? string?] [1 2 3]))) - (is (= ["1" 2 "3"] (m/unparse [:catn [:a string?] [:b int?] [:c string?]] (miu/-tags {:a "1" :b 2 :c "3"})))) - (is (= ::m/invalid (m/unparse [:catn [:a string?] [:b int?] [:c string?]] (miu/-tags {:a 1 :b 2 :c 3}))))) + (is (= ["1" 2 "3"] (m/unparse [:catn [:a string?] [:b int?] [:c string?]] (m/tags {:a "1" :b 2 :c "3"})))) + (is (= ::m/invalid (m/unparse [:catn [:a string?] [:b int?] [:c string?]] (m/tags {:a 1 :b 2 :c 3}))))) (deftest unparse-confusion-test ;; parse-unparse should roundtrip even for weird situations where @@ -3232,10 +3232,10 @@ ["name" 'str] [::m/default [:map-of 'str 'str]]] valid {:id 1, "name" "tommi", "kikka" "kukka", "abba" "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")} + (is (= {:id (m/tag ::int 1) + "name" (m/tag ::str "tommi") + (m/tag ::str "kikka") (m/tag ::str "kukka") + (m/tag ::str "abba") (m/tag ::str "jabba")} (m/parse schema valid))) (is (= valid (->> valid (m/parse schema) (m/unparse schema)))) (is (= ::m/invalid (m/parse schema {"kukka" 42}))))) @@ -3336,7 +3336,7 @@ value [:a]] (is (= true (m/validate schema value))) (is (= nil (m/explain schema value))) - (is (= [(miu/-tagged :a :a)] (m/parse schema value))) + (is (= [(m/tag :a :a)] (m/parse schema value))) (is (= value (m/unparse schema (m/parse schema value)))) (is (= value (m/decode schema value nil)))))) @@ -3448,14 +3448,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 (= [(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)] + (is (= [(m/tag :l 0) (m/tag :r true) (m/tag :l 1) (m/tag :r false) (m/tag :l 2) (m/tag :r true) (m/tag :l 3) (m/tag :r false) (m/tag :l 4) (m/tag :r true) (m/tag :l 5) + (m/tag :r false) (m/tag :l 6) (m/tag :r true) (m/tag :l 7) (m/tag :r false) (m/tag :l 8) (m/tag :r true) (m/tag :l 9) (m/tag :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 [(miu/-tagged :a 1) (miu/-tagged :a 2) (miu/-tagged :a 3)])))) + (is (= parsed [(m/tag :a 1) (m/tag :a 2) (m/tag :a 3)])))) (deftest every-schema-test (is (m/validate [:every :int] nil)) diff --git a/test/malli/distributive_test.cljc b/test/malli/distributive_test.cljc index 32ffef7d0..dabbf6d68 100644 --- a/test/malli/distributive_test.cljc +++ b/test/malli/distributive_test.cljc @@ -1,10 +1,7 @@ (ns malli.distributive-test - (:require [clojure.test :refer [are deftest is testing]] + (:require [clojure.test :refer [deftest is]] [malli.core :as m] - [malli.impl.util :as miu] [malli.generator :as mg] - [malli.registry :as mr] - [malli.transform :as mt] [malli.util :as mu])) (def options {:registry (merge (mu/schemas) (m/default-schemas))}) @@ -139,7 +136,7 @@ [4 [:map [:y [:= 2]] [:z [:= 4]]]]]]]))) (deftest parse-distributive-multi-test - (is (= (miu/-tagged 1 (miu/-tagged 3 {:y 1, :z 3})) + (is (= (m/tag 1 (m/tag 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 37517e1d5..5e745ff8c 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 (miu/-tagged :str "x"), :y 1, :z true} (m/parse s {:x "x", :y 1, :z true}))))) + (is (= {:x (m/tag :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 (miu/-tagged :str "x")} (m/parse s {:x "x"}))) + (is (= {:x (m/tag :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 (miu/-tagged :str "x"), :z "z"} (m/parse s {:x "x", :z "z"}))))))) + (is (= {:x (m/tag :str "x"), :z "z"} (m/parse s {:x "x", :z "z"}))))))) (def Int (m/schema int?)) From c87be5dc39569d576812194efe1a9ed2027fa09f Mon Sep 17 00:00:00 2001 From: Joel Kaasinen Date: Tue, 7 Jan 2025 15:57:07 +0200 Subject: [PATCH 5/6] doc: use new Tag and Tags records in README.md --- README.md | 48 ++++++++++++++++++++++++++++++++++++------------ 1 file changed, 36 insertions(+), 12 deletions(-) diff --git a/README.md b/README.md index f98af08bd..d08c7a7e1 100644 --- a/README.md +++ b/README.md @@ -2445,9 +2445,10 @@ Schemas can be used to parse values using `m/parse` and `m/parser`: [:s string?] [:b boolean?]]]]] ["-server" "foo" "-verbose" true "-user" "joe"]) -;[{:prop "-server", :val [:s "foo"]} -; {:prop "-verbose", :val [:b true]} -; {:prop "-user", :val [:s "joe"]}] +;[#malli.core.Tags{:values {:prop "-server", :val #malli.core.Tag{:key :s, :value "foo"}}} +; #malli.core.Tags{:values {:prop "-verbose", :val #malli.core.Tag{:key :b, :value true}}} +; #malli.core.Tags{:values {:prop "-user", :val #malli.core.Tag{:key :s, :value "joe"}}}] + ``` `m/parser` to create an optimized parser: @@ -2471,13 +2472,25 @@ Schemas can be used to parse values using `m/parse` and `m/parser`: (parse-hiccup [:div {:class [:foo :bar]} [:p "Hello, world of data"]]) -;[:node -; {:name :div -; :props {:class [:foo :bar]} -; :children [[:node -; {:name :p -; :props nil -; :children [[:primitive [:text "Hello, world of data"]]]}]]}] + +;#malli.core.Tag +;{:key :node, +; :value +; #malli.core.Tags +; {:values {:name :div, +; :props {:class [:foo :bar]}, +; :children [#malli.core.Tag +; {:key :node, +; :value +; #malli.core.Tags +; {:values {:name :p, +; :props nil, +; :children [#malli.core.Tag +; {:key :primitive, +; :value +; #malli.core.Tag +; {:key :text, +; :value "Hello, world of data"}}]}}}]}}} ``` Parsing returns tagged values for `:orn`, `:catn`, `:altn` and `:multi`. @@ -2489,10 +2502,10 @@ Parsing returns tagged values for `:orn`, `:catn`, `:altn` and `:multi`. [::m/default :any]]) (m/parse Multi {:type :user, :size 1}) -; => [:user {:type :user, :size 1}] +; => #malli.core.Tag{:key :user, :value {:type :user, :size 1}} (m/parse Multi {:type "sized", :size 1}) -; => [:malli.core/default {:type "sized", :size 1}] +; => #malli.core.Tag{:key :malli.core/default, :value {:type "sized", :size 1}} ``` ## Unparsing values @@ -2508,6 +2521,17 @@ The inverse of parsing, using `m/unparse` and `m/unparser`: ; [:p "Hello, world of data"]] ``` +```clojure +(m/unparse [:orn [:name :string] [:id :int]] + (m/tagged :name "x")) +; => "x" + +(m/unparse [:* [:catn [:name :string] [:id :int]]] + [(m/tags {:name "x" :id 1}) + (m/tags {:name "y" :id 2})]) +; => ["x" 1 "y" 2] +``` + ## Serializable functions Enabling serializable function schemas requires [SCI](https://github.com/borkdude/sci) or [cherry](https://github.com/squint-cljs/cherry) (for client side) as external dependency. If From 5e3d6b473f52e7c2aed367bfd4a6811d6761d6c1 Mon Sep 17 00:00:00 2001 From: Joel Kaasinen Date: Wed, 8 Jan 2025 08:33:34 +0200 Subject: [PATCH 6/6] doc: update CHANGELOG.md --- CHANGELOG.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e70b8db11..4d927ea96 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,9 +14,11 @@ We use [Break Versioning][breakver]. The version numbers follow a `.