-
Notifications
You must be signed in to change notification settings - Fork 0
/
core.cljc
320 lines (286 loc) · 12.3 KB
/
core.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
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
307
308
309
310
311
312
313
314
315
316
317
318
319
320
(ns diffuse.core
(:refer-clojure :exclude [apply comp])
(:require [clojure.core :as cl]
[clojure.set :as set]))
(defn apply
"Applies the change specified in the diff to data.
When the `:type` of diff is:
- `:value`, diff has the following format:
```
{:type :value
:value val}
```
val replaces the data.
- `:set`, diff has the following format:
```
{:type :set
:disj #{val0 ...}
:conj #{val1 ...}}
```
:disj is applied first, then :conj
No overlap is expected between the values in :disj and :conj.
- `:map`, diff has the following format:
```
{:type :map
:key-op {key0 [:assoc val0]}
key1 [:update diff1]
key2 :dissoc
...}
```
- `:vector` or a sequence, diff has the following format:
```
{:type :vector
:index-op {[:no-op size0]
[:update [diff0 diff1 ...]]
[:remove size2]
[:insert [val0 val1 ...]]
...}}
```
Consecutive elements in :index-op are not supposed be of the same type.
When diff is nil, the data is returned unchanged."
[diff data]
(if (nil? diff)
data
(case (:type diff)
:value (:value diff)
:set (-> data
(set/difference (:disj diff))
(set/union (:conj diff)))
:map (reduce-kv (fn [data key op]
(if (= op :dissoc)
(dissoc data key)
(case (first op)
:assoc (assoc data key (second op))
:update (update data key (fn [val]
(apply (second op) val))))))
data
(:key-op diff))
:vector (->> (loop [output []
index-ops (:index-op diff)
data data]
(if (seq index-ops)
(let [[op arg] (first index-ops)]
(case op
:no-op (recur (conj output (subvec data 0 arg))
(rest index-ops)
(subvec data arg))
:update (recur (conj output (mapv apply arg (subvec data 0 (count arg))))
(rest index-ops)
(subvec data (count arg)))
:remove (recur output
(rest index-ops)
(subvec data arg))
:insert (recur (conj output arg)
(rest index-ops)
data)))
(conj output data)))
(into [] cat)))))
(defn- index-op-size [[op arg]]
(if (or (= op :update)
(= op :insert))
(count arg)
arg))
(defn- index-op-split [[op arg] size]
(if (or (= op :update)
(= op :insert))
[[op (subvec arg 0 size)] [op (subvec arg size)]]
[[op size] [op (- arg size)]]))
(defn- head-split [new-iops base-iops]
(let [new-iop (first new-iops)
base-iop (first base-iops)
new-size (index-op-size new-iop)
base-size (index-op-size base-iop)]
(cond
(= new-size base-size)
[new-iops base-iops]
(< new-size base-size)
(let [[base-head base-tail] (index-op-split base-iop new-size)]
[new-iops (->> (rest base-iops)
(cons base-tail)
(cons base-head))])
(> new-size base-size)
(let [[new-head new-tail] (index-op-split new-iop base-size)]
[(->> (rest new-iops)
(cons new-tail)
(cons new-head)) base-iops]))))
(comment
;; Those are the rules for combining the operations on indexed collections.
;; (here, `comp` refers to `index-ops-comp`)
;; :no-op
[[:no-op 2] & b]
[[:no-op 2] & a]
[[:no-op 2] & (comp b a)]
[[:update [d e]] & b]
[[:no-op 2] & a]
[[:update [d e]] & (comp b a)]
[[:remove 2] & b]
[[:no-op 2] & a]
[[:remove 2] & (comp b a)]
[[:insert [x y]] & b]
[[:no-op 2] & a]
[[:insert [x y]] & (comp b (cons [:no-op 2] a))]
;; :update
[[:no-op 2] & b]
[[:update [d e]] & a]
[[:update [d e]] & (comp b a)]
[[:update [f g]] & b]
[[:update [d e]] & a]
[[:update [(d/comp f d) (d/comp g e)]] & (comp b a)]
[[:remove 2] & b]
[[:update [d e]] & a]
[[:remove 2] & (comp b a)]
[[:insert [x y]] & b]
[[:update [d e]] & a]
[[:insert [x y]] & (comp b (cons [:update [d e]] a))]
;; :remove
[[:no-op 2] & b]
[[:remove 2] & a]
[[:remove 2] & (comp (cons [:no-op 2] b) a)]
[[:update [d e]] & b]
[[:remove 2] & a]
[[:remove 2] & (comp (cons [:update [d e]] b) a)]
[[:remove 2] & b]
[[:remove 2] & a]
[[:remove 2] & (comp (cons [:remove 2] b) a)]
[[:insert [x y]] & b]
[[:remove 2] & a]
[[:remove 2] & (comp (cons [:insert [x y]] b) a)]
;; :insert
[[:no-op 2] & b]
[[:insert [x y]] & a]
[[:insert [x y]] & (comp b a)]
[[:update [d e]] & b]
[[:insert [x y]] & a]
[[:insert [(diff-apply d x) (diff-apply e y)]] & (comp b a)]
[[:remove 2] & b]
[[:insert [x y]] & a]
(comp b a)
[[:insert [u v]] & b]
[[:insert [x y]] & a]
[[:insert [u v]] & (comp b (cons [:insert [x y]] a))]
;; Observations:
;; 1. :remove in base-iop has the first priority to go in the output. (4 cases)
;; 2. :insert in new-iop has the second priority to go in the output. (3 cases)
;; 3. :no-op in base-iop disappear and new-iop goes to the output. (3 cases)
;; 4. for other cases, need to see both new-iop and base-iop together. (6 cases)
;; 5. We can exchange contiguous :insert and :remove nodes without changing
;; the semantic of the diff.
_)
(declare comp)
(defn- index-ops-comp [new-iops base-iops]
(loop [output []
new-iops new-iops
base-iops base-iops]
(cond
(empty? base-iops) (into output new-iops)
(empty? new-iops) (into output base-iops)
:else (let [[split-new-iops split-base-iops] (head-split new-iops base-iops)
[new-op new-arg :as new-iop] (first split-new-iops)
[base-op base-arg :as base-iop] (first split-base-iops)]
(if (= new-op :insert)
(recur (conj output new-iop)
(rest split-new-iops)
split-base-iops)
(case base-op
:remove (recur (conj output base-iop)
split-new-iops
(rest split-base-iops))
:no-op (recur (conj output new-iop)
(rest split-new-iops)
(rest split-base-iops))
:update (case new-op
:no-op (recur (conj output base-iop)
(rest split-new-iops)
(rest split-base-iops))
:update (recur (conj output [:update (mapv comp new-arg base-arg)])
(rest split-new-iops)
(rest split-base-iops))
:remove (recur (conj output new-iop)
(rest split-new-iops)
(rest split-base-iops)))
:insert (case new-op
:no-op (recur (conj output base-iop)
(rest split-new-iops)
(rest split-base-iops))
:update (recur (conj output [:insert (mapv apply new-arg base-arg)])
(rest split-new-iops)
(rest split-base-iops))
:remove (recur output
(rest split-new-iops)
(rest split-base-iops)))))))))
(defn- index-ops-canonical [iops]
(into []
(cl/comp (partition-by (cl/comp {:no-op :no-op
:update :update
:remove :remsert
:insert :remsert} first))
(mapcat (fn [index-ops]
(let [op (ffirst index-ops)]
(case op
:no-op [[op (transduce (map second) + index-ops)]]
:update [[op (into [] (mapcat second) index-ops)]]
(:remove :insert) (let [{removes :remove
inserts :insert} (group-by first index-ops)
remove-count (transduce (map second) + removes)
insert-elms (into [] (mapcat second) inserts)]
(cond-> []
(pos? remove-count) (conj [:remove remove-count])
(pos? (count insert-elms)) (conj [:insert insert-elms]))))))))
iops))
(defn comp
"Returns a diff whose application is equivalent to the consecutive application of multiple diffs.
We suppose that the diff were crafted without necessarily been aware of the data on which it
would be applied. As a result, diffs are expected not to always have an effect on the data.
Therefore:
```
(= (d/comp {:type :set, :disj #{:a}}
{:type :set, :conj #{:a}})
{:type :set, :disj #{:a}})
```
"
([] nil)
([diff] diff)
([new-diff base-diff]
(cond
(nil? base-diff) new-diff
(nil? new-diff) base-diff
(= :value (:type new-diff)) new-diff
:else (case (:type base-diff)
:value {:type :value
:value (apply new-diff (:value base-diff))}
:set {:type :set
:disj (set/union (:disj new-diff)
(set/difference (:disj base-diff)
(:conj new-diff)))
:conj (set/union (:conj new-diff)
(set/difference (:conj base-diff)
(:disj new-diff)))}
:map (let [new-ops (:key-op new-diff)
base-ops (:key-op base-diff)
key-ops (reduce-kv (fn [ops key new-op]
(->> (if (and (vector? new-op)
(= (first new-op) :update))
(let [base-op (get base-ops key)
new-op-diff (second new-op)]
(case base-op
nil new-op
:dissoc [:assoc (apply new-op-diff nil)]
(case (first base-op)
:assoc [:assoc (apply new-op-diff (second base-op))]
:update [:update (comp new-op-diff (second base-op))])))
new-op)
(assoc ops key)))
base-ops
new-ops)]
(when (seq key-ops)
{:type :map
:key-op key-ops}))
:vector (let [new-iops (:index-op new-diff)
base-iops (:index-op base-diff)
index-ops (-> (index-ops-comp new-iops base-iops)
index-ops-canonical)]
(when (seq index-ops)
{:type :vector
:index-op index-ops})))))
([diff-z diff-y & diffs]
(reduce comp (comp diff-z diff-y) diffs)))