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

Map valueTypes to SQLite encodings.

Browse source 
In the future, we might add a layer of indirection, hashing values to
avoid duplicating storage, or sorting URLs, or handling fulltext indexed
values differently, or ...
This commit is contained in:
Nick Alexander 2016-07-27 21:15:57 -07:00
parent 43423b7d0a
commit 7a90c43a5a
3 changed files with 96 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

59
src/datomish/db.cljc
View file

@ -70,14 +70,14 @@
[db]
"TODO: document this interface."))
;; TODO: handle _?
(defn search->sql-clause [pattern]
(merge
{:select [:*] ;; e :a :v :tx] ;; TODO: generalize columns.
:from [:datoms]}
(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 process v.
{})))
(defn db? [x]
(and (satisfies? IDB x)))
(defn- row->Datom [schema row]
(let [e (:e row)
a (:a row)
v (:v row)]
(Datom. e a (ds/<-SQLite schema a v) (:tx row) (:added row))))
(defrecord DB [sqlite-connection schema idents current-tx]
;; idents is map {ident -> entid} of known idents. See http://docs.datomic.com/identity.html#idents.
@ -94,33 +94,43 @@
;; TODO: use q for searching? Have q use this for searching for a single pattern?
(<eavt [db pattern]
(let [[e a v tx] pattern
v (and v (ds/->SQLite schema a v))] ;; We assume e and a are always given.
(go-pair
;; TODO: find a better expression of this pattern.
(let [rows (<? (->>
(search->sql-clause pattern)
(->>
{:select [:*] ;; e :a :v :tx] ;; TODO: generalize columns.
:from [:datoms]
:where (cons :and (map #(vector := %1 %2) [:e :a :v :tx] (take-while (comp not nil?) [e a v tx])))} ;; Must drop nils.
(sql/format)
(s/all-rows (:sqlite-connection db))))]
(mapv #(Datom. (:e %) (:a %) (:v %) (:tx %) true) rows)))) ;; TODO: map values according to schema.
(s/all-rows (:sqlite-connection db))
(<?)
(mapv (partial row->Datom (.-schema db))))))) ;; TODO: understand why (schema db) fails.
(<avet [db pattern]
(go-pair
;; TODO: find a better expression of this pattern.
(let [[a v] pattern
rows (<? (->>
v (ds/->SQLite schema a v)]
(go-pair
(->>
{:select [:*] :from [:datoms] :where [:and [:= :a a] [:= :v v]]}
(sql/format)
(s/all-rows (:sqlite-connection db))))]
(mapv #(Datom. (:e %) (:a %) (:v %) (:tx %) true) rows)))) ;; TODO: map values according to schema.
(s/all-rows (:sqlite-connection db))
(<?)
(mapv (partial row->Datom (.-schema db))))))) ;; TODO: understand why (schema db) fails.
(<apply-datoms [db datoms]
(go-pair
(let [exec (partial s/execute! (:sqlite-connection db))]
;; TODO: batch insert, batch delete.
(doseq [datom datoms]
(let [[e a v tx added] datom]
(let [[e a v tx added] datom
v (ds/->SQLite (.-schema db) a v)] ;; TODO: understand why (schema db) fails.
;; Append to transaction log.
(<? (exec
["INSERT INTO transactions VALUES (?, ?, ?, ?, ?)" e a v tx added]))
["INSERT INTO transactions VALUES (?, ?, ?, ?, ?)" e a v tx (if added 1 0)]))
;; Update materialized datom view.
(if (.-added datom)
(<? (exec
@ -144,9 +154,6 @@
(close-db [db] (s/close (.-sqlite-connection db))))
(defn db? [x]
(and (satisfies? IDB x)))
(defprotocol IConnection
(close
[conn]
@ -215,7 +222,7 @@
(defn <idents [sqlite-connection]
(go-pair
(let [rows (<? (->>
{:select [:e :v] :from [:datoms] :where [:= :a ":db/ident"]} ;; TODO: don't stringify?
{:select [:e :v] :from [:datoms] :where [:= :a ":db/ident"]} ;; TODO: use raw entid.
(sql/format)
(s/all-rows sqlite-connection)))]
(into {} (map #(-> {(keyword (:v %)) (:e %)})) rows))))
@ -228,7 +235,7 @@
(go-pair
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
(raise "Could not ensure current SQLite schema version."))
(let [idents (into (<? (<idents sqlite-connection)) {:db/txInstant 100 :db/ident 101 :x 102 :y 103 :name 104 :aka 105})] ;; TODO: pre-populate idents and SQLite tables?
(let [idents (into (<? (<idents sqlite-connection)) {:db/txInstant 100 :db/ident 101 :x 102 :y 103 :name 104 :aka 105 :test/kw 106})] ;; TODO: pre-populate idents and SQLite tables?
(map->DB
{:sqlite-connection sqlite-connection
:idents idents
@ -365,7 +372,7 @@
(vec (for [[op & entity] (:entities report)]
(into [op] (for [field entity]
(if (lookup-ref? field)
(first (<? (<eavt db field))) ;; TODO improve this
(first (<? (<eavt db field))) ;; TODO improve this -- this should be avet, shouldn't it?
field)))))
(assoc-in report [:entities])))) ;; TODO: meta.

27
src/datomish/schema.cljc
View file

@ -83,7 +83,7 @@
;; TODO: consider doing this with a protocol and extending the underlying Clojure(Script) types.
(def value-type-map
{:db.type/ref { :valid? #(and (integer? %) (pos? %)) :->SQLite identity :<-SQLite identity }
:db.type/keyword { :valid? keyword? :->SQLite name :<-SQLite keyword }
:db.type/keyword { :valid? keyword? :->SQLite str :<-SQLite #(keyword (subs % 1)) }
:db.type/string { :valid? string? :->SQLite identity :<-SQLite identity }
:db.type/boolean { :valid? #(instance? Boolean %) :->SQLite #(if % 1 0) :<-SQLite #(if (= % 1) true false) }
:db.type/integer { :valid? integer? :->SQLite identity :<-SQLite identity }
@ -104,6 +104,31 @@
(raise "Unknown attribute " attr ", expected one of " (sorted-set (keys schema))
{:error :schema/valueType, :attribute attr}))))
(defn ->SQLite [schema attr value]
{:pre [(schema? schema)]}
(let [schema (.-schema schema)]
(if-let [valueType (get-in schema [attr :db/valueType])]
(if-let [valid? (get-in value-type-map [valueType :valid?])]
(if (valid? value)
((get-in value-type-map [valueType :->SQLite]) value)
(raise "Invalid value for attribute " attr ", expected " valueType " but got " value
{:error :schema/valueType, :attribute attr, :value value}))
(raise "Unknown valueType for attribute " attr ", expected one of " (sorted-set (keys value-type-map))
{:error :schema/valueType, :attribute attr}))
(raise "Unknown attribute " attr ", expected one of " (sorted-set (keys schema))
{:error :schema/valueType, :attribute attr}))))
(defn <-SQLite [schema attr value]
{:pre [(schema? schema)]}
(let [schema (.-schema schema)]
(if-let [valueType (get-in schema [attr :db/valueType])]
(if-let [<-SQLite (get-in value-type-map [valueType :<-SQLite])]
(<-SQLite value)
(raise "Unknown valueType for attribute " attr ", expected one of " (sorted-set (keys value-type-map))
{:error :schema/valueType, :attribute attr}))
(raise "Unknown attribute " attr ", expected one of " (sorted-set (keys schema))
{:error :schema/valueType, :attribute attr}))))
(defn- validate-schema [schema]
(doseq [[a kv] schema]
(when-not (:db/valueType kv)

32
test/datomish/db_test.cljc
View file

@ -184,3 +184,35 @@
(finally
(<? (dm/close-db db)))))))
(deftest-async test-valueType-keyword
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c
(merge test-schema {:test/kw {:db/unique :db.unique/identity
:db/valueType :db.type/keyword}})))
conn (dm/connection-with-db db)
now -1]
(try
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :test/kw :test/kw1]] now))
eid (get-in report [:tempids (dm/id-literal :db.part/user -1)])]
(is (= (<? (<datoms db))
#{[eid :test/kw ":test/kw1"]})) ;; Value is raw.
(testing "Adding the same value compares existing values correctly."
(<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw1]] now))
(is (= (<? (<datoms db))
#{[eid :test/kw ":test/kw1"]}))) ;; Value is raw.
(testing "Upserting retracts existing value correctly."
(<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw2]] now))
(is (= (<? (<datoms db))
#{[eid :test/kw ":test/kw2"]}))) ;; Value is raw.
(testing "Retracting compares values correctly."
(<? (dm/<transact! conn [[:db/retract eid :test/kw :test/kw2]] now))
(is (= (<? (<datoms db))
#{}))))
(finally
(<? (dm/close-db db)))))))