-
Notifications
You must be signed in to change notification settings - Fork 2
/
core.clj
798 lines (686 loc) · 31.2 KB
/
core.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
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
(ns aggregate.core
(:refer-clojure :exclude [load])
(:require [clojure.java.jdbc :as jdbc]
[parsargs.core :as p]))
;; -------------------------------------------------------------------
;; For testing in the REPL
;; This will start an in-memory DB instance
#_ (def con {:connection
(jdbc/get-connection
{:classname "org.h2.Driver"
:subprotocol "h2"
:subname "mem:repl"
:user "sa"
:password ""})})
;; Alternatively, this will start a DB server
#_ (do (require '[aggregate.h2 :as h2])
(require '[aggregate.core :as agg])
(h2/start-db))
;; Subsequently you can use @h2/db-con, which will use the DB server
;; To inspect the state of the DB use http://localhost:8082
;;--------------------------------------------------------------------
;; Concepts
;;
;; * An er-config is a map with :entities and :options, :entities is a
;; map {entity-kw -> entity-spec}.
;;
;; * An entity-spec is a map that contains :options and :relations, where
;; :relations is a map {relation-kw -> relation-spec}.
;; The options map contains functions for reading, inserting, updating or
;; deleting records.
;;
;; * A relation-spec is a map with the keys
;; - relation-type Admissible values are :one>, :<many and :<many>
;; - entity-kw A keyword denoting an entity
;; - fk-kw A keyword denoting the foreign-key name
;; - owned? A boolean telling if the related entity is owned,
;; i.e. will be deleted when the owner or the link is
;; deleted.
;; - query-fn A function returning records by a foreign key.
;; (only relevant for :<many and :<many>)
;; - update-links-fn A function for updating link table records.
;; (only relevant for :<many>)
;;--------------------------------------------------------------------
;; Common utilities
(defn- log
[& xs]
#_(apply println xs)
xs)
;;--------------------------------------------------------------------
;; Factories for default DB access functions based on clojure.java.jdbc
(defn extract-id
"Extracts id value from results like ({:scope_identity() 2}) or ({:id 2, ...})."
[id-kw insert-result]
(let [record (first insert-result)]
(or (get record id-kw) (-> record vals first))))
(defn persisted?
"Returns true if the map m has already been persisted.
It is assumed that the existence of an id-kw key is enough evidence."
[db-spec entity-kw id-kw m]
(contains? m id-kw))
(defn make-read-fn
"Returns a read function [db-spec id -> row-map] for a specific table.
It returns a single record or nil. The tablename may be passed as
string or keyword."
[tablename id-kw]
{:pre [id-kw]}
(fn [db-spec id]
(first
(jdbc/query db-spec
[(str "select * from " (name tablename) " where " (name id-kw) " = ?") id]))))
(defn make-insert-fn
"Returns an insert function [db-spec row-map -> row-map] for a specific table.
It returns the record, possibly augmented with the generated id in
an :id slot. The tablename may be passed as string or keyword."
[tablename id-kw]
{:pre [id-kw]}
(fn [db-spec row-map]
(let [id (->> (jdbc/insert! db-spec
(keyword tablename)
row-map)
(extract-id id-kw))]
(assoc row-map id-kw id))))
(defn make-update-fn
"Returns an update function [db-spec set-map -> set-map] for a
specific table, which takes a map of values and updates the record
denoted by the :id contained in set-map. It returns the set-map.
The tablename may be passed as string or keyword."
[tablename id-kw]
{:pre [id-kw]}
(fn [db-spec set-map]
{:pre [(get set-map id-kw)]}
(let [set-map' (dissoc set-map id-kw)]
(when-not (empty? set-map')
(jdbc/update! db-spec
(keyword tablename)
(dissoc set-map id-kw)
[(str (name id-kw) " = ?") (get set-map id-kw)])))
set-map))
(defn make-delete-fn
"Returns a delete function [db-spec id -> (Seq id)] for a specific
table, which deletes the record id points to. It returns the number
of deleted records (usually 1), or nil if none was deleted.
The tablename may be passed as string or keyword."
[tablename id-kw]
{:pre [id-kw]}
(fn [db-spec id]
(let [n (first (jdbc/delete! db-spec
(keyword tablename)
[(str (name id-kw) " = ?") id]))]
(if (> n 0) n nil))))
(defn make-query-<many-fn
"Returns a finder function [db-spec id -> (Seq Map)] for a specific
table, that returns -- as sequence of maps -- all records that have
id as value of the foreign key field denoted by fk-kw.
Assumes a simple n to 1 relationship."
[tablename fk-kw]
{:pre [fk-kw]}
(fn [db-spec id]
(jdbc/query db-spec [(str "select * from " (name tablename)
" where " (name fk-kw) " = ?") id])))
(defn make-query-<many>-fn
"Returns a finder function [db-spec id -> (Seq Map)] for a
specific table whose records are in a m to n relationship
realized by a link table containing two foreign keys. The
function returns a sequence of maps."
([tablename linktablename fk-a fk-b]
(make-query-<many>-fn tablename linktablename fk-a fk-b :id))
([tablename linktablename fk-a fk-b b-id-kw]
{:pre [fk-a fk-b]}
(let [sql (str "select * from " (name tablename)
" A join " (name linktablename) " AB"
" on A." (name b-id-kw) " = AB." (name fk-b)
" where AB." (name fk-a) " = ?")]
(fn [db-spec id-b]
(->> (jdbc/query db-spec [sql id-b])
(map #(dissoc % (keyword fk-a) (keyword fk-b))))))))
(defn make-update-links-fn
"Returns a function that updates a link table by first deleting all
records having a-id as value in the field fk-a, and afterwards
inserting for each of the bs one record with fk-a = a-id and fk-b
= (:id b)."
([linktablename fk-a fk-b]
(make-update-links-fn linktablename fk-a fk-b :id))
([linktablename fk-a fk-b b-id-kw]
{:pre [fk-a fk-b b-id-kw]}
(fn [db-spec a-id bs]
(jdbc/delete! db-spec (keyword linktablename) [(str (name fk-a) " = ?") a-id])
(doseq [b bs]
(jdbc/insert! db-spec (keyword linktablename) {(keyword fk-a) a-id
(keyword fk-b) (get b b-id-kw)})))))
(defn make-entity-options
"Returns a map containing all four default JDBC based implementations
for read, insert, update and delete."
([tablename]
(make-entity-options tablename :id))
([tablename id-kw]
{:pre [id-kw]}
{:id-kw id-kw
:read-fn (make-read-fn tablename id-kw)
:insert-fn (make-insert-fn tablename id-kw)
:update-fn (make-update-fn tablename id-kw)
:delete-fn (make-delete-fn tablename id-kw)}))
;;--------------------------------------------------------------------
;; Helpers for succinctly creating er-config map
(defn- default-fk
"Returns a keyword that has the suffix '_id'."
[entity-kw]
(-> entity-kw name (str "_id") keyword))
(defn- default-link-tablename
"Takes two tablenames and joins them with '_' and returns the result as keyword."
[a-entity-kw b-entity-kw]
(keyword (str (name a-entity-kw) "_" (name b-entity-kw))))
(defn- with-default-entity-options
"Returns a map containing all four default JDBC based implementations
for read, insert, update and delete."
[er-config
entity-kw
{:keys [read-fn insert-fn update-fn delete-fn]}]
(let [{:keys [id-kw
read-fn-factory
insert-fn-factory
update-fn-factory
delete-fn-factory]} (-> er-config :options)
e-id-kw (or (-> er-config :entities entity-kw :options :id-kw) id-kw :id)]
{:id-kw e-id-kw
:read-fn (or read-fn (read-fn-factory entity-kw e-id-kw))
:insert-fn (or insert-fn (insert-fn-factory entity-kw e-id-kw))
:update-fn (or update-fn (update-fn-factory entity-kw e-id-kw))
:delete-fn (or delete-fn (delete-fn-factory entity-kw e-id-kw))}))
(defn- with-default-relation-fns
"Returns a pair [relation-kw relation] with default functions added where missing."
[er-config
parent-entity-kw
[relation-kw {:keys [relation-type entity-kw fk-kw query-fn update-links-fn] :as relation}]]
(let [{:keys [query-<many-fn-factory
query-<many>-fn-factory
update-links-fn-factory]} (-> er-config :options)]
(vector relation-kw
(case relation-type
:one> (assoc relation
:query-fn (or query-fn
(-> er-config :entities entity-kw :options :read-fn)))
:<many (let [fk-kw (or fk-kw (default-fk parent-entity-kw))]
(assoc relation
:fk-kw fk-kw
:query-fn (or query-fn
(query-<many-fn-factory entity-kw fk-kw))))
:<many> (let [fk-a (default-fk parent-entity-kw)
fk-b (default-fk entity-kw)
b-id-kw (-> er-config :entities entity-kw :options :id-kw)]
(assoc relation
:query-fn
(or query-fn
(query-<many>-fn-factory
entity-kw
(default-link-tablename parent-entity-kw entity-kw) fk-a fk-b b-id-kw))
:update-links-fn
(or update-links-fn
(update-links-fn-factory
(default-link-tablename parent-entity-kw entity-kw) fk-a fk-b b-id-kw))))))))
(defn- with-defaults
"Returns an er-config with default functions added where missing."
[er-config]
(let [er-config'
(update-in er-config [:entities]
(fn [entities]
(->> entities
(map (fn [[entity-kw {:keys [options relations]}]]
(vector entity-kw
{:options (with-default-entity-options er-config entity-kw options)
:relations relations})))
(into {}))))]
(update-in er-config' [:entities]
(fn [entities]
(->> entities
(map (fn [[entity-kw {:keys [options relations]}]]
(vector entity-kw
{:options options
:relations (->> relations
(map (partial with-default-relation-fns er-config' entity-kw))
(into {}))})))
(into {}))))))
(defn- with-default-options
"Returns the default options, replacing defaults by entries in the
options-map."
[er-options]
(merge {:id-kw :id
:persisted-pred-fn persisted?
:read-fn-factory make-read-fn
:insert-fn-factory make-insert-fn
:update-fn-factory make-update-fn
:delete-fn-factory make-delete-fn
:query-<many-fn-factory make-query-<many-fn
:query-<many>-fn-factory make-query-<many>-fn
:update-links-fn-factory make-update-links-fn} er-options))
(defn- entityspec?
"Returns true if x is a vector containing a keyword as first and a
map as second item"
[x]
(and (vector? x)
(keyword? (first x))
(map? (second x))))
(def ^:private er-config-parser
(partial p/parse
(p/sequence :options (p/optval map? {})
:entity-specs (p/some (p/value entityspec?)))))
(defn make-er-config
"Creates a er-config map from an optional options-map and an
arbitrary number of entity-specs, i.e.
(agg/make-er-config options-map? entities)
Available options:
:read-fn-factory A function (fn [tablename]) returning the
default read function.
:insert-fn-factory A function (fn [tablename]) returning the
default insert function.
:update-fn-factory A function (fn [tablename]) returning the
default update function.
:delete-fn-factory A function (fn [tablename]) returning the
default delete function.
:query-<many-fn-factory A function (fn [tablename fk-kw]) returning
the default query-for-many function using
one foreign key.
:query-<many>-fn-factory A function (fn [tablename linktablename fk-a fk-b])
returning the default query-for-many function
that uses a linktable.
:update-links-fn-factory A function (fn [linktablename fk-a fk-b])
returning the default function to update
link tables.
:id-kw A keyword that is taken as default primary
key column name.
:persisted-pred-fn A predicate (fn [db-spec entity-kw id-kw row-map])
that returns true if the given row-map is already
present in DB."
[& args]
(let [{:keys [options entity-specs]} (er-config-parser args)]
(with-defaults {:options (with-default-options options)
:entities (into {} entity-specs)})))
(defn- relationspec?
"Returns true if x is a vector, where the first item is a keyword
and the second is a map containing :relation-type."
[x]
(and (vector? x)
(keyword? (first x))
(contains? (second x) :relation-type)))
(def ^:private entity-parser
(partial p/parse
(p/sequence :entity-kw (p/value keyword?)
:options (p/optval #(and (map? %) (nil? (:relation-type %))) {})
:relation-specs (p/some (p/value relationspec?)))))
(defn entity
"Returns an entity-spec from an entity keyword, an optional
options-map and an arbitrary number of relation-specs, i.e.
(agg/entity entity-kw options-map? relations)
Available options:
:read-fn A function (fn [db-spec id]) returning the
record with primary key value id as a map.
:insert-fn A function (fn [db-spec row-map]) that inserts
the row-map as record, and returns the row-map
containing the new primary key value.
:update-fn A function (fn [db-spec set-map]) that updates
the record identified by the primary key value
within set-map with the values of set-map.
:delete-fn A function (fn [db-spec id]) that deletes the
record identified by the primary key value.
:id-kw The keyword to be used to get/assoc the primary
key value. It is also used as primary key
column name in default DB access functions."
([& args]
(let [{:keys [entity-kw options relation-specs]} (entity-parser args)]
(vector entity-kw {:options options
:relations (into {} relation-specs)}))))
(defn ->1
"Returns a relation-spec for a :one> relationship.
Available options:
:fk-kw A keyword denoting the foreign-key name.
:owned? A boolean telling if the related entity is owned,
i.e. will be deleted when the owner or the link is
deleted. Defaults to true."
([relation-kw entity-kw]
(->1 relation-kw entity-kw {}))
([relation-kw entity-kw options]
(vector relation-kw (merge {:relation-type :one>
:entity-kw entity-kw
:query-fn nil
:fk-kw (default-fk relation-kw)
:owned? true}
options))))
(defn ->n
"Returns a relation-spec for a :<many relationship.
Available options:
:fk-kw A keyword denoting the foreign-key name.
:query-fn A function returning records by a foreign key.
:owned? A boolean telling if the related entity is owned,
i.e. will be deleted when the owner or the link is
deleted. Defaults to true."
([relation-kw entity-kw]
(->n relation-kw entity-kw {}))
([relation-kw entity-kw options]
(vector relation-kw (merge {:relation-type :<many
:entity-kw entity-kw
:fk-kw nil
:query-fn nil
:owned? true}
options))))
(defn ->mn
"Returns a relation-spec for a :<many> relationship.
Available options:
:query-fn A function returning records by a foreign key.
:update-links-fn A function for updating link table records.
:owned? A boolean telling if the related entity is owned,
i.e. will be deleted when the owner or the link is
deleted. Defaults to false."
([relation-kw entity-kw]
(->mn relation-kw entity-kw {}))
([relation-kw entity-kw options]
(vector relation-kw (merge {:relation-type :<many>
:entity-kw entity-kw
:query-fn nil
:update-links-fn nil
:owned? false}
options))))
(defn- dissoc-ks
"Remove keys in ks from m."
[m ks]
(apply (partial dissoc m) ks))
(defn without
"Removes entities (specified by a keyword) and relations (specified
in a vector, where the first item is the entity keyword) from the er-config."
[er-config & entities-or-entity-relation-seqs]
(reduce (fn [er-config k-or-ks]
(if (coll? k-or-ks)
(update-in er-config [:entities (first k-or-ks) :relations] dissoc-ks (rest k-or-ks))
(update-in er-config [:entities] dissoc k-or-ks)))
er-config
entities-or-entity-relation-seqs))
(defn- keep-ks
"Removes all but ks keys from map m."
[m ks]
(let [ks-set (set ks)]
(into {} (filter (comp ks-set first) m))))
(defn only
"Removes all relations that are NOT specified by the vectors.
A vector must begin with an entity-kw, all remaining items denote
relations."
[er-config & entity-relation-seqs]
(reduce (fn [er-config ks]
(update-in er-config [:entities (first ks) :relations] keep-ks (rest ks)))
er-config
entity-relation-seqs))
;;--------------------------------------------------------------------
;; Common utility functions for the big three: load, save! and delete!
(defn- without-relations-and-entity
"Removes all key-value-pairs from m that correspond to relations."
[er-config entity-kw m]
(->> er-config :entities entity-kw :relations
(keys)
(cons ::entity)
(apply (partial dissoc m))))
(defn- rt?
"Is relation of type?
Returns true if the relation-type equals t."
[t [_ {:keys [relation-type]}]]
(= t relation-type))
(defn- rr?
"Is relation relevant?
Returns true if the relation points to an existing entity description."
[er-config [_ {:keys [entity-kw]}]]
(contains? (:entities er-config) entity-kw))
(defn- visited?
"Returns true if `id` is not nil and the pair [`entity-kw` `id`]
belongs to set `visited`."
[visited entity-kw id]
(and id (visited [entity-kw id])))
(declare load-relations save* delete!)
;;--------------------------------------------------------------------
;; Load aggregate
(defn- load-relation
"Loads more data according to the specified relation."
[er-config db-spec visited id-kw m
[relation-kw
{:keys [relation-type entity-kw fk-kw query-fn]}]]
(case relation-type
:one>
(let [child (let [id (get m fk-kw)]
(if (and (not (visited? visited entity-kw id))
(-> er-config :entities entity-kw))
(some->> (query-fn db-spec id)
(#(assoc % ::entity entity-kw))
(load-relations er-config db-spec visited))))]
(if child
(assoc m relation-kw child)
(dissoc m relation-kw fk-kw)))
(:<many :<many>)
(if (-> er-config :entities entity-kw)
(assoc m
relation-kw
(->> (get m id-kw)
(query-fn db-spec)
(map #(assoc % ::entity entity-kw))
;; invoke load for each record returned by the query
(mapv (partial load-relations er-config db-spec visited))))
m)))
(defn- load-relations
[er-config db-spec visited m]
(if-let [entity-kw (::entity m)]
(let [entity (-> er-config :entities entity-kw)
id-kw (-> entity :options :id-kw)
id (get m id-kw)
relations (-> entity :relations)]
(if (visited? visited entity-kw id)
m ;; short-circuit
(reduce (partial load-relation
er-config db-spec (conj visited [entity-kw id]) id-kw)
m
relations)))))
(defn load
"Loads an aggregate by `id`. The `entity-kw` denotes the aggregate root.
Returns a map containing the entity-kw in ::entity and all data, or
nil if the entity-kw is unknown or the record does not exist."
([er-config db-spec entity-kw id]
(let [read-fn (-> er-config :entities entity-kw :options :read-fn)
m (if read-fn
(some-> (read-fn db-spec id)
(assoc ::entity entity-kw)))]
(load-relations er-config db-spec #{} m)))
([er-config db-spec m]
(load-relations er-config db-spec #{} m)))
;;--------------------------------------------------------------------
;; Save aggregate
(defn- save-prerequisite!
"Saves a record that `m` points to by a foreign-key and returns updated `m`."
[er-config
db-spec
visited
update-m-fn
id-kw
m
[relation-kw {:keys [entity-kw fk-kw owned?]}]]
(log "save-prerequisite of relation" relation-kw "-> entity" entity-kw
"identified by" fk-kw (get m fk-kw))
(if (visited? visited entity-kw (get m fk-kw))
m ;; short-circuit, don't handle entity that m points to twice
(if-let [p (relation-kw m)] ; does m contain the prerequisite?
;; save the prerequisite record and take its id as foreign key
(let [id-kw (-> er-config :entities entity-kw :options :id-kw)
persisted? (-> er-config :options :persisted-pred-fn)
saved-p (save* er-config db-spec visited entity-kw p)]
(assoc m
fk-kw (get saved-p id-kw)
relation-kw saved-p))
;; prerequisite does not exist in m
(let [fk-id (fk-kw m)
persisted? (-> er-config :options :persisted-pred-fn)]
(when (and fk-id (persisted? db-spec entity-kw id-kw m))
;; m is persisted and points to the prerequisite, so update m
(update-m-fn db-spec {id-kw (get m id-kw) fk-kw nil}))
(when (and owned? fk-id)
;; delete the former prerequisite by the foreign key from DB
(delete! er-config db-spec entity-kw fk-id))
(if (persisted? db-spec entity-kw id-kw m)
(dissoc m fk-kw)
m)))))
(defn- save-dependants!
"Saves records that point via foreign-key to m."
[er-config
db-spec
visited
id-kw
m
[relation-kw {:keys [relation-type entity-kw fk-kw update-links-fn query-fn owned?]}]]
(log "save-dependants" relation-kw "->" entity-kw relation-type (get m id-kw))
(let [m-id (get m id-kw)
m-entity-kw (::entity m)
dependants (let [d-id-kw (-> er-config :entities entity-kw :options :id-kw)
update-fn (-> er-config :entities entity-kw :options :update-fn)
current-ds (query-fn db-spec m-id)
saved-ds (->> (get m relation-kw)
(map #(if (= relation-type :<many>)
%
;; insert foreign key value
(assoc % fk-kw m-id)))
(map #(save* er-config
db-spec
visited
entity-kw
%))
(mapv #(dissoc % fk-kw)))
saved-ds-ids (->> saved-ds (map #(get % d-id-kw)) set)]
;; delete or unlink all orphans
(doseq [orphan (->> current-ds (remove #(saved-ds-ids (get % d-id-kw))))]
(if owned?
(delete! er-config db-spec entity-kw orphan)
(if (not= relation-type :<many>)
(update-fn db-spec (assoc orphan fk-kw nil)))))
(if (= relation-type :<many>)
;; remove all links for m and insert new links
(update-links-fn db-spec m-id saved-ds))
saved-ds)]
(if (-> er-config :entities entity-kw)
;; don't add empty collections for already processed entities
(assoc m relation-kw dependants)
m)))
(defn- persist!
"Invokes either the :update or the :insert function, depending on whether
m is persisted or not."
[er-config db-spec ins-or-up-fn entity-kw id-kw m]
(let [bare-m (without-relations-and-entity er-config entity-kw m)
_ (log "persisting" entity-kw bare-m)
saved-m (ins-or-up-fn db-spec bare-m)]
(assoc m
id-kw (get saved-m id-kw)
::entity entity-kw)))
(defn- save*
"Saves an aggregate data structure to the database."
[er-config db-spec visited entity-kw m]
{:pre [entity-kw (or (nil? m) (map? m))]}
(log "save" entity-kw m)
(when m
(let [entity (-> er-config :entities entity-kw)
id-kw (-> entity :options :id-kw)
id (get m id-kw)]
(if (visited? visited entity-kw id)
m ;; short-circuit, m was processed before
(let [persisted? (-> er-config :options :persisted-pred-fn)
upsert-fn (-> er-config :entities entity-kw :options
(get (if (persisted? db-spec entity-kw id-kw m)
:update-fn
:insert-fn)))
relations (-> entity :relations)
update-fn (-> entity :options :update-fn)
visited (if id
(conj visited [entity-kw id])
visited)
;; first process all records linked with a :one> relation-type
;; because we need their ids as foreign keys in m
m (->> relations
(filter (partial rt? :one>))
(filter (partial rr? er-config))
(reduce (partial save-prerequisite!
er-config db-spec visited update-fn id-kw)
m)
;; this will persist m itself (containing all foreign keys)
(persist! er-config db-spec upsert-fn entity-kw id-kw))]
;; process all other types of relations
;; that require m's id as value for the foreign key
(->> relations
(remove (partial rt? :one>))
(filter #(contains? m (first %)))
(filter (partial rr? er-config))
(reduce (partial save-dependants! er-config db-spec visited id-kw) m)))))))
(defn save!
"Saves an aggregate data structure to the database."
([er-config db-spec m]
(save* er-config db-spec #{} (::entity m) m))
([er-config db-spec entity-kw m]
(save* er-config db-spec #{} entity-kw m)))
;;--------------------------------------------------------------------
;; Delete aggregate
(defn- nil->0
"Returns 0 for a non-number value of n, else n."
[n]
(if (number? n) n 0))
(defn- delete-prerequisite!
"Deletes a record that m points to by a foreign key.
Returns the number of deleted records or nil."
[er-config db-spec m
[relation-kw {:keys [relation-type entity-kw fk-kw owned?]}]]
(log "delete prerequisite" relation-kw "->" entity-kw)
(when owned?
(let [fk-id (get m fk-kw)
child (get m relation-kw)]
(cond
child (delete! er-config db-spec entity-kw child)
fk-id (delete! er-config db-spec entity-kw fk-id)
:else 0))))
(defn- delete-dependants!
"Deletes all records that m contains, and that point by foreign key to m.
Returns the number of deleted records."
[er-config db-spec id-kw m
[relation-kw {:keys [relation-type entity-kw fk-kw update-links-fn owned?]}]]
(log "delete dependants" relation-kw "->" entity-kw)
(let [deleted (if owned?
(->> (get m relation-kw)
(map (partial delete! er-config db-spec entity-kw))
(map nil->0)
(apply +))
(if (= relation-type :<many)
(let [d-id-kw (-> er-config :entities entity-kw :options :id-kw)
update-fn (-> er-config :entities entity-kw :options :update-fn)]
(->> (get m relation-kw)
(map #(update-fn db-spec {d-id-kw (get % d-id-kw) fk-kw nil}))
doall)
0)
0))]
(when (= relation-type :<many>)
(update-links-fn db-spec (get m id-kw) []))
deleted))
(defn delete!
"Removes an aggregate datastructure from the database.
Returns the number of deleted records."
([er-config db-spec m]
{:pre [(::entity m)]}
(delete! er-config db-spec (::entity m) m))
([er-config db-spec entity-kw m-or-id]
(log "delete" entity-kw)
(if m-or-id
(let [id-kw (-> er-config :entities entity-kw :options :id-kw)
delete-fn (-> er-config :entities entity-kw :options :delete-fn)]
(if (map? m-or-id)
(let [;; delete all records that might point to m
deleted-dependants (->> er-config :entities entity-kw :relations
(remove (partial rt? :one>))
(map (partial delete-dependants! er-config db-spec id-kw m-or-id))
(map nil->0)
(apply +))
;; delete the record
deleted-m (nil->0 (delete-fn db-spec (get m-or-id id-kw)))
;; delete all owned records that m points to via foreign key
deleted-prerequisites (->> er-config :entities entity-kw :relations
(filter (partial rt? :one>))
(map (partial delete-prerequisite! er-config db-spec m-or-id))
(map nil->0)
(apply +))]
(+ deleted-dependants deleted-m deleted-prerequisites))
(delete-fn db-spec m-or-id)))
0)))