-
Notifications
You must be signed in to change notification settings - Fork 21
/
merge.clj
113 lines (88 loc) · 2.9 KB
/
merge.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
(ns duct.core.merge
(:refer-clojure :exclude [replace distinct?])
(:require [clojure.set :as set]
[clojure.walk :as walk]
[integrant.core :as ig]))
(defrecord WrapMeta [val])
(defn wrap
"If a value doesn't support metadata, wrap it in a record that does."
[val]
(if (instance? clojure.lang.IObj val) val (->WrapMeta val)))
(defn unwrap
"Unwrap a value, if it is wrapped. Reverses the [[wrap]] function."
[obj]
(if (instance? WrapMeta obj) (:val obj) obj))
(defn unwrap-all
"Unwrap all values nested in a data structure."
[x]
(walk/postwalk unwrap x))
(defn displace
"Add displace metadata to a value."
[val]
(vary-meta (wrap val) assoc :displace true))
(defn replace
"Add replace metadata to a value."
[val]
(vary-meta (wrap val) assoc :replace true))
(defn- meta* [obj]
(if (instance? clojure.lang.IObj obj) (meta obj)))
(defn- displace? [obj]
(-> obj meta* :displace))
(defn- replace? [obj]
(-> obj meta* :replace))
(defn- different-priority? [left right]
(some (some-fn nil? displace? replace?) [left right]))
(defn- pick-prioritized [left right]
(cond
(nil? left) right
(nil? right) left
(and (displace? left) ;; Pick the rightmost
(displace? right)) ;; if both are marked as displaceable
(with-meta (wrap right)
(merge (meta* left) (meta* right)))
(and (replace? left) ;; Pick the rightmost
(replace? right)) ;; if both are marked as replaceable
(with-meta (wrap right)
(merge (meta* left) (meta* right)))
(or (displace? left)
(replace? right))
(with-meta (wrap right)
(merge (-> left meta* (dissoc :displace))
(-> right meta* (dissoc :replace))))
(or (replace? left)
(displace? right))
(with-meta (wrap left)
(merge (-> right meta* (dissoc :displace))
(-> left meta* (dissoc :replace))))))
(defn- demote? [obj]
(-> obj meta :demote))
(defn- promote? [obj]
(-> obj meta :promote))
(defn- prepend? [obj]
(-> obj meta :prepend))
(defn- distinct? [obj]
(-> obj meta :distinct))
(defn- meta-concat [left right]
(let [combined (concat left right)]
(into (empty left)
(if (or (distinct? left) (distinct? right))
(distinct combined)
combined))))
(defn meta-merge
"Recursively merge values based on the information in their metadata."
[left right]
(cond
(different-priority? left right)
(pick-prioritized left right)
(and (map? left) (map? right))
(if (or (promote? left) (demote? right))
(merge-with meta-merge right left)
(merge-with meta-merge left right))
(and (set? left) (set? right))
(set/union right left)
(and (coll? left) (coll? right))
(if (or (prepend? left) (prepend? right))
(-> (meta-concat right left)
(with-meta (merge (meta left) (select-keys (meta right) [:displace]))))
(meta-concat left right))
:else right))