Last active
March 4, 2019 12:25
-
-
Save metametadata/53a847cd3b02056e8e4c124e63d9ae5a to your computer and use it in GitHub Desktop.
Closed core.spec keys spec, see https://groups.google.com/forum/#!topic/clojure/duY3ojPwPYo
This file contains 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
(ns spec-plus.core | |
(:require #?@(:clj [[clojure.spec.alpha :as s]] | |
:cljs [[cljs.spec.alpha :as s]]) | |
[clojure.set :as set]) | |
#?(:cljs (:require-macros [spec-plus.core]))) | |
#?(:clj | |
(defn -cljs-env? | |
"Take the &env from a macro, and tell whether we are expanding into cljs. | |
Source: https://groups.google.com/d/msg/clojurescript/iBY5HaQda4A/w1lAQi9_AwsJ" | |
[env] | |
(boolean (:ns env)))) | |
#?(:clj | |
(defmacro -keys | |
"Explanation of this pattern: http://blog.nberger.com.ar/blog/2015/09/18/more-portable-complex-macro-musing" | |
[& body] | |
(if (-cljs-env? &env) | |
`(cljs.spec.alpha/keys ~@body) | |
`(clojure.spec.alpha/keys ~@body)))) | |
#?(:clj | |
(defmacro -registry | |
[] | |
(if (-cljs-env? &env) | |
`(cljs.spec.alpha/registry) | |
`(clojure.spec.alpha/registry)))) | |
#?(:clj | |
(defmacro -and | |
[& body] | |
(if (-cljs-env? &env) | |
`(cljs.spec.alpha/and ~@body) | |
`(clojure.spec.alpha/and ~@body)))) | |
(defn -unqualify | |
[k] | |
(keyword (name k))) | |
(defn -with-explain | |
"Will use (update-problem [x problem]) to update all the problems produced by explain-data." | |
[spec update-problem] | |
{:pre [(s/spec? spec) (ifn? update-problem)]} | |
(reify s/Spec | |
(explain* | |
[_ path via in x] | |
(let [data (s/explain* spec path via in x)] | |
(map #(update-problem x %) data))) | |
; Do not modify other methods | |
(conform* [_ x] (s/conform* spec x)) | |
(unform* [_ y] (s/unform* spec y)) | |
(gen* [_ overrides path rmap] (s/gen* spec overrides path rmap)) | |
(with-gen* [_ gfn] (s/with-gen* spec gfn)) | |
(describe* [_] (s/describe* spec)))) | |
(defn -limit-keys | |
"Constructs a spec which fails if there are keys not from the specified list." | |
[allowed-keys-set] | |
(letfn [(no-disallowed-keys? | |
[m] | |
(set/subset? (set (keys m)) allowed-keys-set))] | |
(-with-explain (s/spec no-disallowed-keys?) | |
(fn [m problem] | |
(assoc problem :disallowed-keys (set/difference (set (keys m)) allowed-keys-set)))))) | |
#?(:clj | |
(defmacro speced-keys | |
"Similar to s/keys, but asserts during execution that all keys (passed as arguments to this macro) | |
have specs already registered. | |
Map can be closed (true by default) to disallow unknown keys. | |
Does not support recursive spec definitions, i.e. this will fail: (s/def ::m (speced-keys :opt [::m])). | |
The workaround is to register the keyword first: (s/def ::m any?) (s/def ::m ...). | |
Also see discussion at https://groups.google.com/forum/#!topic/clojure/i8Rz-AnCoa8." | |
[& {:keys [closed? req req-un opt opt-un] | |
:or {closed? true} | |
:as args}] | |
(let [args (select-keys args [:closed? :req :req-un :opt :opt-un]) | |
keys-args (dissoc args :closed?) | |
map-keys (set (apply concat (vals keys-args))) | |
qualified-map-keys (set (concat req opt)) | |
unqualified-map-keys (set (map -unqualify (concat req-un opt-un))) | |
allowed-keys (set/union qualified-map-keys unqualified-map-keys)] | |
`(let [speced-keys# (set (keys (-registry))) | |
unspeced-keys# (set/difference ~map-keys speced-keys#) | |
keys-spec# (-keys ~@(apply concat keys-args))] | |
(when (seq unspeced-keys#) | |
(throw (ex-info (str "these map keys have no specs registered: " (pr-str unspeced-keys#)) {}))) | |
(with-meta | |
(if ~closed? | |
(-and | |
keys-spec# | |
(-limit-keys ~allowed-keys)) | |
keys-spec#) | |
; In the future it can also contain :closed? field | |
{::speced-keys {:keys-spec keys-spec# | |
:allowed-keys ~allowed-keys}}))))) | |
(defn speced-keys-data | |
"Returns speced-keys data from the specified spec (identifier or instance) or throws." | |
[spec] | |
(if-some [result (::speced-keys (meta (if (ident? spec) | |
(s/get-spec spec) | |
spec)))] | |
result | |
(throw (ex-info (str (pr-str spec) " is not a speced-keys spec: " (pr-str spec)) {})))) | |
(defn merge-keys | |
"Constructs a single closed speced-keys spec from other speced-keys specs. | |
(In the future it can be possible to explicitly (sp/open ...)/(sp/close ...) the specified speced-keys spec.)" | |
[& specs] | |
(let [data (map speced-keys-data specs) | |
keys-specs (map :keys-spec data) | |
keys-spec (s/merge-spec-impl (mapv s/form keys-specs) keys-specs nil) | |
allowed-keys (apply set/union (map :allowed-keys data))] | |
(with-meta | |
(s/and | |
keys-spec | |
(-limit-keys allowed-keys)) | |
{::speced-keys {:keys-spec keys-spec | |
:allowed-keys allowed-keys}}))) |
This file contains 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
(s/def ::req-field1 any?) | |
(let [s (sp/speced-keys :req [::req-field1]) | |
value {::req-field1 123 | |
:extra1 100} | |
; act | |
actual (s/explain-data s value)] | |
; assert | |
(is (= {::s/problems [{:in [] | |
:path [] | |
:pred 'no-disallowed-keys? | |
:disallowed-keys #{:extra1} | |
:val value | |
:via []}] | |
::s/spec s | |
::s/value value} | |
actual))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment