/
generators.clj
218 lines (182 loc) · 7.21 KB
/
generators.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
(ns schema.experimental.generators
"(Very) experimental support for compiling schemas to test.check generators.
To use it, you must provide your own test.check dependency.
TODO: add cljs support."
{:deprecated "1.1.0"}
(:require
[clojure.test.check.generators :as generators]
[schema.spec.core :as spec]
schema.spec.collection
schema.spec.leaf
schema.spec.variant
[schema.core :as s]
[schema.macros :as macros]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Private helpers for composite schemas
(defn g-by [f & args]
(generators/fmap
(partial apply f)
(apply generators/tuple args)))
(defn g-apply-by [f args]
(generators/fmap f (apply generators/tuple args)))
(defn- sub-generator
[{:keys [schema]}
{:keys [subschema-generator ^java.util.Map cache] :as params}]
(spec/with-cache cache schema
(fn [d] (#'generators/make-gen (fn [r s] (generators/call-gen @d r (quot s 2)))))
(fn [] (subschema-generator schema params))))
;; Helpers for collections
(declare elements-generator)
(defn element-generator [e params]
(if (vector? e)
(case (first e)
:schema.spec.collection/optional
(generators/one-of
[(generators/return nil)
(elements-generator (next e) params)])
:schema.spec.collection/remaining
(do (macros/assert! (= 2 (count e)) "remaining can have only one schema.")
(generators/vector (sub-generator (second e) params))))
(generators/fmap vector (sub-generator e params))))
(defn elements-generator [elts params]
(->> elts
(map #(element-generator % params))
(apply generators/tuple)
(generators/fmap (partial apply concat))))
(defprotocol CompositeGenerator
(composite-generator [s params]))
(extend-protocol CompositeGenerator
schema.spec.variant.VariantSpec
(composite-generator [s params]
(generators/such-that
(fn [x]
(let [pre (.-pre ^schema.spec.variant.VariantSpec s)
post (.-post ^schema.spec.variant.VariantSpec s)]
(not
(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))))))
;; 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))))
schema.spec.leaf.LeafSpec
(composite-generator [s params]
(macros/assert! false "You must provide a leaf generator for %s" s)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Public
(def Schema
"A Schema for Schemas"
(s/protocol s/Schema))
(def Generator
"A test.check generator"
s/Any)
(def LeafGenerators
"A mapping from schemas to generating functions that should be used."
(s/=> (s/maybe Generator) Schema))
(def +primitive-generators+
{Double generators/double
;; using unchecked-float here will unfortunately generate a lot of
;; infinities, since lots of doubles are out of the float range
Float (generators/fmap unchecked-float generators/double)
Long generators/large-integer
Integer (generators/fmap unchecked-int generators/large-integer)
Short (generators/fmap unchecked-short generators/large-integer)
Character (generators/fmap unchecked-char generators/large-integer)
Byte (generators/fmap unchecked-byte generators/large-integer)
Boolean generators/boolean})
(def +simple-leaf-generators+
(merge
+primitive-generators+
{s/Str generators/string-ascii
s/Bool generators/boolean
s/Num (generators/one-of [generators/large-integer generators/double])
s/Int (generators/one-of
[generators/large-integer
(generators/fmap unchecked-int generators/large-integer)
(generators/fmap bigint generators/large-integer)])
s/Keyword generators/keyword
clojure.lang.Keyword generators/keyword
s/Symbol (generators/fmap (comp symbol name) generators/keyword)
Object generators/any
s/Any generators/any
s/Uuid generators/uuid
s/Inst (generators/fmap (fn [^long ms] (java.util.Date. ms)) generators/int)}
(into {}
(for [[f ctor c] [[doubles double-array Double]
[floats float-array Float]
[longs long-array Long]
[ints int-array Integer]
[shorts short-array Short]
[chars char-array Character]
[bytes byte-array Byte]
[booleans boolean-array Boolean]]]
[f (generators/fmap ctor (generators/vector (macros/safe-get +primitive-generators+ c)))]))))
(defn eq-generators [s]
(when (instance? schema.core.EqSchema s)
(generators/return (.-v ^schema.core.EqSchema s))))
(defn enum-generators [s]
(when (instance? schema.core.EnumSchema s)
(let [vs (vec (.-vs ^schema.core.EnumSchema s))]
(generators/fmap #(nth vs %) (generators/choose 0 (dec (count vs)))))))
(defn default-leaf-generators
[leaf-generators]
(some-fn
leaf-generators
+simple-leaf-generators+
eq-generators
enum-generators))
(defn always [x] (generators/return x))
(def GeneratorWrappers
"A mapping from schemas to wrappers that should be used around the default
generators."
(s/=> (s/maybe (s/=> Generator Generator))
Schema))
(defn such-that
"Helper wrapper that filters to values that match predicate."
[f]
(partial generators/such-that f))
(defn fmap
"Helper wrapper that maps f over all values."
[f]
(partial generators/fmap f))
(defn merged
"Helper wrapper that merges some keys into a schema"
[m]
(fmap #(merge % m)))
(s/defn generator :- Generator
"Produce a test.check generator for schema.
leaf-generators must return generators for all leaf schemas, and can also return
generators for non-leaf schemas to override default generation logic.
constraints is an optional mapping from schema to wrappers for the default generators,
which can impose constraints, fix certain values, etc."
([schema]
(generator schema {}))
([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 (java.util.IdentityHashMap.)})))))
(s/defn sample :- [s/Any]
"Sample k elements from generator."
[k & generator-args]
(generators/sample (apply generator generator-args) k))
(s/defn generate
"Sample a single element of low to moderate size."
[& generator-args]
(generators/generate (apply generator generator-args) 10))