-
Notifications
You must be signed in to change notification settings - Fork 5
/
core.cljc
163 lines (141 loc) · 6.35 KB
/
core.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
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
(ns datoms-differ.core
(:require [clojure.set :as set]))
(defn find-identity-attrs [schema]
(set (keep (fn [[k v]]
(when (= :db.unique/identity (:db/unique v))
k))
schema)))
(defn find-attr [schema target-k target-v]
(set (keep (fn [[k v]]
(when (= target-v (target-k v))
k))
schema)))
(defn find-attrs [schema]
{:identity? (find-attr schema :db/unique :db.unique/identity)
:ref? (find-attr schema :db/valueType :db.type/ref)
:many? (find-attr schema :db/cardinality :db.cardinality/many)
:component? (find-attr schema :db/isComponent true)})
(defn get-entity-ref [attrs entity]
(let [refs (select-keys entity (conj (:identity? attrs) :db/id))]
(case (bounded-count 2 refs)
0 (throw (ex-info "Entity without identity attribute"
{:entity entity
:attrs (:identity attrs)}))
1 (first refs)
2 (throw (ex-info "Entity with multiple identity attributes"
{:entity entity
:attrs (:identity attrs)})))))
(defn reverse-ref? [k]
(= \_ (first (name k))))
(defn reverse-ref-attr [k]
(if (reverse-ref? k)
(keyword (namespace k) (subs (name k) 1))
(keyword (namespace k) (str "_" (name k)))))
(defn find-all-entities [{:keys [ref? many? component?] :as attrs} entity-maps]
(->> (mapcat seq entity-maps)
(mapcat (fn [[k v]]
(cond
(ref? k) (find-all-entities attrs (if (many? k) v [v]))
(reverse-ref? k) (let [reverse-k (reverse-ref-attr k)]
(find-all-entities attrs (if (component? reverse-k) [v] v))))))
(into entity-maps)))
(defn create-refs-lookup [old-refs all-refs]
(let [lowest-new-eid (inc (apply max 1023 (vals old-refs)))]
(->> all-refs
(remove old-refs)
(map-indexed (fn [i ref]
(if (= (first ref) :db/id)
[ref (second ref)]
[ref (+ lowest-new-eid i)])))
(into old-refs))))
(defn flatten-entity-map [{:keys [ref? many? component?] :as attrs} refs entity]
(let [eid (refs (get-entity-ref attrs entity))
disallow-nils (fn [k v]
(when (nil? v)
(throw (ex-info "Attributes cannot be nil" {:entity (get-entity-ref attrs entity)
:key k}))))]
(mapcat (fn [[k v]]
(cond
(= k :db/id)
nil ;; db/id is not an attribute so exclude it
(ref? k)
(for [v (if (many? k) v [v])]
(do
(disallow-nils k v)
[eid k (if (number? v)
v
(refs (get-entity-ref attrs v)))]))
(reverse-ref? k)
(let [reverse-k (reverse-ref-attr k)]
(for [ref-entity-map (if (component? reverse-k) [v] v)]
[(refs (get-entity-ref attrs ref-entity-map)) reverse-k eid]))
:else-scalar
(do
(disallow-nils k v)
[[eid k v]])))
entity)))
(defn disallow-conflicting-values [{:keys [many?]} datoms]
(doseq [[[e a] datoms] (group-by #(take 2 %) datoms)]
(when (and (not (many? a))
(< 1 (count datoms)))
(throw (ex-info (str "Conflicting values asserted for entity: " (pr-str datoms)) {})))))
(defn disallow-empty-entities [all-entities datoms refs]
(let [entity-id-has-datoms? (set (map first datoms))
entity-id-is-known-ref? (set (map second refs))]
(doseq [e all-entities]
(when (and (empty? (dissoc e :db/id))
(not (entity-id-has-datoms? (:db/id e)))
(not (entity-id-is-known-ref? (:db/id e))))
(throw (ex-info (str "No attributes asserted for entity: " (pr-str e)) {}))))))
(defn explode [{:keys [schema refs]} entity-maps]
(let [attrs (find-attrs schema)
all-entities (find-all-entities attrs entity-maps)
entity-refs (distinct (map #(get-entity-ref attrs %) all-entities))
new-refs (create-refs-lookup refs entity-refs)
datoms (set (mapcat #(flatten-entity-map attrs new-refs %) all-entities))]
(disallow-conflicting-values attrs datoms)
(disallow-empty-entities all-entities datoms refs)
{:refs new-refs
:datoms datoms}))
(defn diff [datoms-before datoms-after]
(let [new (set/difference datoms-after datoms-before)
old (set/difference datoms-before datoms-after)]
(concat
(for [[e a v] old] [:db/retract e a v])
(for [[e a v] new] [:db/add e a v]))))
(defn empty-db [schema]
{:schema schema
:refs {}
:source-datoms {}})
(defn create-conn [schema]
(atom (empty-db schema)))
(defn get-datoms [db]
(apply set/union #{} (vals (:source-datoms db))))
(defn disallow-conflicting-sources [db new-source-id new-datoms]
(doseq [[old-source-id old-datoms] (:source-datoms db)]
(when (not= old-source-id new-source-id)
(let [source-ea->v (into {} (for [[e a v] old-datoms]
[[e a] v]))]
(doseq [[e a v] new-datoms]
(let [source-v (source-ea->v [e a])]
(when (and source-v (not= source-v v))
(throw (ex-info (str "Conflicting values asserted between sources: "
(pr-str [old-source-id {a source-v}]) " vs "
(pr-str [new-source-id {a v}]))
{:e e :a a :source-values {old-source-id source-v new-source-id v}})))))))))
(defn with [db source entity-maps]
(let [{:keys [datoms refs]} (explode db entity-maps)
_ (disallow-conflicting-sources db source datoms)
db-after (if (-> entity-maps meta :partial-update?)
(update-in (assoc db :refs refs) [:source-datoms source] #(into % datoms))
(assoc-in (assoc db :refs refs) [:source-datoms source] datoms))]
{:tx-data (diff (get-datoms db) (get-datoms db-after))
:db-before db
:db-after db-after}))
(defn transact! [conn source entity-maps]
(let [report (atom nil)]
(swap! conn (fn [db]
(let [r (with db source entity-maps)]
(reset! report r)
(:db-after r))))
@report))