Hacking on exec-repl.

src/datomish/clauses.cljc

@@ -0,0 +1,256 @@
+;; 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.clauses
+  (:require
+     [datomish.source
+      :refer [attribute-in-source
+              constant-in-source
+              source->from
+              source->constraints]]
+     [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise-str cond-let]]
+     [datascript.parser :as dp
+      #?@(:cljs
+            [:refer
+             [PlainSymbol Predicate Not Pattern DefaultSrc Variable Constant Placeholder]])]
+     [honeysql.core :as sql]
+     [clojure.string :as str]
+     )
+  #?(:clj
+       (:import
+          [datascript.parser
+           PlainSymbol Predicate Not Pattern DefaultSrc Variable Constant Placeholder])))
+
+;; A CC is a collection of clauses that are combined with JOIN.
+;; The topmost form in a query is a ConjoiningClauses.
+;;
+;; Ordinary pattern clauses turn into FROM parts and WHERE parts using :=.
+;; Predicate clauses turn into the same, but with other functions.
+;; Function clauses with bindings turn into:
+;;   * Subqueries. Perhaps less efficient? Certainly clearer.
+;;   * Projection expressions, if only used for output.
+;;   * Inline expressions?
+;; `not` turns into NOT EXISTS with WHERE clauses inside the subquery to
+;; bind it to the outer variables, or adds simple WHERE clauses to the outer
+;; clause.
+;; `not-join` is similar, but with explicit binding.
+;; `or` turns into a collection of UNIONs inside a subquery.
+;; `or`'s documentation states that all clauses must include the same vars,
+;; but that's an over-simplification: all clauses must refer to the external
+;; unification vars.
+;; The entire UNION-set is JOINed to any surrounding expressions per the `rule-vars`
+;; clause, or the intersection of the vars in the two sides of the JOIN.
+
+;; `from` is a list of [source alias] pairs, suitable for passing to honeysql.
+;; `bindings` is a map from var to qualified columns.
+;; `wheres` is a list of fragments that can be joined by `:and`.
+(defrecord ConjoiningClauses [source from external-bindings bindings wheres])
+
+(defn bind-column-to-var [cc variable col]
+  (let [var (:symbol variable)]
+    (util/conj-in cc [:bindings var] col)))
+
+(defn constrain-column-to-constant [cc col position value]
+  (util/conj-in cc [:wheres]
+                [:= col (if (= :a position)
+                          (attribute-in-source (:source cc) value)
+                          (constant-in-source (:source cc) value))]))
+
+(defn- bindings->where
+  "Take a bindings map like
+    {?foo [:datoms12.e :datoms13.v :datoms14.e]}
+  and produce a list of constraints expression like
+    [[:= :datoms12.e :datoms13.v] [:= :datoms12.e :datoms14.e]]
+
+  TODO: experiment; it might be the case that producing more
+  pairwise equalities we get better or worse performance."
+  [bindings]
+  (mapcat (fn [[_ vs]]
+            (when (> (count vs) 1)
+              (let [root (first vs)]
+                (map (fn [v] [:= root v]) (rest vs)))))
+          bindings))
+
+;; This is so we can link clauses to the outside world.
+(defn impose-external-bindings [cc]
+  (if (empty? (:external-bindings cc))
+    cc
+    (let [ours (:bindings cc)
+          theirs (:external-bindings cc)
+          vars (clojure.set/intersection (set (keys theirs)) (set (keys ours)))]
+      (util/concat-in
+        cc [:wheres]
+        (map
+          (fn [v]
+            (let [external (first (v theirs))
+                  internal (first (v ours))]
+              (assert external)
+              (assert internal)
+              [:= external internal]))
+          vars)))))
+
+(defn expand-where-from-bindings
+  "Take the bindings in the CC and contribute
+   additional where clauses. Calling this more than
+   once will result in duplicate clauses."
+  [cc]
+  (impose-external-bindings
+    (assoc cc :wheres (concat (bindings->where (:bindings cc))
+                              (:wheres cc)))))
+
+;; Pattern building is recursive, so we need forward declarations.
+(declare Not->NotJoinClause not-join->where-fragment)
+
+;; Accumulates a pattern into the CC. Returns a new CC.
+(defn apply-pattern-clause
+  "Transform a DataScript Pattern instance into the parts needed
+   to build a SQL expression.
+
+  @arg cc A CC instance.
+  @arg pattern The pattern instance.
+  @return an augmented CC"
+  [cc pattern]
+  (when-not (instance? Pattern pattern)
+    (raise-str "Expected to be called with a Pattern instance." pattern))
+  (when-not (instance? DefaultSrc (:source pattern))
+    (raise-str "Non-default sources are not supported in patterns. Pattern: " pattern))
+
+  (let [[table alias] (source->from (:source cc))   ; e.g., [:datoms :datoms123]
+        places (map (fn [place col] [place col])
+                    (:pattern pattern)
+                    (:columns (:source cc)))]
+    (reduce
+      (fn [cc
+           [pattern-part                           ; ?x, :foo/bar, 42
+            position]]                             ; :a
+        (let [col (sql/qualify alias (name position))]    ; :datoms123.a
+          (condp instance? pattern-part
+            ;; Placeholders don't contribute any bindings, nor do
+            ;; they constrain the query -- there's no need to produce
+            ;; IS NOT NULL, because we don't store nulls in our schema.
+            Placeholder
+            cc
+
+            Variable
+            (bind-column-to-var cc pattern-part col)
+
+            Constant
+            (constrain-column-to-constant cc col position (:value pattern-part))
+
+            (raise-str "Unknown pattern part " pattern-part))))
+
+      ;; Record the new table mapping.
+      (util/conj-in cc [:from] [table alias])
+
+      places)))
+
+(defn- plain-symbol->sql-predicate-symbol [fn]
+  (when-not (instance? PlainSymbol fn)
+    (raise-str "Predicate functions must be named by plain symbols." fn))
+  (#{:> :< :=} (keyword (name (:symbol fn)))))
+
+(defn apply-predicate-clause [cc predicate]
+  (when-not (instance? Predicate predicate)
+    (raise-str "Expected to be called with a Predicate instance." predicate))
+  (let [f (plain-symbol->sql-predicate-symbol (:fn predicate))]
+    (when-not f
+      (raise-str "Unknown function " (:fn predicate)))
+
+    (let [args (map
+                 (fn [arg]
+                   (condp instance? arg
+                     Placeholder
+                     (raise-str "Can't use a placeholder in a predicate.")
+
+                     Variable
+                     (let [v (:symbol arg)
+                           internal-bindings (v (:bindings cc))
+                           external-bindings (v (:external-bindings cc))]
+                       (or (first internal-bindings)
+                           (first external-bindings)
+                           (raise-str "No bindings yet for " v)))
+
+                     Constant
+                     (constant-in-source (:source cc) (:value arg))
+
+                     (raise-str "Unknown predicate argument " arg)))
+
+                 (:args predicate))]
+      (util/conj-in cc [:wheres] (cons f args)))))
+
+(defn apply-not-clause [cc not]
+  (when-not (instance? Not not)
+    (raise-str "Expected to be called with a Not instance." not))
+  (when-not (instance? DefaultSrc (:source not))
+    (raise-str "Non-default sources are not supported in patterns. Pattern: " not))
+
+  ;; If our bindings are already available, great -- emit a :wheres
+  ;; fragment, and include the external bindings so that they match up.
+  ;; Otherwise, we need to delay. Right now we're lazy, so we just fail:
+  ;; reorder your query yourself.
+  (util/conj-in cc [:wheres]
+                (not-join->where-fragment
+                  (Not->NotJoinClause (:source cc)
+                                      (merge-with concat
+                                                  (:external-bindings cc)
+                                                  (:bindings cc))
+                                      not))))
+
+;; We're keeping this simple for now: a straightforward type switch.
+(defn apply-clause [cc it]
+  (if (instance? Not it)
+    (apply-not-clause cc it)
+    (if (instance? Predicate it)
+      (apply-predicate-clause cc it)
+      (apply-pattern-clause cc it))))
+
+(defn expand-pattern-clauses
+  "Reduce a sequence of patterns into a CC."
+  [cc patterns]
+  (reduce apply-clause cc patterns))
+
+(defn patterns->cc [source patterns external-bindings]
+  (expand-where-from-bindings
+    (expand-pattern-clauses
+      (->ConjoiningClauses source [] (or external-bindings {}) {} [])
+      patterns)))
+
+(defn cc->partial-subquery
+  "Build part of a honeysql query map from a CC: the `:from` and `:where` parts.
+  This allows for reuse both in top-level query generation and also for
+  subqueries and NOT EXISTS clauses."
+  [cc]
+  (merge
+    {:from (:from cc)}
+    (when-not (empty? (:wheres cc))
+      {:where (cons :and (:wheres cc))})))
+
+
+;; A `not-join` clause is a filter. It takes bindings from the enclosing query
+;; and runs as a subquery with `NOT EXISTS`.
+;; The only difference between `not` and `not-join` is that `not` computes
+;; its varlist by recursively walking the provided patterns.
+;; DataScript's parser does variable extraction for us, and also verifies
+;; that a declared variable list is valid for the clauses given.
+(defrecord NotJoinClause [unify-vars cc])
+
+(defn make-not-join-clause [source external-bindings unify-vars patterns]
+  (->NotJoinClause unify-vars (patterns->cc source patterns external-bindings)))
+
+(defn Not->NotJoinClause [source external-bindings not]
+  (when-not (instance? DefaultSrc (:source not))
+    (raise-str "Non-default sources are not supported in patterns. Pattern: "
+           not))
+  (make-not-join-clause source external-bindings (:vars not) (:clauses not)))
+
+(defn not-join->where-fragment [not-join]
+  [:not
+    (if (empty? (:bindings (:cc not-join)))
+      ;; If the `not` doesn't establish any bindings, it means it only contains
+      ;; expressions that constrain variables established outside itself.
+      ;; We can just return an expression.
+      (cons :and (:wheres (:cc not-join)))
+
+      ;; If it does establish bindings, then it has to be a subquery.
+      [:exists (merge {:select [1]} (cc->partial-subquery (:cc not-join)))])])

src/datomish/context.cljc

@@ -0,0 +1,9 @@
+;; 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/.
+
+;; A context, very simply, holds on to a default source. Eventually
+;; it'll also do projection and similar transforms.
+(ns datomish.context)
+
+(defrecord Context [default-source elements cc])

src/datomish/db.cljc

@@ -8,25 +8,139 @@
       [datomish.pair-chan :refer [go-pair <?]]
       [cljs.core.async.macros :refer [go]]))
   (:require
-   [datomish.util :as util :refer [raise]]
+   [datomish.context :as context]
+   [datomish.projection :as projection]
+   [datomish.query :as query]
+   [datomish.source :as source]
    [datomish.sqlite :as s]
    [datomish.sqlite-schema :as sqlite-schema]
+   [datomish.util :as util :refer [raise raise-str]]
    #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
-             [clojure.core.async :as a :refer [go <! >!]]])
+             [clojure.core.async :as a :refer [chan go <! >!]]])
    #?@(:cljs [[datomish.pair-chan]
-              [cljs.core.async :as a :refer [<! >!]]])))
+              [cljs.core.async :as a :refer [chan <! >!]]])))
 
 (defprotocol IDB
+  (idents
+    [db]
+    "Return map {ident -> entid} if known idents.  See http://docs.datomic.com/identity.html#idents.")
+
+  (query-context
+    [db])
+
   (close
     [db]
     "Close this database. Returns a pair channel of [nil error]."))
 
-(defrecord DB [sqlite-connection]
+(defn db? [x]
+  (and (satisfies? IDB x)))
+
+;; TODO: implement support for DB parts?
+(def tx0 0x2000000)
+
+;; 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))
+
+(defrecord DB [sqlite-connection idents max-tx]
   IDB
-  (close [db] (close (.-sqlite-connection db))))
+  (idents [db] @(:idents db))
+  (query-context [db] (context/->Context (source/datoms-source db) nil nil))
+  (close [db] (s/close (.-sqlite-connection db))))
 
 (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."))
+      (raise-str "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.
+
+
+
+#?(: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)]))))
+
+;; 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)))))
+
+(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 args]
+  (let [parsed (query/parse find)
+        context (-> db
+                  query-context
+                  (query/find-into-context parsed))
+        row-pair-transducer (projection/row-pair-transducer context)
+        sql (query/context->sql-string context args)
+        chan (chan 50 row-pair-transducer)]
+
+    (s/<?all-rows (.-sqlite-connection db) sql chan)
+    chan))
+
+(defn reduce-error-pair [f [rv re] [v e]]
+  (if re
+    [nil re]
+    (if e
+      [nil e]
+      [(f rv v) nil])))
+
+(defn <?q
+  "Execute the provided query on the provided DB.
+   Returns a transduced pair-chan with one [[results] err] item."
+  [db find args]
+  (a/reduce (partial reduce-error-pair conj) [[] nil]
+            (<?run db find args)))

src/datomish/exec.cljc

@@ -1,40 +0,0 @@
-;; 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.exec
-  #?(:cljs
-     (:require-macros
-      [datomish.util :refer [while-let]]
-      [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!]]])))
-
-(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 [initial-context (dq/make-context)
-        context (dq/expand-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)]
-
-    (s/<?all-rows db (dq/context->sql-string context) chan)
-    chan))

src/datomish/exec_repl.cljc

@@ -9,10 +9,11 @@
       [datomish.pair-chan :refer [go-pair <?]]
       [cljs.core.async.macros :refer [go]]))
   (:require
-     [datomish.exec :as exec]
+     [datomish.db :as db]
      [datomish.sqlite :as s]
      [datomish.sqlite-schema :as ss]
      [datomish.query :as dq]
+     [datomish.transact :as transact]
      #?@(:clj
            [[datomish.jdbc-sqlite]
             [datomish.pair-chan :refer [go-pair <?]]
@@ -39,16 +40,16 @@
   "Given an open database, returns a lazy sequence of results.
    When fully consumed, underlying resources will be released."
   [db find]
-  (pair-channel->lazy-seq (exec/<?run db find))))
+  (pair-channel->lazy-seq (db/<?run db find))))
 
-#_(defn xxopen []
+(defn xxopen []
     (datomish.pair-chan/go-pair
       (let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))]
         (clojure.core.async/<!! (ss/<ensure-current-version d))
         (def db d))))
 
 ;; With an open DB…
-#_(datomish.exec/run-to-pair-seq
+#_(run-to-pair-seq
     db
     '[:find ?page :in $ :where [?page :page/starred true ?t]])
 
@@ -58,13 +59,39 @@
       "/tmp/foo.sqlite"
       '[:find ?page :in $ :where [?page :page/starred true ?t]]))
 
-#_(defn test-run []
+#_
-    (datomish.pair-chan/go-pair
+(go-pair
-      (let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))]
+  (let [connection (<? (s/<sqlite-connection "/tmp/foo.sqlite"))
-        (<! (ss/<ensure-current-version d))
+        d (<? (db/<with-sqlite-connection connection))]
-        (let [chan (exec/<?run d
+    (println
-                               '[:find ?page :in $ :where [?page :page/starred true ?t]])]
+      "Result: "
-          (println (datomish.pair-chan/<? chan))
+      (<! (db/<?q d '[:find ?page :in $ :where [?page :page/starred true ?t]] {})))))
-          (println (datomish.pair-chan/<? chan))
+
-          (println (datomish.pair-chan/<? chan))
+
-          (s/close d)))))
+#_
+(go-pair
+  (let [connection (<? (s/<sqlite-connection "/tmp/foo.sqlite"))
+        dd (<? (db/<with-sqlite-connection connection))]
+    (def *db* dd)))
+#_
+(clojure.core.async/<!!
+(go-pair
+(let [now -1
+      forms (mapcat (fn [i]
+                      (map (fn [j]
+                             [:db/add i :x j true])
+                           (range 1000 (* i 2000) i)))
+                    (range 1 10))]
+  (println "Adding" (count forms) "forms")
+  (<? (transact/<transact! *db* forms nil now)))))
+
+#_
+(go-pair
+  (let [connection (<? (s/<sqlite-connection "/tmp/foo.sqlite"))
+        dd (<? (db/<with-sqlite-connection connection))]
+    (println
+       (count
+         (<? (db/<?q dd
+                     '[:find ?e ?v :in $ :where
+                       [?e :x ?v]
+                       #_[(> ?v 1000)]] {}))))))

src/datomish/projection.cljc

@@ -0,0 +1,54 @@
+;; 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.projection
+  (:require
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise-str cond-let]]
+   [datascript.parser :as dp
+    #?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
+   )
+  #?(:clj (:import [datascript.parser Pattern DefaultSrc Variable Constant Placeholder]))
+  )
+
+(defn lookup-variable [cc variable]
+  (or (-> cc :bindings variable first)
+      (raise-str "Couldn't find variable " variable)))
+
+(defn sql-projection
+  "Take a `find` clause's `:elements` list and turn it into a SQL
+   projection clause, suitable for passing as a `:select` clause to
+   honeysql.
+
+   For example:
+
+     [Variable{:symbol ?foo}, Variable{:symbol ?bar}]
+
+   with bindings in the context:
+
+     {?foo [:datoms12.e :datoms13.v], ?bar [:datoms13.e]}
+
+   =>
+
+     [[:datoms12.e :foo] [:datoms13.e :bar]]
+
+   @param context A Context, containing elements.
+   @return a sequence of pairs."
+  [context]
+  (def foo context)
+  (let [elements (:elements context)]
+    (when-not (every? #(instance? Variable %1) elements)
+      (raise-str "Unable to :find non-variables."))
+    (map (fn [elem]
+           (let [var (:symbol elem)]
+             [(lookup-variable (:cc context) var) (util/var->sql-var var)]))
+         elements)))
+
+(defn row-pair-transducer [context]
+  ;; For now, we only support straight var lists, so
+  ;; our transducer is trivial.
+  (let [columns-in-order (map second (sql-projection context))]
+    (map (fn [[row err]]
+           (if err
+             [row err]
+             [(map row columns-in-order) nil])))))

src/datomish/query.cljc

@@ -4,184 +4,50 @@
 
 (ns datomish.query
   (:require
-   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
+   [datomish.clauses :as clauses]
+   [datomish.context :as context]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise-str cond-let]]
+   [datomish.projection :as projection]
    [datomish.transforms :as transforms]
    [datascript.parser :as dp
-    #?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
+    #?@(:cljs
+          [:refer [
+            BindScalar
+            Constant
+            DefaultSrc
+            Pattern
+            Placeholder
+            SrcVar
+            Variable
+            ]])]
    [clojure.string :as str]
    [honeysql.core :as sql]
    )
-  #?(:clj (:import [datascript.parser Pattern DefaultSrc Variable Constant Placeholder]))
+  #?(:clj
-  )
+       (:import
+          [datascript.parser
+            BindScalar
+            Constant
+            DefaultSrc
+            Pattern
+            Placeholder
+            SrcVar
+            Variable
+           ])))
 
 ;; Setting this to something else will make your output more readable,
 ;; but not automatically safe for use.
 (def sql-quoting-style :ansi)
 
-;;
-;; Context.
-;;
-;; `attribute-transform` is a function from attribute to constant value. Used to
-;; turn, e.g., :p/attribute into an interned integer.
-;; `constant-transform` is a function from constant value to constant value. Used to
-;; turn, e.g., the literal 'true' into 1.
-;; `from` is a list of table pairs, suitable for passing to honeysql.
-;; `:bindings` is a map from var to qualified columns.
-;; `:wheres` is a list of fragments that can be joined by `:and`.
-;;
-(defrecord Context [from bindings wheres elements attribute-transform constant-transform])
-
-(defn attribute-in-context [context attribute]
-  ((:attribute-transform context) attribute))
-
-(defn constant-in-context [context constant]
-  ((:constant-transform context) constant))
-
-(defn bind-column-to-var [context variable col]
-  (let [var (:symbol variable)
-        existing-bindings (get-in context [:bindings var])]
-    (assoc-in context [:bindings var] (conj existing-bindings col))))
-
-(defn constrain-column-to-constant [context col position value]
-  (util/conj-in context [:wheres]
-                [:= col (if (= :a position)
-                          (attribute-in-context context value)
-                          (constant-in-context context value))]))
-
-(defn lookup-variable [context variable]
-  (or (-> context :bindings variable first)
-      (raise (str "Couldn't find variable " variable))))
-
-(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
-   to build a SQL expression.
-
-  @arg context A Context instance.
-  @arg pattern The pattern instance.
-  @return an augmented Context."
-  [context pattern]
-  (when-not (instance? Pattern pattern)
-    (raise "Expected to be called with a Pattern instance."))
-  (when-not (instance? DefaultSrc (:source pattern))
-    (raise (str "Non-default sources are not supported in patterns. Pattern: "
-                (print-str pattern))))
-
-  (let [table :datoms
-        alias (gensym (name table))
-        places (map (fn [place col] [place col])
-                    (:pattern pattern)
-                    [:e :a :v :tx])]
-    (reduce
-      (fn [context
-           [pattern-part                           ; ?x, :foo/bar, 42
-            position]]                             ; :a
-        (let [col (sql/qualify alias (name position))]    ; :datoms123.a
-          (condp instance? pattern-part
-            ;; Placeholders don't contribute any bindings, nor do
-            ;; they constrain the query -- there's no need to produce
-            ;; IS NOT NULL, because we don't store nulls in our schema.
-            Placeholder
-            context
-
-            Variable
-            (bind-column-to-var context pattern-part col)
-
-            Constant
-            (constrain-column-to-constant context col position (:value pattern-part))
-
-            (raise (str "Unknown pattern part " (print-str pattern-part))))))
-
-      ;; Record the new table mapping.
-      (util/conj-in context [:from] [table alias])
-
-      places)))
-
-(defn- bindings->where
-  "Take a bindings map like
-    {?foo [:datoms12.e :datoms13.v :datoms14.e]}
-  and produce a list of constraints expression like
-    [[:= :datoms12.e :datoms13.v] [:= :datoms12.e :datoms14.e]]
-
-  TODO: experiment; it might be the case that producing more
-  pairwise equalities we get better or worse performance."
-  [bindings]
-  (mapcat (fn [[_ vs]]
-            (when (> (count vs) 1)
-              (let [root (first vs)]
-                (map (fn [v] [:= root v]) (rest vs)))))
-          bindings))
-
-(defn expand-where-from-bindings
-  "Take the bindings in the context and contribute
-   additional where clauses. Calling this more than
-   once will result in duplicate clauses."
-  [context]
-  (assoc context :wheres (concat (bindings->where (:bindings context))
-                                 (:wheres context))))
-
-(defn apply-elements-to-context [context elements]
-  (assoc context :elements elements))
-
-(defn expand-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
-   projection clause, suitable for passing as a `:select` clause to
-   honeysql.
-
-   For example:
-
-     [Variable{:symbol ?foo}, Variable{:symbol ?bar}]
-
-   with bindings in the context:
-
-     {?foo [:datoms12.e :datoms13.v], ?bar [:datoms13.e]}
-
-   =>
-
-     [[:datoms12.e :foo] [:datoms13.e :bar]]
-
-   @param context A Context, containing elements.
-   @return a sequence of pairs."
-  [context]
-  (let [elements (:elements context)]
-    (when-not (every? #(instance? Variable %1) elements)
-      (raise "Unable to :find non-variables."))
-    (map (fn [elem]
-           (let [var (:symbol elem)]
-             [(lookup-variable context var) (util/var->sql-var var)]))
-         elements)))
-
-(defn row-pair-transducer [context projection]
-  ;; For now, we only support straight var lists, so
-  ;; our transducer is trivial.
-  (let [columns-in-order (map second projection)]
-    (map (fn [[row err]]
-           (if err
-             [row err]
-             [(map row columns-in-order) nil])))))
-
 (defn context->sql-clause [context]
   (merge
-    {:select (sql-projection context)
+    {:select (projection/sql-projection context)
-     :from (:from context)}
+
-    (if (empty? (:wheres context))
+     ;; Always SELECT DISTINCT, because Datalog is set-based.
-      {}
+     ;; TODO: determine from schema analysis whether we can avoid
-      {:where (cons :and (:wheres context))})))
+     ;; the need to do this.
+     :modifiers [:distinct]}
+    (clauses/cc->partial-subquery (:cc context))))
 
 (defn context->sql-string [context]
   (->
@@ -191,43 +57,65 @@
 
 (defn- validate-with [with]
   (when-not (nil? with)
-    (raise "`with` not supported.")))
+    (raise-str "`with` not supported.")))
 
 (defn- validate-in [in]
-  (when-not (and (== 1 (count in))
+  (when (nil? in)
-                 (= "$" (name (-> in first :variable :symbol))))
+    (raise-str ":in expression cannot be nil."))
-    (raise (str "Complex `in` not supported: " (print-str in)))))
+  (when-not (= "$" (name (-> in first :variable :symbol)))
+    (raise-str "Non-default sources not supported."))
+  (when-not (every? (partial instance? BindScalar) (rest in))
+    (raise-str "Non-scalar bindings not supported.")))
 
-(defn expand-find-into-context [context find]
+(defn in->bindings
-  ;; There's some confusing use of 'where' and friends here. That's because
+  "Take an `:in` list and return a bindings map suitable for use
-  ;; the parsed Datalog includes :where, and it's also input to honeysql's
+   as external bindings in a CC."
-  ;; SQL formatter.
+  [in]
+  (reduce
+    (fn [m b]
+      (or
+        (when (instance? BindScalar b)
+          (let [var (:variable b)]
+            (when (instance? Variable var)
+              (let [v (:symbol var)]
+                (assoc m v [(sql/param (util/var->sql-var v))])))))
+        m))
+    {}
+    in))
+
+(defn find-into-context
+  "Take a parsed `find` expression and return a fully populated
+  Context. You'll want this so you can get access to the
+  projection, amongst other things."
+  [context find]
   (let [{:keys [find in with where]} find]  ; Destructure the Datalog query.
     (validate-with with)
     (validate-in in)
-    (apply-elements-to-context
+    (let [external-bindings (in->bindings in)]
-      (expand-where-from-bindings
+      (assoc context
-        (expand-patterns-into-context context where))    ; 'where' here is the Datalog :where clause.
+             :elements (:elements find)
-      (:elements find))))
+             :cc (clauses/patterns->cc (:default-source context) where external-bindings)))))
+
+(defn context->sql-string
+  [context args]
+  (-> context
+    context->sql-clause
+    (sql/format args :quoting sql-quoting-style)))
 
 (defn find->sql-clause
   "Take a parsed `find` expression and turn it into a structured SQL
    expression that can be formatted by honeysql."
   [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
-       (expand-find-into-context context)
+       (find-into-context context)
        context->sql-clause))
 
 (defn find->sql-string
   "Take a parsed `find` expression and turn it into SQL."
-  [context find]
+  [context find args]
-  (->>
+  (->
-    find
+    (find->sql-clause context find)
-    (find->sql-clause context)
+    (sql/format args :quoting sql-quoting-style)))
-    (sql/format :quoting sql-quoting-style)))
 
 (defn parse
   "Parse a Datalog query array into a structured `find` expression."
@@ -235,27 +123,13 @@
   (dp/parse-query q))
 
 (comment
+  (def sql-quoting-style nil)
   (datomish.query/find->sql-string
+    (datomish.context/->Context (datomish.source/datoms-source nil) nil nil)
     (datomish.query/parse
-      '[:find ?page :in $ :where [?page :page/starred true ?t] ])))
+      '[:find ?timestampMicros ?page :in $ ?latest :where
-
-(comment
-  (datomish.query/find->prepared-context
-    (datomish.query/parse
-      '[:find ?timestampMicros ?page
-        :in $
-        :where
         [?page :page/starred true ?t]
-        [?t :db/txInstant ?timestampMicros]])))
+        [?t :db/txInstant ?timestampMicros]
-
+        (not [(> ?t ?latest)]) ])
-(comment
+    {:latest 5})
-  (pattern->sql
+)
-    (first
-      (:where
-        (datomish.query/parse
-          '[:find (max ?timestampMicros) (pull ?page [:page/url :page/title]) ?page
-          :in $
-          :where
-          [?page :page/starred true ?t]
-          [?t :db/txInstant ?timestampMicros]])))
-    identity))

src/datomish/source.cljc

@@ -0,0 +1,62 @@
+;; 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.source
+  (:require
+   [datomish.transforms :as transforms]))
+
+;;;
+;;; A source is something that can match patterns. For example:
+;;;
+;;; * The database itself.
+;;; * The history of the database.
+;;; * A filtered version of the database or the history.
+;;;
+;;; We model this in a SQL context as something that can:
+;;;
+;;; * Give us a table name.
+;;; * Give us a new alias for the table name.
+;;; * Provide us with a list of columns to match, positionally,
+;;;   against patterns.
+;;; * Provide us with a set of WHERE fragments that, in combination
+;;;   with the table name, denote the source.
+;;; * Transform constants and attributes into something usable
+;;;   by the source.
+
+(defrecord
+  Source
+  [table               ; e.g., :datoms
+   columns             ; e.g., [:e :a :v :tx]
+
+   ;; `attribute-transform` is a function from attribute to constant value. Used to
+   ;; turn, e.g., :p/attribute into an interned integer.
+   ;; `constant-transform` is a function from constant value to constant value. Used to
+   ;; turn, e.g., the literal 'true' into 1.
+   attribute-transform
+   constant-transform
+   
+   ;; Not currently used.
+   make-constraints    ; ?fn [source alias] => [where-clauses]
+   ])
+
+(defn datoms-source [db]
+  (->Source :datoms
+            [:e :a :v :tx :added]
+            transforms/attribute-transform-string
+            transforms/constant-transform-default
+            nil))
+
+(defn source->from [source]
+  (let [table (:table source)]
+    [table (gensym (name table))]))
+
+(defn source->constraints [source alias]
+  (when-let [f (:make-constraints source)]
+    (f alias)))
+
+(defn attribute-in-source [source attribute]
+  ((:attribute-transform source) attribute))
+
+(defn constant-in-source [source constant]
+  ((:constant-transform source) constant))

src/datomish/sqlite.cljc

@@ -59,7 +59,9 @@
    when no more results exist. Consume with <?."
   [db [sql & bindings :as rest] chan]
   (go-safely [c chan]
-    (let [result (<! (-each db sql bindings (fn [row] (put! c [row nil]))))]
+    (let [result (<! (-each db sql bindings
+                            (fn [row]
+                              (put! c [row nil]))))]
       ;; We assume that a failure will result in the promise
       ;; channel being rejected and no further row callbacks
       ;; being called.

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

src/datomish/transact.cljc

@@ -0,0 +1,243 @@
+;; 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.transact
+  #?(:cljs
+     (:require-macros
+      [datomish.pair-chan :refer [go-pair <?]]
+      [cljs.core.async.macros :refer [go]]))
+  #?(:clj (:import [datomish.db Datom TxReport]))
+  (:require
+   [datomish.context :as context]
+   [datomish.db :as db :refer [#?@(:cljs [Datom TxReport]) db?]]
+   [datomish.projection :as projection]
+   [datomish.query :as query]
+   [datomish.source :as source]
+   [datomish.sqlite :as s]
+   [datomish.sqlite-schema :as sqlite-schema]
+   [datomish.util :as util :refer [raise raise-str]]
+   [honeysql.core :as sql]
+   #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
+             [clojure.core.async :as a :refer [chan go <! >!]]])
+   #?@(:cljs [[datomish.pair-chan]
+              [cljs.core.async :as a :refer [chan <! >!]]])))
+
+(defn- tx-id? [e]
+  (= e :db/current-tx))
+
+(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: 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? 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? 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? db)]}
+  (go-pair
+    (validate-attr a entity)
+    (validate-val  v entity)
+    (let [tx    (or tx (:current-tx report))
+          e     (<? (db/<entid-strict db e))
+          v     (if (db/ref? db a) (<? (db/<entid-strict db v)) v)
+          datom (Datom. e a v tx true)]
+      (if (db/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? db)]}
+  (go-pair
+    (let [tx (:current-tx report)]
+      (if-let [e (<? (db/<entid db e))]
+        (let [v (if (db/ref? db a) (<? (db/<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? 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 (db/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 (db/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 (db/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 (db/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})))
+
+          (db/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 (<? (db/<allocate-tx db))
+              report     (<? (<transact-tx-data db now
+                                                (db/map->TxReport
+                                                  {:current-tx current-tx
+                                                   :tx-data    []
+                                                   :tempids    {}
+                                                   :tx-meta    tx-meta}) tx-data))]
+          (<? (<process-db-part db report))
+          report)))))
+
+

src/datomish/util.cljc

@@ -8,10 +8,20 @@
    [clojure.string :as str]))
 
 #?(:clj
-   (defmacro raise [& fragments]
+   (defmacro raise-str
+     "Like `raise`, but doesn't require a data argument."
+     [& fragments]
+     `(throw (ex-info (str ~@(map (fn [m#] (if (string? m#) m# (list 'pr-str m#))) fragments)) {}))))
+
+#?(:clj
+   (defmacro raise
+     "The last argument must be a map."
+     [& 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)))))
+       `(throw
+          (ex-info
+            (str ~@(map (fn [m#] (if (string? m#) m# (list 'pr-str m#))) msgs)) ~data)))))
 
 #?(:clj
    (defmacro cond-let [& clauses]
@@ -26,7 +36,7 @@
   (if (and (symbol? x)
            (str/starts-with? (name x) "?"))
     (keyword (subs (name x) 1))
-    (raise (str x " is not a Datalog var."))))
+    (raise-str x " is not a Datalog var.")))
 
 (defn conj-in
   "Associates a value into a sequence in a nested associative structure, where
@@ -40,6 +50,13 @@
     (assoc m k (conj-in (get m k) ks v))
     (assoc m k (conj (get m k) v))))
 
+(defn concat-in
+  {:static true}
+  [m [k & ks] vs]
+  (if ks
+    (assoc m k (concat-in (get m k) ks vs))
+    (assoc m k (concat (get m k) vs))))
+
 (defmacro while-let [binding & forms]
   `(loop []
      (when-let ~binding

test/datomish/db_test.cljc

@@ -0,0 +1,131 @@
+;; 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]
+   [datomish.transact :as transact]
+   #?@(: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     (<? (transact/<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     (<? (transact/<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        (<? (transact/<transact! db [[:db/add     0 :x "valuex"]] nil now))
+              rb        (<? (transact/<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)))))))
+
+(defn result=
+  "Query results are unordered. Do a set-wise comparison instead."
+  [expected actual]
+  (= (set expected)
+     (set actual)))
+
+(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     (<? (transact/<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 (result=
+                [[0 x "valuex" db/tx0] ;; TODO: include added.
+                 [db/tx0 txInstant now db/tx0]]
+                (<? (db/<?q db '[:find ?e ?a ?v ?tx :in $ :where [?e ?a ?v ?tx]] {})))))
+        (finally
+          (<? (db/close db)))))))

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

@@ -14,7 +14,7 @@
      (let [caught
            (try
              (do
-               (util/raise "succeed")
+               (util/raise "succeed" {})
                "fail")
              (catch :default e e))]
        (is (= "succeed" (aget caught "data"))))))