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 <?]]
[cljs.core.async.macros :refer [go]]))
(:require
[clojure.set]
[datomish.query.context :as context]
[datomish.query.projection :as projection]
[datomish.query.source :as source]
@ -15,7 +16,6 @@
[datomish.datom :as dd :refer [datom datom? #?@(:cljs [Datom])]]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
[datomish.schema :as ds]
[datomish.schema-changes]
[datomish.sqlite :as s]
[datomish.sqlite-schema :as sqlite-schema]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
@ -74,9 +74,13 @@
[db]
"Return the schema of this database.")
(idents
[db]
"Return the known idents of this database, as a map from keyword idents to entids.")
(entid
[db ident]
"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
[db]
@ -101,12 +105,12 @@
"Apply datoms to the store.")
(<apply-db-ident-assertions
[db added-idents]
"Apply added idents to the store.")
[db added-idents merge]
"Apply added idents to the store, using `merge` as a `merge-with` function.")
(<apply-db-install-assertions
[db fragment]
"Apply added schema fragment to the store.")
[db fragment merge]
"Apply added schema fragment to the store, using `merge` as a `merge-with` function.")
(<advance-tx
[db]
@ -140,14 +144,25 @@
]
rowid)))
(defrecord DB [sqlite-connection schema idents current-tx]
;; idents is map {ident -> entid} of known idents. See http://docs.datomic.com/identity.html#idents.
(defrecord DB [sqlite-connection schema entids ident-map current-tx]
;; 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
(query-context [db] (context/->Context (source/datoms-source db) nil nil))
(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
[db]
@ -231,7 +246,7 @@
;; TODO: handle exclusion across transactions here.
(update db :current-tx inc))))
(<apply-db-ident-assertions [db added-idents]
(<apply-db-ident-assertions [db added-idents merge]
(go-pair
(let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
exec (partial s/execute! (:sqlite-connection db))]
@ -239,9 +254,12 @@
(doseq [[ident entid] added-idents]
(<? (exec
["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
(let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
exec (partial s/execute! (:sqlite-connection db))]
@ -250,7 +268,12 @@
(doseq [[attr value] attr-map]
(<? (exec
["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)))
@ -261,6 +284,23 @@
:cljs
(.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.
(defn <?run
"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
{:error :schema/alter-schema :old old :new new})
new))]
(-> (db/map->DB
{: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})
(-> (db/db sqlite-connection bootstrap/idents bootstrap/symbolic-schema current-tx)
;; 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
;; schema changes, since the applied datoms would conflict with the bootstrapping
@ -127,9 +122,4 @@
{:error :bootstrap/bad-symbolic-schema,
:new symbolic-schema :old bootstrap/symbolic-schema
})))
(db/map->DB
{: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)})))))
(db/db sqlite-connection idents symbolic-schema (inc current-tx))))))

3
src/datomish/schema_changes.cljc
View file

@ -6,9 +6,6 @@
(:require
[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
"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))
(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.
a (get (db/idents db) a a)
(let [e (db/entid db e)
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
(get (db/idents db) v v))]
(db/entid db v))]
[op e a v tx]))
(defrecord Transaction [db tempids entities])
@ -120,7 +120,7 @@
(let [tx (:tx report)
txInstant (:txInstant report)]
;; 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]]
(cond
@ -153,8 +153,8 @@
(defn- tx-instant? [db [op e a & _]]
(and (= op :db/add)
(= e (get-in db [:idents :db/tx]))
(= a (get-in db [:idents :db/txInstant]))))
(= (db/entid db e) (db/entid db :db/tx))
(= (db/entid db a) (db/entid db :db/txInstant))))
(defn- update-txInstant [db report]
"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
;; inconsistent.
tx (:tx report)
db* (assoc-in db [:idents :db/tx] tx)]
db* (db/with-ident db :db/tx tx)]
(when-not (sequential? initial-es)
(raise "Bad transaction data " initial-es ", expected sequential collection"
{:error :transact/syntax, :tx-data initial-es}))
@ -453,7 +453,7 @@
;; Upsert or allocate id-literals.
(defn- is-ident? [db [_ a & _]]
(= a (get-in db [:idents :db/ident])))
(= a (db/entid db :db/ident)))
(defn collect-db-ident-assertions
"Transactions may add idents, install new partitions, and install new schema attributes.
@ -486,15 +486,13 @@
{:error :schema/idents
:op ia }))))))))
(defn- symbolicate-datom [db [e a v added]]
(let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))
symbolicate (fn [x]
(get entids x x))]
(datom
(symbolicate e)
(symbolicate a)
(symbolicate v)
added)))
(defn- symbolicate-datom [db [e a v tx added]]
(datom
(db/ident db e)
(db/ident db a)
(db/ident db v)
tx
added))
(defn collect-db-install-assertions
"Transactions may add idents, install new partitions, and install new schema attributes.
@ -534,26 +532,18 @@
(collect-db-ident-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
(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)
(<?))]
(-> report

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

@ -34,14 +34,14 @@
(declare explode-entity)
(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 [reverse? (reverse-ref? a)
(let [a (db/ident db a) ;; We expect a to be an ident, but it's legal to provide an entid.
a* (db/entid db a)
reverse? (reverse-ref? 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*)))
(raise "Bad attribute " a ": reverse attribute name requires {:db/valueType :db.type/ref} in schema"
{:error :transact/syntax, :attribute a, :op entity}))
a* (get-in db [:idents a] a)]
{:error :transact/syntax, :attribute a, :op entity}))]
(cond
reverse?
(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 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-schema]
[datomish.datom]
[datomish.db :as db]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async]]
@ -37,35 +36,32 @@
(into {} (map (juxt (comp :idx first) second) (:tempids tx))))
(defn- <datoms-after [db tx]
(let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))]
(go-pair
(->>
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx > ?" tx])
(<?)
(mapv #(vector (:e %) (get entids (:a %) (str "fail" (:a %))) (:v %)))
(filter #(not (= :db/txInstant (second %))))
(set)))))
(go-pair
(->>
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx > ?" tx])
(<?)
(mapv #(vector (:e %) (d/ident db (:a %)) (:v %)))
(filter #(not (= :db/txInstant (second %))))
(set))))
(defn- <datoms [db]
(<datoms-after db 0))
(defn- <shallow-entity [db eid]
;; 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
(->>
(s/all-rows (:sqlite-connection db) ["SELECT a, v FROM datoms WHERE e = ?" eid])
(<?)
(mapv #(vector (entids (:a %)) (:v %)))
(reduce conj {})))))
(go-pair
(->>
(s/all-rows (:sqlite-connection db) ["SELECT a, v FROM datoms WHERE e = ?" eid])
(<?)
(mapv #(vector (d/ident db (:a %)) (:v %)))
(reduce conj {}))))
(defn- <transactions-after [db tx]
(let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))]
(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])
(<?)
(mapv #(vector (:e %) (entids (:a %)) (:v %) (:tx %) (:added %)))))))
(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])
(<?)
(mapv #(vector (:e %) (d/ident db (:a %)) (:v %) (:tx %) (:added %))))))
(defn- <transactions [db]
(<transactions-after db 0))
@ -381,10 +377,12 @@
(with-tempfile [t (tempfile)]
(let [conn (<? (d/<connect t))]
(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]]))
db-after (:db-after report)
tx (:tx db-after)]
(is (= (:test/ident (db/idents db-after)) (get-in report [:tempids (d/id-literal :db.part/db -1)]))))
eid (get-in report [:tempids (d/id-literal :db.part/db -1)])]
(is (= eid (d/entid (d/db conn) :test/ident)))
(is (= :test/ident (d/ident (d/db conn) eid))))
;; TODO: This should fail, but doesn't, due to stringification of :test/ident.
;; (is (thrown-with-msg?
@ -417,7 +415,7 @@
tx (:tx db-after)]
(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"
(is (= (get-in db-after [:symbolic-schema :test/attr])