Allow to add new :db/ident mappings.
This commit is contained in:
parent
fbd5863921
commit
661e7ed123
2 changed files with 70 additions and 1 deletions
|
@ -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)))))
|
||||
|
||||
|
|
|
@ -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)))))))
|
||||
|
|
Loading…
Reference in a new issue