Merge pull request #29 from jobtravaini/such-that-retries

Implement such-that maximum retries option

project.clj

@@ -7,7 +7,7 @@
   :dependencies [[org.clojure/test.check "0.9.0"]
                  [prismatic/schema "1.2.1"]]
 
-  :profiles {:dev {:dependencies [[org.clojure/clojure "1.8.0"]
+  :profiles {:dev {:dependencies [[org.clojure/clojure "1.11.1"]
                                   [org.clojure/clojurescript "1.10.520"]]
                    :plugins [[lein-codox "0.9.4"]
                              [lein-release/lein-release "1.0.4"]]}

src/schema_generators/generators.cljc

@@ -67,21 +67,23 @@
           (or (pre x)
               (and post (post x))))))
      (generators/one-of
-      (for [o (macros/safe-get s :options)]
-        (if-let [g (:guard o)]
-          (generators/such-that g (sub-generator o params))
-          (sub-generator o params))))))
+       (for [o (macros/safe-get s :options)]
+         (if-let [g (:guard o)]
+           (generators/such-that g (sub-generator o params) (get params :max-retries 10))
+           (sub-generator o params))))
+     (get params :max-retries 10)))
 
   ;; TODO: this does not currently capture proper semantics of maps with
   ;; both specific keys and key schemas that can override them.
   schema.spec.collection.CollectionSpec
   (composite-generator [s params]
     (generators/such-that
      (complement (.-pre ^schema.spec.collection.CollectionSpec s))
-     (generators/fmap (:konstructor s) (elements-generator (:elements s) params))))
+     (generators/fmap (:konstructor s) (elements-generator (:elements s) params))
+     (get params :max-retries 10)))
 
   schema.spec.leaf.LeafSpec
-  (composite-generator [s params]
+  (composite-generator [s _]
     (macros/assert! false "You must provide a leaf generator for %s" s)))
 
 (def Schema
@@ -96,6 +98,13 @@
   "A mapping from schemas to generating functions that should be used."
   (s/=> (s/maybe Generator) Schema))
 
+(def Options
+  "A map of options to interact with core generator behaviors"
+  {:max-retries s/Int})
+
+(def SchemaOptions
+  "A mapping from schemas to options used by generators"
+  (s/=> (s/maybe Options) Schema))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public
@@ -176,8 +185,10 @@
 
 (defn such-that
   "Helper wrapper that filters to values that match predicate."
-  [f]
-  (partial generators/such-that f))
+  ([f]
+   (partial generators/such-that f))
+  ([f max-retries]
+   #(generators/such-that f % max-retries)))
 
 (defn fmap
   "Helper wrapper that maps f over all values."
@@ -198,21 +209,26 @@
    constraints is an optional mapping from schema to wrappers for the default generators,
    which can impose constraints, fix certain values, etc."
   ([schema]
-     (generator schema {}))
+   (generator schema {}))
   ([schema leaf-generators]
-     (generator schema leaf-generators {}))
+   (generator schema leaf-generators {}))
   ([schema :- Schema
     leaf-generators :- LeafGenerators
     wrappers :- GeneratorWrappers]
-     (let [leaf-generators (default-leaf-generators leaf-generators)
-           gen (fn [s params]
-                 ((or (wrappers s) identity)
-                  (or (leaf-generators s)
-                      (composite-generator (s/spec s) params))))]
-       (generators/fmap
-        (s/validator schema)
-        (gen schema {:subschema-generator gen :cache #?(:clj (java.util.IdentityHashMap.)
-                                                        :cljs (atom {}))})))))
+   (generator schema leaf-generators wrappers {}))
+  ([schema :- Schema
+    leaf-generators :- LeafGenerators
+    wrappers :- GeneratorWrappers
+    options :- SchemaOptions]
+   (let [leaf-generators (default-leaf-generators leaf-generators)
+         gen (fn [s params]
+               ((or (wrappers s) identity)
+                (or (leaf-generators s)
+                    (composite-generator (s/spec s) (merge params (options s))))))]
+     (generators/fmap
+       (s/validator schema)
+       (gen schema {:subschema-generator gen :cache #?(:clj (java.util.IdentityHashMap.)
+                                                       :cljs (atom {}))})))))
 
 (s/defn sample :- [s/Any]
   "Sample k elements from generator."

test/schema_generators/generators_test.cljc

@@ -1,15 +1,16 @@
 (ns schema-generators.generators-test
   #?(:clj (:use clojure.test))
   (:require
-   #?(:cljs [cljs.test :refer-macros [deftest is testing run-tests]])
-   #?(:cljs [cljs.reader :refer [read-string]])
-   [clojure.test.check]
-   [clojure.test.check.properties :as properties :include-macros true]
-   [clojure.test.check.generators :as check-generators]
-   [clojure.test.check.clojure-test #?@(:clj [:refer [defspec]]
-                                        :cljs [:refer-macros [defspec]])]
-   [schema.core :as s :include-macros true]
-   [schema-generators.generators :as generators]))
+    #?(:cljs [cljs.test :refer-macros [deftest is testing run-tests]])
+    #?(:cljs [cljs.reader :refer [read-string]])
+    [clojure.test.check]
+    [clojure.test.check.properties :as properties :include-macros true]
+    [clojure.test.check.generators :as check-generators]
+    [clojure.test.check.clojure-test #?@(:clj  [:refer [defspec]]
+                                         :cljs [:refer-macros [defspec]])]
+    [schema.core :as s :include-macros true]
+    [schema-generators.generators :as generators])
+  #?(:clj (:import (clojure.lang ExceptionInfo))))
 
 (def OGInner
   {(s/required-key "l") [s/Int]
@@ -80,3 +81,26 @@
 (defspec can-mix-wildcard-keys-with-specific-keys 50
   (properties/for-all [m (generators/generator Issue16RegressionSchema)]
     (is (number? (:x m)))))
+
+(def FailRetries
+  (s/conditional
+    int? s/Str))
+
+(deftest validate-maximum-retries-test
+  (is (thrown-with-msg?
+        ExceptionInfo #"Couldn't satisfy such-that predicate after 100 tries."
+        (generators/generate FailRetries {} {} {FailRetries {:max-retries 100}})))
+
+  (is (thrown-with-msg?
+        ExceptionInfo #"Couldn't satisfy such-that predicate after 10 tries."
+        (generators/generate FailRetries))))
+
+(deftest validate-generation-before-maximum-retries
+  (let [retries (atom 0)
+        target (rand-int 100)
+        counter (fn [candidate]
+                  (swap! retries inc)
+                  (when (< target @retries)
+                    candidate))
+        ToGenerate (s/conditional counter s/Str)]
+    (is (string? (generators/generate ToGenerate {} {} {ToGenerate {:max-retries 100}})))))