Last active
January 4, 2017 18:29
-
-
Save mullr/e7f8230920225496370ae38fc55f2175 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defn ^:skip-wiki encoding-of-spec-impl | |
"Do not call this directly, use 'encoding-of'" | |
[inner-pred-form inner-pred | |
inner->outer-fn outer->inner-fn | |
gfn] | |
(let [inner-spec (delay (s/specize* inner-pred inner-pred-form))] | |
(reify | |
s/Specize | |
(specize* [s] s) | |
(specize* [s _] s) | |
s/Spec | |
(conform* [_ x] | |
(let [c (s/conform* @inner-spec (outer->inner-fn x))] | |
(if (= c ::s/invalid) | |
::s/invalid | |
c))) | |
(unform* [_ x] | |
(let [u (s/unform* @inner-spec x)] | |
(if (= u ::s/invalid) | |
::s/invalid | |
(inner->outer-fn u)))) | |
(explain* [_ path via in x] nil) | |
(gen* [_ overrides path rmap] | |
(if gfn | |
(gfn) | |
(gen/fmap inner->outer-fn (s/gen inner-pred)))) | |
(with-gen* [_ gfn] (encoding-of-spec-impl inner-pred-form inner-pred | |
inner->outer-fn outer->inner-fn | |
gfn)) | |
(describe* [_] `(encoding-of ~(s/describe* @inner-spec)))))) | |
(defmacro encoding-of [inner-pred-form inner->outer-fn outer->inner-fn] | |
`(encoding-of-spec-impl '~(#'s/res inner-pred-form) | |
~inner-pred-form | |
~inner->outer-fn | |
~outer->inner-fn | |
nil)) | |
(comment | |
(s/def :t/nat nat-int?) | |
(s/def :t/float float?) | |
(s/def :t/nat-or-float (s/or :nat :t/nat | |
:float :t/float)) | |
(s/def :t/test-map (s/keys :req [:t/nat-or-float])) | |
(s/def :t/stringy-map (encoding-of :t/test-map pr-str read-string)) | |
(s/conform :t/stringy-map "{:t/nat-or-float 42}") | |
(s/unform :t/stringy-map {:t/nat-or-float [:nat 42]}) | |
(gen/sample (s/gen :t/stringy-map)) | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment