WIP: delay/future/promise schemas

src/malli/core.cljc

@@ -2718,6 +2718,21 @@
                                   :re-transformer (fn [_ children] (apply re/alt-transformer children))
                                   :re-min-max (fn [_ children] (reduce -re-alt-min-max {:max 0} (-vmap last children)))})})
 
+;;TODO make non-proxy for explain path
+(defn -delay-schema [_]
+  (-proxy-schema {:type :delay
+                  :fn (fn [{:keys [force] :as p} c o]
+                        (-check-children! :delay p c 1 1)
+                        (let [c (mapv #(schema % o) c)
+                              v (-validator (first c))]
+                          [c (map -form c) (schema [:fn (fn [d]
+                                                          (if (delay? d)
+                                                            (if (or (realized? d) force)
+                                                              (v @d)
+                                                              true)
+                                                            false))]
+                                                   o)]))}))
+
 (defn base-schemas []
   {:and (-and-schema)
    :or (-or-schema)
@@ -2741,6 +2756,7 @@
    :-> (-->-schema nil)
    :function (-function-schema nil)
    :schema (-schema-schema nil)
+   :delay (-delay-schema nil)
    ::schema (-schema-schema {:raw true})})
 
 (defn default-schemas []

src/malli/generator.cljc

@@ -314,6 +314,9 @@
 (defn -function-gen [schema options]
   (gen/return (m/-instrument {:schema schema, :gen #(generate % options)} nil options)))
 
+(defn -delay-gen [schema options]
+  (gen/return (delay (generate (-child-gen schema options) options))))
+
 (defn -regex-generator [schema options]
   (cond-> (generator schema options) (not (m/-regex-op? schema)) (-> vector gen-tuple)))
 
@@ -415,6 +418,7 @@
 (defmethod -schema-generator :=> [schema options] (-=>-gen schema options))
 (defmethod -schema-generator :-> [schema options] (-=>-gen schema options))
 (defmethod -schema-generator :function [schema options] (-function-gen schema options))
+(defmethod -schema-generator :delay [schema options] (-delay-gen schema options))
 (defmethod -schema-generator 'ifn? [_ _] gen/keyword)
 (defmethod -schema-generator :ref [schema options] (-ref-gen schema options))
 (defmethod -schema-generator :schema [schema options] (generator (m/deref schema) options))

test/malli/core_test.cljc

@@ -3581,3 +3581,25 @@
   (is (not (m/validate [:sequential {:min 11} :int] (eduction identity (range 10)))))
   (is (not (m/validate [:seqable {:min 11} :int] (eduction identity (range 10)))))
   (is (nil? (m/explain [:sequential {:min 9} :int] (eduction identity (range 10))))))
+
+(deftest delay-test
+  (testing "schema matches delay"
+    (is (m/validate [:delay :int] (delay 1)))
+    (is (m/validate [:delay :int] (doto (delay 1) deref)))
+    (is (m/validate [:delay {:force true} :int] (delay 1)))
+    (is (m/validate [:delay {:force true} :int] (doto (delay 1) deref)))
+    (is (nil? (m/explain [:delay :int] (delay 1))))
+    (is (nil? (m/explain [:delay :int] (doto (delay 1) deref))))
+    (is (nil? (m/explain [:delay {:force true} :int] (delay 1)))))
+  (testing "schema does not match delay"
+    (is (m/validate [:delay :boolean] (delay 1)))
+    (is (not (m/validate [:delay :boolean] (doto (delay 1) deref))))
+    (is (not (m/validate [:delay {:force true} :boolean] (delay 1))))
+    (is (not (m/validate [:delay {:force true} :boolean] (doto (delay 1) deref))))
+    (is (not (m/validate [:delay :boolean] 1)))
+    (is (nil? (m/explain [:delay :boolean] (delay 1))))
+    ;;TODO make a non-proxy schema for :delay and describe problem.
+    (is (m/explain [:delay :boolean] (doto (delay 1) deref)))
+    (is (m/explain [:delay {:force true} :boolean] (delay 1)))
+    (is (m/explain [:delay {:force true} :boolean] (doto (delay 1) deref)))
+    (is (m/explain [:delay :boolean] 1))))

test/malli/generator_test.cljc

@@ -698,13 +698,15 @@
 
 (deftest infinite-generator-test
   ;; equivalent to :never, which is infinite
-  (is (thrown? #?(:clj Exception, :cljs js/Error)
-               (mg/generate [:schema {:registry {::a [:ref ::a]}}
-                             [:ref ::a]])))
+  (is (thrown-with-msg? #?(:clj Exception, :cljs js/Error)
+                        #":malli\.generator/unsatisfiable-schema"
+                        (mg/generate [:schema {:registry {::a [:ref ::a]}}
+                                      [:ref ::a]])))
   ;; equivalent to [:tuple :never], which is infinite
-  (is (thrown? #?(:clj Exception, :cljs js/Error)
-               (mg/generate [:schema {:registry {::a [:tuple [:ref ::a]]}}
-                             [:ref ::a]])))
+  (is (thrown-with-msg? #?(:clj Exception, :cljs js/Error)
+                        #":malli\.generator/unsatisfiable-schema"
+                        (mg/generate [:schema {:registry {::a [:tuple [:ref ::a]]}}
+                                      [:ref ::a]])))
   ;; equivalent to [:maybe :never] == [:maybe [:maybe :never]] == ..., which is just :nil
   (is (every? nil? (mg/sample [:schema {:registry {::a [:maybe [:ref ::a]]}}
                                [:ref ::a]]))))
@@ -1124,3 +1126,13 @@
   (doseq [_ (range 100)
           v (mg/sample [:seqable {:min 1} :any])]
     (is (seq v))))
+
+(deftest delay-generator-test
+  (testing "satisfiable child"
+    (is (delay? (mg/generate [:delay :int] {:seed 0})))
+    (is (= 1784201 @(mg/generate [:delay :int] {:seed 0}))))
+  (testing "unsatisfiable child"
+    (is (delay? (mg/generate [:delay [:schema {:registry {::a [:tuple [:ref ::a]]}} [:ref ::a]]] {:seed 0})))
+    (is (thrown-with-msg? #?(:clj Exception, :cljs js/Error)
+                          #":malli\.generator/unsatisfiable-schema"
+                          @(mg/generate [:delay [:schema {:registry {::a [:tuple [:ref ::a]]}} [:ref ::a]]] {:seed 0})))))