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

Handle nested maps, sequences in maps, and reverse references.

Browse source
This commit is contained in:
Nick Alexander 2016-08-04 14:01:11 -07:00
parent d9a8cb0d6a
commit 44db8116bf
2 changed files with 158 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

85
src/datomish/db.cljc
View file

@ -477,28 +477,72 @@
true
entity))
(defn explode-entities [schema report]
(let [initial-es (:entities report)
initial-report (assoc report :entities [])]
(loop [report initial-report
es initial-es]
(let [[entity & entities] es]
(cond
(nil? entity)
report
(defn- #?@(:clj [^Boolean reverse-ref?]
:cljs [^boolean reverse-ref?]) [attr]
(if (keyword? attr)
(= \_ (nth (name attr) 0))
(raise "Bad attribute type: " attr ", expected keyword"
{:error :transact/syntax, :attribute attr})))
(map? entity)
;; TODO: reverse refs, lists, nested maps
(if-let [eid (:db/id entity)]
(let [exploded (for [[a v] (dissoc entity :db/id)]
[:db/add eid a v])]
(recur report (concat exploded entities)))
(raise "Map entity missing :db/id, got " entity
{:error :transact/entity-missing-db-id
(defn- reverse-ref [attr]
(if (keyword? attr)
(if (reverse-ref? attr)
(keyword (namespace attr) (subs (name attr) 1))
(keyword (namespace attr) (str "_" (name attr))))
(raise "Bad attribute type: " attr ", expected keyword"
{:error :transact/syntax, :attribute attr})))
(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)
straight-a (if reverse? (reverse-ref a) a)
straight-a* (get-in db [:idents straight-a] straight-a)
_ (when (and reverse? (not (ds/ref? (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)]
(cond
reverse?
(explode-entity-a-v db entity v straight-a eid)
(and (map? v)
(not (id-literal? v)))
;; Another entity is given as a nested map.
(if (ds/ref? (schema db) straight-a*)
(let [other (assoc v (reverse-ref a) eid
;; TODO: make the new ID have the same part as the original eid.
;; TODO: make the new ID not show up in the tempids map. (Does Datomic exposed the new ID this way?)
:db/id (id-literal :db.part/user))]
(explode-entity db other))
(raise "Bad attribute " a ": nested map " v " given but attribute name requires {:db/valueType :db.type/ref} in schema"
{:error :transact/entity-map-type-ref
:op entity }))
(sequential? v)
(if (ds/multival? (schema db) a*) ;; dm/schema
(mapcat (partial explode-entity-a-v db entity eid a) v) ;; Allow sequences of nested maps, etc. This does mean [[1]] will work.
(raise "Sequential values " v " but attribute " a " is :db.cardinality/one"
{:error :transact/entity-sequential-cardinality-one
:op entity }))
true
(recur (util/conj-in report [:entities] entity) entities))))))
[[:db/add eid a* v]])))
(defn- explode-entity [db entity]
(if (map? entity)
(if-let [eid (:db/id entity)]
(mapcat (partial apply explode-entity-a-v db entity eid) (dissoc entity :db/id))
(raise "Map entity missing :db/id, got " entity
{:error :transact/entity-missing-db-id
:op entity }))
[entity]))
(defn explode-entities [db entities]
"Explode map shorthand, such as {:db/id e :attr value :_reverse ref}, to a list of vectors,
like [[:db/add e :attr value] [:db/add ref :reverse e]]."
(mapcat (partial explode-entity db) entities))
(defn maybe-ident->entid [db [op e a v tx :as orig]]
(let [e (get (idents db) e e) ;; TODO: use ident, entid here.
@ -582,10 +626,7 @@
;; Normalize Datoms into :db/add or :db/retract vectors.
(update :entities (partial map maybe-datom->entity))
;; Explode map shorthand, such as {:db/id e :attr value :_reverse ref},
;; to a list of vectors, like
;; [[:db/add e :attr value] [:db/add ref :reverse e]].
(->> (explode-entities (schema db)))
(update :entities (partial explode-entities db))
(update :entities (partial map ensure-entity-form))

93
test/datomish/db_test.cljc
View file

@ -50,6 +50,7 @@
(<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 (dm/idents db)) (keys (dm/idents db)))]
(go-pair
(->>
@ -112,6 +113,11 @@
:db/unique :db.unique/value
:db/valueType :db.type/string}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -8)}
{:db/id (dm/id-literal :test -9)
:db/ident :friends
:db/cardinality :db.cardinality/many
:db/valueType :db.type/ref}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -9)}
])
(deftest-async test-add-one
@ -576,3 +582,90 @@
(finally
(<? (dm/close-db db)))))))
(deftest-async test-explode-sequences
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(try
(testing ":db.cardinality/many sequences are accepted"
(<? (dm/<transact! conn [{:db/id 101 :aka ["first" "second"]}]))
(is (= (<? (<datoms-after (dm/db conn) tx0))
#{[101 :aka "first"]
[101 :aka "second"]})))
(testing ":db.cardinality/many sequences are recursively applied, allowing unexpected sequence nesting"
(<? (dm/<transact! conn [{:db/id 102 :aka [[["first"]] ["second"]]}]))
(is (= (<? (<datoms-after (dm/db conn) tx0))
#{[101 :aka "first"]
[101 :aka "second"]
[102 :aka "first"]
[102 :aka "second"]})))
(testing ":db.cardinality/one sequences fail"
(is (thrown-with-msg?
ExceptionInfo #"Sequential values"
(<? (dm/<transact! conn [{:db/id 101 :email ["@1" "@2"]}])))))
(finally
(<? (dm/close-db db)))))))
(deftest-async test-explode-maps
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(try
(testing "nested maps are accepted"
(<? (dm/<transact! conn [{:db/id 101 :friends {:name "Petr"}}]))
;; TODO: this works only because we have a single friend.
(let [{petr :friends} (<? (<shallow-entity (dm/db conn) 101))]
(is (= (<? (<datoms-after (dm/db conn) tx0))
#{[101 :friends petr]
[petr :name "Petr"]}))))
(testing "recursively nested maps are accepted"
(<? (dm/<transact! conn [{:db/id 102 :friends {:name "Ivan" :friends {:name "Petr"}}}]))
;; This would be much easier with `entity` and lookup refs.
(let [{ivan :friends} (<? (<shallow-entity (dm/db conn) 102))
{petr :friends} (<? (<shallow-entity (dm/db conn) ivan))]
(is (= (<? (<datoms-after (dm/db conn) tx0))
#{[101 :friends petr]
[petr :name "Petr"]
[102 :friends ivan]
[ivan :name "Ivan"]
[ivan :friends petr]}))))
(testing "nested maps without :db.type/ref fail"
(is (thrown-with-msg?
ExceptionInfo #"\{:db/valueType :db.type/ref\}"
(<? (dm/<transact! conn [{:db/id 101 :aka {:name "Petr"}}])))))
(finally
(<? (dm/close-db db)))))))
(deftest-async test-explode-reverse-refs
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(try
(testing "reverse refs are accepted"
(<? (dm/<transact! conn [{:db/id 101 :name "Igor"}]))
(<? (dm/<transact! conn [{:db/id 102 :name "Oleg" :_friends 101}]))
(is (= (<? (<datoms-after (dm/db conn) tx0))
#{[101 :name "Igor"]
[102 :name "Oleg"]
[101 :friends 102]})))
(testing "reverse refs without :db.type/ref fail"
(is (thrown-with-msg?
ExceptionInfo #"\{:db/valueType :db.type/ref\}"
(<? (dm/<transact! conn [{:db/id 101 :_aka 102}])))))
(finally
(<? (dm/close-db db)))))))