/
merge.clj
95 lines (75 loc) · 2.54 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
(ns duct.core.merge
(:refer-clojure :exclude [replace])
(:require [clojure.set :as set]
[clojure.walk :as walk]
[duct.core.merge :as merge]
[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 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))
(merge-with meta-merge left right)
(and (set? left) (set? right))
(set/union right left)
(and (coll? left) (coll? right))
(if (or (-> left meta :prepend)
(-> right meta :prepend))
(-> (into (empty left) (concat right left))
(with-meta (merge (meta left)
(select-keys (meta right) [:displace]))))
(into (empty left) (concat left right)))
:else right))