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

Part 2: Clean up <transact!.

Browse source
This commit is contained in:
Nick Alexander 2016-07-14 12:18:39 -07:00
parent 5202b147ee
commit 3db3edaa64
4 changed files with 83 additions and 151 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

228
src/datomish/db.cljc
View file

@ -9,7 +9,7 @@
[cljs.core.async.macros :refer [go]])) [cljs.core.async.macros :refer [go]]))
(:require (:require
[honeysql.core :as sql] [honeysql.core :as sql]
[datomish.util :as util :refer [raise]] [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.sqlite :as s] [datomish.sqlite :as s]
[datomish.sqlite-schema :as sqlite-schema] [datomish.sqlite-schema :as sqlite-schema]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]] #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
@ -26,6 +26,10 @@
IDB IDB
(close [db] (s/close (.-sqlite-connection db)))) (close [db] (s/close (.-sqlite-connection db))))
(defn db? [x]
(and (satisfies? IDB x)))
;; TODO: implement support for DB parts?
(def tx0 0x2000000) (def tx0 0x2000000)
(defn <with-sqlite-connection [sqlite-connection] (defn <with-sqlite-connection [sqlite-connection]
@ -35,33 +39,23 @@
(map->DB {:sqlite-connection sqlite-connection (map->DB {:sqlite-connection sqlite-connection
:current-tx (atom (dec tx0))}))) ;; TODO: get rid of dec. :current-tx (atom (dec tx0))}))) ;; TODO: get rid of dec.
(defn- #?@(:clj [^Boolean tx-id?] ;; TODO: consider CLJS interop.
:cljs [^boolean tx-id?]) (defn- tx-id? [e]
[e] (= e :db/current-tx))
(or (= e :db/current-tx)
(= e ":db/current-tx"))) ;; for datascript.js interop
(defrecord TxReport [;; db-before db-after ;; TODO: write tx-meta to transaction.
tx-data tempids tx-meta]) (defrecord TxReport [tx-data tempids tx-meta])
#?(:clj
(defmacro cond-let [& clauses]
(when-let [[test expr & rest] clauses]
`(~(if (vector? test) 'if-let 'if) ~test
~expr
(cond-let ~@rest)))))
;; TODO: persist max-tx and max-eid in SQLite.
(defn <allocate-tx [db] (defn <allocate-tx [db]
(go-pair (go-pair
(swap! (:current-tx db) inc))) (swap! (:current-tx db) inc)))
;; TODO: add fancy destructuring.
;; TODO: handle reading.
(deftype Datom [e a v tx added]) (deftype Datom [e a v tx added])
;; printing and reading (defn datom? [x] (instance? Datom x))
;; #datomic/DB {:schema <map>, :datoms <vector of [e a v tx]>}
;; (defn ^Datom datom-from-reader [vec]
;; (apply datom vec))
#?(:clj #?(:clj
(defmethod print-method Datom [^Datom d, ^java.io.Writer w] (defmethod print-method Datom [^Datom d, ^java.io.Writer w]
@ -84,34 +78,31 @@
(raise "Cannot store nil as a value at " at (raise "Cannot store nil as a value at " at
{:error :transact/syntax, :value v, :context at}))) {:error :transact/syntax, :value v, :context at})))
;; TODO: implement schemas.
(defn multival? [db attr] false) (defn multival? [db attr] false)
;; TODO: implement schemas.
(defn ref? [db attr] false) (defn ref? [db attr] false)
(defn <entid [db eid] (defn <entid [db eid]
;; {:pre [(db? db)]} {:pre [(db? db)]}
(go-pair (go-pair
(cond (cond
(number? eid) eid (number? eid)
;; (sequential? eid) eid
;; (cond
;; (not= (count eid) 2) (sequential? eid)
;; (raise "Lookup ref should contain 2 elements: " eid (raise "Lookup ref for entity id not yet supported, got " eid
;; {:error :lookup-ref/syntax, :entity-id eid}) {:error :entity-id/syntax
;; (not (is-attr? db (first eid) :db.unique/identity)) :entity-id eid})
;; (raise "Lookup ref attribute should be marked as :db.unique/identity: " eid
;; {:error :lookup-ref/unique
;; :entity-id eid})
;; (nil? (second eid))
;; nil
;; :else
;; (:e (first (-datoms db :avet eid))))
:else :else
(raise "Expected number or lookup ref for entity id, got " eid (raise "Expected number or lookup ref for entity id, got " eid
{:error :entity-id/syntax {:error :entity-id/syntax
:entity-id eid})))) :entity-id eid}))))
(defn <entid-strict [db eid] (defn <entid-strict [db eid]
{:pre [(db? db)]}
(go-pair (go-pair
(or (<? (<entid db eid)) (or (<? (<entid db eid))
(raise "Nothing found for entity id " eid (raise "Nothing found for entity id " eid
@ -119,6 +110,7 @@
:entity-id eid})))) :entity-id eid}))))
(defn <entid-some [db eid] (defn <entid-some [db eid]
{:pre [(db? db)]}
(go-pair (go-pair
(when eid (when eid
(<? (<entid-strict db eid))))) (<? (<entid-strict db eid)))))
@ -126,22 +118,24 @@
;; TODO: handle _? ;; TODO: handle _?
(defn search->sql-clause [pattern] (defn search->sql-clause [pattern]
(merge (merge
{: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 (if (keyword? %2) (str %2) %2)) [:e :a :v :tx] pattern))} ;; TODO: use schema to intern a and v.
{}))) {})))
(defn <search [db pattern] (defn <search [db pattern]
{:pre [(db? db)]}
(go-pair (go-pair
;; TODO: find a better expression of this pattern. ;; TODO: find a better expression of this pattern.
(let [rows (<? (->> (let [rows (<? (->>
(search->sql-clause pattern) (search->sql-clause pattern)
(sql/format) (sql/format)
(s/all-rows (:sqlite-connection db))))] (s/all-rows (:sqlite-connection db))))]
(map #(Datom. (:e %) (:a %) (:v %) (:tx %) true) rows)))) (mapv #(Datom. (:e %) (:a %) (:v %) (:tx %) true) rows))))
(defn- <transact-report [db report datom] (defn- <transact-report [db report datom]
{:pre [(db? db)]}
(go-pair (go-pair
(let [exec (partial s/execute! (:sqlite-connection db))] (let [exec (partial s/execute! (:sqlite-connection db))]
;; Append to transaction log. ;; Append to transaction log.
@ -154,11 +148,12 @@
["INSERT INTO datoms VALUES (?, ?, ?, ?, 0, 0)" (.-e datom) (str (.-a datom)) (.-v datom) (.-tx datom)])) ["INSERT INTO datoms VALUES (?, ?, ?, ?, 0, 0)" (.-e datom) (str (.-a datom)) (.-v datom) (.-tx datom)]))
(<? (exec (<? (exec
;; TODO: verify this is correct. ;; TODO: verify this is correct.
["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" (.-e datom) (.-a datom) (.-v datom)]))) ["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" (.-e datom) (str (.-a datom)) (.-v datom)])))
(-> report (-> report
(update-in [:tx-data] conj datom))))) (update-in [:tx-data] conj datom)))))
(defn- <transact-add [db report [_ e a v tx :as entity]] (defn- <transact-add [db report [_ e a v tx :as entity]]
{:pre [(db? db)]}
(go-pair (go-pair
(validate-attr a entity) (validate-attr a entity)
(validate-val v entity) (validate-val v entity)
@ -180,6 +175,7 @@
(<? (<transact-report db report datom))))))) (<? (<transact-report db report datom)))))))
(defn- <transact-retract [db report [_ e a v _ :as entity]] ;; TODO: think about retracting with tx. (defn- <transact-retract [db report [_ e a v _ :as entity]] ;; TODO: think about retracting with tx.
{:pre [(db? db)]}
(go-pair (go-pair
(let [tx (:current-tx report)] (let [tx (:current-tx report)]
(if-let [e (<? (<entid db e))] (if-let [e (<? (<entid db e))]
@ -190,9 +186,14 @@
(<? (<transact-report db report (Datom. e a v tx false))) (<? (<transact-report db report (Datom. e a v tx false)))
report)) report))
report)))) report))))
(defn- #?@(:clj [^Boolean neg-number?]
:cljs [^boolean neg-number?])
[x]
(and (number? x) (neg? x)))
(defn <transact-tx-data (defn <transact-tx-data
[db now initial-report initial-es] [db now initial-report initial-es]
{:pre [(db? db)]}
(go-pair (go-pair
(when-not (or (nil? initial-es) (when-not (or (nil? initial-es)
(sequential? initial-es)) (sequential? initial-es))
@ -203,101 +204,49 @@
(let [[entity & entities] es] (let [[entity & entities] es]
(cond (cond
(nil? entity) (nil? entity)
;; We're done! Add transaction datom to the report.
(let [current-tx (:current-tx report)] (let [current-tx (:current-tx report)]
(<? (<transact-report db report (Datom. current-tx :db/txInstant now current-tx true))) (<? (<transact-report db report (Datom. current-tx :db/txInstant now current-tx true)))
(-> report (-> report
(assoc-in [:tempids :db/current-tx] current-tx))) (assoc-in [:tempids :db/current-tx] current-tx)))
;; (map? entity) (map? entity)
;; (let [old-eid (:db/id entity)] (raise "Map entities are not yet supported, got " entity
;; (cond-let {:error :transact/syntax
;; ;; :db/current-tx => tx :op entity })
;; (tx-id? old-eid)
;; (let [id (current-tx report)]
;; (recur (allocate-eid report old-eid id)
;; (cons (assoc entity :db/id id) entities)))
;; ;; lookup-ref => resolved | error
;; (sequential? old-eid)
;; (let [id (entid-strict db old-eid)]
;; (recur report
;; (cons (assoc entity :db/id id) entities)))
;; ;; upserted => explode | error
;; [upserted-eid (upsert-eid db entity)]
;; (if (and (neg-number? old-eid)
;; (contains? (:tempids report) old-eid)
;; (not= upserted-eid (get (:tempids report) old-eid)))
;; (retry-with-tempid initial-report initial-es old-eid upserted-eid)
;; (recur (allocate-eid report old-eid upserted-eid)
;; (concat (explode db (assoc entity :db/id upserted-eid)) entities)))
;; ;; resolved | allocated-tempid | tempid | nil => explode
;; (or (number? old-eid)
;; (nil? old-eid))
;; (let [new-eid (cond
;; (nil? old-eid) (next-eid db)
;; (neg? old-eid) (or (get (:tempids report) old-eid)
;; (next-eid db))
;; :else old-eid)
;; new-entity (assoc entity :db/id new-eid)]
;; (recur (allocate-eid report old-eid new-eid)
;; (concat (explode db new-entity) entities)))
;; ;; trash => error
;; :else
;; (raise "Expected number or lookup ref for :db/id, got " old-eid
;; { :error :entity-id/syntax, :entity entity })))
(sequential? entity) (sequential? entity)
(let [[op e a v] entity] (let [[op e a v] entity]
(cond (cond
;; (= op :db.fn/call) (= op :db.fn/call)
;; (let [[_ f & args] entity] (raise "DataScript's transactor functions are not yet supported, got " entity
;; (recur report (concat (apply f db args) entities))) {:error :transact/syntax
:op entity })
;; (= op :db.fn/cas) (= op :db.fn/cas)
;; (let [[_ e a ov nv] entity (raise "Datomic's compare-and-swap is not yet supported, got " entity
;; e (entid-strict db e) {:error :transact/syntax
;; _ (validate-attr a entity) :op entity })
;; ov (if (ref? db a) (entid-strict db ov) ov)
;; nv (if (ref? db a) (entid-strict db nv) nv)
;; _ (validate-val nv entity)
;; datoms (<searchdb [e a])]
;; (if (multival? db a)
;; (if (some (fn [^Datom d] (= (.-v d) ov)) datoms)
;; (recur (transact-add report [:db/add e a nv]) entities)
;; (raise ":db.fn/cas failed on datom [" e " " a " " (map :v datoms) "], expected " ov
;; {:error :transact/cas, :old datoms, :expected ov, :new nv}))
;; (let [v (:v (first datoms))]
;; (if (= v ov)
;; (recur (transact-add report [:db/add e a nv]) entities)
;; (raise ":db.fn/cas failed on datom [" e " " a " " v "], expected " ov
;; {:error :transact/cas, :old (first datoms), :expected ov, :new nv })))))
(tx-id? e) (tx-id? e)
(recur report (cons [op (:current-tx report) a v] entities)) (recur report (cons [op (:current-tx report) 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 report)] entities))
;; (neg-number? e) (neg-number? e)
;; (if (not= op :db/add) (if (not= op :db/add)
;; (raise "Negative entity ids are resolved for :db/add only" (raise "Negative entity ids are resolved for :db/add only"
;; {:error :transact/syntax {:error :transact/syntax
;; :op entity }) :op entity })
;; (let [upserted-eid (when (is-attr? db a :db.unique/identity) (raise "Negative entity ids are not yet supported, got " entity
;; (:e (first (-datoms db :avet [a v])))) {:error :transact/syntax
;; allocated-eid (get-in report [:tempids e])] :op entity }))
;; (if (and upserted-eid allocated-eid (not= upserted-eid allocated-eid))
;; (retry-with-tempid initial-report initial-es e upserted-eid)
;; (let [eid (or upserted-eid allocated-eid (next-eid db))]
;; (recur (allocate-eid report e eid) (cons [op eid a v] entities))))))
;; (and (ref? db a) (neg-number? v)) (and (ref? db a) (neg-number? v))
;; (if-let [vid (get-in report [:tempids v])] (raise "Negative entity ids are not yet supported, got " entity
;; (recur report (cons [op e a vid] entities)) {:error :transact/syntax
;; (recur (allocate-eid report v (next-eid db)) es)) :op entity })
(= op :db/add) (= op :db/add)
(recur (<? (<transact-add db report entity)) entities) (recur (<? (<transact-add db report entity)) entities)
@ -305,31 +254,24 @@
(= op :db/retract) (= op :db/retract)
(recur (<? (<transact-retract db report entity)) entities) (recur (<? (<transact-retract db report entity)) entities)
;; (= op :db.fn/retractAttribute) (= op :db.fn/retractAttribute)
;; (if-let [e (entid db e)] (raise "DataScript's :db.fn/retractAttribute shortcut is not yet supported, got " entity
;; (let [_ (validate-attr a entity) {:error :transact/syntax
;; datoms (<search db [e a])] :op entity })
;; (recur (reduce transact-retract-datom report datoms)
;; (concat (retract-components db datoms) entities)))
;; (recur report entities))
;; (= op :db.fn/retractEntity) (= op :db.fn/retractEntity)
;; (if-let [e (entid db e)] (raise "Datomic's :db.fn/retractEntity shortcut is not yet supported, got " entity
;; (let [e-datoms (<search db [e]) {:error :transact/syntax
;; v-datoms (mapcat (fn [a] (<search db [nil a e])) (-attrs-by db :db.type/ref))] :op entity })
;; (recur (reduce transact-retract-datom report (concat e-datoms v-datoms))
;; (concat (retract-components db e-datoms) entities)))
;; (recur report entities))
:else :else
(raise "Unknown operation at " entity ", expected :db/add, :db/retract, :db.fn/call, :db.fn/retractAttribute or :db.fn/retractEntity" (raise "Unknown operation at " entity ", expected :db/add, :db/retract, :db.fn/call, :db.fn/retractAttribute or :db.fn/retractEntity"
{:error :transact/syntax, :operation op, :tx-data entity}))) {:error :transact/syntax, :operation op, :tx-data entity})))
;; (datom? entity) (datom? entity)
;; (let [[e a v tx added] entity] (raise "Datom entities are not yet supported, got " entity
;; (if added {:error :transact/syntax
;; (recur (transact-add report [:db/add e a v tx]) entities) :op entity })
;; (recur report (cons [:db/retract e a v] entities))))
:else :else
(raise "Bad entity type at " entity ", expected map or vector" (raise "Bad entity type at " entity ", expected map or vector"
@ -340,7 +282,7 @@
([db tx-data] ([db tx-data]
(<transact! db tx-data nil 0xdeadbeef)) ;; TODO: timestamp! (<transact! db tx-data nil 0xdeadbeef)) ;; TODO: timestamp!
([db tx-data tx-meta now] ([db tx-data tx-meta now]
;; {:pre [(db/db? db)]} {:pre [(db? db)]}
(go-pair (go-pair
(let [current-tx (<? (<allocate-tx db))] (let [current-tx (<? (<allocate-tx db))]
(<? (<transact-tx-data db now (<? (<transact-tx-data db now
@ -349,15 +291,3 @@
:tx-data [] :tx-data []
:tempids {} :tempids {}
:tx-meta tx-meta}) tx-data)))))) :tx-meta tx-meta}) tx-data))))))
#_ (a/<!! (<transact! db []))
#_ .
#_ (def db (<?? (<with-sqlite-connection (<?? (s/<sqlite-connection "/Users/nalexander/test5.db")))))
#_ (<?? (<transact! db [[:db/add 0 1 "test"]]))
#_ (<?? (<transact! db [[:db/retract 0 1 "test"]]))

2
src/datomish/repl.clj
View file

@ -5,7 +5,7 @@
(ns datomish.repl (ns datomish.repl
(:require (:require
[datomish.db :as db] [datomish.db :as db]
[datomish.util :as util :refer [raise]] [datomish.util :as util :refer [raise cond-let]]
[datomish.sqlite :as s] [datomish.sqlite :as s]
[datomish.jdbc-sqlite :as j] [datomish.jdbc-sqlite :as j]
[tempfile.core] [tempfile.core]

2
test/datomish/db_test.cljc
View file

@ -9,7 +9,7 @@
[datomish.node-tempfile-macros :refer [with-tempfile]] [datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]])) [cljs.core.async.macros :as a :refer [go]]))
(:require (:require
[datomish.util :as util :refer [raise]] [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.sqlite :as s] [datomish.sqlite :as s]
[datomish.db :as db] [datomish.db :as db]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]] #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]

2
test/datomish/test.cljs
View file

@ -3,6 +3,7 @@
[doo.runner :refer-macros [doo-tests doo-all-tests]] [doo.runner :refer-macros [doo-tests doo-all-tests]]
[cljs.test :as t :refer-macros [is are deftest testing]] [cljs.test :as t :refer-macros [is are deftest testing]]
datomish.promise-sqlite-test datomish.promise-sqlite-test
datomish.db-test
datomish.sqlite-user-version-test datomish.sqlite-user-version-test
datomish.test.util datomish.test.util
datomish.test.transforms datomish.test.transforms
@ -11,6 +12,7 @@
(doo-tests (doo-tests
'datomish.promise-sqlite-test 'datomish.promise-sqlite-test
'datomish.db-test
'datomish.sqlite-user-version-test 'datomish.sqlite-user-version-test
'datomish.test.util 'datomish.test.util
'datomish.test.transforms 'datomish.test.transforms