Pass a Context into query.

Still need: entid -> ident on egress.  Ability to define set of idents dynamically.

src/datomish/db.cljc

@@ -8,25 +8,346 @@
       [datomish.pair-chan :refer [go-pair <?]]
       [cljs.core.async.macros :refer [go]]))
   (: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.exec :as de]
+   [datomish.query :as dq]
+   [datomish.transforms :as dt]
    [datomish.sqlite-schema :as sqlite-schema]
    #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
              [clojure.core.async :as a :refer [go <! >!]]])
    #?@(:cljs [[datomish.pair-chan]
               [cljs.core.async :as a :refer [<! >!]]])))
 
+;; TODO: split connection and DB, in preparation for a DB-as-values world.
 (defprotocol IDB
+  (idents
+    [db]
+    "Return map {ident -> entid} if known idents.  See http://docs.datomic.com/identity.html#idents.")
+
   (close
     [db]
     "Close this database. Returns a pair channel of [nil error]."))
 
-(defrecord DB [sqlite-connection]
+(defrecord DB [sqlite-connection idents max-tx]
   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]
   (go-pair
     (when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
       (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)))))

src/datomish/exec.cljc

@@ -9,29 +9,30 @@
       [datomish.pair-chan :refer [go-pair <?]]
       [cljs.core.async.macros :refer [go]]))
   (:require
-     [datomish.sqlite :as s]
-     [datomish.sqlite-schema :as ss]
-     [datomish.query :as dq]
-     #?@(:clj
-           [[datomish.jdbc-sqlite]
-            [datomish.pair-chan :refer [go-pair <?]]
-            [datomish.util :refer [while-let]]
-            [clojure.core.async :refer
-             [go                   ; macro in cljs.
-              <! >! chan close! take!]]])
-     #?@(:cljs
-           [[datomish.promise-sqlite]
-            [datomish.pair-chan]
-            [datomish.util]
-            [cljs.core.async :as a :refer
-             [<! >! chan close! take!]]])))
+   [datomish.sqlite :as s]
+   [datomish.sqlite-schema :as ss]
+   [datomish.query :as dq]
+   #?@(:clj
+       [[datomish.jdbc-sqlite]
+        [datomish.pair-chan :refer [go-pair <?]]
+        [datomish.util :refer [while-let]]
+        [clojure.core.async :refer
+         [go                   ; macro in cljs.
+          <! >! chan close! take!]]])
+   #?@(:cljs
+       [[datomish.promise-sqlite]
+        [datomish.pair-chan]
+        [datomish.util]
+        [cljs.core.async :as a :refer
+         [<! >! chan close! take!]]])))
 
 (defn <?run
   "Execute the provided query on the provided DB.
    Returns a transduced channel of [result err] pairs.
    Closes the channel when fully consumed."
   [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))
         chan (chan 50 row-pair-transducer)]
 

src/datomish/exec_repl.cljc

@@ -24,14 +24,14 @@
             [datomish.util]])))
 
 #?(:clj
-(defn pair-channel->lazy-seq
-  "Returns a blocking lazy sequence of items taken from the provided channel."
-  [channel]
-  (lazy-seq
-   (when-let [v (clojure.core.async/<!! channel)]
-     (if (second v)
-       (cons v nil)
-       (cons v (channel->lazy-seq channel)))))))
+   (defn pair-channel->lazy-seq
+     "Returns a blocking lazy sequence of items taken from the provided channel."
+     [channel]
+     (lazy-seq
+       (when-let [v (clojure.core.async/<!! channel)]
+         (if (second v)
+           (cons v nil)
+           (cons v (pair-channel->lazy-seq channel)))))))
 
 #?(:clj
 (defn run-to-pair-seq

src/datomish/query.cljc

@@ -4,7 +4,7 @@
 
 (ns datomish.query
   (: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]
    [datascript.parser :as dp
     #?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
@@ -52,10 +52,16 @@
   (or (-> context :bindings variable first)
       (raise (str "Couldn't find variable " variable))))
 
-(defn make-context []
-  (->Context [] {} [] []
-             transforms/attribute-transform-string
-             transforms/constant-transform-default))
+(defn make-context
+  ([]
+   (make-context transforms/attribute-transform-string 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
   "Transform a DataScript Pattern instance into the parts needed
@@ -127,10 +133,10 @@
 (defn apply-elements-to-context [context elements]
   (assoc context :elements elements))
 
-(defn patterns->context
-  "Turn a sequence of patterns into a Context."
-  [patterns]
-  (reduce apply-pattern-to-context (make-context) patterns))
+(defn patterns->into-context
+  "Reduce a sequence of patterns into a Context."
+  [context patterns]
+  (reduce apply-pattern-to-context context patterns))
 
 (defn sql-projection
   "Take a `find` clause's `:elements` list and turn it into a SQL
@@ -157,7 +163,7 @@
       (raise "Unable to :find non-variables."))
     (map (fn [elem]
            (let [var (:symbol elem)]
-             [(lookup-variable context var) (var->sql-var var)]))
+             [(lookup-variable context var) (util/var->sql-var var)]))
          elements)))
 
 (defn row-pair-transducer [context projection]
@@ -170,11 +176,12 @@
              [(map row columns-in-order) nil])))))
 
 (defn context->sql-clause [context]
-  {:select (sql-projection context)
-   :from (:from context)
-   :where (if (empty? (:wheres context))
-            nil
-            (cons :and (:wheres context)))})
+  (merge
+    {:select (sql-projection context)
+     :from (:from context)}
+    (if (empty? (:wheres context))
+      {}
+      {:where (cons :and (:wheres context))})))
 
 (defn context->sql-string [context]
   (->
@@ -191,7 +198,8 @@
                  (= "$" (name (-> in first :variable :symbol))))
     (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
   ;; the parsed Datalog includes :where, and it's also input to honeysql's
   ;; SQL formatter.
@@ -200,24 +208,26 @@
     (validate-in in)
     (apply-elements-to-context
       (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))))
 
 (defn find->sql-clause
   "Take a parsed `find` expression and turn it into a structured SQL
    expression that can be formatted by honeysql."
-  [find]
+  [context find]
   ;; 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
   ;; SQL formatter.
-  (-> find find->prepared-context context->sql-clause))
+  (->> find
+       (find->into-context context)
+       context->sql-clause))
 
 (defn find->sql-string
   "Take a parsed `find` expression and turn it into SQL."
-  [find]
-  (->
+  [context find]
+  (->>
     find
-    find->sql-clause
+    (find->sql-clause context)
     (sql/format :quoting sql-quoting-style)))
 
 (defn parse

src/datomish/repl.clj

@@ -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)))

src/datomish/sqlite_schema.cljc

@@ -8,7 +8,7 @@
       [datomish.pair-chan :refer [go-pair <?]]
       [cljs.core.async.macros :refer [go]]))
   (:require
-   [datomish.util :as util :refer [raise]]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
    [datomish.sqlite :as s]
    #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
              [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 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 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)"])
 
 (defn <create-current-version
@@ -42,7 +42,7 @@
   {: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.
   (go-pair
-    (raise "No migrations yet defioned!")
+    (raise "No migrations yet defined!")
     (<? (s/set-user-version db current-version))
     (<? (s/get-user-version db))))
 

src/datomish/util.cljc

@@ -3,12 +3,22 @@
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 
 (ns datomish.util
+  #?(:cljs (:require-macros datomish.util))
   (:require
-     [clojure.string :as str]))
+   [clojure.string :as str]))
 
-(defn raise [s]
-  #?(:clj (throw (Exception. s)))
-  #?(:cljs (throw (js/Error s))))
+#?(:clj
+   (defmacro raise [& fragments]
+     (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
   "Turns '?xyz into :xyz."

test/datomish/db_test.cljc

@@ -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)))))))

test/datomish/sqlite_user_version_test.cljc

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

test/datomish/test.cljs

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

test/datomish/test/util.cljc

@@ -10,11 +10,11 @@
   (is (= :XX (util/var->sql-var '?XX))))
 
 #?(:cljs
-     (deftest test-raise
-       (let [caught
-             (try
-               (do
-                 (util/raise "succeed")
-                 "fail")
-               (catch :default e e))]
-         (is (= "succeed" (aget caught "message"))))))
+   (deftest test-raise
+     (let [caught
+           (try
+             (do
+               (util/raise "succeed")
+               "fail")
+             (catch :default e e))]
+       (is (= "succeed" (aget caught "data"))))))