-
Notifications
You must be signed in to change notification settings - Fork 93
/
visitor.cljc
184 lines (153 loc) · 7.88 KB
/
visitor.cljc
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
(ns spec-tools.visitor
"Tools for walking spec definitions."
(:require [clojure.spec.alpha :as s]
[spec-tools.core :as st]
[spec-tools.parse :as parse]
[spec-tools.impl :as impl]
[spec-tools.form :as form]))
(defn- spec-dispatch
[spec accept options]
(cond
(or (s/spec? spec) (s/regex? spec) (keyword? spec))
(let [form (s/form spec)]
(if (not= form ::s/unknown)
(if (seq? form)
(impl/normalize-symbol (first form))
(spec-dispatch form accept options))
spec))
(set? spec) ::set
(seq? spec) (impl/normalize-symbol (first (impl/strip-fn-if-needed spec)))
(symbol? spec) (impl/normalize-symbol spec)
:else (impl/normalize-symbol (form/resolve-form spec))))
(defmulti visit-spec spec-dispatch :default ::default)
(defn visit
"Walk a spec definition. Takes 2-3 arguments, the spec and the accept
function, and optionally a options map, and returns the result of
calling the accept function. Options map can be used to pass in context-
specific information to to sub-visits & accepts.
The accept function is called with 4 arguments: the dispatch term for the
spec (see below), the spec itself, vector with the results of
recursively walking the children of the spec and the options map.
The dispatch term is one of the following
* if the spec is a function call: a fully qualified symbol for the function
with the following exceptions:
- cljs.core symbols are converted to clojure.core symbols
- cljs.spec.alpha symbols are converted to clojure.spec.alpha symbols
* if the spec is a set: :spec-tools.visitor/set
* otherwise: the spec itself"
([spec accept]
(visit spec accept nil))
([spec accept {:keys [::visited] :as options}]
;; quick fix for #75: don't rewalk on recursive specs
;; correct solution would be walk on a reference of a spec?
(if-not (get visited spec)
(let [options (if (keyword? spec)
(update options ::visited (fnil conj #{}) spec)
options)]
(visit-spec spec accept options))
(visit-spec nil accept options))))
(defmethod visit-spec ::set [spec accept options]
(accept ::set spec (vec (if (keyword? spec) (impl/extract-form spec) spec)) options))
(defmethod visit-spec 'clojure.spec.alpha/keys [spec accept options]
(let [keys (impl/extract-keys (impl/extract-form spec))]
(accept 'clojure.spec.alpha/keys spec (mapv #(visit % accept options) keys) options)))
(defmethod visit-spec 'clojure.spec.alpha/or [spec accept options]
(let [[_ & {:as inner-spec-map}] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/or spec (mapv #(visit % accept options) (vals inner-spec-map)) options)))
(defmethod visit-spec 'clojure.spec.alpha/and [spec accept options]
(let [[_ & inner-specs] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/and spec (mapv #(visit % accept options) inner-specs) options)))
(defn- visit-merge [spec accept options]
(let [[_ & inner-specs] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/merge spec (mapv #(visit % accept options) inner-specs) options)))
(defmethod visit-spec 'clojure.spec.alpha/merge [spec accept options]
(visit-merge spec accept options))
(defmethod visit-spec 'spec-tools.core/merge [spec accept options]
(visit-merge spec accept options))
(defmethod visit-spec 'clojure.spec.alpha/multi-spec [spec accept options]
(let [methods-specs (->> (impl/extract-form spec)
(parse/get-multi-spec-sub-specs)
(into {}))]
(accept 'clojure.spec.alpha/multi-spec spec (mapv #(visit (val %) accept options) methods-specs) options)))
(defmethod visit-spec 'clojure.spec.alpha/every [spec accept options]
(let [[_ inner-spec] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/every spec [(visit inner-spec accept options)] options)))
(defmethod visit-spec 'clojure.spec.alpha/every-kv [spec accept options]
(let [[_ inner-spec1 inner-spec2] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/every-kv spec (mapv
#(visit % accept options)
[inner-spec1 inner-spec2]) options)))
(defmethod visit-spec 'clojure.spec.alpha/coll-of [spec accept options]
(let [form (impl/extract-form spec)
pred (second form)
{:keys [type]} (parse/parse-spec form)
dispatch (case type
:map-of ::map-of
:set ::set-of
:vector ::vector-of)]
(accept dispatch spec [(visit pred accept options)] options)))
(defmethod visit-spec 'clojure.spec.alpha/map-of [spec accept options]
(let [[_ k v] (impl/extract-form spec)]
(accept ::map-of spec (mapv #(visit % accept options) [k v]) options)))
(defmethod visit-spec 'clojure.spec.alpha/* [spec accept options]
(let [[_ inner-spec] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/* spec [(visit inner-spec accept options)] options)))
(defmethod visit-spec 'clojure.spec.alpha/+ [spec accept options]
(let [[_ inner-spec] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/+ spec [(visit inner-spec accept options)] options)))
(defmethod visit-spec 'clojure.spec.alpha/? [spec accept options]
(let [[_ inner-spec] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/? spec [(visit inner-spec accept options)] options)))
(defmethod visit-spec 'clojure.spec.alpha/alt [spec accept options]
(let [[_ & {:as inner-spec-map}] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/alt spec (mapv #(visit % accept options) (vals inner-spec-map)) options)))
(defmethod visit-spec 'clojure.spec.alpha/cat [spec accept options]
(let [[_ & {:as inner-spec-map}] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/cat spec (mapv #(visit % accept options) (vals inner-spec-map)) options)))
(defmethod visit-spec 'clojure.spec.alpha/& [spec accept options]
(let [[_ inner-spec] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/& spec [(visit inner-spec accept options)] options)))
(defmethod visit-spec 'clojure.spec.alpha/tuple [spec accept options]
(let [[_ & inner-specs] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/tuple spec (mapv #(visit % accept options) inner-specs) options)))
;; TODO: broken: http://dev.clojure.org/jira/browse/CLJ-2147
(defmethod visit-spec 'clojure.spec.alpha/keys* [spec accept options]
(let [keys (impl/extract-keys (impl/extract-form spec))]
(accept 'clojure.spec.alpha/keys* spec (mapv #(visit % accept options) keys) options)))
(defmethod visit-spec 'clojure.spec.alpha/nilable [spec accept options]
(let [[_ inner-spec] (impl/extract-form spec)]
(accept 'clojure.spec.alpha/nilable spec [(visit inner-spec accept options)] options)))
(defmethod visit-spec 'spec-tools.core/spec [spec accept options]
(let [[_ {inner-spec :spec}] (impl/extract-form spec)]
(accept ::spec spec [(visit inner-spec accept options)] options)))
(defmethod visit-spec ::default [spec accept options]
(accept (spec-dispatch spec accept options) spec nil options))
;;
;; sample visitor
;;
(defn spec-collector
"a visitor that collects all registered specs. Returns
a map of spec-name => spec."
[]
(let [specs (atom {})]
(fn [_ spec _ _]
(if-let [s (s/get-spec spec)]
(swap! specs assoc spec s)
@specs))))
;; TODO: uses ^:skip-wiki functions from clojure.spec
(comment
(defn convert-specs!
"Collects all registered subspecs from a spec and
transforms their registry values into Spec Records.
Does not convert clojure.spec.alpha regex ops."
[spec]
(let [specs (visit spec (spec-collector))
report (atom #{})]
(doseq [[k v] specs]
(if (keyword? v)
(swap! report into (convert-specs! v))
(when-not (or (s/regex? v) (st/spec? v))
(let [s (st/create-spec {:spec v})]
(impl/register-spec! k s)
(swap! report conj k)))))
@report)))