Compare commits
9 commits
Author | SHA1 | Date | |
---|---|---|---|
|
f163b743fa | ||
|
04e772a5bc | ||
|
b545ddc0e1 | ||
|
54b1d268fa | ||
|
44411f0e94 | ||
|
f3e1f3ae20 | ||
|
3db3edaa64 | ||
|
5202b147ee | ||
|
2b705019a7 |
11 changed files with 575 additions and 67 deletions
|
@ -8,25 +8,346 @@
|
||||||
[datomish.pair-chan :refer [go-pair <?]]
|
[datomish.pair-chan :refer [go-pair <?]]
|
||||||
[cljs.core.async.macros :refer [go]]))
|
[cljs.core.async.macros :refer [go]]))
|
||||||
(:require
|
(:require
|
||||||
[datomish.util :as util :refer [raise]]
|
[honeysql.core :as sql]
|
||||||
|
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
|
||||||
[datomish.sqlite :as s]
|
[datomish.sqlite :as s]
|
||||||
|
[datomish.exec :as de]
|
||||||
|
[datomish.query :as dq]
|
||||||
|
[datomish.transforms :as dt]
|
||||||
[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 <?]]
|
||||||
[clojure.core.async :as a :refer [go <! >!]]])
|
[clojure.core.async :as a :refer [go <! >!]]])
|
||||||
#?@(:cljs [[datomish.pair-chan]
|
#?@(:cljs [[datomish.pair-chan]
|
||||||
[cljs.core.async :as a :refer [<! >!]]])))
|
[cljs.core.async :as a :refer [<! >!]]])))
|
||||||
|
|
||||||
|
;; TODO: split connection and DB, in preparation for a DB-as-values world.
|
||||||
(defprotocol IDB
|
(defprotocol IDB
|
||||||
|
(idents
|
||||||
|
[db]
|
||||||
|
"Return map {ident -> entid} if known idents. See http://docs.datomic.com/identity.html#idents.")
|
||||||
|
|
||||||
(close
|
(close
|
||||||
[db]
|
[db]
|
||||||
"Close this database. Returns a pair channel of [nil error]."))
|
"Close this database. Returns a pair channel of [nil error]."))
|
||||||
|
|
||||||
(defrecord DB [sqlite-connection]
|
(defrecord DB [sqlite-connection idents max-tx]
|
||||||
IDB
|
IDB
|
||||||
(close [db] (close (.-sqlite-connection db))))
|
(idents [db] @(:idents db))
|
||||||
|
|
||||||
|
(close [db] (s/close (.-sqlite-connection db))))
|
||||||
|
|
||||||
|
(defn db? [x]
|
||||||
|
(and (satisfies? IDB x)))
|
||||||
|
|
||||||
|
(defn <q
|
||||||
|
"Execute the provided query on the provided DB.
|
||||||
|
Returns a transduced pair-chan of [[results] err]."
|
||||||
|
[db find]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(let [attribute-transform (fn [a] (get (idents db) a a))
|
||||||
|
constant-transform dt/constant-transform-default
|
||||||
|
initial-context (dq/make-context attribute-transform constant-transform)
|
||||||
|
context (dq/find->into-context initial-context (dq/parse find))
|
||||||
|
row-pair-transducer (dq/row-pair-transducer context (dq/sql-projection context))
|
||||||
|
chan (a/chan 50 row-pair-transducer)]
|
||||||
|
|
||||||
|
(s/<?all-rows (:sqlite-connection db) (dq/context->sql-string context) chan)
|
||||||
|
;; TODO: extract this reducing function lifted to the Maybe monad.
|
||||||
|
(let [g (fn [f [rv re] [v e]]
|
||||||
|
(if re
|
||||||
|
[nil re]
|
||||||
|
(if e
|
||||||
|
[nil e]
|
||||||
|
[(f rv v) nil])))]
|
||||||
|
(go-pair
|
||||||
|
(<? (a/reduce (partial g conj) [[] nil] chan))))))
|
||||||
|
|
||||||
|
;; TODO: implement support for DB parts?
|
||||||
|
(def tx0 0x2000000)
|
||||||
|
|
||||||
(defn <with-sqlite-connection [sqlite-connection]
|
(defn <with-sqlite-connection [sqlite-connection]
|
||||||
(go-pair
|
(go-pair
|
||||||
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
|
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
|
||||||
(raise "Could not ensure current SQLite schema version."))
|
(raise "Could not ensure current SQLite schema version."))
|
||||||
(->DB sqlite-connection)))
|
(map->DB {:sqlite-connection sqlite-connection
|
||||||
|
:idents (atom {:db/txInstant 100 :x 101 :y 102}) ;; TODO: pre-populate idents and SQLite tables?
|
||||||
|
:current-tx (atom (dec tx0))}))) ;; TODO: get rid of dec.
|
||||||
|
|
||||||
|
;; TODO: consider CLJS interop.
|
||||||
|
(defn- tx-id? [e]
|
||||||
|
(= e :db/current-tx))
|
||||||
|
|
||||||
|
;; TODO: write tx-meta to transaction.
|
||||||
|
(defrecord TxReport [tx-data tempids tx-meta])
|
||||||
|
|
||||||
|
;; TODO: persist max-tx and max-eid in SQLite.
|
||||||
|
(defn <allocate-tx [db]
|
||||||
|
(go-pair
|
||||||
|
(swap! (:current-tx db) inc)))
|
||||||
|
|
||||||
|
;; TODO: add fancy destructuring.
|
||||||
|
;; TODO: handle reading.
|
||||||
|
(deftype Datom [e a v tx added])
|
||||||
|
|
||||||
|
(defn datom? [x] (instance? Datom x))
|
||||||
|
|
||||||
|
#?(:clj
|
||||||
|
(defmethod print-method Datom [^Datom d, ^java.io.Writer w]
|
||||||
|
(.write w (str "#datomish/Datom "))
|
||||||
|
(binding [*out* w]
|
||||||
|
(pr [(.-e d) (.-a d) (.-v d) (.-tx d) (.-added d)]))))
|
||||||
|
|
||||||
|
(defn- validate-eid [eid at]
|
||||||
|
(when-not (number? eid)
|
||||||
|
(raise "Bad entity id " eid " at " at ", expected number"
|
||||||
|
{:error :transact/syntax, :entity-id eid, :context at})))
|
||||||
|
|
||||||
|
(defn- validate-attr [attr at]
|
||||||
|
(when-not (number? attr)
|
||||||
|
(raise "Bad entity attribute " attr " at " at ", expected number"
|
||||||
|
{:error :transact/syntax, :attribute attr, :context at})))
|
||||||
|
|
||||||
|
(defn- validate-val [v at]
|
||||||
|
(when (nil? v)
|
||||||
|
(raise "Cannot store nil as a value at " at
|
||||||
|
{:error :transact/syntax, :value v, :context at})))
|
||||||
|
|
||||||
|
;; TODO: implement schemas.
|
||||||
|
(defn multival? [db attr] false)
|
||||||
|
|
||||||
|
;; TODO: implement schemas.
|
||||||
|
(defn ref? [db attr] false)
|
||||||
|
|
||||||
|
(defn <entid [db eid]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(cond
|
||||||
|
(number? eid)
|
||||||
|
eid
|
||||||
|
|
||||||
|
(keyword? eid)
|
||||||
|
;; Turn ident into entid if possible.
|
||||||
|
(get (idents db) eid eid)
|
||||||
|
|
||||||
|
(sequential? eid)
|
||||||
|
(raise "Lookup ref for entity id not yet supported, got " eid
|
||||||
|
{:error :entity-id/syntax
|
||||||
|
:entity-id eid})
|
||||||
|
|
||||||
|
:else
|
||||||
|
(raise "Expected number or lookup ref for entity id, got " eid
|
||||||
|
{:error :entity-id/syntax
|
||||||
|
:entity-id eid}))))
|
||||||
|
|
||||||
|
(defn <entid-strict [db eid]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(or (<? (<entid db eid))
|
||||||
|
(raise "Nothing found for entity id " eid
|
||||||
|
{:error :entity-id/missing
|
||||||
|
:entity-id eid}))))
|
||||||
|
|
||||||
|
(defn <entid-some [db eid]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(when eid
|
||||||
|
(<? (<entid-strict db eid)))))
|
||||||
|
|
||||||
|
;; 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 %2) [:e :a :v :tx] pattern))} ;; TODO: use schema to v.
|
||||||
|
{})))
|
||||||
|
|
||||||
|
(defn <search [db pattern]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
;; TODO: find a better expression of this pattern.
|
||||||
|
(let [rows (<? (->>
|
||||||
|
(search->sql-clause pattern)
|
||||||
|
(sql/format)
|
||||||
|
(s/all-rows (:sqlite-connection db))))]
|
||||||
|
(mapv #(Datom. (:e %) (:a %) (:v %) (:tx %) true) rows))))
|
||||||
|
|
||||||
|
(defn- <transact-report [db report datom]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(let [exec (partial s/execute! (:sqlite-connection db))
|
||||||
|
[e a v tx added] [(.-e datom) (.-a datom) (.-v datom) (.-tx datom) (.-added datom)]] ;; TODO: destructuring.
|
||||||
|
(validate-eid e [e a v tx added]) ;; TODO: track original vs. transformed?
|
||||||
|
;; Append to transaction log.
|
||||||
|
(<? (exec
|
||||||
|
["INSERT INTO transactions VALUES (?, ?, ?, ?, ?)" e a v tx added]))
|
||||||
|
;; Update materialized datom view.
|
||||||
|
(if (.-added datom)
|
||||||
|
(<? (exec
|
||||||
|
;; TODO: use schema to insert correct indexing flags.
|
||||||
|
["INSERT INTO datoms VALUES (?, ?, ?, ?, 0, 0)" e a v tx]))
|
||||||
|
(<? (exec
|
||||||
|
;; TODO: verify this is correct.
|
||||||
|
["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" e a v])))
|
||||||
|
(-> report
|
||||||
|
(update-in [:tx-data] conj datom)))))
|
||||||
|
|
||||||
|
(defn- <transact-add [db report [_ e a v tx :as entity]]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(validate-attr a entity)
|
||||||
|
(validate-val v entity)
|
||||||
|
(let [tx (or tx (:current-tx report))
|
||||||
|
e (<? (<entid-strict db e))
|
||||||
|
v (if (ref? db a) (<? (<entid-strict db v)) v)
|
||||||
|
datom (Datom. e a v tx true)]
|
||||||
|
(if (multival? db a)
|
||||||
|
;; TODO: consider adding a UNIQUE CONSTRAINT and using INSERT OR IGNORE.
|
||||||
|
(if (empty? (<? (<search db [e a v])))
|
||||||
|
(<? (<transact-report db report datom))
|
||||||
|
report)
|
||||||
|
(if-let [^Datom old-datom (first (<? (<search db [e a])))]
|
||||||
|
(if (= (.-v old-datom) v)
|
||||||
|
report
|
||||||
|
(let [ra (<? (<transact-report db report (Datom. e a (.-v old-datom) tx false)))
|
||||||
|
rb (<? (<transact-report db ra datom))]
|
||||||
|
rb)) ;; TODO: express this better.
|
||||||
|
(<? (<transact-report db report datom)))))))
|
||||||
|
|
||||||
|
(defn- <transact-retract [db report [_ e a v _ :as entity]] ;; TODO: think about retracting with tx.
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(let [tx (:current-tx report)]
|
||||||
|
(if-let [e (<? (<entid db e))]
|
||||||
|
(let [v (if (ref? db a) (<? (<entid-strict db v)) v)]
|
||||||
|
(validate-attr a entity)
|
||||||
|
(validate-val v entity)
|
||||||
|
(if-let [old-datom (first (<? (<search db [e a v])))]
|
||||||
|
(<? (<transact-report db report (Datom. e a v tx false)))
|
||||||
|
report))
|
||||||
|
report))))
|
||||||
|
(defn- #?@(:clj [^Boolean neg-number?]
|
||||||
|
:cljs [^boolean neg-number?])
|
||||||
|
[x]
|
||||||
|
(and (number? x) (neg? x)))
|
||||||
|
|
||||||
|
(defn <transact-tx-data
|
||||||
|
[db now initial-report initial-es]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(when-not (or (nil? initial-es)
|
||||||
|
(sequential? initial-es))
|
||||||
|
(raise "Bad transaction data " initial-es ", expected sequential collection"
|
||||||
|
{:error :transact/syntax, :tx-data initial-es}))
|
||||||
|
(loop [report initial-report
|
||||||
|
es initial-es]
|
||||||
|
(let [[entity & entities] es
|
||||||
|
current-tx (:current-tx report)]
|
||||||
|
(cond
|
||||||
|
(nil? entity)
|
||||||
|
;; We're done! Add transaction datom to the report.
|
||||||
|
(do
|
||||||
|
;; TODO: don't special case :db/txInstant attribute.
|
||||||
|
(<? (<transact-report db report (Datom. current-tx (get (idents db) :db/txInstant) now current-tx true)))
|
||||||
|
(-> report
|
||||||
|
(assoc-in [:tempids :db/current-tx] current-tx)))
|
||||||
|
|
||||||
|
(map? entity)
|
||||||
|
(raise "Map entities are not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
(sequential? entity)
|
||||||
|
(let [[op e a v] entity]
|
||||||
|
(cond
|
||||||
|
(keyword? a)
|
||||||
|
(if-let [entid (get (idents db) a)]
|
||||||
|
(recur report (cons [op e entid v] entities))
|
||||||
|
(raise "No entid found for ident " a
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity}))
|
||||||
|
|
||||||
|
(= op :db.fn/call)
|
||||||
|
(raise "DataScript's transactor functions are not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
(= op :db.fn/cas)
|
||||||
|
(raise "Datomic's compare-and-swap is not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
(tx-id? e)
|
||||||
|
(recur report (cons [op current-tx a v] entities))
|
||||||
|
|
||||||
|
(and (ref? db a) (tx-id? v))
|
||||||
|
(recur report (cons [op e a current-tx] entities))
|
||||||
|
|
||||||
|
(neg-number? e)
|
||||||
|
(if (not= op :db/add)
|
||||||
|
(raise "Negative entity ids are resolved for :db/add only"
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
(raise "Negative entity ids are not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity }))
|
||||||
|
|
||||||
|
(and (ref? db a) (neg-number? v))
|
||||||
|
(raise "Negative entity ids are not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
(= op :db/add)
|
||||||
|
(recur (<? (<transact-add db report entity)) entities)
|
||||||
|
|
||||||
|
(= op :db/retract)
|
||||||
|
(recur (<? (<transact-retract db report entity)) entities)
|
||||||
|
|
||||||
|
(= op :db.fn/retractAttribute)
|
||||||
|
(raise "DataScript's :db.fn/retractAttribute shortcut is not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
(= op :db.fn/retractEntity)
|
||||||
|
(raise "Datomic's :db.fn/retractEntity shortcut is not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
:else
|
||||||
|
(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})))
|
||||||
|
|
||||||
|
(datom? entity)
|
||||||
|
(raise "Datom entities are not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
:else
|
||||||
|
(raise "Bad entity type at " entity ", expected map or vector"
|
||||||
|
{:error :transact/syntax, :tx-data entity})
|
||||||
|
)))))
|
||||||
|
|
||||||
|
(defn <process-db-part
|
||||||
|
"Transactions may add idents, install new partitions, and install new schema attributes. Handle
|
||||||
|
them, atomically, here."
|
||||||
|
[db report]
|
||||||
|
(go-pair
|
||||||
|
nil))
|
||||||
|
|
||||||
|
(defn <transact!
|
||||||
|
([db tx-data]
|
||||||
|
(<transact! db tx-data nil 0xdeadbeef)) ;; TODO: timestamp!
|
||||||
|
([db tx-data tx-meta now]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(s/in-transaction!
|
||||||
|
(:sqlite-connection db)
|
||||||
|
#(go-pair
|
||||||
|
(let [current-tx (<? (<allocate-tx db))
|
||||||
|
report (<? (<transact-tx-data db now
|
||||||
|
(map->TxReport
|
||||||
|
{:current-tx current-tx
|
||||||
|
:tx-data []
|
||||||
|
:tempids {}
|
||||||
|
:tx-meta tx-meta}) tx-data))]
|
||||||
|
(<? (<process-db-part db report))
|
||||||
|
report)))))
|
||||||
|
|
|
@ -31,7 +31,8 @@
|
||||||
Returns a transduced channel of [result err] pairs.
|
Returns a transduced channel of [result err] pairs.
|
||||||
Closes the channel when fully consumed."
|
Closes the channel when fully consumed."
|
||||||
[db find]
|
[db find]
|
||||||
(let [context (dq/find->prepared-context (dq/parse find))
|
(let [initial-context (dq/make-context)
|
||||||
|
context (dq/find->into-context initial-context (dq/parse find))
|
||||||
row-pair-transducer (dq/row-pair-transducer context (dq/sql-projection context))
|
row-pair-transducer (dq/row-pair-transducer context (dq/sql-projection context))
|
||||||
chan (chan 50 row-pair-transducer)]
|
chan (chan 50 row-pair-transducer)]
|
||||||
|
|
||||||
|
|
|
@ -31,7 +31,7 @@
|
||||||
(when-let [v (clojure.core.async/<!! channel)]
|
(when-let [v (clojure.core.async/<!! channel)]
|
||||||
(if (second v)
|
(if (second v)
|
||||||
(cons v nil)
|
(cons v nil)
|
||||||
(cons v (channel->lazy-seq channel)))))))
|
(cons v (pair-channel->lazy-seq channel)))))))
|
||||||
|
|
||||||
#?(:clj
|
#?(:clj
|
||||||
(defn run-to-pair-seq
|
(defn run-to-pair-seq
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
|
|
||||||
(ns datomish.query
|
(ns datomish.query
|
||||||
(:require
|
(:require
|
||||||
[datomish.util :as util :refer [raise var->sql-var]]
|
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
|
||||||
[datomish.transforms :as transforms]
|
[datomish.transforms :as transforms]
|
||||||
[datascript.parser :as dp
|
[datascript.parser :as dp
|
||||||
#?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
|
#?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
|
||||||
|
@ -52,10 +52,16 @@
|
||||||
(or (-> context :bindings variable first)
|
(or (-> context :bindings variable first)
|
||||||
(raise (str "Couldn't find variable " variable))))
|
(raise (str "Couldn't find variable " variable))))
|
||||||
|
|
||||||
(defn make-context []
|
(defn make-context
|
||||||
(->Context [] {} [] []
|
([]
|
||||||
transforms/attribute-transform-string
|
(make-context transforms/attribute-transform-string transforms/constant-transform-default))
|
||||||
transforms/constant-transform-default))
|
([attribute-transform constant-transform]
|
||||||
|
(map->Context {:from []
|
||||||
|
:bindings {}
|
||||||
|
:wheres []
|
||||||
|
:elements []
|
||||||
|
:attribute-transform attribute-transform
|
||||||
|
:constant-transform constant-transform})))
|
||||||
|
|
||||||
(defn apply-pattern-to-context
|
(defn apply-pattern-to-context
|
||||||
"Transform a DataScript Pattern instance into the parts needed
|
"Transform a DataScript Pattern instance into the parts needed
|
||||||
|
@ -127,10 +133,10 @@
|
||||||
(defn apply-elements-to-context [context elements]
|
(defn apply-elements-to-context [context elements]
|
||||||
(assoc context :elements elements))
|
(assoc context :elements elements))
|
||||||
|
|
||||||
(defn patterns->context
|
(defn patterns->into-context
|
||||||
"Turn a sequence of patterns into a Context."
|
"Reduce a sequence of patterns into a Context."
|
||||||
[patterns]
|
[context patterns]
|
||||||
(reduce apply-pattern-to-context (make-context) patterns))
|
(reduce apply-pattern-to-context context patterns))
|
||||||
|
|
||||||
(defn sql-projection
|
(defn sql-projection
|
||||||
"Take a `find` clause's `:elements` list and turn it into a SQL
|
"Take a `find` clause's `:elements` list and turn it into a SQL
|
||||||
|
@ -157,7 +163,7 @@
|
||||||
(raise "Unable to :find non-variables."))
|
(raise "Unable to :find non-variables."))
|
||||||
(map (fn [elem]
|
(map (fn [elem]
|
||||||
(let [var (:symbol elem)]
|
(let [var (:symbol elem)]
|
||||||
[(lookup-variable context var) (var->sql-var var)]))
|
[(lookup-variable context var) (util/var->sql-var var)]))
|
||||||
elements)))
|
elements)))
|
||||||
|
|
||||||
(defn row-pair-transducer [context projection]
|
(defn row-pair-transducer [context projection]
|
||||||
|
@ -170,11 +176,12 @@
|
||||||
[(map row columns-in-order) nil])))))
|
[(map row columns-in-order) nil])))))
|
||||||
|
|
||||||
(defn context->sql-clause [context]
|
(defn context->sql-clause [context]
|
||||||
|
(merge
|
||||||
{:select (sql-projection context)
|
{:select (sql-projection context)
|
||||||
:from (:from context)
|
:from (:from context)}
|
||||||
:where (if (empty? (:wheres context))
|
(if (empty? (:wheres context))
|
||||||
nil
|
{}
|
||||||
(cons :and (:wheres context)))})
|
{:where (cons :and (:wheres context))})))
|
||||||
|
|
||||||
(defn context->sql-string [context]
|
(defn context->sql-string [context]
|
||||||
(->
|
(->
|
||||||
|
@ -191,7 +198,8 @@
|
||||||
(= "$" (name (-> in first :variable :symbol))))
|
(= "$" (name (-> in first :variable :symbol))))
|
||||||
(raise (str "Complex `in` not supported: " (print-str in)))))
|
(raise (str "Complex `in` not supported: " (print-str in)))))
|
||||||
|
|
||||||
(defn find->prepared-context [find]
|
(defn find->into-context [context find]
|
||||||
|
"TODO"
|
||||||
;; There's some confusing use of 'where' and friends here. That's because
|
;; There's some confusing use of 'where' and friends here. That's because
|
||||||
;; the parsed Datalog includes :where, and it's also input to honeysql's
|
;; the parsed Datalog includes :where, and it's also input to honeysql's
|
||||||
;; SQL formatter.
|
;; SQL formatter.
|
||||||
|
@ -200,24 +208,26 @@
|
||||||
(validate-in in)
|
(validate-in in)
|
||||||
(apply-elements-to-context
|
(apply-elements-to-context
|
||||||
(expand-where-from-bindings
|
(expand-where-from-bindings
|
||||||
(patterns->context where)) ; 'where' here is the Datalog :where clause.
|
(patterns->into-context context where)) ; 'where' here is the Datalog :where clause.
|
||||||
(:elements find))))
|
(:elements find))))
|
||||||
|
|
||||||
(defn find->sql-clause
|
(defn find->sql-clause
|
||||||
"Take a parsed `find` expression and turn it into a structured SQL
|
"Take a parsed `find` expression and turn it into a structured SQL
|
||||||
expression that can be formatted by honeysql."
|
expression that can be formatted by honeysql."
|
||||||
[find]
|
[context find]
|
||||||
;; There's some confusing use of 'where' and friends here. That's because
|
;; There's some confusing use of 'where' and friends here. That's because
|
||||||
;; the parsed Datalog includes :where, and it's also input to honeysql's
|
;; the parsed Datalog includes :where, and it's also input to honeysql's
|
||||||
;; SQL formatter.
|
;; SQL formatter.
|
||||||
(-> find find->prepared-context context->sql-clause))
|
(->> find
|
||||||
|
(find->into-context context)
|
||||||
|
context->sql-clause))
|
||||||
|
|
||||||
(defn find->sql-string
|
(defn find->sql-string
|
||||||
"Take a parsed `find` expression and turn it into SQL."
|
"Take a parsed `find` expression and turn it into SQL."
|
||||||
[find]
|
[context find]
|
||||||
(->
|
(->>
|
||||||
find
|
find
|
||||||
find->sql-clause
|
(find->sql-clause context)
|
||||||
(sql/format :quoting sql-quoting-style)))
|
(sql/format :quoting sql-quoting-style)))
|
||||||
|
|
||||||
(defn parse
|
(defn parse
|
||||||
|
|
41
src/datomish/repl.clj
Normal file
41
src/datomish/repl.clj
Normal file
|
@ -0,0 +1,41 @@
|
||||||
|
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||||
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||||
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||||
|
|
||||||
|
(ns datomish.repl
|
||||||
|
(:require
|
||||||
|
[datomish.db :as db]
|
||||||
|
[datomish.util :as util :refer [raise cond-let]]
|
||||||
|
[datomish.sqlite :as s]
|
||||||
|
[datomish.jdbc-sqlite :as j]
|
||||||
|
[tempfile.core]
|
||||||
|
[datomish.pair-chan :refer [go-pair <?]]
|
||||||
|
[clojure.core.async :as a :refer [go <! >! <!! >!!]]))
|
||||||
|
|
||||||
|
(defn <?? [pair-chan]
|
||||||
|
(datomish.pair-chan/consume-pair (<!! pair-chan)))
|
||||||
|
|
||||||
|
(defn debug-db [db]
|
||||||
|
(<??
|
||||||
|
(go-pair
|
||||||
|
(let [ds (<? (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms"]))]
|
||||||
|
(println (count ds) "datoms.")
|
||||||
|
(doseq [d ds] (println d)))
|
||||||
|
(let [ts (<? (s/all-rows (:sqlite-connection db) ["SELECT * FROM transactions"]))]
|
||||||
|
(println (count ts) "transactions.")
|
||||||
|
(doseq [t ts] (println t)))))
|
||||||
|
db)
|
||||||
|
|
||||||
|
(defn reset-db! [db]
|
||||||
|
(<??
|
||||||
|
(go-pair
|
||||||
|
(<? (s/execute! (:sqlite-connection db) ["DELETE FROM datoms"]))
|
||||||
|
(<? (s/execute! (:sqlite-connection db) ["DELETE FROM transactions"]))))
|
||||||
|
db)
|
||||||
|
|
||||||
|
(defn db-with [datoms]
|
||||||
|
(go-pair
|
||||||
|
(let [c (<? (s/<sqlite-connection (tempfile.core/tempfile)))
|
||||||
|
d (<? (db/<with-sqlite-connection c))]
|
||||||
|
(<? (db/<transact! d datoms))
|
||||||
|
d)))
|
|
@ -8,7 +8,7 @@
|
||||||
[datomish.pair-chan :refer [go-pair <?]]
|
[datomish.pair-chan :refer [go-pair <?]]
|
||||||
[cljs.core.async.macros :refer [go]]))
|
[cljs.core.async.macros :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]
|
||||||
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
|
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
|
||||||
[clojure.core.async :refer [go <! >!]]])
|
[clojure.core.async :refer [go <! >!]]])
|
||||||
|
@ -24,7 +24,7 @@
|
||||||
"CREATE INDEX avet ON datoms (a, v, e) WHERE index_avet = 1" ;; Opt-in index: only if a has :db/index true.
|
"CREATE INDEX avet ON datoms (a, v, e) WHERE index_avet = 1" ;; Opt-in index: only if a has :db/index true.
|
||||||
"CREATE INDEX vaet ON datoms (v, a, e) WHERE index_vaet = 1" ;; Opt-in index: only if a has :db/valueType :db.type/ref
|
"CREATE INDEX vaet ON datoms (v, a, e) WHERE index_vaet = 1" ;; Opt-in index: only if a has :db/valueType :db.type/ref
|
||||||
"CREATE TABLE transactions (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL, added TINYINT NOT NULL DEFAULT 1)"
|
"CREATE TABLE transactions (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL, added TINYINT NOT NULL DEFAULT 1)"
|
||||||
"CREATE INDEX tx ON transactions (tx)"
|
"CREATE INDEX tx ON transactions (tx, e, a)" ;; Allow to find a previous value relatively efficiently.
|
||||||
"CREATE TABLE attributes (name TEXT NOT NULL PRIMARY KEY, a INTEGER UNIQUE NOT NULL)"])
|
"CREATE TABLE attributes (name TEXT NOT NULL PRIMARY KEY, a INTEGER UNIQUE NOT NULL)"])
|
||||||
|
|
||||||
(defn <create-current-version
|
(defn <create-current-version
|
||||||
|
@ -42,7 +42,7 @@
|
||||||
{:pre [(> from-version 0)]} ;; Or we'd create-current-version instead.
|
{:pre [(> from-version 0)]} ;; Or we'd create-current-version instead.
|
||||||
{:pre [(< from-version current-version)]} ;; Or we wouldn't need to update-from-version.
|
{:pre [(< from-version current-version)]} ;; Or we wouldn't need to update-from-version.
|
||||||
(go-pair
|
(go-pair
|
||||||
(raise "No migrations yet defioned!")
|
(raise "No migrations yet defined!")
|
||||||
(<? (s/set-user-version db current-version))
|
(<? (s/set-user-version db current-version))
|
||||||
(<? (s/get-user-version db))))
|
(<? (s/get-user-version db))))
|
||||||
|
|
||||||
|
|
|
@ -3,12 +3,22 @@
|
||||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||||
|
|
||||||
(ns datomish.util
|
(ns datomish.util
|
||||||
|
#?(:cljs (:require-macros datomish.util))
|
||||||
(:require
|
(:require
|
||||||
[clojure.string :as str]))
|
[clojure.string :as str]))
|
||||||
|
|
||||||
(defn raise [s]
|
#?(:clj
|
||||||
#?(:clj (throw (Exception. s)))
|
(defmacro raise [& fragments]
|
||||||
#?(:cljs (throw (js/Error s))))
|
(let [msgs (butlast fragments)
|
||||||
|
data (last fragments)]
|
||||||
|
`(throw (ex-info (str ~@(map (fn [m#] (if (string? m#) m# (list 'pr-str m#))) msgs)) ~data)))))
|
||||||
|
|
||||||
|
#?(:clj
|
||||||
|
(defmacro cond-let [& clauses]
|
||||||
|
(when-let [[test expr & rest] clauses]
|
||||||
|
`(~(if (vector? test) 'if-let 'if) ~test
|
||||||
|
~expr
|
||||||
|
(cond-let ~@rest)))))
|
||||||
|
|
||||||
(defn var->sql-var
|
(defn var->sql-var
|
||||||
"Turns '?xyz into :xyz."
|
"Turns '?xyz into :xyz."
|
||||||
|
|
123
test/datomish/db_test.cljc
Normal file
123
test/datomish/db_test.cljc
Normal file
|
@ -0,0 +1,123 @@
|
||||||
|
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||||
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||||
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||||
|
|
||||||
|
(ns datomish.db-test
|
||||||
|
#?(:cljs
|
||||||
|
(:require-macros
|
||||||
|
[datomish.pair-chan :refer [go-pair <?]]
|
||||||
|
[datomish.node-tempfile-macros :refer [with-tempfile]]
|
||||||
|
[cljs.core.async.macros :as a :refer [go]]))
|
||||||
|
(:require
|
||||||
|
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
|
||||||
|
[datomish.sqlite :as s]
|
||||||
|
[datomish.db :as db]
|
||||||
|
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
|
||||||
|
[tempfile.core :refer [tempfile with-tempfile]]
|
||||||
|
[datomish.test-macros :refer [deftest-async]]
|
||||||
|
[clojure.test :as t :refer [is are deftest testing]]
|
||||||
|
[clojure.core.async :refer [go <! >!]]])
|
||||||
|
#?@(:cljs [[datomish.pair-chan]
|
||||||
|
[datomish.test-macros :refer-macros [deftest-async]]
|
||||||
|
[datomish.node-tempfile :refer [tempfile]]
|
||||||
|
[cljs.test :as t :refer-macros [is are deftest testing async]]
|
||||||
|
[cljs.core.async :as a :refer [<! >!]]])))
|
||||||
|
|
||||||
|
(defn <datoms [db]
|
||||||
|
(go-pair
|
||||||
|
(->>
|
||||||
|
(<? (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms ORDER BY tx ASC, e, a, v"]))
|
||||||
|
(mapv #(vector (:e %) (:a %) (:v %) (:tx %) true)))))
|
||||||
|
|
||||||
|
(defn <transactions [db]
|
||||||
|
(go-pair
|
||||||
|
(->>
|
||||||
|
(<? (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions ORDER BY tx ASC, e, a, v, added"]))
|
||||||
|
(mapv #(vector (:e %) (:a %) (:v %) (:tx %) (:added %))))))
|
||||||
|
|
||||||
|
(deftest-async test-add-one
|
||||||
|
(with-tempfile [t (tempfile)]
|
||||||
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
|
(try
|
||||||
|
(let [now -1
|
||||||
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
|
report (<? (db/<transact! db [[:db/add 0 :x "valuex"]] nil now))
|
||||||
|
current-tx (:current-tx report)]
|
||||||
|
(is (= current-tx db/tx0))
|
||||||
|
(is (= (<? (<datoms db))
|
||||||
|
[[0 x "valuex" db/tx0 true]
|
||||||
|
[db/tx0 txInstant now db/tx0 true]]))
|
||||||
|
(is (= (<? (<transactions db))
|
||||||
|
[[0 x "valuex" db/tx0 1] ;; TODO: true, not 1.
|
||||||
|
[db/tx0 txInstant now db/tx0 1]])))
|
||||||
|
(finally
|
||||||
|
(<? (db/close db)))))))
|
||||||
|
|
||||||
|
(deftest-async test-add-two
|
||||||
|
(with-tempfile [t (tempfile)]
|
||||||
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
|
(try
|
||||||
|
(let [now -1
|
||||||
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
|
y (<? (db/<entid db :y)) ;; TODO: convert entids to idents on egress.
|
||||||
|
report (<? (db/<transact! db [[:db/add 0 :x "valuex"] [:db/add 1 :y "valuey"]] nil now))
|
||||||
|
current-tx (:current-tx report)]
|
||||||
|
(is (= current-tx db/tx0))
|
||||||
|
(is (= (<? (<datoms db))
|
||||||
|
[[0 x "valuex" db/tx0 true]
|
||||||
|
[1 y "valuey" db/tx0 true]
|
||||||
|
[db/tx0 txInstant now db/tx0 true]]))
|
||||||
|
(is (= (<? (<transactions db))
|
||||||
|
[[0 x "valuex" db/tx0 1] ;; TODO: true, not 1.
|
||||||
|
[1 y "valuey" db/tx0 1]
|
||||||
|
[db/tx0 txInstant now db/tx0 1]])))
|
||||||
|
(finally
|
||||||
|
(<? (db/close db)))))))
|
||||||
|
|
||||||
|
;; TODO: test multipe :add and :retract of the same datom in the same transaction.
|
||||||
|
(deftest-async test-retract
|
||||||
|
(with-tempfile [t (tempfile)]
|
||||||
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
|
(try
|
||||||
|
(let [now -1
|
||||||
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
|
ra (<? (db/<transact! db [[:db/add 0 :x "valuex"]] nil now))
|
||||||
|
rb (<? (db/<transact! db [[:db/retract 0 :x "valuex"]] nil now))
|
||||||
|
txa (:current-tx ra)
|
||||||
|
txb (:current-tx rb)]
|
||||||
|
(is (= (<? (<datoms db))
|
||||||
|
[[txa txInstant now txa true]
|
||||||
|
[txb txInstant now txb true]]))
|
||||||
|
(is (= (<? (<transactions db))
|
||||||
|
[[0 x "valuex" txa 1] ;; TODO: true, not 1.
|
||||||
|
[txa txInstant -1 txa 1]
|
||||||
|
[0 x "valuex" txb 0]
|
||||||
|
[txb txInstant -1 txb 1]])))
|
||||||
|
(finally
|
||||||
|
(<? (db/close db)))))))
|
||||||
|
|
||||||
|
(deftest-async test-q
|
||||||
|
(with-tempfile [t (tempfile)]
|
||||||
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
|
(try
|
||||||
|
(let [now -1
|
||||||
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
|
report (<? (db/<transact! db [[:db/add 0 :x "valuex"]] nil now))
|
||||||
|
current-tx (:current-tx report)]
|
||||||
|
(is (= current-tx db/tx0))
|
||||||
|
(is (= (<? (<datoms db))
|
||||||
|
[[0 x "valuex" db/tx0 true]
|
||||||
|
[db/tx0 txInstant now db/tx0 true]]))
|
||||||
|
(is (= (<? (db/<q db '[:find ?e ?a ?v ?tx :in $ :where [?e ?a ?v ?tx]]))
|
||||||
|
[[1 x "valuex" db/tx0] ;; TODO: include added.
|
||||||
|
[db/tx0 txInstant now db/tx0]])))
|
||||||
|
(finally
|
||||||
|
(<? (db/close db)))))))
|
|
@ -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]
|
||||||
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
|
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
|
||||||
[tempfile.core :refer [tempfile with-tempfile]]
|
[tempfile.core :refer [tempfile with-tempfile]]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -17,4 +17,4 @@
|
||||||
(util/raise "succeed")
|
(util/raise "succeed")
|
||||||
"fail")
|
"fail")
|
||||||
(catch :default e e))]
|
(catch :default e e))]
|
||||||
(is (= "succeed" (aget caught "message"))))))
|
(is (= "succeed" (aget caught "data"))))))
|
||||||
|
|
Loading…
Reference in a new issue