-
-
Notifications
You must be signed in to change notification settings - Fork 8
/
instance.clj
319 lines (256 loc) · 9.63 KB
/
instance.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
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
(ns toucan2.instance
"Toucan 2 instances are a custom map type that does two things regular maps do not do:
1. They are associated with a particular model; [[toucan2.protocols/model]] can be used to get it. This is usually set
when the instance comes out of that database.
2. They track their [[toucan2.protocols/original]] version when they come out of the application database. This can in
turn be used to calculate the [[toucan2.protocols/changes]] that have been made, which powers features
like [[toucan2.save/save!]].
Normally a Toucan instance is considered equal to a plain map with the same
current (via [[toucan2.protocols/current]]) value. It is considered equal to other instances if they have the same
current value and their model is the same."
(:refer-clojure :exclude [instance?])
(:require
[potemkin :as p]
[pretty.core :as pretty]
[toucan2.protocols :as protocols]
[toucan2.realize :as realize]))
(set! *warn-on-reflection* true)
(def ^:dynamic *print-original*
"For debugging purposes: whether to print the original version of an instance, in addition to the current version, when
printing an [[instance]]."
false)
(defn instance?
"True if `x` is a Toucan2 instance, i.e. a `toucan2.instance.Instance` or some other class that satisfies the correct
interfaces.
Toucan instances need to implement [[protocols/IModel]], [[protocols/IWithModel]], and [[protocols/IRecordChanges]]."
[x]
(every? #(clojure.core/instance? % x)
[toucan2.protocols.IModel
toucan2.protocols.IWithModel
toucan2.protocols.IRecordChanges]))
(defn instance-of?
"True if `x` is a Toucan2 instance, and its [[protocols/model]] `isa?` `model`.
```clj
(instance-of? ::bird (instance ::toucan {})) ; -> true
(instance-of? ::toucan (instance ::bird {})) ; -> false
```"
[model x]
(and (instance? x)
(isa? (protocols/model x) model)))
(defn- changes*
"Changes between `orig` and `m`. Unlike [[clojure.data/diff]], this is a shallow diff. Only columns that are added or
modified should be returned."
[original current]
(if (or (not (map? original))
(not (map? current)))
current
(not-empty
(into
(empty original)
(map (fn [k]
(let [original-value (get original k)
current-value (get current k)]
(when-not (= original-value current-value)
[k current-value]))))
(keys current)))))
(declare ->TransientInstance)
(p/def-map-type Instance [model
^clojure.lang.IPersistentMap orig
^clojure.lang.IPersistentMap m
mta]
(get [_ k default-value]
(get m k default-value))
(assoc [this k v]
(let [m' (assoc m k v)]
(if (identical? m m')
this
(Instance. model orig m' mta))))
(dissoc [this k]
(let [m' (dissoc m k)]
(if (identical? m m')
this
(Instance. model orig m' mta))))
(keys [_this]
(keys m))
(meta [_this]
mta)
(with-meta [this new-meta]
(if (identical? mta new-meta)
this
(Instance. model orig m new-meta)))
clojure.lang.IPersistentCollection
(cons [this o]
(cond
(map? o)
(reduce #(apply assoc %1 %2) this o)
(clojure.core/instance? java.util.Map o)
(reduce
#(apply assoc %1 %2)
this
(into {} o))
:else
(if-let [[k v] (seq o)]
(assoc this k v)
this)))
(equiv [_this another]
(cond
(clojure.core/instance? toucan2.protocols.IModel another)
(and (= model (protocols/model another))
(= m another))
(map? another)
(= m another)
:else
false))
(empty [_this]
(Instance. model (empty orig) (empty m) mta))
java.util.Map
(containsKey [_this k]
(.containsKey m k))
clojure.lang.IEditableCollection
(asTransient [_this]
(->TransientInstance model (transient m) mta))
protocols/IModel
(protocols/model [_this]
model)
protocols/IWithModel
(with-model [this new-model]
(if (= model new-model)
this
(Instance. new-model orig m mta)))
protocols/IRecordChanges
(original [_this]
orig)
(with-original [this new-original]
(if (identical? orig new-original)
this
(let [new-original (if (nil? new-original)
{}
new-original)]
(assert (map? new-original))
(Instance. model new-original m mta))))
(current [_this]
m)
(with-current [this new-current]
(if (identical? m new-current)
this
(let [new-current (if (nil? new-current)
{}
new-current)]
(assert (map? new-current))
(Instance. model orig new-current mta))))
(changes [_this]
(not-empty (changes* orig m)))
protocols/IDispatchValue
(dispatch-value [_this]
(protocols/dispatch-value model))
realize/Realize
(realize [_this]
(if (identical? orig m)
(let [m (realize/realize m)]
(Instance. model m m mta))
(Instance. model (realize/realize orig) (realize/realize m) mta)))
pretty/PrettyPrintable
(pretty [_this]
(if *print-original*
(list `instance model (symbol "#_") orig m)
(list `instance model m))))
(deftype ^:no-doc TransientInstance [model ^clojure.lang.ITransientMap m mta]
clojure.lang.ITransientMap
(conj [this v]
(let [m' (conj! m v)]
(if (identical? m m')
this
(TransientInstance. model m' mta))))
(persistent [_this]
(let [m (persistent! m)]
(Instance. model m m mta)))
(assoc [this k v]
(let [m' (assoc! m k v)]
(if (identical? m m')
this
(TransientInstance. model m' mta))))
(without [this k]
(let [m' (dissoc! m k)]
(if (identical? m m')
this
(TransientInstance. model m' mta))))
(valAt [_this k]
(.valAt m k))
(valAt [_this k not-found]
(.valAt m k not-found))
(count [_this]
(count m))
pretty/PrettyPrintable
(pretty [_this]
(list `->TransientInstance model m mta)))
(defn instance
"Create a new Toucan 2 instance. See the namespace docstring for [[toucan2.instance]] for more information about *what*
a Toucan 2 instance is.
This function has several arities:
* With no args, creates an empty instance with its *model* set to `nil`
* With one arg, creates an empty instance of a *model*.
* With two args, creates an instance of a *model* from an existing map. This is optimized: if the map is already an
instance of the model, returns the map as-is.
* With three or more args, creates an instance of a *model* with key-value args."
(^toucan2.instance.Instance []
(instance nil))
(^toucan2.instance.Instance [model]
(instance model {}))
(^toucan2.instance.Instance [model m]
(assert ((some-fn map? nil?) m)
(format "Expected a map or nil, got ^%s %s" (.getCanonicalName (class m)) (pr-str m)))
(cond
;; optimization: if `m` is already an instance with `model` return it as-is.
(and (instance? m)
(= (protocols/model m) model))
m
;; DISABLED FOR NOW BECAUSE MAYBE THE OTHER MODEL HAS A DIFFERENT UNDERLYING EMPTY MAP OR KEY TRANSFORM
;;
;; ;; optimization 2: if `m` is an instance of something else use [[protocols/with-model]]
;; (instance? m)
;; (protocols/with-model m model)
:else
(let [m* (into {} m)]
(->Instance model m* m* (meta m)))))
(^toucan2.instance.Instance [model k v & more]
(let [m (into {} (partition-all 2) (list* k v more))]
(instance model m))))
(extend-protocol protocols/IWithModel
nil
(with-model [_this model]
(instance model))
clojure.lang.IPersistentMap
(with-model [m model]
(instance model m)))
(defn reset-original
"Return a copy of `an-instance` with its `original` value set to its current value, discarding the previous original
value. No-ops if `an-instance` is not a Toucan 2 instance."
[an-instance]
(if (instance? an-instance)
(protocols/with-original an-instance (protocols/current an-instance))
an-instance))
;;; TODO -- should we have a revert-changes helper function as well?
(defn update-original
"Applies `f` directly to the underlying `original` map of `an-instance`. No-ops if `an-instance` is not
an [[Instance]]."
[an-instance f & args]
(if (instance? an-instance)
(protocols/with-original an-instance (apply f (protocols/original an-instance) args))
an-instance))
(defn update-current
"Applies `f` directly to the underlying `current` map of `an-instance`; useful if you need to operate on it directly.
Acts like regular `(apply f instance args)` if `an-instance` is not an [[Instance]]."
[an-instance f & args]
(protocols/with-current an-instance (apply f (protocols/current an-instance) args)))
(defn update-original-and-current
"Like `(apply f instance args)`, but affects both the `original` map and `current` map of `an-instance` rather than
just the current map. Acts like regular `(apply f instance args)` if `instance` is not an `Instance`.
`f` is applied directly to the underlying `original` and `current` maps of `instance` itself. `f` is only applied
once if `original` and `current` are currently the same object (i.e., the new `original` and `current` will also be
the same object). If `current` and `original` are not the same object, `f` is applied twice."
[an-instance f & args]
(if (identical? (protocols/original an-instance) (protocols/current an-instance))
(reset-original (apply update-current an-instance f args))
(as-> an-instance an-instance
(apply update-original an-instance f args)
(apply update-current an-instance f args))))