Hacky work to support :db/ident.
Still need: entid -> ident on egress. Ability to define set of idents dynamically.
This commit is contained in:
parent
3db3edaa64
commit
f3e1f3ae20
2 changed files with 71 additions and 41 deletions
|
@ -17,13 +17,20 @@
|
||||||
#?@(:cljs [[datomish.pair-chan]
|
#?@(:cljs [[datomish.pair-chan]
|
||||||
[cljs.core.async :as a :refer [<! >!]]])))
|
[cljs.core.async :as a :refer [<! >!]]])))
|
||||||
|
|
||||||
|
;; TODO: split connection and DB, in preparation for a DB-as-values world.
|
||||||
(defprotocol IDB
|
(defprotocol IDB
|
||||||
|
(idents
|
||||||
|
[db]
|
||||||
|
"Return map {ident -> entid} if known idents. See http://docs.datomic.com/identity.html#idents.")
|
||||||
|
|
||||||
(close
|
(close
|
||||||
[db]
|
[db]
|
||||||
"Close this database. Returns a pair channel of [nil error]."))
|
"Close this database. Returns a pair channel of [nil error]."))
|
||||||
|
|
||||||
(defrecord DB [sqlite-connection max-tx]
|
(defrecord DB [sqlite-connection idents max-tx]
|
||||||
IDB
|
IDB
|
||||||
|
(idents [db] @(:idents db))
|
||||||
|
|
||||||
(close [db] (s/close (.-sqlite-connection db))))
|
(close [db] (s/close (.-sqlite-connection db))))
|
||||||
|
|
||||||
(defn db? [x]
|
(defn db? [x]
|
||||||
|
@ -37,6 +44,7 @@
|
||||||
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
|
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
|
||||||
(raise "Could not ensure current SQLite schema version."))
|
(raise "Could not ensure current SQLite schema version."))
|
||||||
(map->DB {:sqlite-connection sqlite-connection
|
(map->DB {:sqlite-connection sqlite-connection
|
||||||
|
:idents (atom {:db/txInstant 100 :x 101 :y 102}) ;; TODO: pre-populate idents and SQLite tables?
|
||||||
:current-tx (atom (dec tx0))}))) ;; TODO: get rid of dec.
|
:current-tx (atom (dec tx0))}))) ;; TODO: get rid of dec.
|
||||||
|
|
||||||
;; TODO: consider CLJS interop.
|
;; TODO: consider CLJS interop.
|
||||||
|
@ -69,8 +77,8 @@
|
||||||
{:error :transact/syntax, :entity-id eid, :context at})))
|
{:error :transact/syntax, :entity-id eid, :context at})))
|
||||||
|
|
||||||
(defn- validate-attr [attr at]
|
(defn- validate-attr [attr at]
|
||||||
(when-not (or (keyword? attr) (string? attr))
|
(when-not (number? attr)
|
||||||
(raise "Bad entity attribute " attr " at " at ", expected keyword or string"
|
(raise "Bad entity attribute " attr " at " at ", expected number"
|
||||||
{:error :transact/syntax, :attribute attr, :context at})))
|
{:error :transact/syntax, :attribute attr, :context at})))
|
||||||
|
|
||||||
(defn- validate-val [v at]
|
(defn- validate-val [v at]
|
||||||
|
@ -91,6 +99,10 @@
|
||||||
(number? eid)
|
(number? eid)
|
||||||
eid
|
eid
|
||||||
|
|
||||||
|
(keyword? eid)
|
||||||
|
;; Turn ident into entid if possible.
|
||||||
|
(get (idents db) eid eid)
|
||||||
|
|
||||||
(sequential? eid)
|
(sequential? eid)
|
||||||
(raise "Lookup ref for entity id not yet supported, got " eid
|
(raise "Lookup ref for entity id not yet supported, got " eid
|
||||||
{:error :entity-id/syntax
|
{:error :entity-id/syntax
|
||||||
|
@ -121,7 +133,7 @@
|
||||||
{:select [:*] ;; e :a :v :tx] ;; TODO: generalize columns.
|
{:select [:*] ;; e :a :v :tx] ;; TODO: generalize columns.
|
||||||
:from [:datoms]}
|
:from [:datoms]}
|
||||||
(if-not (empty? pattern)
|
(if-not (empty? pattern)
|
||||||
{:where (cons :and (map #(vector := %1 (if (keyword? %2) (str %2) %2)) [:e :a :v :tx] pattern))} ;; TODO: use schema to intern a and v.
|
{:where (cons :and (map #(vector := %1 %2) [:e :a :v :tx] pattern))} ;; TODO: use schema to v.
|
||||||
{})))
|
{})))
|
||||||
|
|
||||||
(defn <search [db pattern]
|
(defn <search [db pattern]
|
||||||
|
@ -137,18 +149,20 @@
|
||||||
(defn- <transact-report [db report datom]
|
(defn- <transact-report [db report datom]
|
||||||
{:pre [(db? db)]}
|
{:pre [(db? db)]}
|
||||||
(go-pair
|
(go-pair
|
||||||
(let [exec (partial s/execute! (:sqlite-connection db))]
|
(let [exec (partial s/execute! (:sqlite-connection db))
|
||||||
|
[e a v tx added] [(.-e datom) (.-a datom) (.-v datom) (.-tx datom) (.-added datom)]] ;; TODO: destructuring.
|
||||||
|
(validate-eid e [e a v tx added]) ;; TODO: track original vs. transformed?
|
||||||
;; Append to transaction log.
|
;; Append to transaction log.
|
||||||
(<? (exec
|
(<? (exec
|
||||||
["INSERT INTO transactions VALUES (?, ?, ?, ?, ?)" (.-e datom) (str (.-a datom)) (.-v datom) (.-tx datom) (.-added datom)]))
|
["INSERT INTO transactions VALUES (?, ?, ?, ?, ?)" e a v tx added]))
|
||||||
;; Update materialized datom view.
|
;; Update materialized datom view.
|
||||||
(if (.-added datom)
|
(if (.-added datom)
|
||||||
(<? (exec
|
(<? (exec
|
||||||
;; TODO: use schema to insert correct indexing flags.
|
;; TODO: use schema to insert correct indexing flags.
|
||||||
["INSERT INTO datoms VALUES (?, ?, ?, ?, 0, 0)" (.-e datom) (str (.-a datom)) (.-v datom) (.-tx datom)]))
|
["INSERT INTO datoms VALUES (?, ?, ?, ?, 0, 0)" e a v tx]))
|
||||||
(<? (exec
|
(<? (exec
|
||||||
;; TODO: verify this is correct.
|
;; TODO: verify this is correct.
|
||||||
["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" (.-e datom) (str (.-a datom)) (.-v datom)])))
|
["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" e a v])))
|
||||||
(-> report
|
(-> report
|
||||||
(update-in [:tx-data] conj datom)))))
|
(update-in [:tx-data] conj datom)))))
|
||||||
|
|
||||||
|
@ -201,12 +215,14 @@
|
||||||
{:error :transact/syntax, :tx-data initial-es}))
|
{:error :transact/syntax, :tx-data initial-es}))
|
||||||
(loop [report initial-report
|
(loop [report initial-report
|
||||||
es initial-es]
|
es initial-es]
|
||||||
(let [[entity & entities] es]
|
(let [[entity & entities] es
|
||||||
|
current-tx (:current-tx report)]
|
||||||
(cond
|
(cond
|
||||||
(nil? entity)
|
(nil? entity)
|
||||||
;; We're done! Add transaction datom to the report.
|
;; We're done! Add transaction datom to the report.
|
||||||
(let [current-tx (:current-tx report)]
|
(do
|
||||||
(<? (<transact-report db report (Datom. current-tx :db/txInstant now current-tx true)))
|
;; TODO: don't special case :db/txInstant attribute.
|
||||||
|
(<? (<transact-report db report (Datom. current-tx (get (idents db) :db/txInstant) now current-tx true)))
|
||||||
(-> report
|
(-> report
|
||||||
(assoc-in [:tempids :db/current-tx] current-tx)))
|
(assoc-in [:tempids :db/current-tx] current-tx)))
|
||||||
|
|
||||||
|
@ -218,6 +234,13 @@
|
||||||
(sequential? entity)
|
(sequential? entity)
|
||||||
(let [[op e a v] entity]
|
(let [[op e a v] entity]
|
||||||
(cond
|
(cond
|
||||||
|
(keyword? a)
|
||||||
|
(if-let [entid (get (idents db) a)]
|
||||||
|
(recur report (cons [op e entid v] entities))
|
||||||
|
(raise "No entid found for ident " a
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity}))
|
||||||
|
|
||||||
(= op :db.fn/call)
|
(= op :db.fn/call)
|
||||||
(raise "DataScript's transactor functions are not yet supported, got " entity
|
(raise "DataScript's transactor functions are not yet supported, got " entity
|
||||||
{:error :transact/syntax
|
{:error :transact/syntax
|
||||||
|
@ -229,10 +252,10 @@
|
||||||
:op entity })
|
:op entity })
|
||||||
|
|
||||||
(tx-id? e)
|
(tx-id? e)
|
||||||
(recur report (cons [op (:current-tx report) a v] entities))
|
(recur report (cons [op current-tx a v] entities))
|
||||||
|
|
||||||
(and (ref? db a) (tx-id? v))
|
(and (ref? db a) (tx-id? v))
|
||||||
(recur report (cons [op e a (:current-tx report)] entities))
|
(recur report (cons [op e a current-tx] entities))
|
||||||
|
|
||||||
(neg-number? e)
|
(neg-number? e)
|
||||||
(if (not= op :db/add)
|
(if (not= op :db/add)
|
||||||
|
|
|
@ -37,60 +37,67 @@
|
||||||
|
|
||||||
(deftest-async test-add-one
|
(deftest-async test-add-one
|
||||||
(with-tempfile [t (tempfile)]
|
(with-tempfile [t (tempfile)]
|
||||||
(let [c (<? (s/<sqlite-connection t))
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
db (<? (db/<with-sqlite-connection c))]
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
(try
|
(try
|
||||||
(let [now -1
|
(let [now -1
|
||||||
report (<? (db/<transact! db [[:db/add 0 :a "value"]] nil now))
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
|
report (<? (db/<transact! db [[:db/add 0 :x "valuex"]] nil now))
|
||||||
current-tx (:current-tx report)]
|
current-tx (:current-tx report)]
|
||||||
(is (= current-tx db/tx0))
|
(is (= current-tx db/tx0))
|
||||||
(is (= (<? (<datoms db))
|
(is (= (<? (<datoms db))
|
||||||
[[0 ":a" "value" db/tx0 true]
|
[[0 x "valuex" db/tx0 true]
|
||||||
[db/tx0 ":db/txInstant" now db/tx0 true]]))
|
[db/tx0 txInstant now db/tx0 true]]))
|
||||||
(is (= (<? (<transactions db))
|
(is (= (<? (<transactions db))
|
||||||
[[0 ":a" "value" db/tx0 1] ;; TODO: true, not 1.
|
[[0 x "valuex" db/tx0 1] ;; TODO: true, not 1.
|
||||||
[db/tx0 ":db/txInstant" now db/tx0 1]])))
|
[db/tx0 txInstant now db/tx0 1]])))
|
||||||
(finally
|
(finally
|
||||||
(<? (db/close db)))))))
|
(<? (db/close db)))))))
|
||||||
|
|
||||||
(deftest-async test-add-two
|
(deftest-async test-add-two
|
||||||
(with-tempfile [t (tempfile)]
|
(with-tempfile [t (tempfile)]
|
||||||
(let [c (<? (s/<sqlite-connection t))
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
db (<? (db/<with-sqlite-connection c))]
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
(try
|
(try
|
||||||
(let [now -1
|
(let [now -1
|
||||||
report (<? (db/<transact! db [[:db/add 0 :a "valuea"] [:db/add 1 :b "valueb"]] nil now))
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
|
y (<? (db/<entid db :y)) ;; TODO: convert entids to idents on egress.
|
||||||
|
report (<? (db/<transact! db [[:db/add 0 :x "valuex"] [:db/add 1 :y "valuey"]] nil now))
|
||||||
current-tx (:current-tx report)]
|
current-tx (:current-tx report)]
|
||||||
(is (= current-tx db/tx0))
|
(is (= current-tx db/tx0))
|
||||||
(is (= (<? (<datoms db))
|
(is (= (<? (<datoms db))
|
||||||
[[0 ":a" "valuea" db/tx0 true]
|
[[0 x "valuex" db/tx0 true]
|
||||||
[1 ":b" "valueb" db/tx0 true]
|
[1 y "valuey" db/tx0 true]
|
||||||
[db/tx0 ":db/txInstant" now db/tx0 true]]))
|
[db/tx0 txInstant now db/tx0 true]]))
|
||||||
(is (= (<? (<transactions db))
|
(is (= (<? (<transactions db))
|
||||||
[[0 ":a" "valuea" db/tx0 1] ;; TODO: true, not 1.
|
[[0 x "valuex" db/tx0 1] ;; TODO: true, not 1.
|
||||||
[1 ":b" "valueb" db/tx0 1]
|
[1 y "valuey" db/tx0 1]
|
||||||
[db/tx0 ":db/txInstant" now db/tx0 1]])))
|
[db/tx0 txInstant now db/tx0 1]])))
|
||||||
(finally
|
(finally
|
||||||
(<? (db/close db)))))))
|
(<? (db/close db)))))))
|
||||||
|
|
||||||
;; TODO: test multipe :add and :retract of the same datom in the same transaction.
|
;; TODO: test multipe :add and :retract of the same datom in the same transaction.
|
||||||
(deftest-async test-retract
|
(deftest-async test-retract
|
||||||
(with-tempfile [t (tempfile)]
|
(with-tempfile [t (tempfile)]
|
||||||
(let [c (<? (s/<sqlite-connection t))
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
db (<? (db/<with-sqlite-connection c))]
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
(try
|
(try
|
||||||
(let [now -1
|
(let [now -1
|
||||||
ra (<? (db/<transact! db [[:db/add 0 :a "value"]] nil now))
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
rb (<? (db/<transact! db [[:db/retract 0 :a "value"]] nil now))
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
txa (:current-tx ra)
|
ra (<? (db/<transact! db [[:db/add 0 :x "valuex"]] nil now))
|
||||||
txb (:current-tx rb)]
|
rb (<? (db/<transact! db [[:db/retract 0 :x "valuex"]] nil now))
|
||||||
|
txa (:current-tx ra)
|
||||||
|
txb (:current-tx rb)]
|
||||||
(is (= (<? (<datoms db))
|
(is (= (<? (<datoms db))
|
||||||
[[txa ":db/txInstant" now txa true]
|
[[txa txInstant now txa true]
|
||||||
[txb ":db/txInstant" now txb true]]))
|
[txb txInstant now txb true]]))
|
||||||
(is (= (<? (<transactions db))
|
(is (= (<? (<transactions db))
|
||||||
[[0 ":a" "value" txa 1] ;; TODO: true, not 1.
|
[[0 x "valuex" txa 1] ;; TODO: true, not 1.
|
||||||
[txa ":db/txInstant" -1 txa 1]
|
[txa txInstant -1 txa 1]
|
||||||
[0 ":a" "value" txb 0]
|
[0 x "valuex" txb 0]
|
||||||
[txb ":db/txInstant" -1 txb 1]])))
|
[txb txInstant -1 txb 1]])))
|
||||||
(finally
|
(finally
|
||||||
(<? (db/close db)))))))
|
(<? (db/close db)))))))
|
||||||
|
|
Loading…
Reference in a new issue