-
-
Notifications
You must be signed in to change notification settings - Fork 22
/
patch.cljc
72 lines (64 loc) · 2.08 KB
/
patch.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
;;
;; Copyright (c) Huahai Yang. All rights reserved.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file LICENSE at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.
;;
(ns editscript.patch
(:require [clojure.set :as set]
[editscript.edit :as e]))
#?(:clj (set! *warn-on-reflection* true))
#?(:clj (set! *unchecked-math* :warn-on-boxed))
(defn- vget
[x p]
(case (e/get-type x)
(:map :vec :set) (get x p)
:lst (nth x p)))
(defn- vdelete
[x p]
(case (e/get-type x)
;;NB, there is a special case where dissoc has no effect:
;;if p is ##NaN, then p cannot be found in x, for (= ##NaN ##NaN) is false!
:map (dissoc x p)
:vec (vec (concat (subvec x 0 p) (subvec x (inc ^long p))))
:set (set/difference x #{p})
:lst (->> (split-at p x)
(#(concat (first %) (next (last %))))
(apply list))))
(defn- vadd
[x p v]
(case (e/get-type x)
:map (assoc x p v)
:vec (vec (concat (conj (subvec x 0 p) v) (subvec x p)))
:set (conj x v)
:lst (->> (split-at p x)
(#(concat (first %) (conj (last %) v)))
(apply list))))
(defn- vreplace
[x p v]
(case (e/get-type x)
:map (assoc x p v)
:vec (vec (concat (conj (subvec x 0 p) v) (subvec x (inc ^long p))))
:set (-> x (set/difference #{p}) (conj v))
:lst (->> (split-at p x)
(#(concat (first %) (conj (rest (last %)) v)))
(apply list))))
(defn- valter
[x p o v]
(case o
:- (vdelete x p)
:+ (vadd x p v)
:r (vreplace x p v)))
(defn patch*
[old [path op value]]
(letfn [(up [x p o v]
(let [[f & r] p]
(if r
(valter x f :r (up (vget x f) r o v))
(if (seq p)
(valter x f o v)
v))))]
(up old path op value)))