-
-
Notifications
You must be signed in to change notification settings - Fork 54
/
spec.clj
266 lines (220 loc) · 9.01 KB
/
spec.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
(ns orchard.spec
(:require
[clojure.pprint :as pp]
[clojure.string :as string]
[clojure.walk :as walk]
[orchard.misc :as misc]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These are all wrappers for Clojure Spec functions. ;;
;; - clojure.spec (released between Clojure 1.8 and 1.9, but never included in Clojure) ;;
;; - clojure.spec.alpha (renamed from clojure.spec and included in Clojure 1.9) ;;
;; - clojure.alpha.spec (spec-2, the new experimental version) ;;
;; We can't simply require the ns because it's existence depends on the Clojure version ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; clojure.spec
(def ^:private clojure-spec-get-spec
(misc/call-when-resolved 'clojure.spec/get-spec))
(def ^:private clojure-spec-describe
(misc/call-when-resolved 'clojure.spec/describe))
(def ^:private clojure-spec-form
(misc/call-when-resolved 'clojure.spec/form))
(def ^:private clojure-spec-gen
(misc/call-when-resolved 'clojure.spec/gen))
(def ^:private clojure-spec-registry
(misc/call-when-resolved 'clojure.spec/registry))
(def clojure-spec?
"True if `clojure.spec` is supported, otherwise false."
(some? (resolve (symbol "clojure.spec" "get-spec"))))
;; clojure.spec.alpha
(def ^:private clojure-spec-alpha-get-spec
(misc/call-when-resolved 'clojure.spec.alpha/get-spec))
(def ^:private clojure-spec-alpha-describe
(misc/call-when-resolved 'clojure.spec.alpha/describe))
(def ^:private clojure-spec-alpha-form
(misc/call-when-resolved 'clojure.spec.alpha/form))
(def ^:private clojure-spec-alpha-gen
(misc/call-when-resolved 'clojure.spec.alpha/gen))
(def ^:private clojure-spec-alpha-registry
(misc/call-when-resolved 'clojure.spec.alpha/registry))
(def clojure-spec-alpha?
"True if `clojure.spec.alpha` is supported, otherwise false."
(some? (resolve (symbol "clojure.spec.alpha" "get-spec"))))
;; clojure.alpha.spec - spec-2
(def ^:private clojure-alpha-spec-get-spec
(misc/call-when-resolved 'clojure.alpha.spec/get-spec))
(def ^:private clojure-alpha-spec-describe
(misc/call-when-resolved 'clojure.alpha.spec/describe))
(def ^:private clojure-alpha-spec-form
(misc/call-when-resolved 'clojure.alpha.spec/form))
(def ^:private clojure-alpha-spec-gen
(misc/call-when-resolved 'clojure.alpha.spec/gen))
(def ^:private clojure-alpha-spec-registry
(misc/call-when-resolved 'clojure.alpha.spec/registry))
(def clojure-alpha-spec?
"True if `clojure.alpha.spec` is supported, otherwise false."
(some? (resolve (symbol "clojure.alpha.spec" "get-spec"))))
(def spec?
"True if `clojure.spec`, `clojure.spec.alpha` or`clojure.alpha.spec` is supported, otherwise false."
(or clojure-spec? clojure-spec-alpha? clojure-alpha-spec?))
(defn- try-fn [f & args]
(try (apply f args) (catch Exception _)))
(defn- ex-unable-to-resolve-spec [s]
(ex-info (format "Unable to resolve spec: %s" s) {:s s}))
(defn get-spec [k]
(or (clojure-alpha-spec-get-spec k)
(clojure-spec-alpha-get-spec k)
(clojure-spec-get-spec k)))
(defn describe [s]
(or (try-fn clojure-alpha-spec-describe s)
(try-fn clojure-spec-alpha-describe s)
(try-fn clojure-spec-describe s)
(throw (ex-unable-to-resolve-spec s))))
(defn registry []
(apply merge
(clojure-spec-registry)
(clojure-spec-alpha-registry)
(clojure-alpha-spec-registry)))
(defn form [s]
(or (try-fn clojure-alpha-spec-form s)
(try-fn clojure-spec-alpha-form s)
(try-fn clojure-spec-form s)
(throw (ex-unable-to-resolve-spec s))))
(defn gen [s]
(or (try-fn clojure-alpha-spec-gen s)
(try-fn clojure-spec-alpha-gen s)
(try-fn clojure-spec-gen s)
(throw (ex-unable-to-resolve-spec s))))
(def ^:private generate*
"All Clojure Spec versions use test.check under the hood. So let's
directly use its `generate` function instead of going through the
various Spec versions again."
(misc/call-when-resolved 'clojure.test.check.generators/generate))
(defn generate [s]
(when-let [gen (gen s)]
(generate* gen)))
;;; Utility functions
(defn str-non-colls
"Given a form, convert all non collection childs to str."
[form]
(walk/postwalk #(if (coll? %)
%
(str %))
form))
(defn- ns-name->ns-alias
"Return mapping from full namespace name to its alias in the given namespace."
[^String ns]
(if ns
(reduce-kv (fn [m alias ns]
(assoc m (name (ns-name ns)) (name alias)))
{}
(ns-aliases (symbol ns)))
{}))
(defn spec-list
"Retrieves a list of all specs in the registry, sorted by ns/name.
If filter-regex is not empty, keep only the specs with that prefix."
([filter-regex]
(spec-list filter-regex nil))
([filter-regex ns]
(let [ns-alias (ns-name->ns-alias ns)
sorted-specs (->> (registry)
keys
(mapcat (fn [kw]
;; Return an aliased entry in the current ns (if any)
;; with the fully qualified keyword
(let [keyword-ns (namespace kw)]
(if (= ns keyword-ns)
[(str kw) (str "::" (name kw))]
(if-let [alias (ns-alias keyword-ns)]
[(str kw) (str "::" alias "/" (name kw))]
[(str kw)])))))
sort)]
(if (not-empty filter-regex)
(filter (fn [spec-symbol-str]
(let [checkable-part (if (.startsWith ^String spec-symbol-str ":")
(subs spec-symbol-str 1)
spec-symbol-str)]
(re-find (re-pattern filter-regex) checkable-part)))
sorted-specs)
sorted-specs))))
(defn get-multi-spec-sub-specs
"Given a multi-spec form, call its multi method methods to retrieve
its subspecs."
[multi-spec-form]
(let [[_ multi-method-symbol & _] multi-spec-form]
(->> @(resolve multi-method-symbol)
methods
(map (fn [[spec-k method]]
[spec-k (form (method nil))])))))
(defn add-multi-specs
"Walk down a spec form and for every subform that is a multi-spec
add its sub specs."
[form]
(walk/postwalk (fn [sub-form]
(if (and (coll? sub-form)
(symbol? (first sub-form))
(-> sub-form first name (= "multi-spec")))
(concat sub-form (get-multi-spec-sub-specs sub-form))
sub-form))
form))
(defn spec-from-string
"Given a string like \"clojure.core/let\" or \":user/email\" returns
the associated spec in the registry, if there is one."
[s]
(let [[spec-ns spec-kw] (string/split s #"/")]
(if (.startsWith ^String spec-ns ":")
(get-spec (keyword (subs spec-ns 1) spec-kw))
(get-spec (symbol s)))))
(defn normalize-spec-fn-form
"Given a form like (fn* [any-symbol] ... any-symbol...) replace fn* with fn
and any occurrence of any-symbol with %."
[[_ [sym] & r]]
(concat '(clojure.core/fn [%])
(walk/postwalk (fn [form]
(if (and (symbol? form) (= form sym))
'%
form))
r)))
(defn normalize-spec-form
"Applys normalize-spec-fn-form to any fn* sub form."
[sub-form]
(walk/postwalk (fn [form]
(if (and (seq? form) (= 'fn* (first form)))
(normalize-spec-fn-form form)
form))
sub-form))
(defn- expand-ns-alias
"Expand a possible ns aliased keyword into a fully qualified keyword."
[^String ns ^String spec-name]
(if (and ns (.startsWith spec-name "::"))
(let [slash (.indexOf spec-name "/")]
(if (= -1 slash)
;; This is a keyword in the current namespace
(str ":" ns "/" (subs spec-name 2))
;; This is a keyword in an aliased namespace
(let [[keyword-ns kw] (.split (subs spec-name 2) "/")
aliases (ns-aliases (symbol ns))
ns-name (some-> keyword-ns symbol aliases ns-name name)]
(if ns-name
(str ":" ns-name "/" kw)
spec-name))))
;; Nothing to expand
spec-name))
(defn spec-form
"Given a spec symbol as a string, get the spec form and prepare it for
a response."
([spec-name]
(spec-form spec-name nil))
([spec-name ns]
(when-let [spec (spec-from-string (expand-ns-alias ns spec-name))]
(-> (form spec)
add-multi-specs
normalize-spec-form
str-non-colls))))
(defn spec-example
"Given a spec symbol as a string, returns a string with a pretty printed
example generated by the spec."
[spec-name]
(with-out-str
(-> (spec-from-string spec-name)
generate
pp/pprint)))