-
Notifications
You must be signed in to change notification settings - Fork 7
/
zip.clj
306 lines (271 loc) · 8.99 KB
/
zip.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
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
(ns com.yetanalytics.datasim.json.zip
(:require [clojure.zip :as z]
[clojure.spec.alpha :as s]
[clojure.spec.gen.alpha :as sgen]
[com.yetanalytics.datasim.json :as json]))
(s/def :com.yetanalytics.datasim.json.zip.loc.ppath/l
(s/nilable
(s/every ::json/any)))
(s/def :com.yetanalytics.datasim.json.zip.loc.ppath/r
(s/nilable
(s/every ::json/any)))
(s/def :com.yetanalytics.datasim.json.zip.loc.ppath/pnodes
(s/nilable
(s/every ::json/any)))
(s/def :com.yetanalytics.datasim.json.zip.loc/ppath
(s/nilable
(s/keys :req-un
[:com.yetanalytics.datasim.json.zip.loc.ppath/l
:com.yetanalytics.datasim.json.zip.loc.ppath/r
:com.yetanalytics.datasim.json.zip.loc.ppath/pnodes
:com.yetanalytics.datasim.json.zip.loc/ppath])))
(declare json-zip)
(s/def ::loc
(s/with-gen (s/tuple ::json/any
:com.yetanalytics.datasim.json.zip.loc/ppath)
(fn []
(sgen/bind
(s/gen ::json/any)
(fn [any-json]
(sgen/elements
(take-while (complement z/end?)
(iterate z/next
(json-zip any-json)))))))))
(s/fdef json-zip
:args (s/cat :root ::json/any)
:ret ::loc
:fn (fn [{{root :root} :args
[node _] :ret}]
(= root node)))
(defn json-zip
"Produce a zipper for the JSON"
[root]
(z/zipper
coll?
seq
(fn make-node
[node kids]
(if-let [empty-coll (empty node)]
(into empty-coll
kids)
;; if clojure.core/empty doesn't work, check for map entry
(if (map-entry? node)
(if (= 2 (count kids))
(let [[k v] kids]
(clojure.lang.MapEntry. k v))
(throw (ex-info "Can only have two children in a MapEntry"
{:type ::map-entry-constraint
:node node
:children kids})))
(throw (ex-info (format "Don't know how to make %s node" (type node))
{:type ::unknown-collection
:node node
:node-type (type node)
:children kids})))))
root))
(s/fdef internal?
:args (s/cat :loc ::loc)
:ret boolean?)
(defn internal?
"Is a location internal, ie a map entry or key"
[loc]
(let [node (z/node loc)]
(or (map-entry? node)
;; key position
(and (string? node)
(zero? (count (z/lefts loc)))
(some-> loc z/up z/node map-entry?))
false)))
(s/fdef el-key
:args (s/cat :loc ::loc)
:ret (s/nilable
::json/key))
(defn el-key
[loc]
(when-not (internal? loc)
(when-let [p (peek (z/path loc))]
(cond
(map-entry? p)
(key p)
(vector? p)
(count (z/lefts loc))))))
(s/fdef k-path
:args (s/cat :loc ::loc)
:ret (s/nilable
::json/key-path))
(defn k-path
[loc]
(into []
(reverse
(keep el-key
(take-while some?
(iterate z/up loc))))))
(s/fdef prune
:args (s/cat :loc ::loc)
:ret ::loc)
(defn prune
"Remove the current node, if it is a value in a map entry also remove the parent.
Shouldn't get called on root"
[loc]
(let [ploc (z/up loc)
pnode (z/node ploc)]
(z/remove
(if (map-entry? pnode)
ploc
loc))))
;; given a root and a key-path, can we return a loc at that path?
;; this would make up some for the inefficiency of having to walk everything
;; when there is a known path?
(s/fdef get-child
:args (s/cat :loc ::loc
:k ::json/key)
:ret (s/nilable ::loc))
(defn get-child
"Returns the child of loc at k or nil if key not present.
Will skip map-entries entirely, like clojure.core/get"
[loc k]
(when (and loc
(z/branch? loc)
(not (internal? loc)))
(let [node (z/node loc)]
(when-let [[fk fv :as found] (find node k)]
(let [child-locs (iterate z/right
(z/down loc))]
(if (map? node)
;; if the node is a map, we want to skip the map entries
(-> (some
(fn [cl]
(when (= found (z/node cl))
cl))
child-locs)
z/down
z/right)
(nth child-locs fk)))))))
(s/fdef get-child-in
:args (s/cat :loc (s/nilable ::loc)
:key-path ::json/key-path)
:ret (s/nilable ::loc))
(defn get-child-in
"Like clojure.core/get-in, but for zipper structures."
[loc key-path]
(reduce get-child loc key-path))
(s/fdef loc-in
:args (s/cat :root ::json/any
:key-path ::json/key-path)
:ret (s/nilable ::loc))
(defn loc-in
"Convenience, like get-child-in, but it takes root and returns a loc or nil."
[root key-path]
(-> root json-zip (get-child-in key-path)))
(s/fdef stub-in
:args (s/cat :loc ::loc
:key-path ::json/key-path)
:ret ::loc)
(defn stub-in
"Given a loc an key path, stub out the path if it does not exist, returning
a loc for the destination. If the loc does not exist, it will have the value
::stub. If incorrect keys are given for the data, will throw.
If stub-in encounters an intermediate node of ::stub, it will replce it with
the proper datastructure for the key path."
[loc key-path]
(let [node (z/node loc)]
(if (map-entry? node)
(recur (-> loc z/down z/right) key-path)
(if-let [k (first key-path)]
(if (or (coll? node) (= ::stub node))
(do (assert (cond
(map? node) (string? k)
(coll? node) (number? k)
:else true) "Incorrect key type for node")
(recur
(if (= ::stub node)
(cond
(string? k)
(-> loc
(z/replace
(z/make-node loc
{}
[(clojure.lang.MapEntry. k
::stub)]))
z/down)
(number? k)
(-> loc
(z/replace
(z/make-node loc
[]
(repeat (inc k) ::stub)))
z/down
(->> (iterate z/right))
(nth k)))
(let [child-locs (take-while
(complement nil?)
(iterate z/right
(z/down loc)))]
(if-let [[fk fv :as found] (find node k)]
(if (map? node)
(some
(fn [cl]
(when (= found (z/node cl))
cl))
child-locs)
(nth child-locs fk))
(if (map? node)
(-> loc
(z/append-child
(clojure.lang.MapEntry. k
::stub))
z/down
z/rightmost)
(let [[lc rc] (split-at k child-locs)]
(-> loc
(z/replace
(z/make-node loc
node
(concat
(map z/node lc)
(repeat (- (inc k)
(count lc))
::stub)
(map z/node rc))))
z/down
(->> (iterate z/right))
(nth k)))))))
(rest key-path)))
(throw (ex-info "Can't path into a leaf node"
{:type ::cant-path-leaf-node
:loc loc
:key-path key-path})))
loc))))
(s/def ::path-map
(s/map-of
::json/key-path
::json/any))
(s/fdef json-locs
:args (s/cat :json ::json/any)
:ret (s/every ::loc)
:fn (fn [{locs :ret}]
(every? (complement internal?) locs)))
(defn json-locs
[json]
(->> json
json-zip
(iterate z/next)
(take-while (complement z/end?))
;; don't look at map entries/keys
(remove internal?)))
(s/fdef json->path-map
:args (s/cat :json ::json/any)
:ret ::path-map)
(defn json->path-map
"given some json, return a map of full paths to values"
[json]
(into {}
(map (fn [loc]
[(k-path loc) (z/node loc)])
(json-locs json))))
(s/fdef path-map->json
:args (s/cat :path-map ::path-map)
:ret ::json/any)
(defn path-map->json
[path-map]
(get path-map []))