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 `. [: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 diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 5ccb8a397..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 ;; @@ -385,7 +406,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 +627,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] @@ -865,15 +886,15 @@ (-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-some [unparse (get unparsers (key x))] - (unparse (val x)) + (if (tag? x) + (if-some [unparse (get unparsers (:key x))] + (unparse (:value x)) ::invalid) ::invalid)))) (-transformer [this transformer method options] @@ -1011,6 +1032,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 (tag? %)) (not (tags? %))) parsers (cond->> (-vmap (fn [[key {:keys [optional]} schema]] (let [parser (f schema)] @@ -1035,7 +1058,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 @@ -1645,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 (val 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: @@ -2683,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 1fa33c258..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"}))) @@ -62,10 +61,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 +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 {: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] @@ -96,7 +95,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} :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 +103,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 dbf7f137c..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 val parse vector) (->> arities val :arities (map parse))) + single (= :single (:key arities)) + 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) @@ -60,7 +61,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..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 {} 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 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,12 +192,13 @@ [] 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 (map? m) (= (count m) (count unparsers))) + (if (and (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: @@ -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,12 +255,13 @@ (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-some [kv (find unparsers (key x))] - ((val kv) (val x)) + (if (tag? 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..ef57df787 100644 --- a/src/malli/impl/util.cljc +++ b/src/malli/impl/util.cljc @@ -5,8 +5,7 @@ (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))) (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..28a627db3 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -254,10 +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 (= ::m/invalid (m/unparse schema* (miu/-tagged :pos 0)))) + (is (= 1 (m/unparse schema* (m/tag :pos 1)))) + (is (= ::m/invalid (m/unparse schema* [:pos 1]))) + (is (= ::m/invalid (m/unparse schema* (m/tag :pos 0)))) (doseq [schema [schema schema*]] (testing (m/form schema) @@ -1159,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))) @@ -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 (m/tag :sized valid1)))) (is (= valid2 (m/unparse schema (m/parse schema valid2)))) + (is (= valid2 (m/unparse schema (m/tag :human valid2)))) (is (= valid3 (m/unparse schema (m/parse schema 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))) @@ -1267,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" @@ -1618,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 + [] (m/tags {}) nil [0] nil [{:path [], :in [0], :schema s, :value 0, :type ::m/input-remaining}]))) (testing "single" @@ -1634,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"] (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}]))) @@ -1652,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] (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}]))) @@ -1673,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] (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}]))) @@ -1684,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 (= (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* {: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 @@ -1706,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}]))) @@ -1723,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}]))) @@ -1742,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}]))))) @@ -3009,8 +3013,30 @@ (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?]] (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 + ;; 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])) @@ -3206,10 +3232,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 (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}))))) @@ -3310,7 +3336,7 @@ value [:a]] (is (= true (m/validate schema value))) (is (= nil (m/explain schema value))) - (is (= [[: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)))))) @@ -3422,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 (= [[: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 (= [(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 [[:a 1] [:a 2] [: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/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..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 (= [1 [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/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" diff --git a/test/malli/util_test.cljc b/test/malli/util_test.cljc index be7e7ac6e..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 [: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 [: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 [: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?))