Skip to content

Instantly share code, notes, and snippets.

@metametadata
Last active Mar 4, 2019
Embed
What would you like to do?
(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}})))
(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