:seqable / :every

README.md

@@ -383,6 +383,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 `(: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.

src/malli/core.cljc

@@ -641,6 +641,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))))
@@ -1178,6 +1186,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")
@@ -1199,22 +1222,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
@@ -1224,20 +1261,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)
@@ -2616,6 +2658,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)

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)]

test/malli/core_test.cljc

@@ -3358,6 +3358,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 {: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)

test/malli/generator_test.cljc

@@ -1067,9 +1067,30 @@
        #":malli\.generator/distinct-generator-failure"
        (mg/generate [:map-of {:min 2} [:= 1] :any])))
   (is (thrown-with-msg?
-       #?(:clj Exception, :cljs js/Error)
-       #":malli\.generator/and-generator-failure"
-       (mg/generate [:and pos? neg?]))))
+        #?(:clj Exception, :cljs js/Error)
+        #":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}])))