|
| 1 | +; Copyright (c) Rich Hickey. All rights reserved. |
| 2 | +; The use and distribution terms for this software are covered by the |
| 3 | +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) |
| 4 | +; which can be found in the file epl-v10.html at the root of this distribution. |
| 5 | +; By using this software in any fashion, you are agreeing to be bound by |
| 6 | +; the terms of this license. |
| 7 | +; You must not remove this notice, or any other, from this software. |
| 8 | + |
| 9 | +(ns cljs.spec.impl.gen.alpha |
| 10 | + (:refer-clojure :exclude [boolean cat hash-map list map not-empty set vector |
| 11 | + char double int keyword symbol string uuid delay]) |
| 12 | + (:require-macros [cljs.core :as c] |
| 13 | + [cljs.spec.impl.gen.alpha :as gen :refer [dynaload lazy-combinators lazy-prims]]) |
| 14 | + (:require [cljs.core :as c])) |
| 15 | + |
| 16 | +(deftype LazyVar [f ^:mutable cached] |
| 17 | + IDeref |
| 18 | + (-deref [this] |
| 19 | + (if-not (nil? cached) |
| 20 | + cached |
| 21 | + (let [x (f)] |
| 22 | + (when-not (nil? x) |
| 23 | + (set! cached x)) |
| 24 | + x)))) |
| 25 | + |
| 26 | +(def ^:private quick-check-ref |
| 27 | + (dynaload 'clojure.test.check/quick-check)) |
| 28 | + |
| 29 | +(defn quick-check |
| 30 | + [& args] |
| 31 | + (apply @quick-check-ref args)) |
| 32 | + |
| 33 | +(def ^:private for-all*-ref |
| 34 | + (dynaload 'clojure.test.check.properties/for-all*)) |
| 35 | + |
| 36 | +(defn for-all* |
| 37 | + "Dynamically loaded clojure.test.check.properties/for-all*." |
| 38 | + [& args] |
| 39 | + (apply @for-all*-ref args)) |
| 40 | + |
| 41 | +(let [g? (dynaload 'clojure.test.check.generators/generator?) |
| 42 | + g (dynaload 'clojure.test.check.generators/generate) |
| 43 | + mkg (dynaload 'clojure.test.check.generators/->Generator)] |
| 44 | + (defn- generator? |
| 45 | + [x] |
| 46 | + (@g? x)) |
| 47 | + (defn- generator |
| 48 | + [gfn] |
| 49 | + (@mkg gfn)) |
| 50 | + (defn generate |
| 51 | + "Generate a single value using generator." |
| 52 | + [generator] |
| 53 | + (@g generator))) |
| 54 | + |
| 55 | +(defn ^:skip-wiki delay-impl |
| 56 | + [gfnd] |
| 57 | + ;;N.B. depends on test.check impl details |
| 58 | + (generator (fn [rnd size] |
| 59 | + ((:gen @gfnd) rnd size)))) |
| 60 | + |
| 61 | +;(defn gen-for-name |
| 62 | +; "Dynamically loads test.check generator named s." |
| 63 | +; [s] |
| 64 | +; (let [g (dynaload s)] |
| 65 | +; (if (generator? g) |
| 66 | +; g |
| 67 | +; (throw (js/Error. (str "Var " s " is not a generator")))))) |
| 68 | + |
| 69 | +(lazy-combinators hash-map list map not-empty set vector vector-distinct fmap elements |
| 70 | + bind choose one-of such-that tuple sample return |
| 71 | + large-integer* double* frequency) |
| 72 | + |
| 73 | +(lazy-prims any any-printable boolean char char-alpha char-alphanumeric char-ascii double |
| 74 | + int keyword keyword-ns large-integer ratio simple-type simple-type-printable |
| 75 | + string string-ascii string-alphanumeric symbol symbol-ns uuid) |
| 76 | + |
| 77 | +(defn cat |
| 78 | + "Returns a generator of a sequence catenated from results of |
| 79 | +gens, each of which should generate something sequential." |
| 80 | + [& gens] |
| 81 | + (fmap #(apply concat %) |
| 82 | + (apply tuple gens))) |
| 83 | + |
| 84 | +(defn- ^boolean qualified? [ident] (not (nil? (namespace ident)))) |
| 85 | + |
| 86 | +(def ^:private |
| 87 | +gen-builtins |
| 88 | + (c/delay |
| 89 | + (let [simple (simple-type-printable)] |
| 90 | + {any? (one-of [(return nil) (any-printable)]) |
| 91 | + number? (one-of [(large-integer) (double)]) |
| 92 | + integer? (large-integer) |
| 93 | + int? (large-integer) |
| 94 | + pos-int? (large-integer* {:min 1}) |
| 95 | + neg-int? (large-integer* {:max -1}) |
| 96 | + nat-int? (large-integer* {:min 0}) |
| 97 | + float? (double) |
| 98 | + double? (double) |
| 99 | + string? (string-alphanumeric) |
| 100 | + ident? (one-of [(keyword-ns) (symbol-ns)]) |
| 101 | + simple-ident? (one-of [(keyword) (symbol)]) |
| 102 | + qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)])) |
| 103 | + keyword? (keyword-ns) |
| 104 | + simple-keyword? (keyword) |
| 105 | + qualified-keyword? (such-that qualified? (keyword-ns)) |
| 106 | + symbol? (symbol-ns) |
| 107 | + simple-symbol? (symbol) |
| 108 | + qualified-symbol? (such-that qualified? (symbol-ns)) |
| 109 | + uuid? (uuid) |
| 110 | + inst? (fmap #(js/Date. %) |
| 111 | + (large-integer)) |
| 112 | + seqable? (one-of [(return nil) |
| 113 | + (list simple) |
| 114 | + (vector simple) |
| 115 | + (map simple simple) |
| 116 | + (set simple) |
| 117 | + (string-alphanumeric)]) |
| 118 | + indexed? (vector simple) |
| 119 | + map? (map simple simple) |
| 120 | + vector? (vector simple) |
| 121 | + list? (list simple) |
| 122 | + seq? (list simple) |
| 123 | + char? (char) |
| 124 | + set? (set simple) |
| 125 | + nil? (return nil) |
| 126 | + false? (return false) |
| 127 | + true? (return true) |
| 128 | + boolean? (boolean) |
| 129 | + zero? (return 0) |
| 130 | + ;rational? (one-of [(large-integer) (ratio)]) |
| 131 | + coll? (one-of [(map simple simple) |
| 132 | + (list simple) |
| 133 | + (vector simple) |
| 134 | + (set simple)]) |
| 135 | + empty? (elements [nil '() [] {} #{}]) |
| 136 | + associative? (one-of [(map simple simple) (vector simple)]) |
| 137 | + sequential? (one-of [(list simple) (vector simple)]) |
| 138 | + ;ratio? (such-that ratio? (ratio)) |
| 139 | + }))) |
| 140 | + |
| 141 | +(defn gen-for-pred |
| 142 | + "Given a predicate, returns a built-in generator if one exists." |
| 143 | + [pred] |
| 144 | + (if (set? pred) |
| 145 | + (elements pred) |
| 146 | + (get @gen-builtins pred))) |
| 147 | + |
| 148 | +(comment |
| 149 | + (require 'clojure.test.check) |
| 150 | + (require 'clojure.test.check.properties) |
| 151 | + (require 'cljs.spec.impl.gen) |
| 152 | + (in-ns 'cljs.spec.impl.gen) |
| 153 | + |
| 154 | + ;; combinators, see call to lazy-combinators above for complete list |
| 155 | + (generate (one-of [(gen-for-pred integer?) (gen-for-pred string?)])) |
| 156 | + (generate (such-that #(< 10000 %) (gen-for-pred integer?))) |
| 157 | + (let [reqs {:a (gen-for-pred number?) |
| 158 | + :b (gen-for-pred keyword?)} |
| 159 | + opts {:c (gen-for-pred string?)}] |
| 160 | + (generate (bind (choose 0 (count opts)) |
| 161 | + #(let [args (concat (seq reqs) (shuffle (seq opts)))] |
| 162 | + (->> args |
| 163 | + (take (+ % (count reqs))) |
| 164 | + (mapcat identity) |
| 165 | + (apply hash-map)))))) |
| 166 | + (generate (cat (list (gen-for-pred string?)) |
| 167 | + (list (gen-for-pred integer?)))) |
| 168 | + |
| 169 | + ;; load your own generator |
| 170 | + ;(gen-for-name 'clojure.test.check.generators/int) |
| 171 | + |
| 172 | + ;; failure modes |
| 173 | + ;(gen-for-name 'unqualified) |
| 174 | + ;(gen-for-name 'clojure.core/+) |
| 175 | + ;(gen-for-name 'clojure.core/name-does-not-exist) |
| 176 | + ;(gen-for-name 'ns.does.not.exist/f) |
| 177 | + |
| 178 | + ) |
| 179 | + |
| 180 | + |
0 commit comments