diff --git a/README.md b/README.md index a02942ca5..0f44477ef 100644 --- a/README.md +++ b/README.md @@ -409,6 +409,51 @@ default branching can be arbitrarily nested: ; => true ``` +## Seqable schemas + +The `:seqable` and `:every` schemas describe `seqable?` collections. They +differ in their handling of collections that are neither `counted?` nor `indexed?`, and their +[parsers](#parsing-values): +1. `:seqable` parses its elements but `:every` does not and returns the identical input, and +2. valid unparsed `:seqable` values lose the original collection type while `:every` + returns the identical input. + +`:seqable` validates the entire collection, while `:every` checks only the +largest of `:min`, `(inc :max)`, and `(::m/coll-check-limit options 101)`, or +the entire collection if the input is `counted?` or `indexed?`. + +```clojure +;; :seqable and :every validate identically with small, counted, or indexed collections. +(m/validate [:seqable :int] #{1 2 3}) +;=> true +(m/validate [:seqable :int] [1 2 3]) +;=> true +(m/validate [:seqable :int] (sorted-set 1 2 3)) +;=> true +(m/validate [:seqable :int] (range 1000)) +;=> true +(m/validate [:seqable :int] (conj (vec (range 1000)) nil)) +;=> false + +(m/validate [:every :int] #{1 2 3}) +;=> true +(m/validate [:every :int] [1 2 3]) +;=> true +(m/validate [:every :int] (sorted-set 1 2 3)) +;=> true +(m/validate [:every :int] (vec (range 1000))) +;=> true +(m/validate [:every :int] (conj (vec (range 1000)) nil)) +;=> false + +;; for large uncounted and unindexed collections, :every only checks a certain length +(m/validate [:seqable :int] (concat (range 1000) [nil])) +;=> false +(m/validate [:every :int] (concat (range 1000) [nil])) +;=> true +``` + + ## Sequence schemas You can use `:sequential` to describe homogeneous sequential Clojure collections. diff --git a/src/malli/core.cljc b/src/malli/core.cljc index 1c0550a10..f9ee15f05 100644 --- a/src/malli/core.cljc +++ b/src/malli/core.cljc @@ -650,6 +650,14 @@ (defn -validate-limits [min max] (or ((-min-max-pred count) {:min min :max max}) (constantly true))) +(defn -needed-bounded-checks [min max options] + (c/max (or (some-> max inc) 0) + (or min 0) + (::coll-check-limit options 101))) + +(defn -validate-bounded-limits [needed min max] + (or ((-min-max-pred #(bounded-count needed %)) {:min min :max max}) (constantly true))) + (defn -qualified-keyword-pred [properties] (when-let [ns-name (some-> properties :namespace name)] (fn [x] (= (namespace x) ns-name)))) @@ -1187,6 +1195,21 @@ (-get [_ key default] (get children key default)) (-set [this key value] (-set-assoc-children this key value)))))))) +(defn- -check-entire-bounded-collection? [x] + (or (nil? x) + (counted? x) + (indexed? x) + ;; note: js/Object not ISeqable + #?(:clj (instance? java.util.Map x)) + ;; many Seq's are List's, so just pick some popular classes + #?@(:bb [] + :clj [(instance? java.util.AbstractList x) + (instance? java.util.Vector x)]) + #?(:clj (instance? CharSequence x) + :cljs (string? x)) + #?(:clj (.isArray (class x)) + :cljs (identical? js/Array (c/type x))))) + (defn -collection-schema [props] (if (fn? props) (do (-deprecated! "-collection-schema doesn't take fn-props, use :compiled property instead") @@ -1208,22 +1231,36 @@ (let [[schema :as children] (-vmap #(schema % options) children) form (delay (-simple-form parent properties children -form options)) cache (-create-cache options) - validate-limits (-validate-limits min max) + bounded (when (:bounded props) + (when fempty + (-fail! ::cannot-provide-empty-and-bounded-props)) + (-needed-bounded-checks min max options)) + validate-limits (if bounded + (-validate-bounded-limits (c/min bounded (or max bounded)) min max) + (-validate-limits min max)) ->parser (fn [f g] (let [child-parser (f schema)] (fn [x] (cond (not (fpred x)) ::invalid (not (validate-limits x)) ::invalid - :else (let [x' (reduce - (fn [acc v] - (let [v' (child-parser v)] - (if (miu/-invalid? v') (reduced ::invalid) (conj acc v')))) - [] x)] - (cond - (miu/-invalid? x') x' - g (g x') - fempty (into fempty x') - :else x'))))))] + :else (if bounded + (let [child-validator child-parser] + (reduce + (fn [x v] + (if (child-validator v) x (reduced ::invalid))) + x (cond->> x + (not (-check-entire-bounded-collection? x)) + (eduction (take bounded))))) + (let [x' (reduce + (fn [acc v] + (let [v' (child-parser v)] + (if (miu/-invalid? v') (reduced ::invalid) (conj acc v')))) + [] x)] + (cond + (miu/-invalid? x') x' + g (g x') + fempty (into fempty x') + :else x')))))))] ^{:type ::schema} (reify AST @@ -1233,20 +1270,25 @@ (let [validator (-validator schema)] (fn [x] (and (fpred x) (validate-limits x) - (reduce (fn [acc v] (if (validator v) acc (reduced false))) true x))))) + (reduce (fn [acc v] (if (validator v) acc (reduced false))) true + (cond->> x + (and bounded (not (-check-entire-bounded-collection? x))) + (eduction (take bounded)))))))) (-explainer [this path] (let [explainer (-explainer schema (conj path 0))] (fn [x in acc] (cond (not (fpred x)) (conj acc (miu/-error path in this x ::invalid-type)) (not (validate-limits x)) (conj acc (miu/-error path in this x ::limits)) - :else (let [size (count x)] + :else (let [size (if (and bounded (not (-check-entire-bounded-collection? x))) + bounded + (count x))] (loop [acc acc, i 0, [x & xs] x] (if (< i size) (cond-> (or (explainer x (conj in (fin i x)) acc) acc) xs (recur (inc i) xs)) acc))))))) - (-parser [_] (->parser -parser parse)) - (-unparser [_] (->parser -unparser unparse)) + (-parser [_] (->parser (if bounded -validator -parser) (if bounded identity parse))) + (-unparser [_] (->parser (if bounded -validator -unparser) (if bounded identity unparse))) (-transformer [this transformer method options] (let [collection? #(or (sequential? %) (set? %)) this-transformer (-value-transformer transformer this method options) @@ -2625,6 +2667,8 @@ :map-of (-map-of-schema) :vector (-collection-schema {:type :vector, :pred vector?, :empty []}) :sequential (-collection-schema {:type :sequential, :pred sequential?}) + :seqable (-collection-schema {:type :seqable, :pred seqable?}) + :every (-collection-schema {:type :every, :pred seqable?, :bounded true}) :set (-collection-schema {:type :set, :pred set?, :empty #{}, :in (fn [_ x] x)}) :enum (-enum-schema) :maybe (-maybe-schema) diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc index 50e680050..bd9a95330 100644 --- a/src/malli/generator.cljc +++ b/src/malli/generator.cljc @@ -143,6 +143,19 @@ (first gs) (gen/one-of gs))) +(defn- -seqable-gen [schema options] + (let [el (-> schema m/children first)] + (gen-one-of + (-> [nil-gen] + (into (map #(-coll-gen schema % options)) + [identity vec eduction #(into-array #?(:clj Object) %)]) + (conj (-coll-distinct-gen schema set options)) + (cond-> + (and (= :tuple (m/type el)) + (= 2 (count (m/children el)))) + (conj (let [[k v] (m/children el)] + (generator [:map-of (or (m/properties schema) {}) k v] options)))))))) + (defn -or-gen [schema options] (if-some [gs (not-empty (into [] (keep #(-not-unreachable (generator % options))) @@ -432,6 +445,8 @@ (defmethod -schema-generator :sequential [schema options] (-coll-gen schema identity options)) (defmethod -schema-generator :set [schema options] (-coll-distinct-gen schema set options)) (defmethod -schema-generator :enum [schema options] (gen-elements (m/children schema options))) +(defmethod -schema-generator :seqable [schema options] (-seqable-gen schema options)) +(defmethod -schema-generator :every [schema options] (-seqable-gen schema options)) ;;infinite seqs? (defmethod -schema-generator :maybe [schema options] (let [g (-> schema (m/children options) first (generator options) -not-unreachable)] diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc index 56b62913d..e579afb9e 100644 --- a/test/malli/core_test.cljc +++ b/test/malli/core_test.cljc @@ -3384,6 +3384,98 @@ ::xymap] {:registry registry, ::m/ref-key :id})))))))) +(deftest seqable-schema-test + (is (m/validate [:seqable :int] nil)) + (is (m/validate [:seqable :int] #{1 2 3})) + (is (m/validate [:seqable :int] [1 2 3])) + (is (m/validate [:seqable :int] (sorted-set 1 2 3))) + (is (m/validate [:seqable :int] #{1 2 3})) + (is (m/validate [:seqable :int] (range 1000))) + (is (not (m/validate [:seqable :int] (conj (vec (range 1000)) nil)))) + (is (not (m/validate [:seqable :int] (concat (range 1000) [nil])))) + (is (not (m/validate [:seqable :int] (eduction (concat (range 1000) [nil]))))) + ;;FIXME need to handle eductions better, they don't support .count(). should count + ;; them as we check elements so we don't recompute each element. + #_(is (not (m/validate [:seqable {:min 1000} :int] (eduction (concat (range 1000) [nil]))))) + (is (not (m/validate [:seqable {:min 1000} :int] (concat (range 1000) [nil])))) + (is (nil? (m/explain [:seqable :int] #{1 2 3}))) + (is (not (m/validate [:seqable :int] #{1 nil 3}))) + (is (= #{["should be an integer"]} + (me/humanize (m/explain [:seqable :int] #{1 nil 3})))) + (let [original (interleave (range 10) (cycle [true false])) + 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]] + 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]])))) + +(deftest every-schema-test + (is (m/validate [:every :int] nil)) + (is (m/validate [:every :int] #{1 2 3})) + (is (m/validate [:every :int] [1 2 3])) + (is (m/validate [:every :int] (sorted-set 1 2 3))) + (is (not (m/validate [:every :int] (conj (vec (range 1000)) nil)))) + (is (nil? (m/explain [:every :int] #{1 2 3}))) + (is (not (m/validate [:every :int] #{1 nil 3}))) + (is (m/validate [:every :int] (concat (range 1000) [nil]))) + (is (m/validate [:every :int] (eduction (concat (range 1000) [nil])))) + ;; counted/indexed colls have everything validated + (is (not (m/validate [:every :int] (vec (concat (range 1000) [nil]))))) + (is (m/validate [:every :int] (concat (range 1000) [nil]))) + (is (m/validate [:every :int] (eduction (concat (range 1000) [nil])))) + (is (m/validate [:every {:min 1000} :int] (concat (range 1000) [nil]))) + (is (m/validate [:every :int] (concat (range 1000) [nil]) {::m/coll-check-limit 1000})) + (is (m/validate [:every {:min 1000} :int] (eduction (concat (range 1000) [nil])))) + ;; counted/indexed colls have everything validated + (is (not (m/validate [:every {:min 1000} :int] (vec (concat (range 1000) [nil]))))) + (is (not (m/validate [:every {:min 1001} :int] (concat (range 1000) [nil])))) + (is (not (m/validate [:every {:min 1001} :int] (eduction (concat (range 1000) [nil]))))) + (is (m/validate [:every {:max 1000} :int] (range 1000))) + (is (not (m/validate [:every {:max 1000} :int] (range 1001)))) + (is (not (m/validate [:every {:max 1001} :int] (concat (range 1000) [nil])))) + (is (not (m/validate [:every {:max 1001} :int] (eduction (concat (range 1000) [nil]))))) + (is (= #{["should be an integer"]} + (me/humanize (m/explain [:every :int] #{1 nil 3})))) + (is (nil? (m/explain [:every :int] (concat (range 1000) [nil])))) + (is (nil? (m/explain [:every :int] (eduction (concat (range 1000) [nil]))))) + (is (= (concat (repeat 1000 nil) [["should be an integer"]]) + (me/humanize (m/explain [:every {:min 1001} :int] (concat (range 1000) [nil]))))) + (is (= (concat (repeat 1000 nil) [["should be an integer"]]) + (me/humanize (m/explain [:every {:min 1001} :int] (eduction (concat (range 1000) [nil])))))) + (is (= (concat (repeat 1000 nil) [["should be an integer"]]) + (me/humanize (m/explain [:every {:max 1001} :int] (concat (range 1000) [nil]))))) + (is (= (concat (repeat 1000 nil) [["should be an integer"]]) + (me/humanize (m/explain [:every {:max 1001} :int] (eduction (concat (range 1000) [nil])))))) + (doseq [parse [#'m/parse #'m/unparse]] + (testing parse + (let [good-sequence (interleave (range 10) (cycle [true false]))] + (is (identical? good-sequence + (parse [:every [:orn [:l :int] [:r :boolean]]] + good-sequence)))) + (is (= ::m/invalid + (parse [:every [:orn [:l :int] [:r :boolean]]] + (interleave (range 10) (cycle [true false nil]))))) + (doseq [coerce [#'identity #?(:clj #'eduction + ;;TODO :cljs ? + )]] + (testing coerce + (let [bad-but-too-big (coerce + (concat (interleave (range 1000) (cycle [true false])) + [nil])) + bad-indexed-seq (vec bad-but-too-big)] + (is (identical? bad-but-too-big + (parse [:every [:orn [:l :int] [:r :boolean]]] + bad-but-too-big))) + (is (= ::m/invalid + (parse [:every [:orn [:l :int] [:r :boolean]]] + bad-indexed-seq))))))))) + (deftest proxy-schema-explain-path (let [y-schema [:int {:doc "int"}] schema (m/schema [(mu/-select-keys) diff --git a/test/malli/generator_test.cljc b/test/malli/generator_test.cljc index 768ada924..5fdcbc5e5 100644 --- a/test/malli/generator_test.cljc +++ b/test/malli/generator_test.cljc @@ -1071,6 +1071,27 @@ #":malli\.generator/and-generator-failure" (mg/generate [:and pos? neg?])))) +(deftest seqable-every-generator-test + (doseq [op [:seqable :every]] + (testing op + #?(:clj (is (= '[[nil ()] + ["Eduction" (0)] + ["PersistentHashSet" ()] + ["Object[]" (0)] + ["PersistentVector" (-2 2 0 1)] + ["PersistentVector" (1 -2)] + ["PersistentVector" (-9)] + ["PersistentVector" (3 -49 -4)] + ["PersistentVector" (-23 1 82)] + ["Eduction" (126 -24 -236 0 -18 0 0 2 -1)]] + (mapv (juxt #(some-> (class %) .getSimpleName) sequence) (mg/sample [op :int] {:seed 0})))) + :cljs (is (= '[() (0) () (0) (-2 2 0 1) (1 -2) (-9) (3 -49 -4) (-23 1 82) (126 -24 -236 0 -18 0 0 2 -1)] + (mapv sequence (mg/sample [op :int] {:seed 0}))))) + (is (= '({-1 false} + {-4399 true, 59 false, -4049 false, -49 false, -1 false, 15 false, -967 false, -3 false, -674 false, 2730 true, -2104 false, 3 false, -444 true, 8 false} + {119 true, 1324 false, 7276 false, -2410 true}) + (filter map? (mg/sample [op [:tuple :int :boolean]] {:seed 1 :size 30}))))))) + (deftest double-with-long-min-test (is (m/validate :double (shrink [:double {:min 3}]))) (is (= 3.0 (shrink [:double {:min 3}]))))