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

Allow to add new :db/ident mappings.

Browse source
This commit is contained in:
Nick Alexander 2016-07-27 14:30:01 -07:00
parent fbd5863921
commit 661e7ed123
2 changed files with 70 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
src/datomish/db.cljc
View file

@ -527,6 +527,45 @@
;; Upsert or allocate id-literals.
(defn- is-ident? [db [_ a & _]]
(= a (get-in db [:idents :db/ident])))
(defn process-db-idents
"Transactions may add idents, install new partitions, and install new schema attributes.
Handle :db/ident assertions here."
[db tx-data]
{:pre [(db? db)
;; (report? report)
]}
;; TODO: use q to filter the report!
(let [original-db db
original-ident-assertions (filter (partial is-ident? db) tx-data)]
(loop [db original-db
ident-assertions original-ident-assertions]
(let [[ia & ias] ident-assertions]
(cond
(nil? ia)
db
(not (:added ia))
(raise "Retracting a :db/ident is not yet supported, got " ia
{:error :schema/idents
:op ia })
:else
;; Added.
(let [ident (:v ia)]
;; TODO: accept re-assertions?
(when (get-in db [:idents ident])
(raise "Re-asserting a :db/ident is not yet supported, got " ia
{:error :schema/idents
:op ia }))
(if (keyword? ident)
(recur (assoc-in db [:idents ident] (:e ia)) ias)
(raise "Cannot assert a :db/ident with a non-keyword value, got " ia
{:error :schema/idents
:op ia }))))))))
(defn <with [db tx-data]
(go-pair
(let [report (<? (<transact-tx-data db 0xdeadbeef ;; TODO
@ -544,8 +583,9 @@
(<?)
(<advance-tx)
(<?))]
(<?)
(process-db-idents (:tx-data report)))]
(-> report
(assoc-in [:db-after] db-after)))))

29
test/datomish/db_test.cljc
View file

@ -147,3 +147,32 @@
(finally
(<? (dm/close-db db)))))))
(deftest-async test-add-ident
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)
now -1]
(try
(let [report (<? (dm/<transact! conn [[:db/add 44 :db/ident :name]] now))
db-after (:db-after report)
tx (:current-tx db-after)]
(is (= (:name (dm/idents db-after)) 44)))
;; TODO: This should fail, but doesn't, due to stringification of :name.
;; (is (thrown-with-msg?
;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got "
;; (<? (dm/<transact! conn [[:db/retract 44 :db/ident :name]] now))))
;; ;; Renaming looks like retraction and then assertion.
;; (is (thrown-with-msg?
;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got"
;; (<? (dm/<transact! conn [[:db/add 44 :db/ident :other-name]] now))))
;; (is (thrown-with-msg?
;; ExceptionInfo #"Re-asserting a :db/ident is not yet supported, got"
;; (<? (dm/<transact! conn [[:db/add 55 :db/ident :name]] now))))
(finally
(<? (dm/close-db db)))))))