greg/mentat
1
0
Fork 0
Code Issues 294 Pull requests Projects Releases 9 Packages Wiki Activity

Add d/{ident,entid} for mapping between keyword idents and integer entids.

Browse source
This commit is contained in:
Nick Alexander 2016-08-05 13:59:07 -07:00 committed by Richard Newman
parent d687d4221a
commit cfe753a3bd
7 changed files with 107 additions and 88 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
src/datomish/db.cljc
View file

@ -8,6 +8,7 @@
[datomish.pair-chan :refer [go-pair <?]] [datomish.pair-chan :refer [go-pair <?]]
[cljs.core.async.macros :refer [go]])) [cljs.core.async.macros :refer [go]]))
(:require (:require
[clojure.set]
[datomish.query.context :as context] [datomish.query.context :as context]
[datomish.query.projection :as projection] [datomish.query.projection :as projection]
[datomish.query.source :as source] [datomish.query.source :as source]
@ -15,7 +16,6 @@
[datomish.datom :as dd :refer [datom datom? #?@(:cljs [Datom])]] [datomish.datom :as dd :refer [datom datom? #?@(:cljs [Datom])]]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]] [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
[datomish.schema :as ds] [datomish.schema :as ds]
[datomish.schema-changes]
[datomish.sqlite :as s] [datomish.sqlite :as s]
[datomish.sqlite-schema :as sqlite-schema] [datomish.sqlite-schema :as sqlite-schema]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]] #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
@ -74,9 +74,13 @@
[db] [db]
"Return the schema of this database.") "Return the schema of this database.")
(idents (entid
[db] [db ident]
"Return the known idents of this database, as a map from keyword idents to entids.") "Returns the entity id associated with a symbolic keyword, or the id itself if passed.")
(ident
[db eid]
"Returns the keyword associated with an id, or the key itself if passed.")
(current-tx (current-tx
[db] [db]
@ -101,12 +105,12 @@
"Apply datoms to the store.") "Apply datoms to the store.")
(<apply-db-ident-assertions (<apply-db-ident-assertions
[db added-idents] [db added-idents merge]
"Apply added idents to the store.") "Apply added idents to the store, using `merge` as a `merge-with` function.")
(<apply-db-install-assertions (<apply-db-install-assertions
[db fragment] [db fragment merge]
"Apply added schema fragment to the store.") "Apply added schema fragment to the store, using `merge` as a `merge-with` function.")
(<advance-tx (<advance-tx
[db] [db]
@ -140,14 +144,25 @@
] ]
rowid))) rowid)))
(defrecord DB [sqlite-connection schema idents current-tx] (defrecord DB [sqlite-connection schema entids ident-map current-tx]
;; idents is map {ident -> entid} of known idents. See http://docs.datomic.com/identity.html#idents. ;; ident-map maps between keyword idents and integer entids. The set of idents and entids is
;; disjoint, so we represent both directions of the mapping in the same map for simplicity. Also
;; for simplicity, we assume that an entid has at most one associated ident, and vice-versa. See
;; http://docs.datomic.com/identity.html#idents.
IDB IDB
(query-context [db] (context/->Context (source/datoms-source db) nil nil)) (query-context [db] (context/->Context (source/datoms-source db) nil nil))
(schema [db] (.-schema db)) (schema [db] (.-schema db))
(idents [db] (.-idents db)) (entid [db ident]
(if (keyword? ident)
(get (.-ident-map db) ident ident)
ident))
(ident [db eid]
(if-not (keyword? eid)
(get (.-ident-map db) eid eid)
eid))
(current-tx (current-tx
[db] [db]
@ -231,7 +246,7 @@
;; TODO: handle exclusion across transactions here. ;; TODO: handle exclusion across transactions here.
(update db :current-tx inc)))) (update db :current-tx inc))))
(<apply-db-ident-assertions [db added-idents] (<apply-db-ident-assertions [db added-idents merge]
(go-pair (go-pair
(let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol. (let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
exec (partial s/execute! (:sqlite-connection db))] exec (partial s/execute! (:sqlite-connection db))]
@ -239,9 +254,12 @@
(doseq [[ident entid] added-idents] (doseq [[ident entid] added-idents]
(<? (exec (<? (exec
["INSERT INTO idents VALUES (?, ?)" (->SQLite ident) entid])))) ["INSERT INTO idents VALUES (?, ?)" (->SQLite ident) entid]))))
db))
(<apply-db-install-assertions [db fragment] (let [db (update db :ident-map #(merge-with merge % added-idents))
db (update db :ident-map #(merge-with merge % (clojure.set/map-invert added-idents)))]
db)))
(<apply-db-install-assertions [db fragment merge]
(go-pair (go-pair
(let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol. (let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
exec (partial s/execute! (:sqlite-connection db))] exec (partial s/execute! (:sqlite-connection db))]
@ -250,7 +268,12 @@
(doseq [[attr value] attr-map] (doseq [[attr value] attr-map]
(<? (exec (<? (exec
["INSERT INTO schema VALUES (?, ?, ?)" (->SQLite ident) (->SQLite attr) (->SQLite value)]))))) ["INSERT INTO schema VALUES (?, ?, ?)" (->SQLite ident) (->SQLite attr) (->SQLite value)])))))
db))
(let [symbolic-schema (merge-with merge (:symbolic-schema db) fragment)
schema (ds/schema (into {} (map (fn [[k v]] [(entid db k) v]) symbolic-schema)))]
(assoc db
:symbolic-schema symbolic-schema
:schema schema))))
(close-db [db] (s/close (.-sqlite-connection db))) (close-db [db] (s/close (.-sqlite-connection db)))
@ -261,6 +284,23 @@
:cljs :cljs
(.getTime (js/Date.))))) (.getTime (js/Date.)))))
(defn with-ident [db ident entid]
(update db :ident-map #(assoc % ident entid, entid ident)))
(defn db [sqlite-connection idents schema current-tx]
{:pre [(map? idents)
(every? keyword? (keys idents))
(map? schema)
(every? keyword? (keys schema))]}
(let [entid-schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) schema))) ;; TODO: fail if ident missing.
ident-map (into idents (clojure.set/map-invert idents))]
(map->DB
{:sqlite-connection sqlite-connection
:ident-map ident-map
:symbolic-schema schema
:schema entid-schema
:current-tx current-tx})))
;; TODO: factor this into the overall design. ;; TODO: factor this into the overall design.
(defn <?run (defn <?run
"Execute the provided query on the provided DB. "Execute the provided query on the provided DB.

14
src/datomish/db_factory.cljc
View file

@ -97,12 +97,7 @@
(raise "Altering schema attributes is not yet supported, got " new " altering existing schema attribute " old (raise "Altering schema attributes is not yet supported, got " new " altering existing schema attribute " old
{:error :schema/alter-schema :old old :new new}) {:error :schema/alter-schema :old old :new new})
new))] new))]
(-> (db/map->DB (-> (db/db sqlite-connection bootstrap/idents bootstrap/symbolic-schema current-tx)
{:sqlite-connection sqlite-connection
:idents bootstrap/idents
:symbolic-schema bootstrap/symbolic-schema
:schema (ds/schema (into {} (map (fn [[k v]] [(k bootstrap/idents) v]) bootstrap/symbolic-schema))) ;; TODO: fail if ident missing.
:current-tx current-tx})
;; We use <with-internal rather than <transact! to apply the bootstrap transaction ;; We use <with-internal rather than <transact! to apply the bootstrap transaction
;; data but to not follow the regular schema application process. We can't apply the ;; data but to not follow the regular schema application process. We can't apply the
;; schema changes, since the applied datoms would conflict with the bootstrapping ;; schema changes, since the applied datoms would conflict with the bootstrapping
@ -127,9 +122,4 @@
{:error :bootstrap/bad-symbolic-schema, {:error :bootstrap/bad-symbolic-schema,
:new symbolic-schema :old bootstrap/symbolic-schema :new symbolic-schema :old bootstrap/symbolic-schema
}))) })))
(db/map->DB (db/db sqlite-connection idents symbolic-schema (inc current-tx))))))
{:sqlite-connection sqlite-connection
:idents idents
:symbolic-schema symbolic-schema
:schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema))) ;; TODO: fail if ident missing.
:current-tx (inc current-tx)})))))

3
src/datomish/schema_changes.cljc
View file

@ -6,9 +6,6 @@
(:require (:require
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]])) [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]))
(defn- is-install? [db [_ a & _]]
(= a (get-in db [:idents :db.install/attribute])))
(defn datoms->schema-fragment (defn datoms->schema-fragment
"Turn [[:db.part/db :db.install/attribute e] [e :db/ident :attr]] into {:attr {:db/* v}}. "Turn [[:db.part/db :db.install/attribute e] [e :db/ident :attr]] into {:attr {:db/* v}}.

44
src/datomish/transact.cljc
View file

@ -106,11 +106,11 @@
entity)) entity))
(defn maybe-ident->entid [db [op e a v tx :as orig]] (defn maybe-ident->entid [db [op e a v tx :as orig]]
(let [e (get (db/idents db) e e) ;; TODO: use ident, entid here. (let [e (db/entid db e)
a (get (db/idents db) a a) a (db/entid db a)
v (if (ds/kw? (db/schema db) a) ;; TODO: decide if this is best. We could also check for ref and numeric types. v (if (ds/kw? (db/schema db) a) ;; TODO: decide if this is best. We could also check for ref and numeric types.
v v
(get (db/idents db) v v))] (db/entid db v))]
[op e a v tx])) [op e a v tx]))
(defrecord Transaction [db tempids entities]) (defrecord Transaction [db tempids entities])
@ -120,7 +120,7 @@
(let [tx (:tx report) (let [tx (:tx report)
txInstant (:txInstant report)] txInstant (:txInstant report)]
;; n.b., this must not be symbolic -- it's inserted after we map idents -> entids. ;; n.b., this must not be symbolic -- it's inserted after we map idents -> entids.
[:db/add tx (get-in db [:idents :db/txInstant]) txInstant])) [:db/add tx (db/entid db :db/txInstant) txInstant]))
(defn ensure-entity-form [[op e a v & rest :as entity]] (defn ensure-entity-form [[op e a v & rest :as entity]]
(cond (cond
@ -153,8 +153,8 @@
(defn- tx-instant? [db [op e a & _]] (defn- tx-instant? [db [op e a & _]]
(and (= op :db/add) (and (= op :db/add)
(= e (get-in db [:idents :db/tx])) (= (db/entid db e) (db/entid db :db/tx))
(= a (get-in db [:idents :db/txInstant])))) (= (db/entid db a) (db/entid db :db/txInstant))))
(defn- update-txInstant [db report] (defn- update-txInstant [db report]
"Extract [:db/add :db/tx :db/txInstant ...], and update :txInstant with that value." "Extract [:db/add :db/tx :db/txInstant ...], and update :txInstant with that value."
@ -175,7 +175,7 @@
;; to unify all id-literals in :db.part/tx to the current transaction value, but also seems ;; to unify all id-literals in :db.part/tx to the current transaction value, but also seems
;; inconsistent. ;; inconsistent.
tx (:tx report) tx (:tx report)
db* (assoc-in db [:idents :db/tx] tx)] db* (db/with-ident db :db/tx tx)]
(when-not (sequential? initial-es) (when-not (sequential? initial-es)
(raise "Bad transaction data " initial-es ", expected sequential collection" (raise "Bad transaction data " initial-es ", expected sequential collection"
{:error :transact/syntax, :tx-data initial-es})) {:error :transact/syntax, :tx-data initial-es}))
@ -453,7 +453,7 @@
;; Upsert or allocate id-literals. ;; Upsert or allocate id-literals.
(defn- is-ident? [db [_ a & _]] (defn- is-ident? [db [_ a & _]]
(= a (get-in db [:idents :db/ident]))) (= a (db/entid db :db/ident)))
(defn collect-db-ident-assertions (defn collect-db-ident-assertions
"Transactions may add idents, install new partitions, and install new schema attributes. "Transactions may add idents, install new partitions, and install new schema attributes.
@ -486,15 +486,13 @@
{:error :schema/idents {:error :schema/idents
:op ia })))))))) :op ia }))))))))
(defn- symbolicate-datom [db [e a v added]] (defn- symbolicate-datom [db [e a v tx added]]
(let [entids (zipmap (vals (db/idents db)) (keys (db/idents db))) (datom
symbolicate (fn [x] (db/ident db e)
(get entids x x))] (db/ident db a)
(datom (db/ident db v)
(symbolicate e) tx
(symbolicate a) added))
(symbolicate v)
added)))
(defn collect-db-install-assertions (defn collect-db-install-assertions
"Transactions may add idents, install new partitions, and install new schema attributes. "Transactions may add idents, install new partitions, and install new schema attributes.
@ -534,26 +532,18 @@
(collect-db-ident-assertions db) (collect-db-ident-assertions db)
(collect-db-install-assertions db)) (collect-db-install-assertions db))
idents (merge-with merge-ident (:idents db) (:added-idents report))
symbolic-schema (merge-with merge-attr (:symbolic-schema db) (:added-attributes report))
schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema)))
db-after (-> db-after (->
db db
(db/<apply-datoms (:tx-data report)) (db/<apply-datoms (:tx-data report))
(<?) (<?)
(db/<apply-db-ident-assertions (:added-idents report)) (db/<apply-db-ident-assertions (:added-idents report) merge-ident)
(<?) (<?)
(db/<apply-db-install-assertions (:added-attributes report)) (db/<apply-db-install-assertions (:added-attributes report) merge-attr)
(<?) (<?)
;; TODO: abstract this.
(assoc :idents idents
:symbolic-schema symbolic-schema
:schema schema)
(db/<advance-tx) (db/<advance-tx)
(<?))] (<?))]
(-> report (-> report

10
src/datomish/transact/explode.cljc
View file

@ -34,14 +34,14 @@
(declare explode-entity) (declare explode-entity)
(defn- explode-entity-a-v [db entity eid a v] (defn- explode-entity-a-v [db entity eid a v]
;; a should be symbolic at this point. Map it. TODO: use ident/entid to ensure we have a symbolic attr. (let [a (db/ident db a) ;; We expect a to be an ident, but it's legal to provide an entid.
(let [reverse? (reverse-ref? a) a* (db/entid db a)
reverse? (reverse-ref? a)
straight-a (if reverse? (reverse-ref a) a) straight-a (if reverse? (reverse-ref a) a)
straight-a* (get-in db [:idents straight-a] straight-a) straight-a* (db/entid db straight-a)
_ (when (and reverse? (not (ds/ref? (db/schema db) straight-a*))) _ (when (and reverse? (not (ds/ref? (db/schema db) straight-a*)))
(raise "Bad attribute " a ": reverse attribute name requires {:db/valueType :db.type/ref} in schema" (raise "Bad attribute " a ": reverse attribute name requires {:db/valueType :db.type/ref} in schema"
{:error :transact/syntax, :attribute a, :op entity})) {:error :transact/syntax, :attribute a, :op entity}))]
a* (get-in db [:idents a] a)]
(cond (cond
reverse? reverse?
(explode-entity-a-v db entity v straight-a eid) (explode-entity-a-v db entity v straight-a eid)

4
test/datomish/api.cljc
View file

@ -33,3 +33,7 @@
(def id-literal db/id-literal) (def id-literal db/id-literal)
(def db transact/db) (def db transact/db)
(def entid db/entid)
(def ident db/ident)

50
test/datomish/db_test.cljc
View file

@ -14,7 +14,6 @@
[datomish.sqlite :as s] [datomish.sqlite :as s]
[datomish.sqlite-schema] [datomish.sqlite-schema]
[datomish.datom] [datomish.datom]
[datomish.db :as db]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]] #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]] [tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async]] [datomish.test-macros :refer [deftest-async]]
@ -37,35 +36,32 @@
(into {} (map (juxt (comp :idx first) second) (:tempids tx)))) (into {} (map (juxt (comp :idx first) second) (:tempids tx))))
(defn- <datoms-after [db tx] (defn- <datoms-after [db tx]
(let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))] (go-pair
(go-pair (->>
(->> (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx > ?" tx])
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx > ?" tx]) (<?)
(<?) (mapv #(vector (:e %) (d/ident db (:a %)) (:v %)))
(mapv #(vector (:e %) (get entids (:a %) (str "fail" (:a %))) (:v %))) (filter #(not (= :db/txInstant (second %))))
(filter #(not (= :db/txInstant (second %)))) (set))))
(set)))))
(defn- <datoms [db] (defn- <datoms [db]
(<datoms-after db 0)) (<datoms-after db 0))
(defn- <shallow-entity [db eid] (defn- <shallow-entity [db eid]
;; TODO: make this actually be <entity. Handle :db.cardinality/many and :db/isComponent. ;; TODO: make this actually be <entity. Handle :db.cardinality/many and :db/isComponent.
(let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))] (go-pair
(go-pair (->>
(->> (s/all-rows (:sqlite-connection db) ["SELECT a, v FROM datoms WHERE e = ?" eid])
(s/all-rows (:sqlite-connection db) ["SELECT a, v FROM datoms WHERE e = ?" eid]) (<?)
(<?) (mapv #(vector (d/ident db (:a %)) (:v %)))
(mapv #(vector (entids (:a %)) (:v %))) (reduce conj {}))))
(reduce conj {})))))
(defn- <transactions-after [db tx] (defn- <transactions-after [db tx]
(let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))] (go-pair
(go-pair (->>
(->> (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions WHERE tx > ? ORDER BY tx ASC, e, a, v, added" tx])
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions WHERE tx > ? ORDER BY tx ASC, e, a, v, added" tx]) (<?)
(<?) (mapv #(vector (:e %) (d/ident db (:a %)) (:v %) (:tx %) (:added %))))))
(mapv #(vector (:e %) (entids (:a %)) (:v %) (:tx %) (:added %)))))))
(defn- <transactions [db] (defn- <transactions [db]
(<transactions-after db 0)) (<transactions-after db 0))
@ -381,10 +377,12 @@
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [conn (<? (d/<connect t))] (let [conn (<? (d/<connect t))]
(try (try
(is (= :test/ident (d/entid (d/db conn) :test/ident)))
(let [report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/db -1) :db/ident :test/ident]])) (let [report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/db -1) :db/ident :test/ident]]))
db-after (:db-after report) eid (get-in report [:tempids (d/id-literal :db.part/db -1)])]
tx (:tx db-after)] (is (= eid (d/entid (d/db conn) :test/ident)))
(is (= (:test/ident (db/idents db-after)) (get-in report [:tempids (d/id-literal :db.part/db -1)])))) (is (= :test/ident (d/ident (d/db conn) eid))))
;; TODO: This should fail, but doesn't, due to stringification of :test/ident. ;; TODO: This should fail, but doesn't, due to stringification of :test/ident.
;; (is (thrown-with-msg? ;; (is (thrown-with-msg?
@ -417,7 +415,7 @@
tx (:tx db-after)] tx (:tx db-after)]
(testing "New ident is allocated" (testing "New ident is allocated"
(is (some? (get-in db-after [:idents :test/attr])))) (is (some? (d/entid db-after :test/attr))))
(testing "Schema is modified" (testing "Schema is modified"
(is (= (get-in db-after [:symbolic-schema :test/attr]) (is (= (get-in db-after [:symbolic-schema :test/attr])