/
impl.cljc
168 lines (159 loc) · 5.78 KB
/
impl.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
(ns borkdude.rewrite-edn.impl
(:refer-clojure :exclude [assoc update assoc-in update-in dissoc])
(:require [rewrite-clj.node :as node]
[rewrite-clj.zip :as z]))
(defn maybe-right [zloc]
(if (z/rightmost? zloc)
zloc
(z/right zloc)))
(defn skip-right [zloc]
(z/skip z/right
(fn [zloc]
(and
(not (z/rightmost? zloc))
(or (node/whitespace-or-comment? (z/node zloc))
(= :uneval (z/tag zloc)))))
zloc))
(defn indent [zloc key-count first-key-loc]
(let [current-loc (meta (z/node zloc))]
(if (or (= 1 key-count)
(not= (:row first-key-loc) (:row current-loc)))
(let [zloc (-> zloc
(z/insert-space-right (dec (dec (:col first-key-loc))))
z/insert-newline-right)]
zloc)
zloc)))
(defn assoc
[forms k v]
(let [zloc (z/edn forms)
zloc (z/skip z/right (fn [zloc]
(let [t (z/tag zloc)]
(not (contains? #{:token :map} t))))
zloc)
node (z/node zloc)
nil? (and (identical? :token (node/tag node))
(nil? (node/sexpr node)))
zloc (if nil?
(z/replace zloc (node/coerce {}))
zloc)
empty? (or nil? (zero? (count (:children (z/node zloc)))))]
(if empty?
(-> zloc
(z/append-child (node/coerce k))
(z/append-child (node/coerce v))
(z/root))
(let [zloc (z/down zloc)
zloc (skip-right zloc)
;; the location of the first key:
first-key-loc (when-let [first-key (z/node zloc)]
(meta first-key))]
(loop [key-count 0
zloc zloc]
(if (z/rightmost? zloc)
(-> zloc
(z/insert-right (node/coerce k))
(indent key-count first-key-loc)
(z/right)
(z/insert-right (node/coerce v))
(z/root))
(let [current-k (z/sexpr zloc)]
(if (= current-k k)
(let [zloc (-> zloc (z/right) (skip-right))
zloc (z/replace zloc (node/coerce v))]
(z/root zloc))
(recur
(inc key-count)
(-> zloc
;; move over value to next key
(skip-right)
(z/right)
(skip-right)))))))))))
(defn update [forms k f]
(let [zloc (z/edn forms)
zloc (z/skip z/right (fn [zloc]
(let [t (z/tag zloc)]
(not (contains? #{:token :map} t)))) zloc)
node (z/node zloc)
nil? (and (identical? :token (node/tag node))
(nil? (node/sexpr node)))
zloc (if nil?
(z/replace zloc (node/coerce {}))
zloc)
empty? (or nil? (zero? (count (:children (z/node zloc)))))]
(if empty?
(-> zloc
(z/append-child (node/coerce k))
(z/append-child (node/coerce nil))
(z/root)
(update k f))
(let [zloc (z/down zloc)
zloc (skip-right zloc)]
(loop [zloc zloc]
(if (z/rightmost? zloc)
(-> zloc
(z/insert-right (node/coerce k))
(z/right)
(z/insert-right (f (node/coerce nil)))
(z/root))
(let [current-k (z/sexpr zloc)]
(if (= current-k k)
(let [zloc (-> zloc (z/right) (skip-right))
zloc (z/replace zloc (node/coerce (f (z/node zloc))))]
(z/root zloc))
(recur (-> zloc
;; move over value to next key
(skip-right)
(z/right)
(skip-right)))))))))))
(defn update-in [forms keys f]
(if (= 1 (count keys))
(update forms (first keys) f)
(update forms (first keys) #(update-in % (rest keys) f))))
(defn assoc-in [forms keys v]
(if (= 1 (count keys))
(assoc forms (first keys) v)
(update forms (first keys) #(assoc-in % (rest keys) v))))
(defn map-keys [f forms]
(let [zloc (z/edn forms)
zloc (if (= :map (z/tag zloc))
zloc
(z/skip z/right (fn [zloc]
(and (not (z/rightmost zloc))
(not= :map (z/tag zloc)))) zloc))
zloc (z/down zloc)
zloc (skip-right zloc)]
(loop [zloc zloc]
(if (z/rightmost? zloc)
(z/root zloc)
(let [zloc (let [new-key (node/coerce (f (z/sexpr zloc)))]
(-> (z/replace zloc new-key)
z/right))]
(recur (-> zloc
;; move over value to next key
(skip-right)
maybe-right
(skip-right))))))))
(defn dissoc [forms k]
(let [zloc (z/edn forms)
zloc (z/skip z/right (fn [zloc]
(let [t (z/tag zloc)]
(not (contains? #{:token :map} t)))) zloc)
node (z/node zloc)
nil? (and (identical? :token (node/tag node))
(nil? (node/sexpr node)))]
(if nil?
forms
(let [zloc (z/down zloc)
zloc (skip-right zloc)]
(loop [zloc zloc]
(if (z/rightmost? zloc)
forms
(let [current-k (z/sexpr zloc)]
(if (= current-k k)
(-> zloc z/right z/remove
z/remove z/root)
(recur (-> zloc
;; move over value to next key
(skip-right)
(z/right)
(skip-right)))))))))))