diff --git a/playground/src/playground.cljs b/playground/src/playground.cljs index 13a3d9c..d693fd7 100644 --- a/playground/src/playground.cljs +++ b/playground/src/playground.cljs @@ -39,6 +39,8 @@ sci.configs.hoplon.hoplon hoplon.dom + sci.configs.cljs.spec.alpha + [sci.core :as sci] [sci.ctx-store :as store])) @@ -65,7 +67,10 @@ #'sci.configs.reagent.reagent-dom-client/config #'sci.configs.tonsky.datascript/config #'sci.configs.hoplon.javelin/config - #'sci.configs.hoplon.hoplon/config]) + #'sci.configs.hoplon.hoplon/config + #'sci.configs.cljs.spec.alpha/config]) + +(prn :hello2) (def sci-ctx (->> all-configs diff --git a/src/sci/configs/cljs/spec/alpha.cljs b/src/sci/configs/cljs/spec/alpha.cljs new file mode 100644 index 0000000..4c18c0b --- /dev/null +++ b/src/sci/configs/cljs/spec/alpha.cljs @@ -0,0 +1,753 @@ +(ns sci.configs.cljs.spec.alpha + (:refer-clojure :exclude [and or keys merge every cat + ? * assert]) + (:require [clojure.spec.alpha :as s] + [cljs.spec.gen.alpha :as gen] + [cljs.spec.test.alpha :as stest] + [sci.core :as sci] + [sci.ctx-store :as ctx] + [clojure.walk :as walk] + [clojure.core :as c] + [clojure.string :as str] + [sci.lang]) + (:require-macros [sci.configs.macros :as macros])) + +(def sns (sci/create-ns 'cljs.spec.alpha nil)) + +(defonce ^:private registry-ref (atom {})) +(defonce ^:private _speced_vars (atom #{})) + +(defn speced-vars [] + @_speced_vars) + +(defn- unfn [expr] + (if (clojure.core/and (seq? expr) + (symbol? (first expr)) + (= "fn*" (name (first expr)))) + (let [[[s] & form] (rest expr)] + (conj (walk/postwalk-replace {s '%} form) '[%] 'cljs.core/fn)) + expr)) + +(def sci-sym (delay (sci/eval-form (ctx/get-ctx) 'cljs.core/symbol))) + +(defn- ->sym + "Returns a symbol from a symbol or var" + [x] + (if (instance? sci.lang.Var x) + (@sci-sym x) + x)) + +(defn- res [env form] + (cond + (keyword? form) form + (symbol? form) (clojure.core/or (->> form (sci/resolve env) ->sym) form) + (sequential? form) (walk/postwalk #(if (symbol? %) (res env %) %) (unfn form)) + :else form)) + +(defn- ns-qualify + "Qualify symbol s by resolving it or using the current *ns*." + [_env s] + (if (namespace s) + (->sym (sci/resolve (ctx/get-ctx) s)) + (symbol (str @sci/ns) (str s)))) + +(macros/defmacro def* + "Given a namespace-qualified keyword or resolveable symbol k, and a + spec, spec-name, predicate or regex-op makes an entry in the + registry mapping k to the spec. Use nil to remove an entry in + the registry for k." + [k spec-form] + (let [&env (ctx/get-ctx) + k (if (symbol? k) + (let [sym (ns-qualify &env k)] + (swap! _speced_vars conj + (vary-meta sym assoc :fdef-ns (-> &env :ns :name))) + sym) + k) + form (res &env spec-form)] + (swap! registry-ref (fn [r] + (if (nil? form) + (dissoc r k) + (assoc r k form)))) + `(s/def-impl '~k '~form ~spec-form))) + +(macros/defmacro and + "Takes predicate/spec-forms, e.g. + + (s/and even? #(< % 42)) + + Returns a spec that returns the conformed value. Successive + conformed values propagate through rest of predicates." + [& pred-forms] + (let [&env (ctx/get-ctx)] + `(s/and-spec-impl '~(mapv #(res &env %) pred-forms) ~(vec pred-forms) nil))) + +(macros/defmacro or + "Takes key+pred pairs, e.g. + + (s/or :even even? :small #(< % 42)) + + Returns a destructuring spec that returns a map entry containing the + key of the first matching pred and the corresponding value. Thus the + 'key' and 'val' functions can be used to refer generically to the + components of the tagged return." + [& key-pred-forms] + (let [&env (ctx/get-ctx) + pairs (partition 2 key-pred-forms) + keys (mapv first pairs) + pred-forms (mapv second pairs) + pf (mapv #(res &env %) pred-forms)] + (clojure.core/assert (clojure.core/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords") + `(s/or-spec-impl ~keys '~pf ~pred-forms nil))) + +(macros/defmacro nilable + "returns a spec that accepts nil and values satisfiying pred" + [pred] + (let [&env (ctx/get-ctx) + pf (res &env pred)] + `(s/nilable-impl '~pf ~pred nil))) + +(macros/defmacro keys + "Creates and returns a map validating spec. :req and :opt are both + vectors of namespaced-qualified keywords. The validator will ensure + the :req keys are present. The :opt keys serve as documentation and + may be used by the generator. + + The :req key vector supports 'and' and 'or' for key groups: + + (s/keys :req [::x ::y (or ::secret (and ::user ::pwd))] :opt [::z]) + + There are also -un versions of :req and :opt. These allow + you to connect unqualified keys to specs. In each case, fully + qualfied keywords are passed, which name the specs, but unqualified + keys (with the same name component) are expected and checked at + conform-time, and generated during gen: + + (s/keys :req-un [:my.ns/x :my.ns/y]) + + The above says keys :x and :y are required, and will be validated + and generated by specs (if they exist) named :my.ns/x :my.ns/y + respectively. + + In addition, the values of *all* namespace-qualified keys will be validated + (and possibly destructured) by any registered specs. Note: there is + no support for inline value specification, by design. + + Optionally takes :gen generator-fn, which must be a fn of no args that + returns a test.check generator." + [& {:keys [req req-un opt opt-un gen]}] + (let [&env (ctx/get-ctx) + unk #(-> % name keyword) + req-keys (filterv keyword? (flatten req)) + req-un-specs (filterv keyword? (flatten req-un)) + _ (clojure.core/assert (every? #(clojure.core/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un)) + "all keys must be namespace-qualified keywords") + req-specs (into req-keys req-un-specs) + req-keys (into req-keys (map unk req-un-specs)) + opt-keys (into (vec opt) (map unk opt-un)) + opt-specs (into (vec opt) opt-un) + gx (gensym) + parse-req (fn [rk f] + (map (fn [x] + (if (keyword? x) + `(contains? ~gx ~(f x)) + (walk/postwalk + (fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y)) + x))) + rk)) + pred-exprs [`(map? ~gx)] + pred-exprs (into pred-exprs (parse-req req identity)) + pred-exprs (into pred-exprs (parse-req req-un unk)) + keys-pred `(fn* [~gx] (cljs.core/and ~@pred-exprs)) + pred-exprs (mapv (fn [e] `(fn* [~gx] ~e)) pred-exprs) + pred-forms (walk/postwalk #(res &env %) pred-exprs)] + ;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen) + `(s/map-spec-impl {:req '~req :opt '~opt :req-un '~req-un :opt-un '~opt-un + :req-keys '~req-keys :req-specs '~req-specs + :opt-keys '~opt-keys :opt-specs '~opt-specs + :pred-forms '~pred-forms + :pred-exprs ~pred-exprs + :keys-pred ~keys-pred + :gfn ~gen}))) + +(macros/defmacro keys* + "takes the same arguments as spec/keys and returns a regex op that matches sequences of key/values, + converts them into a map, and conforms that map with a corresponding + spec/keys call: + + user=> (s/conform (s/keys :req-un [::a ::c]) {:a 1 :c 2}) + {:a 1, :c 2} + user=> (s/conform (s/keys* :req-un [::a ::c]) [:a 1 :c 2]) + {:a 1, :c 2} + + the resulting regex op can be composed into a larger regex: + + user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99]) + {:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}" + [& kspecs] + `(let [mspec# (s/keys ~@kspecs)] + (s/with-gen (s/& (s/* (s/cat ::s/k keyword? ::s/v cljs.core/any?)) ::s/kvs->map mspec#) + (fn [] (gen/fmap (fn [m#] (apply concat m#)) (s/gen mspec#)))))) + +(macros/defmacro & + "takes a regex op re, and predicates. Returns a regex-op that consumes + input as per re but subjects the resulting value to the + conjunction of the predicates, and any conforming they might perform." + [re & preds] + (let [&env (ctx/get-ctx) + pv (vec preds)] + `(s/amp-impl ~re '~(res &env re) ~pv '~(mapv #(res &env %) pv)))) + +(def gns (sci/create-ns 'cljs.spec.gen.alpha)) + +(macros/defmacro merge + "Takes map-validating specs (e.g. 'keys' specs) and + returns a spec that returns a conformed map satisfying all of the + specs. Successive conformed values propagate through rest of + predicates. Unlike 'and', merge can generate maps satisfying the + union of the predicates." + [& pred-forms] + (let [&env (ctx/get-ctx)] + `(s/merge-spec-impl '~(mapv #(res &env %) pred-forms) ~(vec pred-forms) nil))) + +(defn- res-kind + [env opts] + (let [{kind :kind :as mopts} opts] + (->> + (if kind + (assoc mopts :kind `~(res env kind)) + mopts) + (mapcat identity)))) + +(macros/defmacro coll-of + "Returns a spec for a collection of items satisfying pred. Unlike + generator will fill an empty init-coll. + + Same options as 'every'. conform will produce a collection + corresponding to :into if supplied, else will match the input collection, + avoiding rebuilding when possible. + + Same options as 'every'. + + See also - every, map-of" + [pred & opts] + (let [&env (ctx/get-ctx) + desc `(coll-of ~(res &env pred) ~@(res-kind &env opts))] + `(s/every ~pred ::s/conform-all true ::s/describe '~desc ~@opts))) + +(macros/defmacro every + "takes a pred and validates collection elements against that pred. + + Note that 'every' does not do exhaustive checking, rather it samples + *coll-check-limit* elements. Nor (as a result) does it do any + conforming of elements. 'explain' will report at most *coll-error-limit* + problems. Thus 'every' should be suitable for potentially large + collections. + + Takes several kwargs options that further constrain the collection: + + :kind - a pred that the collection type must satisfy, e.g. vector? + (default nil) Note that if :kind is specified and :into is + not, this pred must generate in order for every to generate. + :count - specifies coll has exactly this count (default nil) + :min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil) + :distinct - all the elements are distinct (default nil) + + And additional args that control gen + + :gen-max - the maximum coll size to generate (default 20) + :into - one of [], (), {}, #{} - the default collection to generate into + (default same as :kind if supplied, else [] + + Optionally takes :gen generator-fn, which must be a fn of no args that + returns a test.check generator + + See also - coll-of, every-kv +" + [pred & {:keys [into kind count max-count min-count distinct gen-max gen-into gen] :as opts}] + (let [&env (ctx/get-ctx) + desc (::s/describe opts) + nopts (-> opts + (dissoc :gen ::s/describe) + (assoc ::s/kind-form `'~(res &env (:kind opts)) + ::s/describe (clojure.core/or desc `'(every ~(res &env pred) ~@(res-kind &env opts))))) + gx (gensym) + cpreds (cond-> [(list (clojure.core/or kind `coll?) gx)] + count (conj `(= ~count (c/bounded-count ~count ~gx))) + + (clojure.core/or min-count max-count) + (conj `(<= (c/or ~min-count 0) + (c/bounded-count (if ~max-count (inc ~max-count) ~min-count) ~gx) + (c/or ~max-count s/MAX_INT))) + + distinct + (conj `(c/or (empty? ~gx) (apply distinct? ~gx))))] + `(s/every-impl '~pred ~pred ~(assoc nopts ::s/cpred `(fn* [~gx] (c/and ~@cpreds))) ~gen))) + +(macros/defmacro tuple + "takes one or more preds and returns a spec for a tuple, a vector + where each element conforms to the corresponding pred. Each element + will be referred to in paths using its ordinal." + [& preds] + (let [&env (ctx/get-ctx)] + (clojure.core/assert (not (empty? preds))) + `(s/tuple-impl '~(mapv #(res &env %) preds) ~(vec preds)))) + +(macros/defmacro map-of + "Returns a spec for a map whose keys satisfy kpred and vals satisfy + vpred. Unlike 'every-kv', map-of will exhaustively conform every + value. + + Same options as 'every', :kind defaults to map?, with the addition of: + + :conform-keys - conform keys as well as values (default false) + + See also - every-kv" + [kpred vpred & opts] + (let [&env (ctx/get-ctx) + desc `(map-of ~(res &env kpred) ~(res &env vpred) ~@(res-kind &env opts))] + `(s/every-kv ~kpred ~vpred ::s/conform-all true :kind map? ::s/describe '~desc ~@opts))) + +(macros/defmacro every-kv + "like 'every' but takes separate key and val preds and works on associative collections. + + Same options as 'every', :into defaults to {} + + See also - map-of" + + [kpred vpred & opts] + (let [&env (ctx/get-ctx) + desc `(every-kv ~(res &env kpred) ~(res &env vpred) ~@(res-kind &env opts))] + `(s/every (s/tuple ~kpred ~vpred) ::s/kfn (fn [i# v#] (nth v# 0)) :into {} ::s/describe '~desc ~@opts))) + +(macros/defmacro cat + "Takes key+pred pairs, e.g. + + (s/cat :e even? :o odd?) + + Returns a regex op that matches (all) values in sequence, returning a map + containing the keys of each pred and the corresponding value." + [& key-pred-forms] + (let [&env (ctx/get-ctx) + pairs (partition 2 key-pred-forms) + keys (mapv first pairs) + pred-forms (mapv second pairs) + pf (mapv #(res &env %) pred-forms)] + ;;(prn key-pred-forms) + (clojure.core/assert (clojure.core/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords") + `(s/cat-impl ~keys ~pred-forms '~pf))) + +(macros/defmacro * + "Returns a regex op that matches zero or more values matching + pred. Produces a vector of matches iff there is at least one match" + [pred-form] + (let [&env (ctx/get-ctx)] + `(s/rep-impl '~(res &env pred-form) ~pred-form))) + +(macros/defmacro + + "Returns a regex op that matches one or more values matching + pred. Produces a vector of matches" + [pred-form] + (let [&env (ctx/get-ctx)] + `(s/rep+impl '~(res &env pred-form) ~pred-form))) + +(macros/defmacro ? + "Returns a regex op that matches zero or one value matching + pred. Produces a single value (not a collection) if matched." + [pred-form] + (let [&env (ctx/get-ctx)] + `(s/maybe-impl ~pred-form '~(res &env pred-form)))) + +(macros/defmacro alt + "Takes key+pred pairs, e.g. + + (s/alt :even even? :small #(< % 42)) + + Returns a regex op that returns a map entry containing the key of the + first matching pred and the corresponding value. Thus the + 'key' and 'val' functions can be used to refer generically to the + components of the tagged return." + [& key-pred-forms] + (let [&env (ctx/get-ctx) + pairs (partition 2 key-pred-forms) + keys (mapv first pairs) + pred-forms (mapv second pairs) + pf (mapv #(res &env %) pred-forms)] + (clojure.core/assert (clojure.core/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords") + `(s/alt-impl ~keys ~pred-forms '~pf))) + +(macros/defmacro spec + "Takes a single predicate form, e.g. can be the name of a predicate, + like even?, or a fn literal like #(< % 42). Note that it is not + generally necessary to wrap predicates in spec when using the rest + of the spec macros, only to attach a unique generator + + Can also be passed the result of one of the regex ops - + cat, alt, *, +, ?, in which case it will return a regex-conforming + spec, useful when nesting an independent regex. + --- + + Optionally takes :gen generator-fn, which must be a fn of no args that + returns a test.check generator. + + Returns a spec." + [form & {:keys [gen]}] + (let [&env (ctx/get-ctx)] + (when form + `(s/spec-impl '~(res &env form) ~form ~gen nil)))) + +(macros/defmacro assert + "spec-checking assert expression. Returns x if x is valid? according + to spec, else throws an error with explain-data plus ::failure of + :assertion-failed. + Can be disabled at either compile time or runtime: + If *compile-asserts* is false at compile time, compiles to x. Defaults + to the negation value of the ':elide-asserts' compiler option, or true if + not set. + If (check-asserts?) is false at runtime, always returns x. Defaults to + value of 'cljs.spec.alpha/*runtime-asserts*', or false if not set. You can + toggle check-asserts? with (check-asserts bool)." + [spec x] + `(if @#'s/*runtime-asserts* + (s/assert* ~spec ~x) + ~x)) + +(def runtime-asserts + (sci/copy-var s/*runtime-asserts* sns)) + +(defn check-asserts [v] + (sci/set! runtime-asserts v)) + +#_(extend-protocol s/Specize + default + (specize* + ([o] + (prn :oo o) + (if-let [f-n (c/and (fn? o) + (do + (prn :o o) + (#'s/fn-sym (.-name o))))] + (s/spec-impl f-n o nil nil) + (s/spec-impl ::unknown o nil nil))) + ([o form] (s/spec-impl form o nil nil)))) + +(macros/defmacro fdef + "Takes a symbol naming a function, and one or more of the following: + + :args A regex spec for the function arguments as they were a list to be + passed to apply - in this way, a single spec can handle functions with + multiple arities + :ret A spec for the function's return value + :fn A spec of the relationship between args and ret - the + value passed is {:args conformed-args :ret conformed-ret} and is + expected to contain predicates that relate those values + + Qualifies fn-sym with resolve, or using *ns* if no resolution found. + Registers an fspec in the global registry, where it can be retrieved + by calling get-spec with the var or fully-qualified symbol. + + Once registered, function specs are included in doc, checked by + instrument, tested by the runner cljs.spec.test.alpha/check, and (if + a macro) used to explain errors during macroexpansion. + + Note that :fn specs require the presence of :args and :ret specs to + conform values, and so :fn specs will be ignored if :args or :ret + are missing. + + Returns the qualified fn-sym. + + For example, to register function specs for the symbol function: + + (s/fdef cljs.core/symbol + :args (s/alt :separate (s/cat :ns string? :n string?) + :str string? + :sym symbol?) + :ret symbol?)" + [fn-sym & specs] + `(cljs.spec.alpha/def ~fn-sym (s/fspec ~@specs))) + +(macros/defmacro fspec + "takes :args :ret and (optional) :fn kwargs whose values are preds + and returns a spec whose conform/explain take a fn and validates it + using generative testing. The conformed value is always the fn itself. + + See 'fdef' for a single operation that creates an fspec and + registers it, as well as a full description of :args, :ret and :fn + + fspecs can generate functions that validate the arguments and + fabricate a return value compliant with the :ret spec, ignoring + the :fn spec if present. + + Optionally takes :gen generator-fn, which must be a fn of no args + that returns a test.check generator." + [& {:keys [args ret fn gen] :or {ret `cljs.core/any?}}] + (let [&env (ctx/get-ctx) + env &env] + `(s/fspec-impl (s/spec ~args) '~(res env args) + (s/spec ~ret) '~(res env ret) + (s/spec ~fn) '~(res env fn) ~gen))) + +(macros/defmacro int-in + "Returns a spec that validates fixed precision integers in the + range from start (inclusive) to end (exclusive)." + [start end] + `(s/spec (s/and c/int? #(s/int-in-range? ~start ~end %)) + :gen #(gen/large-integer* {:min ~start :max (dec ~end)}))) + +(def tns (sci/create-ns 'cljs.spec.test.alpha)) + +(defn- collectionize + [x] + (if (symbol? x) + (list x) + x)) + +(defn- sym-or-syms->syms [sym-or-syms] + (into [] + (mapcat + (fn [sym] + (if (c/and (str/includes? (str sym) ".") + (sci/find-ns (ctx/get-ctx) sym)) + (let [ni (sci/eval-form (ctx/get-ctx) `(ns-interns '~sym))] + (->> (vals ni) + (map meta) + (filter #(not (:macro %))) + (map :name) + (map + (fn [name-sym] + (symbol (name sym) (name name-sym)))))) + [sym]))) + (collectionize sym-or-syms))) + +(defn- form->sym-or-syms + "Helper for extracting a symbol or symbols from a (potentially + user-supplied) quoted form. In the case that the form has ::no-eval meta, we + know it was generated by us and we directly extract the result, assuming the + shape of the form. This avoids applying eval to extremely large forms in the + latter case." + [sym-or-syms] + (if (::no-eval (meta sym-or-syms)) + (second sym-or-syms) + (eval sym-or-syms))) + + +(macros/defmacro instrument + "Instruments the vars named by sym-or-syms, a symbol or collection +of symbols, or all instrumentable vars if sym-or-syms is not +specified. If a symbol identifies a namespace then all symbols in that +namespace will be enumerated. + +If a var has an :args fn-spec, sets the var's root binding to a +fn that checks arg conformance (throwing an exception on failure) +before delegating to the original fn. + +The opts map can be used to override registered specs, and/or to +replace fn implementations entirely. Opts for symbols not included +in sym-or-syms are ignored. This facilitates sharing a common +options map across many different calls to instrument. + +The opts map may have the following keys: + + :spec a map from var-name symbols to override specs + :stub a set of var-name symbols to be replaced by stubs + :gen a map from spec names to generator overrides + :replace a map from var-name symbols to replacement fns + +:spec overrides registered fn-specs with specs your provide. Use +:spec overrides to provide specs for libraries that do not have +them, or to constrain your own use of a fn to a subset of its +spec'ed contract. + +:stub replaces a fn with a stub that checks :args, then uses the +:ret spec to generate a return value. + +:gen overrides are used only for :stub generation. + +:replace replaces a fn with a fn that checks args conformance, then +invokes the fn you provide, enabling arbitrary stubbing and mocking. + +:spec can be used in combination with :stub or :replace. + +Returns a collection of syms naming the vars instrumented." + ([] + (let [s (speced-vars)] + `(stest/instrument ~(with-meta (list 'quote s) + {::no-eval true})))) + ([xs] + `(stest/instrument ~xs nil)) + ([sym-or-syms opts] + (let [syms (sym-or-syms->syms (form->sym-or-syms sym-or-syms)) + opts-sym (gensym "opts")] + `(let [~opts-sym ~opts] + (reduce + (fn [ret# [_# f#]] + (let [sym# (f#)] + (cond-> ret# sym# (conj sym#)))) + [] + (->> (zipmap '~syms + [~@(map + (fn [sym] + `(fn [] (stest/instrument-1 '~sym ~opts-sym))) + syms)]) + (filter #((stest/instrumentable-syms ~opts-sym) (first %))) + (stest/distinct-by first))))))) + +(defonce ^:private instrumented-vars (atom {})) + +(defn- no-fspec + [v spec] + (ex-info (str "Fn at " v " is not spec'ed.") + {:var v :spec spec ::s/failure :no-fspec})) + +(defn- instrument-choose-fn + "Helper for instrument." + [f spec sym {over :gen :keys [stub replace]}] + (if (some #{sym} stub) + (-> spec (s/gen over) gen/generate) + (get replace sym f))) + +(defn- instrument-choose-spec + "Helper for instrument" + [spec sym {overrides :spec}] + (get overrides sym spec)) + +(defn- instrument-1* + [s v opts] + (let [spec (s/get-spec s) + {:keys [raw wrapped]} (get @instrumented-vars v) + current @v + to-wrap (if (= wrapped current) raw current) + ospec (c/or (instrument-choose-spec spec s opts) + (throw (no-fspec v spec))) + ofn (instrument-choose-fn to-wrap ospec s opts) + checked (@#'stest/spec-checking-fn v ofn ospec)] + (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked}) + checked)) + +(macros/defmacro instrument-1 + [[_quote s] opts] + (let [&env (ctx/get-ctx)] + (when-let [vr (sci/resolve &env s)] + (let [v (meta vr) + var-name (->sym vr)] + (when (and (nil? (:const v)) + (nil? (:macro v)) + (contains? (speced-vars) + var-name)) + `(let [the-var# (resolve '~s) + checked# (#'stest/instrument-1* '~s the-var# ~opts)] + (when checked# (set! ~s checked#)) + '~var-name)))))) + +(macros/defmacro unstrument + "Undoes instrument on the vars named by sym-or-syms, specified + as in instrument. With no args, unstruments all instrumented vars. + Returns a collection of syms naming the vars unstrumented." + ([] + `(stest/unstrument ^::no-eval '[~@(map ->sym (c/keys (deref instrumented-vars)))])) + ([sym-or-syms] + (let [syms (sym-or-syms->syms (form->sym-or-syms sym-or-syms))] + `(reduce + (fn [ret# f#] + (let [sym# (f#)] + (cond-> ret# sym# (conj sym#)))) + [] + [~@(->> syms + (map + (fn [sym] + (when (symbol? sym) + `(fn [] + (stest/unstrument-1 '~sym))))) + (remove nil?))])))) + +(macros/defmacro unstrument-1 + [[_quote s]] + (let [&env (ctx/get-ctx)] + (when-let [v (sci/resolve &env s)] + (when (@instrumented-vars v) + `(let [raw# (#'stest/unstrument-1* '~s (var ~s))] + (when raw# (set! ~s raw#)) + '~s))))) + +(defn- unstrument-1* + [_s v] + (when v + (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] + (swap! instrumented-vars dissoc v) + (let [current @v] + (when (= wrapped current) + raw))))) + +(def namespaces {'cljs.spec.alpha {'def (sci/copy-var def* sns) + 'def-impl (sci/copy-var s/def-impl sns) + 'and (sci/copy-var and sns) + 'and-spec-impl (sci/copy-var s/and-spec-impl sns) + 'or (sci/copy-var or sns) + 'or-spec-impl (sci/copy-var s/or-spec-impl sns) + 'valid? (sci/copy-var s/valid? sns) + 'conform (sci/copy-var s/conform sns) + 'nilable (sci/copy-var nilable sns) + 'nilable-impl (sci/copy-var s/nilable-impl sns) + 'explain (sci/copy-var s/explain sns) + 'explain-data (sci/copy-var s/explain-data sns) + 'keys (sci/copy-var keys sns) + 'map-spec-impl (sci/copy-var s/map-spec-impl sns) + 'keys* (sci/copy-var keys* sns) + 'with-gen (sci/copy-var s/with-gen sns) + '& (sci/copy-var & sns) + 'amp-impl (sci/copy-var s/amp-impl sns) + 'gen (sci/copy-var s/gen sns) + 'merge (sci/copy-var merge sns) + 'merge-spec-impl (sci/copy-var s/merge-spec-impl sns) + 'coll-of (sci/copy-var coll-of sns) + 'every (sci/copy-var every sns) + 'every-impl (sci/copy-var s/every-impl sns) + 'tuple (sci/copy-var tuple sns) + 'tuple-impl (sci/copy-var s/tuple-impl sns) + 'map-of (sci/copy-var map-of sns) + 'every-kv (sci/copy-var every-kv sns) + 'cat (sci/copy-var cat sns) + 'cat-impl (sci/copy-var s/cat-impl sns) + '* (sci/copy-var * sns) + 'rep-impl (sci/copy-var s/rep-impl sns) + '+ (sci/copy-var + sns) + 'rep+impl (sci/copy-var s/rep+impl sns) + '? (sci/copy-var ? sns) + 'maybe-impl (sci/copy-var s/maybe-impl sns) + 'alt (sci/copy-var alt sns) + 'alt-impl (sci/copy-var s/alt-impl sns) + 'describe (sci/copy-var s/describe sns) + 'spec (sci/copy-var spec sns) + 'spec-impl (sci/copy-var s/spec-impl sns) + 'assert (sci/copy-var assert sns) + 'assert* (sci/copy-var s/assert* sns) + 'check-asserts (sci/copy-var check-asserts sns) + '*runtime-asserts* runtime-asserts + 'invalid? (sci/copy-var s/invalid? sns) + 'fdef (sci/copy-var fdef sns) + 'fspec (sci/copy-var fspec sns) + 'fspec-impl (sci/copy-var s/fspec-impl sns) + 'registry (sci/copy-var s/registry sns) + 'int-in (sci/copy-var int-in sns) + 'MAX_INT s/MAX_INT + 'int-in-range? (sci/copy-var s/int-in-range? sns) + 'nonconforming (sci/copy-var s/nonconforming sns) + 'speced-vars (sci/copy-var speced-vars sns)} + 'cljs.spec.gen.alpha {'fmap (sci/copy-var gen/fmap gns) + 'elements (sci/copy-var gen/elements gns) + 'large-integer* (sci/copy-var gen/large-integer* gns) + 'shuffle (sci/copy-var gen/shuffle gns) + 'generate (sci/copy-var gen/generate gns) + 'map (sci/copy-var gen/map gns) + 'simple-type (sci/copy-var gen/simple-type gns)} + 'cljs.spec.test.alpha {'instrument (sci/copy-var instrument tns) + 'distinct-by (sci/copy-var stest/distinct-by tns) + 'instrumentable-syms (sci/copy-var stest/instrumentable-syms tns) + 'instrument-1 (sci/copy-var instrument-1 tns) + 'instrument-1* (sci/copy-var instrument-1* tns) + 'unstrument (sci/copy-var unstrument tns) + 'unstrument-1 (sci/copy-var unstrument-1 tns) + 'unstrument-1* (sci/copy-var unstrument-1* tns)}}) + +(def config {:namespaces namespaces}) + +;; TODO: multi-spec diff --git a/src/sci/configs/fulcro/dom.cljs b/src/sci/configs/fulcro/dom.cljs index 018ce32..7c6a7b4 100644 --- a/src/sci/configs/fulcro/dom.cljs +++ b/src/sci/configs/fulcro/dom.cljs @@ -13,4 +13,4 @@ (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.dom sci-ns {:exclude ['render-to-str]}) 'render-to-str (sci/copy-var render-to-str sci-ns))) -(def namespaces {'com.fulcrologic.fulcro.dom ns-def}) \ No newline at end of file +(def namespaces {'com.fulcrologic.fulcro.dom ns-def})