UNFINISHED: fts extracted types.

We may subsequently wish to make this an error.

project.clj

@@ -8,6 +8,8 @@
                  [org.clojure/core.async "0.2.385"]
                  [datascript "0.15.1"]
                  [honeysql "0.8.0"]
+                 [com.datomic/datomic-free "0.9.5359"]
+                 [com.taoensso/tufte "1.0.2"]
                  [jamesmacaulay/cljs-promises "0.1.0"]]
 
   :cljsbuild {:builds {:release {

src/datomish/d.clj

@@ -0,0 +1,196 @@
+(ns datomish.d
+  (:require [datomic.db :as db]))
+
+(use '[datomic.api :only [q db] :as d])
+(use 'clojure.pprint)
+
+(def uri "datomic:free://localhost:4334//news")
+(d/create-database uri)
+(def conn (d/connect uri))
+
+(def schema-tx (read-string (slurp "src/datomish/schema.edn")))
+(println "schema-tx:")
+(pprint schema-tx)
+
+
+;; alter/attribute does not retract/assert install/attribute.
+;; @(d/transact conn [{:db/id :news/baz
+;;                     :db/cardinality :db.cardinality/one
+;;                     :db.alter/_attribute :db.part/db}])
+
+@(d/transact conn schema-tx)
+
+;; add some data:
+(def data-tx [{:news/title "Rain Tomorrow", :db/id #db/id[:db.part/user -1000001]}])
+
+@(d/transact conn data-tx)
+
+(def x
+  @(d/transact conn [[:db/add #db/id[:db.part/user -1] :news/title "Rain Tomorrow 1" #db/id[:db.part/tx -1]]
+                     [:db/add #db/id[:db.part/user -2] :news/title "Rain Tomorrow 2" #db/id[:db.part/tx -2]]
+                     [:db/add #db/id[:db.part/tx -2] :news/title "Test"]]))
+
+
+;; This drops the tx entirely!
+(def x
+  @(d/transact conn [[:db/add #db/id[:db.part/user -1] :news/title "Rain Tomorrow 3" 13194139534684]]))
+
+(def x
+  @(d/transact conn [[:db/add #db/id[:db.part/user -1] :news/title "Rain Tomorrow 3" 13194139534684]
+                     {:db/id #db/id[:db.part/db -1] :db/ident :test/test2 :db.install/_partition :db.part/db}
+                     [:db/add #db/id[:db.part/tx -2] :news/title "Test"]]))
+
+(def x
+  @(d/transact conn [[:db/add #db/id[:test/test2 -1] :news/title "Rain Tomorrow 5"]]))
+
+;; [:db/add #db/id[:db.part/user -2] :news/title "Rain Tomorrow 2" #db/id[:db.part/tx -2]]
+;; [:db/add #db/id[:db.part/tx -2] :news/title "Test"]]))
+
+
+
+
+(def results (q '[:find ?n :where [?n :news/title]] (db conn)))
+(println (count results))
+(pprint results)
+(pprint (first results))
+
+(def id (ffirst results))
+(def entity (-> conn db (d/entity id)))
+
+;; display the entity map's keys
+(pprint (keys entity))
+
+;; display the value of the entity's community name
+(println (:news/title entity))
+
+;; @(d/transact conn [[:db/retract )
+@(d/transact conn [[:db/add 17592186045427 :news/title "Test"]])
+
+;; 1. Caused by datomic.impl.Exceptions$IllegalArgumentExceptionInfo
+;; :db.error/datoms-conflict Two datoms in the same transaction
+;; conflict {:d1 [17592186045427 :news/title "Test" 13194139534372
+;;                true], :d2 [17592186045427 :news/title "Test2" 13194139534372
+;;                            true]}
+
+;; 1. Caused by datomic.impl.Exceptions$IllegalArgumentExceptionInfo
+;; :db.error/not-an-entity Unable to resolve entity: [:news/foobar
+;;                                                    "a"] in datom [[:news/foobar "a"] :news/foobar "b"]
+;; {:db/error :db.error/not-an-entity}
+;; @(d/transact conn [[:db/add #db/id[db.part/user -1] :news/foobar "a"]
+;;                    [:db/add #db/id[db.part/user -2] :news/zot "a"]])
+
+;; @(d/transact conn [[:db/add #db/id[db.part/user -1] :news/baz #db/id[db.part/user -2]]
+;;                    [:db/add #db/id[db.part/user -2] :news/baz #db/id[db.part/user -1]]])
+;; {:db-before datomic.db.Db@a0166706, :db-after datomic.db.Db@5d0d6a62, :tx-data [#datom[13194139534399 50 #inst "2016-07-20T04:45:19.553-00:00" 13194139534399 true] #datom[17592186045504 68 17592186045505 13194139534399 true] #datom[17592186045505 68 17592186045504 13194139534399 true]], :tempids {-9223350046622220289 17592186045504, -9223350046622220290 17592186045505}}
+
+;; @(d/transact conn [[:db/add [:news/foobar "a"] :news/foobar "b"]])
+
+;; @(d/transact conn [[:db/retract 17592186045505 68 17592186045504 13194139534399]])
+
+;; 1. Caused by datomic.impl.Exceptions$IllegalArgumentExceptionInfo
+;; :db.error/not-a-data-function Unable to resolve data function:
+;; {:news/foobar "a", :news/zot "a", :news/title "test"}
+;; {:db/error :db.error/not-a-data-function}
+
+;; 1. Caused by datomic.impl.Exceptions$IllegalArgumentExceptionInfo
+;; :db.error/entity-missing-db-id Missing :db/id
+;; {:input {:news/foobar "a", :news/zot "a", :news/title "test"}, :db/error :db.error/entity-missing-db-id}
+;; @(d/transact conn [{:news/foobar "a" :news/zot "a" :news/title "test"}])
+
+;; ;; 1. Caused by datomic.impl.Exceptions$IllegalStateExceptionInfo
+;; ;; :db.error/unique-conflict Unique conflict: :news/zot, value: a
+;; ;; already held by: 17592186045489 asserted for: 17592186045483
+;; ;; {:db/error :db.error/unique-conflict}
+;; @(d/transact conn [{:db/id [:news/foobar "a"] :news/zot "a" :news/title "test"}])
+
+;; ;; 1. Caused by datomic.impl.Exceptions$IllegalStateExceptionInfo
+;; ;; :db.error/unique-conflict Unique conflict: :news/zot, value: b
+;; ;; already held by: 17592186045492 asserted for: 17592186045483
+;; @(d/transact conn [
+;;                    {:db/id #db/id[db.part/user -1] :news/foobar "c" :news/zot "c"}])
+;; ;; {:db/id #db/id[db.part/user -1] :news/zot "a"}                   ])
+
+;; ;; 1. Caused by datomic.impl.Exceptions$IllegalStateExceptionInfo
+;; ;; :db.error/unique-conflict Unique conflict: :news/foobar, value: b
+;; ;; already held by: 17592186045478 asserted for: 1
+;; ;; {:db/error :db.error/unique-conflict}
+
+;; @(d/transact conn [[:db/add 17592186045478 :news/foobar "b"]])
+;; @(d/transact conn [[:db/add 17592186045478 :news/foobar "a"]])
+
+;; ;; Datomic accepts two different id-literals resolving to the same entid.
+(def txx #db/id[db.part/tx])
+(def x @(d/transact conn [[:db/add #db/id[db.part/user -1] :news/foobar "c"]
+                          [:db/add #db/id[db.part/user -2] :news/zot "c"]
+                          [:db/add txx :news/title "x"]
+                          [:db/add #db/id[db.part/tx -5] :news/title "x"]
+                          ]))
+
+(def x @(d/transact conn [[:db/add #db/id[db.part/user -1] :news/baz #db/id[db.part/tx]]]))
+
+;; ;; 1. Caused by datomic.impl.Exceptions$IllegalArgumentExceptionInfo
+;; ;; :db.error/tempid-not-an-entity tempid used only as value in
+;; ;; transaction
+;; ;; {:db/error :db.error/tempid-not-an-entity}
+;; @(d/transact conn [[:db/add #db/id[db.part/user -1] :news/baz #db/id[db.part/user -3]]
+;;                    [:db/add #db/id[db.part/user -2] :news/baz #db/id[db.part/user -3]]])
+
+;; ;; 2. Unhandled java.util.concurrent.ExecutionException
+;; ;; java.lang.IndexOutOfBoundsException
+;; @(d/transact conn [[:db/add #db/id[db.part/user -1] :db/ident :news/zot]
+;;                    [:db/add #db/id[db.part/user -2] #db/id[db.part/user -1] "c"]])
+
+(vec
+  (q '[:find ?added ?a ?v ?tx
+       :where
+       [17592186045427 ?a ?v ?tx ?added]
+       ;; [(>= ?e 17592186045427)]
+       ;; [(tx-ids ?log ?t1 ?t2) [?tx ...]]
+       ;; [(tx-data ?log ?tx) [[?e ?a ?v _ ?added]]]
+       ]
+     (d/db conn)))
+;; [[true 63 "Test" 13194139534324]]
+
+(vec
+  (q '[:find ?e ?added ?a ?v ?tx
+       :in ?log ?t1 ?t2
+       :where
+       [(tx-ids ?log ?t1 ?t2) [?tx ...]]
+       [(tx-data ?log ?tx) [[?e ?a ?v _ ?added]]]
+       [(= ?e 17592186045427)]
+       ]
+     (d/log conn) #inst "2013-08-01" #inst "2017-01-01"))
+
+[[17592186045427 false 63 "Rain Tomorrow" 13194139534324] [17592186045427 true 63 "Test" 13194139534324] [17592186045427 false 63 "Test" 13194139534325] [17592186045427 true 63 "Rain Tomorrow" 13194139534322]]
+;; [[17592186045427 false 63 "Rain Tomorrow" 13194139534324] [17592186045427 true 63 "Test" 13194139534324] [17592186045427 true 63 "Rain Tomorrow" 13194139534322]]
+
+@(d/transact conn [[:db/retract 17592186045427 :news/title "Test"]])
+
+
+
+(sort-by first (d/q '[:find ?a ?ident :where
+                      [?e ?a ?ident]
+                      [_ :db.install/attribute ?e]] (db/bootstrap-db)))
+
+(def x (db/bootstrap-db))
+
+(pprint (vec (map (juxt :e :a :v :tx :added) (filter #(= 13194139533312 (:tx %)) (d/datoms x :eavt)))))
+(pprint (sort (set (map (juxt :tx) (d/datoms x :eavt)))))
+
+(def tx0 13194139533312)
+(def tx1 13194139533366)
+(def tx2 13194139533368)
+(def tx3 13194139533375)
+
+(pprint
+  (sort-by first (d/q '[:find ?e ?an ?v ?tx
+                        :in $ ?tx
+                        :where
+                        [?e ?a ?v ?tx true]
+                        [?a :db/ident ?an]
+                        ] x tx3)))
+
+
+;; (d/datoms x :eavt))))
+
+;; 13194139533312

src/datomish/db.cljc

@@ -8,16 +8,19 @@
       [datomish.pair-chan :refer [go-pair <?]]
       [cljs.core.async.macros :refer [go]]))
   (:require
+   [clojure.set]
    [datomish.query.context :as context]
    [datomish.query.projection :as projection]
    [datomish.query.source :as source]
    [datomish.query :as query]
    [datomish.datom :as dd :refer [datom datom? #?@(:cljs [Datom])]]
-   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
+   [datomish.util :as util
+    #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
    [datomish.schema :as ds]
-   [datomish.schema-changes]
    [datomish.sqlite :as s]
    [datomish.sqlite-schema :as sqlite-schema]
+   [taoensso.tufte :as tufte
+    #?(:cljs :refer-macros :clj :refer) [defnp p profiled profile]]
    #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
              [clojure.core.async :as a :refer [chan go <! >!]]])
    #?@(:cljs [[datomish.pair-chan]
@@ -34,6 +37,9 @@
        (uncaughtException [_ thread ex]
          (println ex "Uncaught exception on" (.getName thread))))))
 
+(def max-sql-vars 999)    ;; TODO: generalize.
+
+
 ;; ----------------------------------------------------------------------------
 ;; define data-readers to be made available to EDN readers. in CLJS
 ;; they're magically available. in CLJ, data_readers.clj may or may
@@ -55,7 +61,7 @@
    (->TempId part idx)))
 
 (defn id-literal? [x]
-  (and (instance? TempId x)))
+  (instance? TempId x))
 
 (defprotocol IClock
   (now
@@ -74,13 +80,13 @@
     [db]
     "Return the schema of this database.")
 
-  (idents
-    [db]
-    "Return the known idents of this database, as a map from keyword idents to entids.")
+  (entid
+    [db ident]
+    "Returns the entity id associated with a symbolic keyword, or the id itself if passed.")
 
-  (current-tx
-    [db]
-    "TODO: document this interface.")
+  (ident
+    [db eid]
+    "Returns the keyword associated with an id, or the key itself if passed.")
 
   (in-transaction!
     [db chan-fn]
@@ -88,29 +94,29 @@
     commit the transaction; otherwise, rollback the transaction.  Returns a pair-chan resolving to
     the pair-chan returned by `chan-fn`.")
 
-  (<eavt
-    [db pattern]
-    "Search for datoms using the EAVT index.")
+  (<bootstrapped? [db]
+    "Return true if this database has no transactions yet committed.")
 
-  (<avet
-    [db pattern]
-    "Search for datoms using the AVET index.")
+  (<av
+    [db a v]
+    "Search for a single matching datom using the AVET index.")
 
-  (<apply-datoms
-    [db datoms]
-    "Apply datoms to the store.")
+  (<apply-entities
+    [db tx entities]
+    "Apply entities to the store, returning sequence of datoms transacted.")
 
   (<apply-db-ident-assertions
-    [db added-idents]
-    "Apply added idents to the store.")
+    [db added-idents merge]
+    "Apply added idents to the store, using `merge` as a `merge-with` function.")
 
   (<apply-db-install-assertions
-    [db fragment]
-    "Apply added schema fragment to the store.")
+    [db fragment merge]
+    "Apply added schema fragment to the store, using `merge` as a `merge-with` function.")
 
-  (<advance-tx
-    [db]
-    "TODO: document this interface."))
+  (<next-eid
+    [db id-literal]
+    "Return a unique integer for the given id-literal, accounting for the literal's partition.  The
+    returned integer should never be returned again."))
 
 (defn db? [x]
   (and (satisfies? IDB x)
@@ -140,117 +146,450 @@
           ]
       rowid)))
 
-(defrecord DB [sqlite-connection schema idents current-tx]
-  ;; idents is map {ident -> entid} of known idents.  See http://docs.datomic.com/identity.html#idents.
+(defn datoms-attribute-transform
+  [db x]
+  {:pre [(db? db)]}
+  (entid db x))
+
+(defn datoms-constant-transform
+  [db x]
+  {:pre [(db? db)]}
+  (sqlite-schema/->SQLite x))
+
+(defn datoms-source [db]
+  (source/map->DatomsSource
+    {:table :datoms
+     :schema (:schema db)
+     :fulltext-table :fulltext_values
+     :fulltext-view :all_datoms
+     :columns [:e :a :v :tx :added]
+     :attribute-transform (partial datoms-attribute-transform db)
+     :constant-transform (partial datoms-constant-transform db)
+     :table-alias source/gensym-table-alias
+     :make-constraints nil}))
+
+(defn- retractions->queries [retractions tx fulltext? ->SQLite]
+  (let
+    [f-q
+     "WITH vv AS (SELECT rowid FROM fulltext_values WHERE text = ?)
+     INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag)
+     VALUES (?, ?, (SELECT rowid FROM vv), ?, 0, ?, (SELECT rowid FROM vv), ?)"
+
+     non-f-q
+     "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag)
+     VALUES (?, ?, ?, ?, 0, ?, ?, ?)"]
+    (map
+      (fn [[_ e a v]]
+        (let [[v tag] (->SQLite a v)]
+          (if (fulltext? a)
+            [f-q
+             v e a tx tag tag]
+            [non-f-q
+             e a v tx tag v tag])))
+      retractions)))
+
+(defn- non-fts-many->queries [ops tx ->SQLite indexing? ref? unique?]
+  (let [q "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, index_avet0, index_vaet0, index_fulltext0, unique_value0, sv, svalue_type_tag) VALUES "
+
+        values-part
+        ;; e0, a0, v0, tx0, added0, value_type_tag0
+        ;; index_avet0, index_vaet0, index_fulltext0,
+        ;; unique_value0, sv, svalue_type_tag
+        "(?, ?, ?, ?, 1, ?, ?, ?, 0, ?, ?, ?)"
+
+        repeater (memoize (fn [n] (interpose ", " (repeat n values-part))))]
+
+    ;; This query takes ten variables per item. So we partition into max-sql-vars / 10.
+    (map
+      (fn [chunk]
+        (cons
+          ;; Query string.
+          (apply str q (repeater (count chunk)))
+
+          ;; Bindings.
+          (mapcat (fn [[_ e a v]]
+                    (let [[v tag] (->SQLite a v)]
+                      [e a v tx tag
+                       (indexing? a)      ; index_avet
+                       (ref? a)           ; index_vaet
+                       (unique? a)        ; unique_value
+                       v tag]))
+                  chunk)))
+
+      (partition-all (quot max-sql-vars 10) ops))))
+
+(defn- non-fts-one->queries [ops tx ->SQLite indexing? ref? unique?]
+  (let [first-values-part
+        ;; TODO: order value and tag closer together.
+        ;; flags0
+        ;; sv, svalue_type_tag
+        "(?, ?, ?, ?, ?, ?, ?, ?, 0, ?, ?, ?)"
+        first-repeater (memoize (fn [n] (interpose ", " (repeat n first-values-part))))
+
+        second-values-part
+        "(?, ?, ?, ?, ?, ?)"
+        second-repeater (memoize (fn [n] (interpose ", " (repeat n second-values-part))))
+        ]
+
+    ;; :db.cardinality/one takes two queries.
+    (mapcat
+      (fn [chunk]
+        [(cons
+           (apply
+             str
+             "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, index_avet0, index_vaet0, index_fulltext0, unique_value0, sv, svalue_type_tag) VALUES "
+             (first-repeater (count chunk)))
+           (mapcat (fn [[_ e a v]]
+                     (let [[v tag] (->SQLite a v)]
+                       [e a v tx 1 tag
+                        (indexing? a)   ; index_avet
+                        (ref? a)        ; index_vaet
+                        (unique? a)     ; unique_value
+                        v tag]))
+                   chunk))
+
+         (cons
+           (apply
+             str
+             "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0) VALUES "
+             (second-repeater (count chunk)))
+           (mapcat (fn [[_ e a v]]
+                     (let [[v tag] (->SQLite a v)]
+                       [e a v tx 0 tag]))
+                   chunk))])
+      (partition-all (quot max-sql-vars 11) ops))))
+
+;;; An FTS insertion happens in two parts.
+;;; Firstly, we ensure that the fulltext value is present in the store.
+;;; This is effectively an INSERT OR IGNORE… but FTS tables don't support
+;;; uniqueness constraints. So we do it through a trigger on a view.
+;;; When we insert the value, we pass with it a searchid. We'll use this
+;;; later when inserting the datom.
+;;; Secondly, we insert a row just like for non-FTS. The only difference
+;;; is that the value is the rowid into the fulltext_values table.
+(defn- fts-many->queries [ops tx ->SQLite indexing? ref? unique?]
+  ;; TODO: operations with the same text value should be
+  ;; coordinated here!
+  ;; It'll work fine without so long as queries are executed
+  ;; in order and not combined, but even so it's inefficient.
+  (conj
+    (mapcat
+      (fn [[_ e a v] searchid]
+        (let [[v tag] (->SQLite a v)]
+          ;; First query: ensure the value exists.
+          [["INSERT INTO fulltext_values_view (text, searchid) VALUES (?, ?)"
+            v searchid]
+
+           ;; Second query: tx_lookup.
+           [(str
+              "WITH vv(rowid) AS (SELECT rowid FROM fulltext_values WHERE searchid = ?) "
+              "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, index_avet0, index_vaet0, index_fulltext0, unique_value0, sv, svalue_type_tag) VALUES "
+              "(?, ?, (SELECT rowid FROM vv), ?, 1, ?, ?, ?, 1, ?, (SELECT rowid FROM vv), ?)")
+            searchid
+            e a tx tag
+            (indexing? a)      ; index_avet
+            (ref? a)           ; index_vaet
+            (unique? a)        ; unique_value
+            tag]]))
+      ops
+      (range 2000 999999999))
+    ["UPDATE fulltext_values SET searchid = NULL WHERE searchid IS NOT NULL"]))
+
+(defn fts-one->queries [ops tx ->SQLite indexing? ref? unique?]
+  (conj
+    (mapcat
+      (fn [[_ e a v] searchid]
+        (let [[v tag] (->SQLite a v)]
+          ;; First query: ensure the value exists.
+          [["INSERT INTO fulltext_values_view (text, searchid) VALUES (?, ?)"
+            v searchid]
+
+           ;; Second and third queries: tx_lookup.
+           [(str
+              "WITH vv(rowid) AS (SELECT rowid FROM fulltext_values WHERE searchid = ?) "
+              "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, index_avet0, index_vaet0, index_fulltext0, unique_value0, sv, svalue_type_tag) VALUES "
+              "(?, ?, (SELECT rowid FROM vv), ?, 1, ?, ?, ?, 1, ?, (SELECT rowid FROM vv), ?)")
+            searchid
+            e a tx tag
+            (indexing? a)      ; index_avet
+            (ref? a)           ; index_vaet
+            (unique? a)        ; unique_value
+            tag]
+
+           [(str
+              "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0) VALUES "
+              "(?, ?, (SELECT rowid FROM fulltext_values WHERE searchid = ?), ?, 0, ?)")
+            e a searchid tx tag]]))
+      ops
+      (range 3000 999999999))
+    ["UPDATE fulltext_values SET searchid = NULL WHERE searchid IS NOT NULL"]))
+
+(defn- -run-queries [conn queries exception-message]
+  (go-pair
+    (try
+      (doseq [q queries]
+        (<? (s/execute! conn q)))
+      (catch #?(:clj java.sql.SQLException :cljs js/Error) e
+        (throw (ex-info exception-message {} e))))))
+
+(defn- -preamble-drop [conn]
+  (let [preamble-drop-index ["DROP INDEX IF EXISTS id_tx_lookup_added"]
+        preamble-delete-tx-lookup ["DELETE FROM tx_lookup"]]
+    (go-pair
+      (p :preamble
+         (doseq [q [preamble-drop-index preamble-delete-tx-lookup]]
+           (<? (s/execute! conn q)))))))
+
+(defn- -after-drop [conn]
+  (go-pair
+    (doseq [q [;; The lookup table takes space on disk, so we purge it aggressively.
+               ["DROP INDEX IF EXISTS id_tx_lookup_added"]
+               ["DELETE FROM tx_lookup"]]]
+      (<? (s/execute! conn q)))))
+
+(defn- -build-transaction [conn tx]
+  (let [build-indices ["CREATE INDEX IF NOT EXISTS idx_tx_lookup_added ON tx_lookup (added0)"]
+
+        ;; First is fast, only one table walk: lookup by exact eav.
+        ;; Second is slower, but still only one table walk: lookup old value by ea.
+        insert-into-tx-lookup
+        ["INSERT INTO tx_lookup
+          SELECT t.e0, t.a0, t.v0, t.tx0, t.added0 + 2, t.value_type_tag0, t.index_avet0, t.index_vaet0, t.index_fulltext0, t.unique_value0, t.sv, t.svalue_type_tag, d.rowid, d.e, d.a, d.v, d.tx, d.value_type_tag
+          FROM tx_lookup AS t
+          LEFT JOIN datoms AS d
+          ON t.e0 = d.e AND
+             t.a0 = d.a AND
+             t.sv = d.v AND
+             t.svalue_type_tag = d.value_type_tag AND
+             t.sv IS NOT NULL
+
+          UNION ALL
+          SELECT t.e0, t.a0, t.v0, t.tx0, t.added0 + 2, t.value_type_tag0, t.index_avet0, t.index_vaet0, t.index_fulltext0, t.unique_value0, t.sv, t.svalue_type_tag, d.rowid, d.e, d.a, d.v, d.tx, d.value_type_tag
+          FROM tx_lookup AS t,
+               datoms AS d
+          WHERE t.sv IS NULL AND
+                t.e0 = d.e AND
+                t.a0 = d.a"]
+
+        t-datoms-not-already-present
+        ["INSERT INTO transactions (e, a, v, tx, added, value_type_tag)
+          SELECT e0, a0, v0, ?, 1, value_type_tag0
+          FROM tx_lookup
+          WHERE added0 IS 3 AND e IS NULL" tx] ;; TODO: get rid of magic value 3.
+
+        t-retract-datoms-carefully
+        ["INSERT INTO transactions (e, a, v, tx, added, value_type_tag)
+          SELECT e, a, v, ?, 0, value_type_tag
+          FROM tx_lookup
+          WHERE added0 IS 2 AND ((sv IS NOT NULL) OR (sv IS NULL AND v0 IS NOT v)) AND v IS NOT NULL" tx] ;; TODO: get rid of magic value 2.
+]
+    (go-pair
+      (doseq [q [build-indices insert-into-tx-lookup
+                 t-datoms-not-already-present
+                 t-retract-datoms-carefully]]
+        (<? (s/execute! conn q))))))
+
+(defn- -build-datoms [conn tx]
+  (let [d-datoms-not-already-present
+        ["INSERT INTO datoms (e, a, v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value)
+          SELECT e0, a0, v0, ?, value_type_tag0,
+          index_avet0, index_vaet0, index_fulltext0, unique_value0
+          FROM tx_lookup
+          WHERE added0 IS 3 AND e IS NULL" tx] ;; TODO: get rid of magic value 3.
+
+        ;; TODO: retract fulltext datoms correctly.
+        d-retract-datoms-carefully
+        ["WITH ids AS (SELECT l.rid FROM tx_lookup AS l WHERE l.added0 IS 2 AND ((l.sv IS NOT NULL) OR (l.sv IS NULL AND l.v0 IS NOT l.v)))
+         DELETE FROM datoms WHERE rowid IN ids" ;; TODO: get rid of magic value 2.
+         ]]
+    (-run-queries conn [d-datoms-not-already-present d-retract-datoms-carefully]
+                  "Transaction violates unique constraint")))
+
+(defn- -<apply-entities [db tx entities]
+  (let [schema         (.-schema db)
+        ->SQLite       (partial ds/->SQLite schema)
+        fulltext?      (memoize (partial ds/fulltext? schema))
+        many?          (memoize (fn [a] (ds/multival? schema a)))
+        indexing?      (memoize (fn [a] (ds/indexing? schema a)))
+        ref?           (memoize (fn [a] (ds/ref? schema a)))
+        unique?        (memoize (fn [a] (ds/unique? schema a)))
+        conn           (:sqlite-connection db)
+
+        ;; Collect all the queries we need to run.
+        queries (atom [])
+        operations (group-by first entities)]
+
+    (when-not (clojure.set/subset? (keys operations) #{:db/retract :db/add})
+      (raise (str "Unknown operations " (keys operations))
+             {:error :transact/syntax, :operations (dissoc operations :db/retract :db/add)}))
+
+    ;; We can turn all non-FTS operations into simple SQL queries that we run serially.
+    ;; FTS queries require us to get a rowid from the FTS table and use that for
+    ;; insertion, so we need another pass.
+    ;; We can't just freely use `go-pair` here, because this function is so complicated
+    ;; that ClojureScript blows the stack trying to compile it.
+
+    (when-let [retractions (:db/retract operations)]
+      (swap!
+        queries concat (retractions->queries retractions tx fulltext? ->SQLite)))
+
+    ;; We want to partition our additions into four groups according to two
+    ;; characteristics: whether they require writing to the FTS value table,
+    ;; and whether the attribute has a 'many' cardinality constraint. Each of
+    ;; these four requires different queries.
+    (let [additions
+          (group-by (fn [[op e a v]]
+                      (if (fulltext? a)
+                        (if (many? a)
+                          :fts-many
+                          :fts-one)
+                        (if (many? a)
+                          :non-fts-many
+                          :non-fts-one)))
+                    (:db/add operations))
+          transforms
+          {:fts-one fts-one->queries
+           :fts-many fts-many->queries
+           :non-fts-one non-fts-one->queries
+           :non-fts-many non-fts-many->queries}]
+
+      (doseq [[key ops] additions]
+        (when-let [transform (key transforms)]
+          (swap!
+            queries concat
+            (transform ops tx ->SQLite indexing? ref? unique?)))))
+
+    ;; Now run each query.
+    ;; This code is a little tortured to avoid blowing the compiler stack in cljs.
+
+    (go-pair
+      (<? (-preamble-drop conn))
+
+      (p :run-insert-queries
+         (<? (-run-queries conn @queries "Transaction violates cardinality constraint")))
+
+      ;; Follow up by building indices, then do the work.
+      (p :build-and-transaction
+         (<? (-build-transaction conn tx)))
+
+      (p :update-materialized-datoms
+         (<? (-build-datoms conn tx)))
+
+      (<? (-after-drop conn))
+
+      ;; Return the written transaction.
+      (p :select-tx-data
+         (mapv (partial row->Datom schema)
+               (<?
+                 (s/all-rows
+                   (:sqlite-connection db)
+                   ;; We index on tx, so the following is fast.
+                   ["SELECT * FROM transactions WHERE tx = ?" tx])))))))
+
+(defrecord DB [sqlite-connection schema ident-map]
+  ;; ident-map maps between keyword idents and integer entids.  The set of idents and entids is
+  ;; disjoint, so we represent both directions of the mapping in the same map for simplicity.  Also
+  ;; for simplicity, we assume that an entid has at most one associated ident, and vice-versa.  See
+  ;; http://docs.datomic.com/identity.html#idents.
+
+  ;; TODO: cache parts.  parts looks like {:db.part/db {:start 0 :current 10}}.  It maps between
+  ;; keyword ident part names and integer ranges.
   IDB
-  (query-context [db] (context/->Context (source/datoms-source db) nil nil))
+  (query-context [db] (context/make-context (datoms-source db)))
 
   (schema [db] (.-schema db))
 
-  (idents [db] (.-idents db))
+  (entid [db ident]
+    (if (keyword? ident)
+      (get (.-ident-map db) ident ident)
+      ident))
 
-  (current-tx
-    [db]
-    (inc (:current-tx db)))
+  (ident [db eid]
+    (if-not (keyword? eid)
+      (get (.-ident-map db) eid eid)
+      eid))
 
   (in-transaction! [db chan-fn]
     (s/in-transaction!
       (:sqlite-connection db) chan-fn))
 
-  ;; TODO: use q for searching?  Have q use this for searching for a single pattern?
-  (<eavt [db pattern]
-    (let [[e a v] pattern
-          v       (and v (ds/->SQLite schema a v))] ;; We assume e and a are always given.
-      (go-pair
-        (->>
-          {:select [:e :a :v :tx [1 :added]] ;; TODO: generalize columns.
-           :from   [:all_datoms]
-           :where  (cons :and (map #(vector := %1 %2) [:e :a :v] (take-while (comp not nil?) [e a v])))} ;; Must drop nils.
-          (s/format)
-
-          (s/all-rows (:sqlite-connection db))
-          (<?)
-
-          (mapv (partial row->Datom (.-schema db))))))) ;; TODO: understand why (schema db) fails.
-
-  (<avet [db pattern]
-    (let [[a v] pattern
-          v     (ds/->SQLite schema a v)]
-      (go-pair
-        (->>
-          {:select [:e :a :v :tx [1 :added]] ;; TODO: generalize columns.
-           :from   [:all_datoms]
-           :where  [:and [:= :a a] [:= :v v] [:= :index_avet 1]]}
-          (s/format)
-
-          (s/all-rows (:sqlite-connection db))
-          (<?)
-
-          (mapv (partial row->Datom (.-schema db))))))) ;; TODO: understand why (schema db) fails.
-
-  (<apply-datoms [db datoms]
+  (<bootstrapped? [db]
     (go-pair
-      (let [exec   (partial s/execute! (:sqlite-connection db))
-            schema (.-schema db)] ;; TODO: understand why (schema db) fails.
-        ;; TODO: batch insert, batch delete.
-        (doseq [datom datoms]
-          (let [[e a v tx added] datom
-                v                (ds/->SQLite schema a v)
-                fulltext?        (ds/fulltext? schema a)]
-            ;; Append to transaction log.
-            (<? (exec
-                  ["INSERT INTO transactions VALUES (?, ?, ?, ?, ?)" e a v tx (if added 1 0)]))
-            ;; Update materialized datom view.
-            (if (.-added datom)
-              (let [v (if fulltext?
-                        (<? (<insert-fulltext-value db v))
-                        v)]
-                (<? (exec
-                      ["INSERT INTO datoms VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)" e a v tx
-                       (ds/indexing? schema a) ;; index_avet
-                       (ds/ref? schema a) ;; index_vaet
-                       fulltext? ;; index_fulltext
-                       (ds/unique-value? schema a) ;; unique_value
-                       (ds/unique-identity? schema a) ;; unique_identity
-                       ])))
-              (if fulltext?
-                (<? (exec
-                      ;; TODO: in the future, purge fulltext values from the fulltext_datoms table.
-                      ["DELETE FROM datoms WHERE (e = ? AND a = ? AND v IN (SELECT rowid FROM fulltext_values WHERE text = ?))" e a v]))
-                (<? (exec
-                      ["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" e a v])))))))
-      db))
+      (->
+        (:sqlite-connection db)
+        (s/all-rows ["SELECT EXISTS(SELECT 1 FROM transactions LIMIT 1) AS bootstrapped"])
+        (<?)
+        (first)
+        (:bootstrapped)
+        (not= 0))))
 
-  (<advance-tx [db]
+  (<av [db a v]
+    (let [schema (.-schema db) ;; TODO: understand why (schema db) fails.
+          a (entid db a)
+          [v tag] (ds/->SQLite schema a v)
+          yield-datom
+          (fn [rows]
+            (when-let [row (first rows)]
+              (row->Datom schema row)))]
+      (go-pair
+        (->>
+          ;; TODO: generalize columns.
+          ["SELECT e, a, v, tx, 1 AS added FROM all_datoms
+           WHERE index_avet = 1 AND a = ? AND value_type_tag = ? AND v = ?
+           LIMIT 1" a tag v]
+
+          (s/all-rows (:sqlite-connection db))
+          <?
+          yield-datom))))
+
+  (<next-eid [db tempid]
+    {:pre [(id-literal? tempid)]}
+    {:post [ds/entid?]}
+    (go-pair
+      ;; TODO: keep all of these eid allocations in the transaction report and apply them at the end
+      ;; of the transaction.
+      (let [exec (partial s/execute! (:sqlite-connection db))
+            part (entid db (:part tempid))]
+        (when-not (ds/entid? part) ;; TODO: cache parts materialized view.
+          (raise "Cannot allocate entid for id-literal " tempid " because part " (:part tempid) " is not known"
+                 {:error :db/bad-part
+                  :part (:part tempid)}))
+
+        (p :next-eid-body
+           (<? (exec ["UPDATE parts SET idx = idx + 1 WHERE part = ?" part]))
+        (:eid (first (<? (s/all-rows (:sqlite-connection db) ["SELECT (start + idx) AS eid FROM parts WHERE part = ?" part]))))))))
+
+  (<apply-entities [db tx entities]
+    {:pre [(db? db) (sequential? entities)]}
+    (-<apply-entities db tx entities))
+
+
+  (<apply-db-ident-assertions [db added-idents merge]
     (go-pair
       (let [exec (partial s/execute! (:sqlite-connection db))]
-        ;; (let [ret (<? (exec
-        ;;                 ;; TODO: be more clever about UPDATE OR ...?
-        ;;                 ["UPDATE metadata SET current_tx = ? WHERE current_tx = ?" (inc (:current-tx db)) (:current-tx db)]))]
-
-        ;; TODO: handle exclusion across transactions here.
-        (update db :current-tx inc))))
-
-  (<apply-db-ident-assertions [db added-idents]
-    (go-pair
-      (let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
-            exec     (partial s/execute! (:sqlite-connection db))]
         ;; TODO: batch insert.
         (doseq [[ident entid] added-idents]
           (<? (exec
-                ["INSERT INTO idents VALUES (?, ?)" (->SQLite ident) entid]))))
-      db))
+                ["INSERT INTO idents VALUES (?, ?)" (sqlite-schema/->SQLite ident) entid]))))
 
-  (<apply-db-install-assertions [db fragment]
+      (let [db (update db :ident-map #(merge-with merge % added-idents))
+            db (update db :ident-map #(merge-with merge % (clojure.set/map-invert added-idents)))]
+        db)))
+
+  (<apply-db-install-assertions [db fragment merge]
     (go-pair
-      (let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
-            exec     (partial s/execute! (:sqlite-connection db))]
+      (let [exec (partial s/execute! (:sqlite-connection db))]
         ;; TODO: batch insert.
         (doseq [[ident attr-map] fragment]
           (doseq [[attr value] attr-map]
             (<? (exec
-                  ["INSERT INTO schema VALUES (?, ?, ?)" (->SQLite ident) (->SQLite attr) (->SQLite value)])))))
-      db))
+                  ["INSERT INTO schema VALUES (?, ?, ?)" (sqlite-schema/->SQLite ident) (sqlite-schema/->SQLite attr) (sqlite-schema/->SQLite value)])))))
+
+      (let [symbolic-schema (merge-with merge (:symbolic-schema db) fragment)
+            schema          (ds/schema (into {} (map (fn [[k v]] [(entid db k) v]) symbolic-schema)))]
+        (assoc db
+               :symbolic-schema symbolic-schema
+               :schema schema))))
 
   (close-db [db] (s/close (.-sqlite-connection db)))
 
@@ -261,6 +600,24 @@
        :cljs
        (.getTime (js/Date.)))))
 
+(defn with-ident [db ident entid]
+  (update db :ident-map #(assoc % ident entid, entid ident)))
+
+(defn db [sqlite-connection idents schema]
+  {:pre [(map? idents)
+         (every? keyword? (keys idents))
+         (map? schema)
+         (every? keyword? (keys schema))]}
+  (let [entid-schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) schema))) ;; TODO: fail if ident missing.
+        ident-map    (into idents (clojure.set/map-invert idents))]
+    (map->DB
+      {:sqlite-connection sqlite-connection
+       :ident-map         ident-map
+       :symbolic-schema   schema
+       :schema            entid-schema
+       ;; TODO :parts
+       })))
+
 ;; TODO: factor this into the overall design.
 (defn <?run
   "Execute the provided query on the provided DB.

src/datomish/db/debug.cljc

@@ -0,0 +1,59 @@
+;; 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.debug
+  #?(:cljs
+     (:require-macros
+      [datomish.pair-chan :refer [go-pair <?]]
+      [cljs.core.async.macros :refer [go]]))
+  (:require
+   [datomish.db :as db]
+   [datomish.datom :as dd :refer [datom datom? #?@(:cljs [Datom])]]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
+   [datomish.sqlite :as s]
+   #?@(: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 <! >!]]]))
+  #?(:clj
+     (:import
+      [datomish.datom Datom])))
+
+(defn <datoms-after [db tx]
+  (go-pair
+    (->>
+      (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx > ?" tx])
+      (<?)
+      (mapv #(vector (:e %) (db/ident db (:a %)) (:v %)))
+      (filter #(not (= :db/txInstant (second %))))
+      (set))))
+
+(defn <datoms [db]
+  (<datoms-after db 0))
+
+(defn <shallow-entity [db eid]
+  ;; TODO: make this actually be <entity.  Handle :db.cardinality/many and :db/isComponent.
+  (go-pair
+    (->>
+      (s/all-rows (:sqlite-connection db) ["SELECT a, v FROM datoms WHERE e = ?" eid])
+      (<?)
+      (mapv #(vector (db/ident db (:a %)) (:v %)))
+      (reduce conj {}))))
+
+(defn <transactions-after [db tx]
+  (go-pair
+    (->>
+      (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions WHERE tx > ? ORDER BY tx ASC, e, a, v, added" tx])
+      (<?)
+      (mapv #(vector (:e %) (db/ident db (:a %)) (:v %) (:tx %) (:added %))))))
+
+(defn <transactions [db]
+  (<transactions-after db 0))
+
+(defn <fulltext-values [db]
+  (go-pair
+    (->>
+      (s/all-rows (:sqlite-connection db) ["SELECT rowid, text FROM fulltext_values"])
+      (<?)
+      (mapv #(vector (:rowid %) (:text %))))))

src/datomish/db_factory.cljc

@@ -23,60 +23,58 @@
      (:import
       [datomish.datom Datom])))
 
-;; TODO: implement support for DB parts?
-(def tx0 0x2000000)
-
 (defn <idents [sqlite-connection]
   "Read the ident map materialized view from the given SQLite store.
   Returns a map (keyword ident) -> (integer entid), like {:db/ident 0}."
 
-  (let [<-SQLite (get-in ds/value-type-map [:db.type/keyword :<-SQLite])] ;; TODO: make this a protocol.
-    (go-pair
-      (let [rows (<? (->>
-                       {:select [:ident :entid] :from [:idents]}
-                       (s/format)
-                       (s/all-rows sqlite-connection)))]
-        (into {} (map (fn [row] [(<-SQLite (:ident row)) (:entid row)])) rows)))))
-
-(defn <current-tx [sqlite-connection]
-  "Find the largest tx written to the SQLite store.
-  Returns an integer, -1 if no transactions have been written yet."
-
   (go-pair
-    (let [rows (<? (s/all-rows sqlite-connection ["SELECT COALESCE(MAX(tx), -1) AS current_tx FROM transactions"]))]
-      (:current_tx (first rows)))))
+    (let [rows (<? (->>
+                     {:select [:ident :entid] :from [:idents]}
+                     (s/format)
+                     (s/all-rows sqlite-connection)))]
+      (into {} (map (fn [row] [(sqlite-schema/<-SQLite :db.type/keyword (:ident row)) (:entid row)])) rows))))
 
 (defn <symbolic-schema [sqlite-connection]
   "Read the schema map materialized view from the given SQLite store.
   Returns a map (keyword ident) -> (map (keyword attribute -> keyword value)), like
   {:db/ident {:db/cardinality :db.cardinality/one}}."
 
-  (let [<-SQLite (get-in ds/value-type-map [:db.type/keyword :<-SQLite])] ;; TODO: make this a protocol.
-    (go-pair
+  (go-pair
+    (->>
       (->>
-        (->>
-          {:select [:ident :attr :value] :from [:schema]}
-          (s/format)
-          (s/all-rows sqlite-connection))
-        (<?)
+        {:select [:ident :attr :value] :from [:schema]}
+        (s/format)
+        (s/all-rows sqlite-connection))
+      (<?)
 
-        (group-by (comp <-SQLite :ident))
-        (map (fn [[ident rows]]
-               [ident
-                (into {} (map (fn [row]
-                                [(<-SQLite (:attr row)) (<-SQLite (:value row))]) rows))]))
-        (into {})))))
+      (group-by (comp (partial sqlite-schema/<-SQLite :db.type/keyword) :ident))
+      (map (fn [[ident rows]]
+             [ident
+              (into {} (map (fn [row]
+                              [(sqlite-schema/<-SQLite :db.type/keyword (:attr row))
+                               (sqlite-schema/<-SQLite :db.type/keyword (:value row))]) rows))])) ;; TODO: this is wrong, it doesn't handle true.
+      (into {}))))
+
+(defn <initialize-connection [sqlite-connection]
+  (go-pair
+    ;; Some of these return values when set, and some don't, hence the craziness here.
+    (<? (s/execute! sqlite-connection ["PRAGMA page_size=32768"]))
+    (<? (s/all-rows sqlite-connection ["PRAGMA journal_mode=wal"]))
+    (<? (s/all-rows sqlite-connection ["PRAGMA wal_autocheckpoint=32"]))
+    (<? (s/all-rows sqlite-connection ["PRAGMA journal_size_limit=3145728"]))
+    (s/execute! sqlite-connection ["PRAGMA foreign_keys=ON"])))
 
 (defn <db-with-sqlite-connection
   [sqlite-connection]
   (go-pair
+    (<? (<initialize-connection sqlite-connection))
+
     (when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
       (raise "Could not ensure current SQLite schema version."))
 
-    (let [current-tx   (<? (<current-tx sqlite-connection))
-          bootstrapped (>= current-tx 0)
-          current-tx   (max current-tx tx0)]
-      (when-not bootstrapped
+    (let [db            (db/db sqlite-connection bootstrap/idents bootstrap/symbolic-schema)
+          bootstrapped? (<? (db/<bootstrapped? db))]
+      (when-not bootstrapped?
         ;; We need to bootstrap the DB.
         (let [fail-alter-ident (fn [old new] (if-not (= old new)
                                                (raise "Altering idents is not yet supported, got " new " altering existing ident " old
@@ -86,39 +84,40 @@
                                                (raise "Altering schema attributes is not yet supported, got " new " altering existing schema attribute " old
                                                       {:error :schema/alter-schema :old old :new new})
                                                new))]
-          (-> (db/map->DB
-                {:sqlite-connection sqlite-connection
-                 :idents            bootstrap/idents
-                 :symbolic-schema   bootstrap/symbolic-schema
-                 :schema            (ds/schema (into {} (map (fn [[k v]] [(k bootstrap/idents) v]) bootstrap/symbolic-schema))) ;; TODO: fail if ident missing.
-                 :current-tx        current-tx})
-              ;; We use <with-internal rather than <transact! to apply the bootstrap transaction
-              ;; data but to not follow the regular schema application process.  We can't apply the
-              ;; schema changes, since the applied datoms would conflict with the bootstrapping
-              ;; idents and schema.  (The bootstrapping idents and schema are required to be able to
-              ;; write to the database conveniently; without them, we'd have to manually write
-              ;; datoms to the store.  It's feasible but awkward.)  After bootstrapping, we read
-              ;; back the idents and schema, just like when we re-open.
-              (transact/<with-internal (bootstrap/tx-data) fail-alter-ident fail-alter-attr)
-              (<?))))
+          (do
+            (let [exec (partial s/execute! (:sqlite-connection db))]
+              ;; TODO: allow inserting new parts.
+              ;; TODO: think more carefully about allocating new parts and bitmasking part ranges.
+              (<? (exec
+                    ["INSERT INTO parts VALUES (?, ?, ?)" (db/entid db :db.part/db) 0x0 (inc (apply max (vals bootstrap/idents)))]))
+              (<? (exec
+                    ["INSERT INTO parts VALUES (?, ?, ?)" (db/entid db :db.part/user) 0x10000 0]))
+              (<? (exec
+                    ["INSERT INTO parts VALUES (?, ?, ?)" (db/entid db :db.part/tx) 0x10000000 0])))
+            (-> db
+                ;; We use <with-internal rather than <transact! to apply the bootstrap transaction
+                ;; data but to not follow the regular schema application process.  We can't apply the
+                ;; schema changes, since the applied datoms would conflict with the bootstrapping
+                ;; idents and schema.  (The bootstrapping idents and schema are required to be able to
+                ;; write to the database conveniently; without them, we'd have to manually write
+                ;; datoms to the store.  It's feasible but awkward.)  After bootstrapping, we read
+                ;; back the idents and schema, just like when we re-open.
+                (transact/<with-internal (bootstrap/tx-data) fail-alter-ident fail-alter-attr)
+                (<?)))))
 
       ;; We just bootstrapped, or we are returning to an already bootstrapped DB.
       (let [idents          (<? (<idents sqlite-connection))
             symbolic-schema (<? (<symbolic-schema sqlite-connection))]
-        (when-not bootstrapped
+        (when-not bootstrapped?
+          ;; TODO: parts.
           (when (not (= idents bootstrap/idents))
             (raise "After bootstrapping database, expected new materialized idents and old bootstrapped idents to be identical"
                    {:error :bootstrap/bad-idents,
-                    :new idents :old bootstrap/idents
+                    :new   idents :old bootstrap/idents
                     }))
           (when (not (= symbolic-schema bootstrap/symbolic-schema))
             (raise "After bootstrapping database, expected new materialized symbolic schema and old bootstrapped symbolic schema to be identical"
                    {:error :bootstrap/bad-symbolic-schema,
-                    :new symbolic-schema :old bootstrap/symbolic-schema
+                    :new   symbolic-schema :old bootstrap/symbolic-schema
                     })))
-        (db/map->DB
-          {:sqlite-connection sqlite-connection
-           :idents            idents
-           :symbolic-schema   symbolic-schema
-           :schema            (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema))) ;; TODO: fail if ident missing.
-           :current-tx        (inc current-tx)})))))
+        (db/db sqlite-connection idents symbolic-schema)))))

src/datomish/exec_repl.cljc

@@ -9,6 +9,7 @@
       [datomish.pair-chan :refer [go-pair <?]]
       [cljs.core.async.macros :refer [go]]))
   (:require
+     [datomish.db-factory]
      [datomish.db :as db]
      [datomish.sqlite :as s]
      [datomish.sqlite-schema :as ss]
@@ -44,7 +45,7 @@
 #_
 (defn xxopen []
     (datomish.pair-chan/go-pair
-      (let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))]
+      (let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/import.sqlite"))]
         (clojure.core.async/<!! (ss/<ensure-current-version d))
         (def db d))))
 
@@ -59,19 +60,26 @@
       "/tmp/foo.sqlite"
       '[:find ?page :in $ :where [?page :page/starred true ?t]]))
 
+#_(require 'datomish.exec-repl)
+#_(in-ns 'datomish.exec-repl)
 #_
 (go-pair
-  (let [connection (<? (s/<sqlite-connection "/tmp/foo.sqlite"))
-        d (<? (db/<with-sqlite-connection connection))]
-    (println
-      "Result: "
-      (<! (db/<?q d '[:find ?page :in $ :where [?page :page/starred true ?t]] {})))))
+  (let [connection (<? (s/<sqlite-connection "/tmp/bigport.db"))
+        d (<? (datomish.db-factory/<db-with-sqlite-connection connection))]
+    (def db d)))
+
+#_
+(go-pair
+  (println (count (first (time
+    (<! (db/<?q db
+                '[:find ?url ?title :in $ :where
+                  [?page :page/visitAt ?v] [(> ?v 1438748166567751)] [?page :page/title ?title] [?page :page/url ?url] ] {})))))))
 
 
 #_
 (go-pair
   (let [connection (<? (s/<sqlite-connection "/tmp/foo.sqlite"))
-        dd (<? (db/<with-sqlite-connection connection))]
+        dd (<? (datomish.db-factory/<db-with-sqlite-connection connection))]
     (def *db* dd)))
 #_
 (clojure.core.async/<!!

src/datomish/places/import.cljc

@@ -0,0 +1,114 @@
+;; 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.places.import
+  #?(:cljs
+     (:require-macros
+      [datomish.pair-chan :refer [go-pair <?]]
+      [cljs.core.async.macros :refer [go]]))
+  (:require
+     [datomish.db :as db]
+     [datomish.transact :as transact]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
+   [datomish.sqlite :as s]
+   #?@(: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 <! >!]]])))
+
+(def places-schema-fragment
+  [{:db/id        (db/id-literal :db.part/user)
+    :db/ident     :page/url
+    :db/unique    :db.unique/identity
+    :db/valueType :db.type/string ;; TODO: uri
+    :db.install/_attribute :db.part/db}
+   {:db/id        (db/id-literal :db.part/user)
+    :db/ident     :page/guid
+    :db/unique    :db.unique/identity
+    :db/valueType :db.type/string ;; TODO: uuid or guid?
+    :db.install/_attribute :db.part/db}
+   {:db/id          (db/id-literal :db.part/user)
+    :db/ident       :page/title
+    :db/cardinality :db.cardinality/one
+    :db/valueType   :db.type/string
+    :db.install/_attribute :db.part/db}
+   {:db/id        (db/id-literal :db.part/user)
+    :db/ident     :page/visitAt
+    :db/cardinality :db.cardinality/many
+    :db/valueType :db.type/long ;; TODO: instant
+    :db.install/_attribute :db.part/db}
+   ])
+
+(defn assoc-if
+  ([m k v]
+   (if v
+     (assoc m k v)
+     m))
+  ([m k v & kvs]
+   (if kvs
+     (let [[kk vv & remainder] kvs]
+       (apply assoc-if
+              (assoc-if m k v)
+              kk vv remainder))
+     (assoc-if m k v))))
+
+
+(defn- place->entity [[id rows]]
+  (let [title (:title (first rows))
+        required {:db/id (db/id-literal :db.part/user)
+                  :page/url (:url (first rows))
+                  :page/guid (:guid (first rows))}
+        visits (keep :visit_date rows)]
+
+    (assoc-if required
+              :page/title title
+              :page/visitAt visits)))
+
+(defn import-titles [conn places-connection]
+  (go-pair
+    (let [rows
+          (<?
+            (s/all-rows
+              places-connection
+              ["SELECT DISTINCT p.title AS title, p.guid
+               FROM moz_places AS p
+               WHERE p.title IS NOT NULL AND p.hidden = 0 LIMIT 10"]))]
+      (<?
+        (transact/<transact!
+          conn
+          (map (fn [row]
+                 {:db/id [:page/guid (:guid row)]
+                  :page/title (:title row)})
+               rows))))))
+
+(defn import-places [conn places-connection]
+  (go-pair
+    ;; Ensure schema fragment is in place, even though it may cost a (mostly empty) transaction.
+    (<? (transact/<transact! conn places-schema-fragment))
+
+    (let [rows
+          (<?
+            (s/all-rows
+              places-connection
+              ["SELECT DISTINCT p.id AS id, p.url AS url, p.title AS title, p.visit_count, p.last_visit_date, p.guid,
+               hv.visit_date
+               FROM (SELECT * FROM moz_places LIMIT 1000) AS p LEFT JOIN moz_historyvisits AS hv ON p.id = hv.place_id
+               WHERE p.hidden = 0
+               ORDER BY p.id, hv.visit_date"]))]
+      (<?
+        (transact/<transact!
+          conn
+          (map place->entity (group-by :id rows)))))))
+
+(defn import-titles-from-path [db places]
+  (go-pair
+    (let [conn (transact/connection-with-db db)
+          pdb (<? (s/<sqlite-connection places))]
+      (import-titles conn pdb))))
+
+(defn import-places-from-path [db places]
+  (go-pair
+    (let [conn (transact/connection-with-db db)
+          pdb (<? (s/<sqlite-connection places))]
+      (import-places conn pdb))))

src/datomish/query.cljc

@@ -40,14 +40,26 @@
 (def sql-quoting-style :ansi)
 
 (defn context->sql-clause [context]
-  (merge
-    {:select (projection/sql-projection context)
+  (let [inner
+        (merge
+          {:select (projection/sql-projection-for-relation context)
 
-     ;; Always SELECT DISTINCT, because Datalog is set-based.
-     ;; TODO: determine from schema analysis whether we can avoid
-     ;; the need to do this.
-     :modifiers [:distinct]}
-    (clauses/cc->partial-subquery (:cc context))))
+           ;; Always SELECT DISTINCT, because Datalog is set-based.
+           ;; TODO: determine from schema analysis whether we can avoid
+           ;; the need to do this.
+           :modifiers [:distinct]}
+
+          (when-not (empty? (:group-by-vars context))
+            ;; We shouldn't need to account for types here, until we account for
+            ;; `:or` clauses that bind from different attributes.
+            {:group-by (map util/var->sql-var (:group-by-vars context))})
+
+          (clauses/cc->partial-subquery (:cc context)))]
+  (if (:has-aggregates? context)
+    {:select (projection/sql-projection-for-aggregation context :inner)
+     :modifiers [:distinct]
+     :from [[inner :inner]]}
+    inner)))
 
 (defn context->sql-string [context args]
   (->
@@ -56,8 +68,9 @@
     (sql/format args :quoting sql-quoting-style)))
 
 (defn- validate-with [with]
-  (when-not (nil? with)
-    (raise-str "`with` not supported.")))
+  (when-not (or (nil? with)
+                (every? #(instance? Variable %1) with))
+    (raise "Complex :with not supported." {:with with})))
 
 (defn- validate-in [in]
   (when (nil? in)
@@ -91,10 +104,15 @@
   (let [{:keys [find in with where]} find]  ; Destructure the Datalog query.
     (validate-with with)
     (validate-in in)
-    (let [external-bindings (in->bindings in)]
+    (let [external-bindings (in->bindings in)
+          elements (:elements find)
+          known-types {}
+          group-by-vars (projection/extract-group-by-vars elements with)]
       (assoc context
-             :elements (:elements find)
-             :cc (clauses/patterns->cc (:default-source context) where external-bindings)))))
+             :elements elements
+             :group-by-vars group-by-vars
+             :has-aggregates? (not (nil? group-by-vars))
+             :cc (clauses/patterns->cc (:default-source context) where known-types external-bindings)))))
 
 (defn find->sql-clause
   "Take a parsed `find` expression and turn it into a structured SQL
@@ -116,21 +134,22 @@
   [q]
   (dp/parse-query q))
 
-(comment
-  (def sql-quoting-style nil)
-  (datomish.query/find->sql-string
-    (datomish.query.context/->Context (datomish.query.source/datoms-source nil) nil nil)
-    (datomish.query/parse
-      '[:find ?timestampMicros ?page :in $ ?latest :where
-        [?page :page/starred true ?t]
-        [?t :db/txInstant ?timestampMicros]
-        (not [(> ?t ?latest)]) ])
-    {:latest 5})
-)
+#_
+(def sql-quoting-style nil)
 
 #_
 (datomish.query/find->sql-string
-  (datomish.query.context/->Context (datomish.query.source/datoms-source nil) nil nil)
+  (datomish.query.context/make-context (datomish.query.source/datoms-source nil))
+  (datomish.query/parse
+    '[:find ?timestampMicros ?page :in $ ?latest :where
+      [?page :page/starred true ?t]
+      [?t :db/txInstant ?timestampMicros]
+      (not [(> ?t ?latest)]) ])
+  {:latest 5})
+
+#_
+(datomish.query/find->sql-string
+  (datomish.query.context/make-context (datomish.query.source/datoms-source nil))
   (datomish.query/parse
     '[:find ?page :in $ ?latest :where
       [?page :page/url "http://example.com/"]

src/datomish/query/cc.cljc

@@ -8,6 +8,7 @@
       :refer [attribute-in-source
               constant-in-source]]
      [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
+     [honeysql.core :as sql]
      [datascript.parser :as dp
       #?@(:cljs
             [:refer
@@ -52,27 +53,97 @@
 ;;
 ;; `from` is a list of [source alias] pairs, suitable for passing to honeysql.
 ;; `bindings` is a map from var to qualified columns.
+;; `known-types` is a map from var to type keyword.
+;; `extracted-types` is a mapping, similar to `bindings`, but used to pull
+;; type tags out of the store at runtime.
 ;; `wheres` is a list of fragments that can be joined by `:and`.
-(defrecord ConjoiningClauses [source from external-bindings bindings wheres])
+(defrecord ConjoiningClauses
+           [source
+            from              ; [[:datoms 'datoms123]]
+            external-bindings ; {?var0 (sql/param :foobar)}
+            bindings          ; {?var1 :datoms123.v}
+            known-types       ; {?var1 :db.type/integer}
+            extracted-types   ; {?var2 :datoms123.value_type_tag}
+            wheres            ; [[:= :datoms123.v 15]]
+            ])
 
-(defn bind-column-to-var [cc variable col]
-  (let [var (:symbol variable)]
-    (util/conj-in cc [:bindings var] col)))
+(defn bind-column-to-var [cc variable table position]
+  (let [var (:symbol variable)
+        col (sql/qualify table (name position))
+        bound (util/append-in cc [:bindings var] col)]
+    (if (or (not (= position :v))
+            (contains? (:known-types cc) var)
+            (contains? (:extracted-types cc) var))
+      ;; Type known; no need to accumulate a type-binding.
+      bound
+      (let [tag-col (sql/qualify table :value_type_tag)]
+        (println "Binding type of var" var "from" col ": type in" tag-col)
+        (assoc-in bound [:extracted-types var] tag-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 constrain-column-to-constant [cc table position value]
+  (let [col (sql/qualify table (name position))]
+    (util/append-in cc
+                    [:wheres]
+                    [:= col (if (= :a position)
+                              (attribute-in-source (:source cc) value)
+                              (constant-in-source (:source cc) value))])))
 
-(defn augment-cc [cc from bindings wheres]
+(defprotocol ITypeTagged (->tag-codes [x]))
+
+(extend-protocol ITypeTagged
+  #?@(:cljs
+      [string               (->tag-codes [x] #{4 10 11 12})
+       Keyword              (->tag-codes [x] #{13})   ; TODO: what about idents?
+       boolean              (->tag-codes [x] #{1})
+       number               (->tag-codes [x]
+                              (if (integer? x)
+                                #{0 4 5}     ; Could be a ref or a number or a date.
+                                #{4 5}))])   ; Can't be a ref.
+  #?@(:clj
+      [String               (->tag-codes [x] #{10})
+       clojure.lang.Keyword (->tag-codes [x] #{13})   ; TODO: what about idents?
+       Boolean              (->tag-codes [x] #{1})
+       Integer              (->tag-codes [x] #{0 5})  ; Could be a ref or a number.
+       Long                 (->tag-codes [x] #{0 5})  ; Could be a ref or a number.
+       Float                (->tag-codes [x] #{5})
+       Double               (->tag-codes [x] #{5})
+       java.util.UUID       (->tag-codes [x] #{11})
+       java.util.Date       (->tag-codes [x] #{4})
+       java.net.URI         (->tag-codes [x] #{12})]))
+
+(defn constrain-value-column-to-constant
+  "Constrain a `v` column. Note that this can contribute *two*
+   constraints: one for the column itself, and one for the type tag.
+   We don't need to do this if the attribute is known and thus
+   constrains the type."
+  [cc table-alias value]
+  (let [possible-type-codes (->tag-codes value)
+        aliased (sql/qualify table-alias (name :value_type_tag))
+        clauses (map
+                  (fn [code] [:= aliased code])
+                  possible-type-codes)]
+    (util/concat-in cc [:wheres]
+                    ;; Type checks then value checks.
+                    [(case (count clauses)
+                       0 (raise-str "Unexpected number of clauses.")
+                       1 (first clauses)
+                       (cons :or clauses))
+                     [:= (sql/qualify table-alias (name :v))
+                         (constant-in-source (:source cc) value)]])))
+
+(defn augment-cc [cc from bindings extracted-types wheres]
   (assoc cc
          :from (concat (:from cc) from)
          :bindings (merge-with concat (:bindings cc) bindings)
+         :extracted-types (merge (:extracted-types cc) extracted-types)
          :wheres (concat (:wheres cc) wheres)))
 
 (defn merge-ccs [left right]
-  (augment-cc left (:from right) (:bindings right) (:wheres right)))
+  (augment-cc left
+              (:from right)
+              (:bindings right)
+              (:extracted-types right)
+              (:wheres right)))
 
 (defn- bindings->where
   "Take a bindings map like
@@ -115,9 +186,9 @@
   (impose-external-bindings
     (assoc cc :wheres
            ;; Note that the order of clauses here means that cross-pattern var bindings
-           ;; come first. That's OK: the SQL engine considers these altogether.
-           (concat (bindings->where (:bindings cc))
-                   (:wheres cc)))))
+           ;; come last That's OK: the SQL engine considers these altogether.
+           (concat (:wheres cc)
+                   (bindings->where (:bindings cc))))))
 
 (defn binding-for-symbol-or-throw [cc symbol]
   (let [internal-bindings (symbol (:bindings cc))

src/datomish/query/clauses.cljc

@@ -4,64 +4,96 @@
 
 (ns datomish.query.clauses
   (:require
-     [datomish.query.cc :as cc]
-     [datomish.query.functions :as functions]
-     [datomish.query.source
-      :refer [attribute-in-source
-              constant-in-source
-              source->from
-              source->constraints]]
-     [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
-     [datascript.parser :as dp
-      #?@(:cljs
-            [:refer
-             [
-              Constant
-              DefaultSrc
-              Function
-              Not
-              Or
-              Pattern
-              Placeholder
-              PlainSymbol
-              Predicate
-              Variable
-              ]])]
-     [honeysql.core :as sql]
-     [clojure.string :as str]
-     )
+   [datomish.query.cc :as cc]
+   [datomish.query.functions :as functions]
+   [datomish.query.source
+    :refer [pattern->schema-value-type
+            attribute-in-source
+            constant-in-source
+            source->from
+            source->constraints]]
+   [datomish.schema :as schema]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
+   [datascript.parser :as dp
+    #?@(:cljs
+        [:refer
+         [
+          Constant
+          DefaultSrc
+          Function
+          Not
+          Or
+          Pattern
+          Placeholder
+          PlainSymbol
+          Predicate
+          Variable
+          ]])]
+   [honeysql.core :as sql]
+   [clojure.string :as str]
+   )
   #?(:clj
-       (:import
-          [datascript.parser
-           Constant
-           DefaultSrc
-           Function
-           Not
-           Or
-           Pattern
-           Placeholder
-           PlainSymbol
-           Predicate
-           Variable
-           ])))
+     (:import
+      [datascript.parser
+       Constant
+       DefaultSrc
+       Function
+       Not
+       Or
+       Pattern
+       Placeholder
+       PlainSymbol
+       Predicate
+       Variable
+       ])))
 
 ;; Pattern building is recursive, so we need forward declarations.
 (declare
   Not->NotJoinClause not-join->where-fragment
   simple-or? simple-or->cc)
 
+(defn- check-or-apply-value-type [cc value-type pattern-part]
+  (if (nil? value-type)
+    cc
+    (condp instance? pattern-part
+      Placeholder
+      cc
+
+      Variable
+      (let [var-sym (:symbol pattern-part)]
+        (if-let [existing-type (var-sym (:known-types cc))]
+          (if (= existing-type value-type)
+            cc
+            (raise "Var " var-sym " already has type " existing-type "; this pattern wants " value-type
+                   {:pattern pattern-part :value-type value-type}))
+          (assoc-in cc [:known-types var-sym] value-type)))
+
+      Constant
+      (do
+        (or (and (= :db.type/ref value-type)
+                 (or (keyword? (:value pattern-part))   ; ident
+                     (integer? (:value pattern-part)))) ; entid
+            (schema/ensure-value-matches-type value-type (:value pattern-part)))
+        cc))))
+
 (defn- apply-pattern-clause-for-alias
   "This helper assumes that `cc` has already established a table association
    for the provided alias."
   [cc alias pattern]
-  (let [places (map vector
-                    (:pattern pattern)
-                    (:columns (:source cc)))]
+  (let [pattern (:pattern pattern)
+        columns (:columns (:source cc))
+        places (map vector pattern columns)
+        value-type (pattern->schema-value-type (:source cc) pattern)]   ; Optional; e.g., :db.type/string
     (reduce
       (fn [cc
            [pattern-part                           ; ?x, :foo/bar, 42
             position]]                             ; :a
-        (let [col (sql/qualify alias (name position))]    ; :datoms123.a
+        (let [cc (case position
+                       ;; TODO: we should be able to constrain :e and :a to be
+                       ;; entities... but the type checker expects that to be an int.
+                       :v (check-or-apply-value-type cc value-type pattern-part)
+                       :e (check-or-apply-value-type cc :db.type/ref pattern-part)
+                       cc)]
           (condp instance? pattern-part
             ;; Placeholders don't contribute any bindings, nor do
             ;; they constrain the query -- there's no need to produce
@@ -70,10 +102,16 @@
             cc
 
             Variable
-            (cc/bind-column-to-var cc pattern-part col)
+            (cc/bind-column-to-var cc pattern-part alias position)
 
             Constant
-            (cc/constrain-column-to-constant cc col position (:value pattern-part))
+            (if (and (nil? value-type)
+                     (= position :v))
+              ;; If we don't know the type, but we have a constant, generate
+              ;; a :wheres clause constraining the accompanying value_type_tag
+              ;; column.
+              (cc/constrain-value-column-to-constant cc alias (:value pattern-part))
+              (cc/constrain-column-to-constant cc alias position (:value pattern-part)))
 
             (raise "Unknown pattern part." {:part pattern-part :clause pattern}))))
 
@@ -105,7 +143,7 @@
     (apply-pattern-clause-for-alias
 
       ;; Record the new table mapping.
-      (util/conj-in cc [:from] [table alias])
+      (util/append-in cc [:from] [table alias])
 
       ;; Use the new alias for columns.
       alias
@@ -114,7 +152,7 @@
 (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)))))
+  (#{:> :>= :< :<= := :!=} (keyword (name (:symbol fn)))))
 
 (defn apply-predicate-clause [cc predicate]
   (when-not (instance? Predicate predicate)
@@ -124,7 +162,7 @@
       (raise-str "Unknown function " (:fn predicate)))
 
     (let [args (map (partial cc/argument->value cc) (:args predicate))]
-      (util/conj-in cc [:wheres] (cons f args)))))
+      (util/append-in cc [:wheres] (cons f args)))))
 
 (defn apply-not-clause [cc not]
   (when-not (instance? Not not)
@@ -136,13 +174,19 @@
   ;; 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))))
+  ;;
+  ;; Note that we don't extract and reuse any types established inside
+  ;; the `not` clause: perhaps those won't make sense outside. But it's
+  ;; a filter, so we push the external types _in_.
+  (util/append-in cc
+                  [:wheres]
+                  (not-join->where-fragment
+                    (Not->NotJoinClause (:source cc)
+                                        (:known-types cc)
+                                        (merge-with concat
+                                                    (:external-bindings cc)
+                                                    (:bindings cc))
+                                        not))))
 
 (defn apply-or-clause [cc orc]
   (when-not (instance? Or orc)
@@ -163,6 +207,7 @@
 
   (if (simple-or? orc)
     (cc/merge-ccs cc (simple-or->cc (:source cc)
+                                    (:known-types cc)
                                     (merge-with concat
                                                 (:external-bindings cc)
                                                 (:bindings cc))
@@ -200,12 +245,14 @@
   [cc patterns]
   (reduce apply-clause cc patterns))
 
-(defn patterns->cc [source patterns external-bindings]
+(defn patterns->cc [source patterns known-types external-bindings]
   (cc/expand-where-from-bindings
     (expand-pattern-clauses
       (cc/map->ConjoiningClauses
         {:source source
          :from []
+         :known-types (or known-types {})
+         :extracted-types {}
          :external-bindings (or external-bindings {})
          :bindings {}
          :wheres []})
@@ -230,24 +277,23 @@
 ;; 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]
+(defn Not->NotJoinClause [source known-types external-bindings not]
   (when-not (instance? DefaultSrc (:source not))
     (raise "Non-default sources are not supported in `not` clauses." {:clause not}))
-  (make-not-join-clause source external-bindings (:vars not) (:clauses not)))
+  (map->NotJoinClause
+    {:unify-vars (:vars not)
+     :cc (patterns->cc source (:clauses not) known-types external-bindings)}))
 
 (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 (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)))])])
+     ;; If it does establish bindings, then it has to be a subquery.
+     [:exists (merge {:select [1]} (cc->partial-subquery (:cc not-join)))])])
 
 
 ;; A simple Or clause is one in which each branch can be evaluated against
@@ -288,15 +334,17 @@
 
 (defn simple-or->cc
   "The returned CC has not yet had bindings expanded."
-  [source external-bindings orc]
+  [source known-types external-bindings orc]
   (validate-or-clause orc)
 
   ;; We 'fork' a CC for each pattern, then union them together.
   ;; We need to build the first in order that the others use the same
-  ;; column names.
+  ;; column names and known types.
   (let [cc (cc/map->ConjoiningClauses
              {:source source
               :from []
+              :known-types (or known-types {})
+              :extracted-types {}
               :external-bindings (or external-bindings {})
               :bindings {}
               :wheres []})
@@ -307,6 +355,9 @@
       ;; That was easy.
       primary
 
+      ;; Note that for a simple `or` clause, the same template is used for each,
+      ;; so we can simply use the `extracted-types` bindings from `primary`.
+      ;; A complex `or` is much harder to handle.
       (let [template (assoc primary :wheres [])
             alias (second (first (:from template)))
             ccs (map (partial apply-pattern-clause-for-alias template alias)
@@ -315,7 +366,8 @@
         ;; Because this is a simple clause, we know that the first pattern established
         ;; any necessary bindings.
         ;; Take any new :wheres from each CC and combine them with :or.
-        (assoc primary :wheres
+        (assoc primary
+               :wheres
                [(cons :or
                      (reduce (fn [acc cc]
                                (let [w (:wheres cc)]

src/datomish/query/context.cljc

@@ -2,8 +2,18 @@
 ;; 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.
+;; A context, very simply, holds on to a default source and some knowledge
+;; needed for aggregation.
 (ns datomish.query.context)
 
-(defrecord Context [default-source elements cc])
+(defrecord Context
+  [
+   default-source
+   elements        ; The :find list itself.
+   has-aggregates?
+   group-by-vars   ; A list of variables from :find and :with, used to generate GROUP BY.
+   cc              ; The main conjoining clause.
+   ])
+
+(defn make-context [source]
+  (->Context source nil false nil nil))

src/datomish/query/functions.cljc

@@ -107,6 +107,8 @@
         from [[fulltext-table fulltext-alias]
               [datom-table datom-alias]]
 
+        extracted-types {}    ; TODO
+
         wheres [[:match match-column match-value]      ; The FTS match.
 
                 ;; The fulltext rowid-to-datom correspondence.
@@ -134,7 +136,7 @@
                           ;; if this is a variable rather than a placeholder.
                           [score [0]]]))]
 
-    (cc/augment-cc cc from bindings wheres)))
+    (cc/augment-cc cc from bindings extracted-types wheres)))
 
 (def sql-functions
   ;; Future: versions of this that uses snippet() or matchinfo().

src/datomish/query/projection.cljc

@@ -4,18 +4,114 @@
 
 (ns datomish.query.projection
   (:require
-   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise-str cond-let]]
+   [honeysql.core :as sql]
+   [datomish.query.source :as source]
+   [datomish.sqlite-schema :as ss]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
    [datascript.parser :as dp
-    #?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
+    #?@(:cljs [:refer [Aggregate Pattern DefaultSrc Variable Constant Placeholder PlainSymbol]])]
    )
-  #?(:clj (:import [datascript.parser Pattern DefaultSrc Variable Constant Placeholder]))
+  #?(:clj (:import [datascript.parser Aggregate Pattern DefaultSrc Variable Constant Placeholder PlainSymbol]))
   )
 
 (defn lookup-variable [cc variable]
   (or (-> cc :bindings variable first)
       (raise-str "Couldn't find variable " variable)))
 
-(defn sql-projection
+(def aggregate-functions
+  {:avg :avg
+   :count :count
+   :max :max
+   :min :min
+   :sum :total
+   })
+
+(defn- aggregate-symbols->projected-var [fn-symbol var-symbol]
+  (keyword (str "_" (name fn-symbol) "_" (subs (name var-symbol) 1))))
+
+(defn- aggregate->projected-var [elem]
+  (aggregate-symbols->projected-var (:symbol (:fn elem))
+                                    (:symbol (first (:args elem)))))
+
+(defn simple-aggregate?
+  "If `elem` is a simple aggregate -- symbolic function, one var arg --
+   return the variable symbol."
+  [elem]
+  (when (instance? Aggregate elem)
+    (let [{:keys [fn args]} elem]
+      (when (and (instance? PlainSymbol fn)
+                 (= 1 (count args)))
+        (let [arg (first args)]
+          (when (instance? Variable arg)
+            (:symbol arg)))))))
+
+(defn- aggregate->var [elem]
+  (when (instance? Aggregate elem)
+    (when-not (simple-aggregate? elem)
+      (raise-str "Only know how to handle simple aggregates."))
+
+    (:symbol (first (:args elem)))))
+
+(defn- variable->var [elem]
+  (when (instance? Variable elem)
+    (:symbol elem)))
+
+(defn- aggregate->projection [elem context lookup-fn]
+  (when (instance? Aggregate elem)
+    (when-not (simple-aggregate? elem)
+      (raise-str "Only know how to handle simple aggregates."))
+
+    (let [var-symbol (:symbol (first (:args elem)))
+          fn-symbol (:symbol (:fn elem))
+          lookup-var (lookup-fn var-symbol)
+          fn (get aggregate-functions (keyword fn-symbol))]
+
+      (when-not fn
+        (raise-str "Unknown aggregate function."))
+
+      (let [funcall-var (util/aggregate->sql-var fn lookup-var)
+            project-as (aggregate-symbols->projected-var fn-symbol var-symbol)]
+        [[funcall-var project-as]]))))
+
+(defn- type-projection
+  "Produce a projection pair by looking up `var` in the provided
+   `extracted-types`."
+  [extracted-types var]
+  (when-let [t (get extracted-types var)]
+    [t (util/var->sql-type-var var)]))
+
+(defn- aggregate-type-projection
+  "Produce a passthrough projection pair for a type field
+   in an inner query."
+  [inner var]
+  (let [type-var (util/var->sql-type-var var)]
+    [(sql/qualify inner type-var) type-var]))
+
+(defn- symbol->projection
+  "Given a variable symbol, produce a projection pair.
+   `lookup-fn` will be used to find a column. For a non-aggregate query,
+   this will typically be a lookup into the CC's bindings. For an
+   aggregate query it'll be a qualification of the same var into the
+   subquery.
+   `known-types` is a type map to decide whether to project a type tag.
+   `type-projection-fn` is like `lookup-fn` but for type tag columns."
+  [var lookup-fn known-types type-projection-fn]
+  (let [lookup-var (lookup-fn var)
+        projected-var (util/var->sql-var var)
+        var-projection [lookup-var projected-var]]
+
+    ;; If the type of a variable isn't explicitly known, we also select
+    ;; its type column so we can transform it.
+    (if-let [type-proj (when (not (contains? known-types var))
+                         (type-projection-fn var))]
+      [var-projection type-proj]
+      [var-projection])))
+
+(defn- variable->projection [elem lookup-fn known-types type-projection-fn]
+  (when (instance? Variable elem)
+    (symbol->projection (:symbol elem) lookup-fn known-types type-projection-fn)))
+
+(defn sql-projection-for-relation
   "Take a `find` clause's `:elements` list and turn it into a SQL
    projection clause, suitable for passing as a `:select` clause to
    honeysql.
@@ -32,23 +128,145 @@
 
      [[:datoms12.e :foo] [:datoms13.e :bar]]
 
+   Note that we also look at `:group-by-vars`, because we need to
+   alias columns and apply `DISTINCT` to those columns in order to
+   aggregate correctly.
+
+   This function unpacks aggregate operations, instead selecting the var.
+
    @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)))
+  (let [{:keys [group-by-vars elements cc]} context
+        {:keys [known-types extracted-types]} cc]
+
+    ;; The primary projections from the :find list.
+    ;; Note that deduplication will be necessary, because we unpack aggregates.
+    (let [projected-vars
+          (keep (fn [elem]
+                  (or (aggregate->var elem)
+                      (variable->var elem)
+                      (raise "Only able to :find variables or aggregates."
+                             {:elem elem})))
+                elements)
+
+          ;; If we have any GROUP BY requirements from :with, that aren't already
+          ;; included in the above, project them now.
+          additional-vars
+          (clojure.set/difference
+            (set group-by-vars)
+            (set projected-vars))
+
+          full-var-list
+          (distinct (concat projected-vars additional-vars))
+
+          type-proj-fn
+          (partial type-projection extracted-types)
+
+          lookup-fn
+          (partial lookup-variable cc)]
+
+      (mapcat (fn [var]
+                (symbol->projection var lookup-fn known-types type-proj-fn))
+              full-var-list))))
+
+(defn sql-projection-for-aggregation
+  "Project an element list that contains aggregates. This expects a subquery
+   aliased to `inner-table` which itself will project each var with the
+   correct name."
+  [context inner-table]
+  (let [{:keys [group-by-vars elements cc]} context
+        {:keys [known-types extracted-types]} cc
+        lookup-fn (fn [var]
+                    (sql/qualify inner-table (util/var->sql-var var)))
+        type-proj-fn (partial aggregate-type-projection inner-table)]
+    (mapcat (fn [elem]
+              (or (variable->projection elem lookup-fn known-types type-proj-fn)
+                  (aggregate->projection elem context lookup-fn)
+                  (raise "Only able to :find variables or aggregates."
+                         {:elem elem})))
+            elements)))
+
+(defn make-projectors-for-columns [elements known-types extracted-types]
+  {:pre [(map? extracted-types)
+         (map? known-types)]}
+  (letfn [(variable->projector [elem known-types extracted-types tag-decoder]
+          (when (instance? Variable elem)
+            (let [var (:symbol elem)
+                  projected-var (util/var->sql-var var)]
+
+              (if-let [type (get known-types var)]
+                ;; We know the type! We already know how to decode it.
+                ;; TODO: most of these tags don't actually require calling through to <-tagged-SQLite.
+                ;; TODO: optimize this without making it horrible.
+                (let [decoder (tag-decoder (ss/->tag type))]
+                  (fn [row]
+                    (decoder (get row projected-var))))
+
+                ;; We don't know the type. Find the type projection column
+                ;; and use it to decode the value.
+                (if (contains? extracted-types var)
+                  (let [type-column (util/var->sql-type-var var)]
+                    (fn [row]
+                      (ss/<-tagged-SQLite
+                        (get row type-column)
+                        (get row projected-var))))
+
+                  ;; We didn't extract a type and we don't know it in advance.
+                  ;; Just pass through; the :col will look itself up in the row.
+                  projected-var)))))
+
+          ;; For now we assume numerics and that everything will shake out in the wash.
+          (aggregate->projector [elem]
+            (when (instance? Aggregate elem)
+              (let [var (aggregate->projected-var elem)]
+                (fn [row]
+                  (get row var)))))]
+
+    (let [tag-decoder (memoize
+                        (fn [tag]
+                          (partial ss/<-tagged-SQLite tag)))]
+      (map (fn [elem]
+             (or (variable->projector elem known-types extracted-types tag-decoder)
+                 (aggregate->projector elem)))
+           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])))))
+  (let [{:keys [elements cc]} context
+        {:keys [source known-types extracted-types]} cc
+
+        ;; We know the projection will fail above if these aren't simple variables or aggregates.
+        projectors
+        (make-projectors-for-columns elements known-types extracted-types)]
+
+    (map
+      (fn [[row err]]
+        (if err
+          [row err]
+          [(map (fn [projector] (projector row)) projectors) nil])))))
+
+(defn extract-group-by-vars
+  "Take inputs to :find and, if any aggregates exist in `elements`,
+  return the variable names upon which we should GROUP BY."
+  [elements with]
+  (when (some #(instance? Aggregate %1) elements)
+    (loop [ignore #{}
+           group-by (map :symbol with)
+           e elements]
+
+      (if-let [element (first e)]
+        (if-let [aggregated-var (simple-aggregate? element)]
+          (recur (conj ignore aggregated-var)
+                 group-by
+                 (rest e))
+          (if (instance? Variable element)
+            (let [var (:symbol element)]
+              (recur ignore
+                     (if (contains? ignore var)
+                       group-by
+                       (conj group-by var))
+                     (rest e)))
+            (raise-str "Unknown element." {:element element})))
+
+        ;; Done. Remove any later vars we saw.
+        (remove ignore group-by)))))

src/datomish/query/source.cljc

@@ -4,14 +4,15 @@
 
 (ns datomish.query.source
   (:require
-     [datomish.query.transforms :as transforms]
-     [datascript.parser
-      #?@(:cljs
-            [:refer [Variable Constant Placeholder]])])
+   [datomish.query.transforms :as transforms]
+   [datomish.schema :as schema]
+   [datascript.parser
+    #?@(:cljs
+        [:refer [Variable Constant Placeholder]])])
   #?(:clj
-       (:import [datascript.parser Variable Constant Placeholder])))
+     (:import [datascript.parser Variable Constant Placeholder])))
 
-(defn- gensym-table-alias [table]
+(defn gensym-table-alias [table]
   (gensym (name table)))
 
 ;;;
@@ -39,29 +40,31 @@
   (source->fulltext-from [source]
     "Returns a pair, `[table alias]` for querying the source's fulltext index.")
   (source->constraints [source alias])
+  (pattern->schema-value-type [source pattern])
   (attribute-in-source [source attribute])
   (constant-in-source [source constant]))
 
 (defrecord
-  DatomsSource
-  [table               ; Typically :datoms.
-   fulltext-table      ; Typically :fulltext_values
-   fulltext-view       ; Typically :all_datoms
-   columns             ; e.g., [:e :a :v :tx]
+    DatomsSource
+    [table               ; Typically :datoms.
+     fulltext-table      ; Typically :fulltext_values
+     fulltext-view       ; Typically :all_datoms
+     columns             ; e.g., [:e :a :v :tx]
+     schema              ; An ISchema instance.
 
-   ;; `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
+     ;; `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
 
-   ;; `table-alias` is a function from table to alias, e.g., :datoms => :datoms1234.
-   table-alias
+     ;; `table-alias` is a function from table to alias, e.g., :datoms => :datoms1234.
+     table-alias
 
-   ;; Not currently used.
-   make-constraints    ; ?fn [source alias] => [where-clauses]
-   ]
+     ;; Not currently used.
+     make-constraints    ; ?fn [source alias] => [where-clauses]
+     ]
   Source
 
   (source->from [source attribute]
@@ -88,20 +91,21 @@
     (when-let [f (:make-constraints source)]
       (f alias)))
 
+  (pattern->schema-value-type [source pattern]
+    (let [[_ a v _] pattern
+          schema (:schema (:schema source))]
+      (when (instance? Constant a)
+        (let [val (:value a)]
+          (if (keyword? val)
+            ;; We need to find the entid for the keyword attribute,
+            ;; because the schema stores attributes by ID.
+            (let [id (attribute-in-source source val)]
+              (get-in schema [id :db/valueType]))
+            (when (integer? val)
+              (get-in schema [val :db/valueType])))))))
+
   (attribute-in-source [source attribute]
     ((:attribute-transform source) attribute))
 
   (constant-in-source [source constant]
     ((:constant-transform source) constant)))
-
-(defn datoms-source [db]
-  (map->DatomsSource
-    {:table :datoms
-     :fulltext-table :fulltext_values
-     :fulltext-view :all_datoms
-     :columns [:e :a :v :tx :added]
-     :attribute-transform transforms/attribute-transform-string
-     :constant-transform transforms/constant-transform-default
-     :table-alias gensym-table-alias
-     :make-constraints nil}))
-

src/datomish/schema.cljc

@@ -5,7 +5,12 @@
 ;; Purloined from DataScript.
 
 (ns datomish.schema
-  (:require [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise]]))
+  (:require
+   [datomish.sqlite-schema :as sqlite-schema]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise]]))
+
+(defn entid? [x]
+  (and (integer? x) (pos? x)))
 
 (defprotocol ISchema
   (attrs-by
@@ -94,19 +99,32 @@
                      :key k
                      :value v}))))
 
-;; TODO: consider doing this with a protocol and extending the underlying Clojure(Script) types.
 (def value-type-map
-  {:db.type/ref     { :valid? #(and (integer? %) (pos? %)) :->SQLite identity :<-SQLite identity }
-   :db.type/keyword { :valid? keyword? :->SQLite str :<-SQLite #(keyword (subs % 1)) }
-   :db.type/string  { :valid? string? :->SQLite identity :<-SQLite identity }
-   :db.type/boolean { :valid? #?(:clj #(instance? Boolean %) :cljs #(= js/Boolean (type %))) :->SQLite #(if % 1 0) :<-SQLite #(not= % 0) }
-   :db.type/integer { :valid? integer? :->SQLite identity :<-SQLite identity }
-   :db.type/real    { :valid? #?(:clj float? :cljs number?) :->SQLite identity :<-SQLite identity }
+  {:db.type/ref     { :valid? entid? }
+   :db.type/keyword { :valid? keyword? }
+   :db.type/string  { :valid? string? }
+   :db.type/boolean { :valid? #?(:clj #(instance? Boolean %) :cljs #(= js/Boolean (type %))) }
+   :db.type/long    { :valid? integer? }
+   :db.type/uuid    { :valid? #?(:clj #(instance? java.util.UUID %) :cljs string?) }
+   :db.type/instant { :valid? #?(:clj #(instance? java.util.Date %) :cljs #(= js/Date (type %))) }
+   :db.type/uri     { :valid? #?(:clj #(instance? java.net.URI %) :cljs string?) }
+   :db.type/double  { :valid? #?(:clj float? :cljs number?) }
    })
 
+(defn #?@(:clj  [^Boolean ensure-value-matches-type]
+          :cljs [^boolean ensure-value-matches-type]) [type value]
+  (if-let [valid? (get-in value-type-map [type :valid?])]
+    (when-not (valid? value)
+      (raise "Invalid value for type " type "; got " value
+             {:error :schema/valueType, :type type, :value value}))
+    (raise "Unknown valueType " type ", expected one of " (sorted-set (keys value-type-map))
+           {:error :schema/valueType, :type type})))
+
+;; There's some duplication here so we get better error messages.
 (defn #?@(:clj  [^Boolean ensure-valid-value]
           :cljs [^boolean ensure-valid-value]) [schema attr value]
-  {:pre [(schema? schema)]}
+  {:pre [(schema? schema)
+         (integer? attr)]}
   (let [schema (.-schema schema)]
     (if-let [valueType (get-in schema [attr :db/valueType])]
       (if-let [valid? (get-in value-type-map [valueType :valid?])]
@@ -119,12 +137,13 @@
              {:error :schema/valueType, :attribute attr}))))
 
 (defn ->SQLite [schema attr value]
-  {:pre [(schema? schema)]}
+  {:pre [(schema? schema)
+         (integer? attr)]}
   (let [schema (.-schema schema)]
     (if-let [valueType (get-in schema [attr :db/valueType])]
       (if-let [valid? (get-in value-type-map [valueType :valid?])]
         (if (valid? value)
-          ((get-in value-type-map [valueType :->SQLite]) value)
+          [(sqlite-schema/->SQLite value) (sqlite-schema/->tag valueType)]
           (raise "Invalid value for attribute " attr ", expected " valueType " but got " value
                  {:error :schema/valueType, :attribute attr, :value value}))
         (raise "Unknown valueType for attribute " attr ", expected one of " (sorted-set (keys value-type-map))
@@ -136,8 +155,8 @@
   {:pre [(schema? schema)]}
   (let [schema (.-schema schema)]
     (if-let [valueType (get-in schema [attr :db/valueType])]
-      (if-let [<-SQLite (get-in value-type-map [valueType :<-SQLite])]
-        (<-SQLite value)
+      (if (contains? value-type-map valueType)
+        (sqlite-schema/<-SQLite valueType value)
         (raise "Unknown valueType for attribute " attr ", expected one of " (sorted-set (keys value-type-map))
                {:error :schema/valueType, :attribute attr}))
       (raise "Unknown attribute " attr ", expected one of " (sorted-set (keys schema))

src/datomish/schema.edn

@@ -0,0 +1,59 @@
+[
+ ;; news
+
+ {:db/id #db/id[:db.part/db]
+  :db/ident :news/title
+  :db/valueType :db.type/string
+  :db/cardinality :db.cardinality/one
+  :db/fulltext true
+  :db/doc "A news story's title"
+  :db.install/_attribute :db.part/db}
+
+ {:db/id #db/id[:db.part/db]
+  :db/ident :news/foobar
+  :db/valueType :db.type/string
+  :db/cardinality :db.cardinality/one
+  :db/unique :db.unique/identity
+  :db/fulltext true
+  :db/doc "A news story's foobar"
+  :db.install/_attribute :db.part/db}
+
+ {:db/id #db/id[:db.part/db]
+  :db/ident :news/zot
+  :db/valueType :db.type/string
+  :db/cardinality :db.cardinality/one
+  :db/unique :db.unique/identity
+  :db/fulltext true
+  :db/doc "A news story's zot"
+  :db.install/_attribute :db.part/db}
+
+ {:db/id #db/id[:db.part/db]
+  :db/ident :news/baz
+  :db/valueType :db.type/ref
+  :db/cardinality :db.cardinality/one
+  :db/doc "A news story's baz"
+  :db.install/_attribute :db.part/db}
+
+ {:db/id #db/id[:db.part/db]
+  :db/ident :news/url
+  :db/valueType :db.type/string
+  :db/cardinality :db.cardinality/one
+  :db/doc "A news story's url"
+  :db.install/_attribute :db.part/db}
+
+ {:db/id #db/id[:db.part/db]
+  :db/ident :news/summary
+  :db/valueType :db.type/string
+  :db/cardinality :db.cardinality/one
+  :db/doc "Automatically generated summary of a news story"
+  :db.install/_attribute :db.part/db}
+
+ {:db/id #db/id[:db.part/db]
+  :db/ident :news/category
+  :db/valueType :db.type/string
+  :db/cardinality :db.cardinality/many
+  :db/fulltext true
+  :db/doc "Categories automatically set for a news story"
+  :db.install/_attribute :db.part/db}
+
+ ]

src/datomish/schema_changes.cljc

@@ -6,9 +6,6 @@
   (:require
    [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]))
 
-(defn- is-install? [db [_ a & _]]
-  (= a (get-in db [:idents :db.install/attribute])))
-
 (defn datoms->schema-fragment
   "Turn [[:db.part/db :db.install/attribute e] [e :db/ident :attr]] into {:attr {:db/* v}}.
 

src/datomish/sqlite.cljc

@@ -76,7 +76,7 @@
                ;; channel being rejected and no further row callbacks
                ;; being called.
                (when (second result)
-                 (put! result c))
+                 (put! c result))
                (close! c))))
 
 (defn all-rows

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-str cond-let]]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
    [datomish.sqlite :as s]
    #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
              [clojure.core.async :refer [go <! >!]]])
@@ -19,34 +19,51 @@
 
 (def v1-statements
   ["CREATE TABLE datoms (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL,
+                         value_type_tag SMALLINT NOT NULL,
                          index_avet TINYINT NOT NULL DEFAULT 0, index_vaet TINYINT NOT NULL DEFAULT 0,
                          index_fulltext TINYINT NOT NULL DEFAULT 0,
-                         unique_value TINYINT NOT NULL DEFAULT 0, unique_identity TINYINT NOT NULL DEFAULT 0)"
-   "CREATE INDEX idx_datoms_eavt ON datoms (e, a, v)"
-   "CREATE INDEX idx_datoms_aevt ON datoms (a, e, v)"
+                         unique_value TINYINT NOT NULL DEFAULT 0)"
+   "CREATE UNIQUE INDEX idx_datoms_eavt ON datoms (e, a, value_type_tag, v)"
+   "CREATE UNIQUE INDEX idx_datoms_aevt ON datoms (a, e, value_type_tag, v)"
+
+   ;; n.b., v0/value_type_tag0 can be NULL, in which case we look up v from datoms;
+   ;; and the datom columns are NULL into the LEFT JOIN fills them in.
+   ;; TODO: update comment about sv.
+   "CREATE TABLE tx_lookup (e0 INTEGER NOT NULL, a0 SMALLINT NOT NULL, v0 BLOB NOT NULL, tx0 INTEGER NOT NULL, added0 TINYINT NOT NULL,
+                         value_type_tag0 SMALLINT NOT NULL,
+                         index_avet0 TINYINT, index_vaet0 TINYINT,
+                         index_fulltext0 TINYINT,
+                         unique_value0 TINYINT,
+                         sv BLOB,
+                         svalue_type_tag SMALLINT,
+                         rid INTEGER,
+                         e INTEGER, a SMALLINT, v BLOB, tx INTEGER, value_type_tag SMALLINT)"
+
+   ;; Note that `id_tx_lookup_added` is created and dropped
+   ;; after insertion, which makes insertion slightly faster.
+   ;; Prevent overlapping transactions.  TODO: drop added0?
+   "CREATE UNIQUE INDEX idx_tx_lookup_eavt ON tx_lookup (e0, a0, v0, added0, value_type_tag0) WHERE sv IS NOT NULL"
 
    ;; Opt-in index: only if a has :db/index true.
-   "CREATE UNIQUE INDEX idx_datoms_avet ON datoms (a, v, e) WHERE index_avet IS NOT 0"
+   "CREATE UNIQUE INDEX idx_datoms_avet ON datoms (a, value_type_tag, v, e) WHERE index_avet IS NOT 0"
 
-   ;; Opt-in index: only if a has :db/valueType :db.type/ref.
+   ;; Opt-in index: only if a has :db/valueType :db.type/ref.  No need for tag here since all
+   ;; indexed elements are refs.
    "CREATE UNIQUE INDEX idx_datoms_vaet ON datoms (v, a, e) WHERE index_vaet IS NOT 0"
 
    ;; Opt-in index: only if a has :db/fulltext true; thus, it has :db/valueType :db.type/string,
    ;; which is not :db/valueType :db.type/ref.  That is, index_vaet and index_fulltext are mutually
    ;; exclusive.
-   "CREATE INDEX idx_datoms_fulltext ON datoms (v, a, e) WHERE index_fulltext IS NOT 0"
+   "CREATE INDEX idx_datoms_fulltext ON datoms (value_type_tag, v, a, e) WHERE index_fulltext IS NOT 0"
 
-   ;; TODO: possibly remove this index.  :db.unique/value should be asserted by the transactor in
-   ;; all cases, but the index may speed up some of SQLite's query planning.  For now, it services
-   ;; to validate the transactor implementation.
-   "CREATE UNIQUE INDEX idx_datoms_unique_value ON datoms (v) WHERE unique_value IS NOT 0"
-   ;; TODO: possibly remove this index.  :db.unique/identity should be asserted by the transactor in
-   ;; all cases, but the index may speed up some of SQLite's query planning.  For now, it serves to
-   ;; validate the transactor implementation.
-   "CREATE UNIQUE INDEX idx_datoms_unique_identity ON datoms (a, v) WHERE unique_identity IS NOT 0"
+   ;; TODO: possibly remove this index.  :db.unique/{value,identity} should be asserted by the
+   ;; transactor in all cases, but the index may speed up some of SQLite's query planning.  For now,
+   ;; it serves to validate the transactor implementation.  Note that tag is needed here to
+   ;; differentiate, e.g., keywords and strings.
+   "CREATE UNIQUE INDEX idx_datoms_unique_value ON datoms (a, value_type_tag, v) WHERE unique_value IS NOT 0"
 
-   "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 idx_transactions_tx ON transactions (tx)"
+   "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, value_type_tag SMALLINT NOT NULL)"
+   "CREATE INDEX idx_transactions_tx ON transactions (tx, added)"
 
    ;; Fulltext indexing.
    ;; A fulltext indexed value v is an integer rowid referencing fulltext_values.
@@ -57,27 +74,45 @@
    ;; By default we use Unicode-aware tokenizing (particularly for case folding), but preserve
    ;; diacritics.
    "CREATE VIRTUAL TABLE fulltext_values
-     USING FTS4 (text NOT NULL, tokenize=unicode61 \"remove_diacritics=0\")"
+     USING FTS4 (text NOT NULL, searchid INT, tokenize=unicode61 \"remove_diacritics=0\")"
+
+   ;; This combination of view and triggers allows you to transparently
+   ;; update-or-insert into FTS. Just INSERT INTO fulltext_values_view (text, searchid).
+   "CREATE VIEW fulltext_values_view AS SELECT * FROM fulltext_values"
+   "CREATE TRIGGER replace_fulltext_searchid
+   INSTEAD OF INSERT ON fulltext_values_view
+   WHEN EXISTS (SELECT 1 FROM fulltext_values WHERE text = new.text)
+   BEGIN
+     UPDATE fulltext_values SET searchid = new.searchid WHERE text = new.text;
+   END"
+   "CREATE TRIGGER insert_fulltext_searchid
+   INSTEAD OF INSERT ON fulltext_values_view
+   WHEN NOT EXISTS (SELECT 1 FROM fulltext_values WHERE text = new.text)
+   BEGIN
+     INSERT INTO fulltext_values (text, searchid) VALUES (new.text, new.searchid);
+   END"
 
    ;; A view transparently interpolating fulltext indexed values into the datom structure.
    "CREATE VIEW fulltext_datoms AS
-     SELECT e, a, fulltext_values.text AS v, tx, index_avet, index_vaet, index_fulltext, unique_value, unique_identity
+     SELECT e, a, fulltext_values.text AS v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value
        FROM datoms, fulltext_values
        WHERE datoms.index_fulltext IS NOT 0 AND datoms.v = fulltext_values.rowid"
 
    ;; A view transparently interpolating all entities (fulltext and non-fulltext) into the datom structure.
    "CREATE VIEW all_datoms AS
-     SELECT e, a, v, tx, index_avet, index_vaet, index_fulltext, unique_value, unique_identity
+     SELECT e, a, v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value
        FROM datoms
        WHERE index_fulltext IS 0
      UNION ALL
-     SELECT e, a, v, tx, index_avet, index_vaet, index_fulltext, unique_value, unique_identity
+     SELECT e, a, v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value
        FROM fulltext_datoms"
 
    ;; Materialized views of the schema.
    "CREATE TABLE idents (ident TEXT NOT NULL PRIMARY KEY, entid INTEGER UNIQUE NOT NULL)"
+   ;; TODO: allow arbitrary schema values (true/false) and tag the resulting values.
    "CREATE TABLE schema (ident TEXT NOT NULL, attr TEXT NOT NULL, value TEXT NOT NULL, FOREIGN KEY (ident) REFERENCES idents (ident))"
    "CREATE INDEX idx_schema_unique ON schema (ident, attr, value)"
+   "CREATE TABLE parts (part INTEGER NOT NULL PRIMARY KEY, start INTEGER NOT NULL, idx INTEGER NOT NULL)"
    ])
 
 (defn <create-current-version
@@ -115,3 +150,126 @@
 
         (< v current-version)
         (<? (<update-from-version db v))))))
+
+;; This is close to the SQLite schema since it may impact the value tag bit.
+(defprotocol IEncodeSQLite
+  (->SQLite [x] "Transforms Clojure{Script} values to SQLite."))
+
+(extend-protocol IEncodeSQLite
+  #?@(:clj
+      [String
+       (->SQLite [x] x)
+
+       clojure.lang.Keyword
+       (->SQLite [x] (str x))
+
+       Boolean
+       (->SQLite [x] (if x 1 0))
+
+       Integer
+       (->SQLite [x] x)
+
+       Long
+       (->SQLite [x] x)
+
+       java.util.Date
+       (->SQLite [x] (.getTime x))
+
+       Float
+       (->SQLite [x] x)
+
+       Double
+       (->SQLite [x] x)]
+
+      :cljs
+      [string
+       (->SQLite [x] x)
+
+       Keyword
+       (->SQLite [x] (str x))
+
+       boolean
+       (->SQLite [x] (if x 1 0))
+
+       js/Date
+       (->SQLite [x] (.getTime x))
+
+       number
+       (->SQLite [x] x)]))
+
+;; Datomish rows are tagged with a numeric representation of :db/valueType:
+;; The tag is used to limit queries, and therefore is placed carefully in the relevant indices to
+;; allow searching numeric longs and doubles quickly.  The tag is also used to convert SQLite values
+;; to the correct Datomish value type on query egress.
+(def value-type-tag-map
+  {:db.type/ref     0
+   :db.type/boolean 1
+   :db.type/instant 4
+   :db.type/long    5 ;; SQLite distinguishes integral from decimal types, allowing long and double to share a tag.
+   :db.type/double  5 ;; SQLite distinguishes integral from decimal types, allowing long and double to share a tag.
+   :db.type/string  10
+   :db.type/uuid    11
+   :db.type/uri     12
+   :db.type/keyword 13})
+
+(defn ->tag [valueType]
+  (or
+    (valueType value-type-tag-map)
+    (raise "Unknown valueType " valueType ", expected one of " (sorted-set (keys value-type-tag-map))
+           {:error :SQLite/tag, :valueType valueType})))
+
+#?(:clj
+(defn <-tagged-SQLite
+  "Transforms SQLite values to Clojure with tag awareness."
+  [tag value]
+  (case tag
+    ;; In approximate commonality order.
+    0  value                               ; ref.
+    1  (= value 1)                         ; boolean
+    4  (java.util.Date. value)             ; instant
+    13 (keyword (subs value 1))            ; keyword
+    12 (java.net.URI. value)               ; URI
+    11 (java.util.UUID/fromString value)   ; UUID
+    ;  5 value                             ; numeric
+    ; 10 value                             ; string
+    value
+    )))
+
+#?(:cljs
+(defn <-tagged-SQLite
+  "Transforms SQLite values to ClojureScript with tag awareness."
+  [tag value]
+  ;; In approximate commonality order.
+  (case tag
+    0  value                               ; ref.
+    1  (= value 1)                         ; boolean
+    4  (js/Date. value)                    ; instant
+    13 (keyword (subs value 1))            ; keyword
+    ; 12 value                             ; URI
+    ; 11 value                             ; UUID
+    ;  5 value                             ; numeric
+    ; 10 value                             ; string
+    value
+    )))
+
+(defn tagged-SQLite-to-JS
+  "Transforms SQLite values to JavaScript-compatible values."
+  [tag value]
+  (case tag
+    1  (= value 1)     ; boolean.
+    ;  0 value         ; No point trying to ident.
+    ;  4 value         ; JS doesn't have a Date representation.
+    ; 13 value         ; Return the keyword string from the DB: ":foobar".
+    value))
+
+(defn <-SQLite
+  "Transforms SQLite values to Clojure{Script}."
+  [valueType value]
+  (case valueType
+    :db.type/ref     value
+    :db.type/keyword (keyword (subs value 1))
+    :db.type/string  value
+    :db.type/boolean (not= value 0)
+    :db.type/long    value
+    :db.type/instant (<-tagged-SQLite 4 value)
+    :db.type/double  value))

src/datomish/test_macros.cljc

@@ -4,7 +4,9 @@
 
 (ns datomish.test-macros
   #?(:cljs
-     (:require-macros [datomish.test-macros]))
+     (:require-macros
+        [datomish.test-macros]
+        [datomish.node-tempfile-macros]))
   (:require
    [datomish.pair-chan]))
 
@@ -38,3 +40,20 @@
        (let [[v# e#] (clojure.core.async/<!! (datomish.pair-chan/go-pair ~@body))]
          (when e# (throw e#)) ;; Assert nil just to be safe, even though we should always throw first.
          (clojure.test/is (= e# nil))))))
+
+(defmacro deftest-db
+  [n conn-var & body]
+  `(deftest-async ~n
+    (if-cljs
+      (datomish.node-tempfile-macros/with-tempfile [t# (datomish.node-tempfile/tempfile)]
+         (let [~conn-var (datomish.pair-chan/<? (datomish.api/<connect t#))]
+           (try
+             ~@body
+             (finally
+               (datomish.pair-chan/<? (datomish.api/<close ~conn-var))))))
+      (tempfile.core/with-tempfile [t# (tempfile.core/tempfile)]
+       (let [~conn-var (datomish.pair-chan/<? (datomish.api/<connect t#))]
+         (try
+           ~@body
+           (finally
+             (datomish.pair-chan/<? (datomish.api/<close ~conn-var)))))))))

src/datomish/transact.cljc

@@ -13,6 +13,7 @@
    [datomish.query.source :as source]
    [datomish.query :as query]
    [datomish.db :as db :refer [id-literal id-literal?]]
+   [datomish.db.debug :as debug]
    [datomish.datom :as dd :refer [datom datom? #?@(:cljs [Datom])]]
    [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
    [datomish.schema :as ds]
@@ -21,6 +22,8 @@
    [datomish.sqlite-schema :as sqlite-schema]
    [datomish.transact.bootstrap :as bootstrap]
    [datomish.transact.explode :as explode]
+   [taoensso.tufte :as tufte
+    #?(:cljs :refer-macros :clj :refer) [defnp p profiled profile]]
    #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
              [clojure.core.async :as a :refer [chan go <! >!]]])
    #?@(:cljs [[datomish.pair-chan]
@@ -56,7 +59,8 @@
 
 (defrecord TxReport [db-before ;; The DB before the transaction.
                      db-after  ;; The DB after the transaction.
-                     current-tx ;; The tx ID represented by the transaction in this report.
+                     tx        ;; The tx ID represented by the transaction in this report; refer :db/tx.
+                     txInstant ;; The timestamp instant when the the transaction was processed/committed in this report; refer :db/txInstant.
                      entities  ;; The set of entities (like [:db/add e a v tx]) processed.
                      tx-data   ;; The set of datoms applied to the database, like (Datom. e a v tx added).
                      tempids   ;; The map from id-literal -> numeric entid.
@@ -106,11 +110,13 @@
     entity))
 
 (defn maybe-ident->entid [db [op e a v tx :as orig]]
-  (let [e (get (db/idents db) e e) ;; TODO: use ident, entid here.
-        a (get (db/idents db) a a)
+  (let [e (db/entid db e)
+        a (db/entid db a)
         v (if (ds/kw? (db/schema db) a) ;; TODO: decide if this is best.  We could also check for ref and numeric types.
             v
-            (get (db/idents db) v v))]
+            (db/entid db v))]
+    (when-not (integer? a)
+      (println "WARNING: unknown attribute" a))
     [op e a v tx]))
 
 (defrecord Transaction [db tempids entities])
@@ -120,7 +126,7 @@
   (let [tx        (:tx report)
         txInstant (:txInstant report)]
     ;; n.b., this must not be symbolic -- it's inserted after we map idents -> entids.
-    [:db/add tx (get-in db [:idents :db/txInstant]) txInstant]))
+    [:db/add tx (db/entid db :db/txInstant) txInstant]))
 
 (defn ensure-entity-form [[op e a v & rest :as entity]]
   (cond
@@ -153,8 +159,8 @@
 
 (defn- tx-instant? [db [op e a & _]]
   (and (= op :db/add)
-       (= e (get-in db [:idents :db/tx]))
-       (= a (get-in db [:idents :db/txInstant]))))
+       (= (db/entid db e) (db/entid db :db/tx))
+       (= (db/entid db a) (db/entid db :db/txInstant))))
 
 (defn- update-txInstant [db report]
   "Extract [:db/add :db/tx :db/txInstant ...], and update :txInstant with that value."
@@ -175,7 +181,7 @@
         ;; to unify all id-literals in :db.part/tx to the current transaction value, but also seems
         ;; inconsistent.
         tx         (:tx report)
-        db*        (assoc-in db [:idents :db/tx] tx)]
+        db*        (db/with-ident db :db/tx tx)]
     (when-not (sequential? initial-es)
       (raise "Bad transaction data " initial-es ", expected sequential collection"
              {:error :transact/syntax, :tx-data initial-es}))
@@ -205,23 +211,48 @@
       (->> (update-txInstant db*)))))
 
 (defn- lookup-ref? [x]
-  "Return true if `x` is like [:attr value]."
+  "Return `x` if `x` is like [:attr value], false otherwise."
   (and (sequential? x)
        (= (count x) 2)
        (or (keyword? (first x))
-           (integer? (first x)))))
+           (integer? (first x)))
+       x))
 
 (defn <resolve-lookup-refs [db report]
   {:pre [(db/db? db) (report? report)]}
 
-  (go-pair
-    (->>
-      (vec (for [[op & entity] (:entities report)]
-             (into [op] (for [field entity]
-                          (if (lookup-ref? field)
-                            (first (<? (db/<eavt db field))) ;; TODO improve this -- this should be avet, shouldn't it?
-                            field)))))
-      (assoc-in report [:entities])))) ;; TODO: meta.
+  (let [entities (:entities report)]
+    ;; TODO: meta.
+    (go-pair
+      (if (empty? entities)
+        report
+        (assoc-in
+          report [:entities]
+          ;; We can't use `for` because go-pair doesn't traverse function boundaries.
+          ;; Apologies for the tortured nested loop.
+          (loop [[op & entity] (first entities)
+                 next (rest entities)
+                 acc []]
+            (if (nil? op)
+              acc
+              (recur (first next)
+                     (rest next)
+                     (conj acc
+                           (loop [field (first entity)
+                                  rem (rest entity)
+                                  acc [op]]
+                             (if (nil? field)
+                               acc
+                               (recur (first rem)
+                                      (rest rem)
+                                      (conj acc
+                                            (if-let [[a v] (lookup-ref? field)]
+                                              (or
+                                                ;; The lookup might fail! If so, throw.
+                                                (:e (<? (db/<av db a v)))
+                                                (raise "No entity found with attr " a " and val " v "."
+                                                       {:a a :v v}))
+                                              field))))))))))))))
 
 (declare <resolve-id-literals)
 
@@ -280,7 +311,9 @@
             report
 
             (and (not= op :db/add)
-                 (not (empty? (filter id-literal? [e a v]))))
+                 (or (id-literal? e)
+                     (id-literal? a)
+                     (id-literal? v)))
             (raise "id-literals are resolved for :db/add only"
                    {:error :transact/syntax
                     :op    entity })
@@ -289,26 +322,26 @@
             (and (id-literal? e)
                  (ds/unique-identity? (db/schema db) a)
                  (not-any? id-literal? [a v]))
-            (let [upserted-eid (:e (first (<? (db/<avet db [a v]))))
+            (let [upserted-eid (:e (<? (db/<av db a v)))
                   allocated-eid (get-in report [:tempids e])]
               (if (and upserted-eid allocated-eid (not= upserted-eid allocated-eid))
                 (<? (<retry-with-tempid db initial-report initial-entities e upserted-eid)) ;; TODO: not initial report, just the sorted entities here.
-                (let [eid (or upserted-eid allocated-eid (next-eid db))]
+                (let [eid (or upserted-eid allocated-eid (<? (db/<next-eid db e)))]
                   (recur (allocate-eid report e eid) (cons [op eid a v] entities)))))
 
             ;; Start allocating and retrying.  We try with e last, so as to eventually upsert it.
             (id-literal? v)
             ;; We can't fail with unbound literals here, since we could have multiple.
-            (let [eid (or (get-in report [:tempids v]) (next-eid db))]
+            (let [eid (or (get-in report [:tempids v]) (<? (db/<next-eid db e)))]
               (recur (allocate-eid report v eid) (cons [op e a eid] entities)))
 
             (id-literal? a)
             ;; TODO: should we even allow id-literal attributes?  Datomic fails in some cases here.
-            (let [eid (or (get-in report [:tempids a]) (next-eid db))]
+            (let [eid (or (get-in report [:tempids a]) (<? (db/<next-eid db e)))]
               (recur (allocate-eid report a eid) (cons [op e eid v] entities)))
 
             (id-literal? e)
-            (let [eid (or (get-in report [:tempids e]) (next-eid db))]
+            (let [eid (or (get-in report [:tempids e]) (<? (db/<next-eid db e)))]
               (recur (allocate-eid report e eid) (cons [op eid a v] entities)))
 
             true
@@ -333,127 +366,38 @@
         (ds/ensure-valid-value schema a v)))
     report))
 
-(defn- <ensure-unique-constraints
-  "Throw unless all datoms in :tx-data obey the uniqueness constraints."
-
-  [db report]
-  {:pre [(db/db? db) (report? report)]}
-
-  ;; TODO: consider accumulating errors to show more meaningful error reports.
-  ;; TODO: constrain entities; constrain attributes.
-
-  (go-pair
-    ;; TODO: comment on applying datoms that violate uniqueness.
-    (let [schema (db/schema db)
-          unique-datoms (transient {})] ;; map (nil, a, v)|(e, a, nil)|(e, a, v) -> datom.
-      (doseq [[e a v tx added :as datom] (:tx-data report)]
-
-        (when added
-          ;; Check for violated :db/unique constraint between datom and existing store.
-          (when (ds/unique? schema a)
-            (when-let [found (first (<? (db/<avet db [a v])))]
-              (raise "Cannot add " datom " because of unique constraint: " found
-                     {:error :transact/unique
-                      :attribute a ;; TODO: map attribute back to ident.
-                      :entity datom})))
-
-          ;; Check for violated :db/unique constraint between datoms.
-          (when (ds/unique? schema a)
-            (let [key [nil a v]]
-              (when-let [other (get unique-datoms key)]
-                (raise "Cannot add " datom " and " other " because together they violate unique constraint"
-                       {:error :transact/unique
-                        :attribute a ;; TODO: map attribute back to ident.
-                        :entity datom}))
-              (assoc! unique-datoms key datom)))
-
-          ;; Check for violated :db/cardinality :db.cardinality/one constraint between datoms.
-          (when-not (ds/multival? schema a)
-            (let [key [e a nil]]
-              (when-let [other (get unique-datoms key)]
-                (raise "Cannot add " datom " and " other " because together they violate cardinality constraint"
-                       {:error :transact/unique
-                        :entity datom}))
-              (assoc! unique-datoms key datom)))
-
-          ;; Check for duplicated datoms.  Datomic doesn't allow overlapping writes, and we don't
-          ;; want to guarantee order, so we don't either.
-          (let [key [e a v]]
-            (when-let [other (get unique-datoms key)]
-              (raise "Cannot add duplicate " datom
-                     {:error :transact/unique
-                      :entity datom}))
-            (assoc! unique-datoms key datom)))))
-    report))
-
-(defn <entities->tx-data [db report]
-  {:pre [(db/db? db) (report? report)]}
-  (go-pair
-    (let [initial-report report
-          {tx :tx}       report
-          schema         (db/schema db)]
-      (loop [report initial-report
-             es (:entities initial-report)]
-        (let [[[op e a v :as entity] & entities] es]
-          (cond
-            (nil? entity)
-            report
-
-            (= op :db/add)
-            (if (ds/multival? schema a)
-              (if (empty? (<? (db/<eavt db [e a v])))
-                (recur (transact-report report (datom e a v tx true)) entities)
-                (recur report entities))
-              (if-let [^Datom old-datom (first (<? (db/<eavt db [e a])))]
-                (if  (= (.-v old-datom) v)
-                  (recur report entities)
-                  (recur (-> report
-                             (transact-report (datom e a (.-v old-datom) tx false))
-                             (transact-report (datom e a v tx true)))
-                         entities))
-                (recur (transact-report report (datom e a v tx true)) entities)))
-
-            (= op :db/retract)
-            (if (first (<? (db/<eavt db [e a v])))
-              (recur (transact-report report (datom e a v tx false)) entities)
-              (recur report entities))
-
-            true
-            (raise "Unknown operation at " entity ", expected :db/add, :db/retract"
-                   {:error :transact/syntax, :operation op, :tx-data entity})))))))
-
 (defn <transact-tx-data
   [db report]
   {:pre [(db/db? db) (report? report)]}
 
-  (go-pair
-    (->>
-      report
-      (preprocess db)
+  (let [<apply-entities (fn [db report]
+                          (go-pair
+                            (let [tx-data (<? (db/<apply-entities db (:tx report) (:entities report)))]
+                              (assoc report :tx-data tx-data))))]
+    (go-pair
+      (->>
+        report
+        (preprocess db)
 
-      (<resolve-lookup-refs db)
-      (<?)
+        (<resolve-lookup-refs db)
+        (<?)
+        (p :resolve-lookup-refs)
 
-      (<resolve-id-literals db)
-      (<?)
+        (<resolve-id-literals db)
+        (<?)
+        (p :resolve-id-literals)
 
-      (<ensure-schema-constraints db)
-      (<?)
+        (<ensure-schema-constraints db)
+        (<?)
+        (p :ensure-schema-constraints)
 
-      (<entities->tx-data db)
-      (<?)
-
-      (<ensure-unique-constraints db)
-      (<?))))
-
-;; Normalize as [op int|id-literal int|id-literal value|id-literal]. ;; TODO: mention lookup-refs.
-
-;; Replace lookup-refs with entids where possible.
-
-;; Upsert or allocate id-literals.
+        (<apply-entities db)
+        (<?)
+        (p :apply-entities)
+        ))))
 
 (defn- is-ident? [db [_ a & _]]
-  (= a (get-in db [:idents :db/ident])))
+  (= a (db/entid db :db/ident)))
 
 (defn collect-db-ident-assertions
   "Transactions may add idents, install new partitions, and install new schema attributes.
@@ -486,24 +430,22 @@
                      {:error :schema/idents
                       :op    ia }))))))))
 
-(defn- symbolicate-datom [db [e a v added]]
-  (let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))
-        symbolicate (fn [x]
-                      (get entids x x))]
-    (datom
-      (symbolicate e)
-      (symbolicate a)
-      (symbolicate v)
-      added)))
-
 (defn collect-db-install-assertions
   "Transactions may add idents, install new partitions, and install new schema attributes.
   Collect [:db.part/db :db.install/attribute] assertions here."
   [db report]
   {:pre [(db/db? db) (report? report)]}
 
-  ;; TODO: be more efficient; symbolicating each datom is expensive!
-  (let [datoms (map (partial symbolicate-datom db) (:tx-data report))
+  ;; Symbolicating is not expensive.
+  (let [symbolicate-install-datom
+        (fn [[e a v tx added]]
+          (datom
+            (db/ident db e)
+            (db/ident db a)
+            (db/ident db v)
+            tx
+            added))
+        datoms (map symbolicate-install-datom (:tx-data report))
         schema-fragment (datomish.schema-changes/datoms->schema-fragment datoms)]
     (assoc-in report [:added-attributes] schema-fragment)))
 
@@ -518,7 +460,7 @@
                       ;; transaction ID and transaction timestamp directly from the report; Datomic
                       ;; makes this surprisingly difficult: one needs a :db.part/tx temporary and an
                       ;; explicit upsert of that temporary.
-                      :tx                (db/current-tx db)
+                      :tx                (<? (db/<next-eid db (id-literal :db.part/tx)))
                       :txInstant         (db/now db)
                       :entities          tx-data
                       :tx-data           []
@@ -530,32 +472,25 @@
 
                    (<transact-tx-data db)
                    (<?)
+                   (p :transact-tx-data)
 
                    (collect-db-ident-assertions db)
+                   (p :collect-db-ident-assertions)
 
-                   (collect-db-install-assertions db))
-          idents          (merge-with merge-ident (:idents db) (:added-idents report))
-          symbolic-schema (merge-with merge-attr (:symbolic-schema db) (:added-attributes report))
-          schema          (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema)))
-          db-after        (->
-                            db
+                   (collect-db-install-assertions db)
+                   (p :collect-db-install-assertions))
 
-                            (db/<apply-datoms (:tx-data report))
-                            (<?)
+          db-after (->
+                     db
 
-                            (db/<apply-db-ident-assertions (:added-idents report))
-                            (<?)
+                     (db/<apply-db-ident-assertions (:added-idents report) merge-ident)
+                     (<?)
+                     (->> (p :apply-db-ident-assertions))
 
-                            (db/<apply-db-install-assertions (:added-attributes report))
-                            (<?)
-
-                            ;; TODO: abstract this.
-                            (assoc :idents idents
-                                   :symbolic-schema symbolic-schema
-                                   :schema schema)
-
-                            (db/<advance-tx)
-                            (<?))]
+                     (db/<apply-db-install-assertions (:added-attributes report) merge-attr)
+                     (<?)
+                     (->> (p :apply-db-install-assertions)))
+          ]
       (-> report
           (assoc-in [:db-after] db-after)))))
 

src/datomish/transact/bootstrap.cljc

@@ -17,13 +17,15 @@
    ;; TODO: support user-specified functions in the future.
    ;; :db.install/function {:db/valueType :db.type/ref
    ;;                       :db/cardinality :db.cardinality/many}
-   :db/txInstant         {:db/valueType   :db.type/integer
+   :db/txInstant         {:db/valueType   :db.type/long
                           :db/cardinality :db.cardinality/one
                           } ;; :db/index       true} TODO: Handle this using SQLite protocol.
    :db/valueType         {:db/valueType   :db.type/ref
                           :db/cardinality :db.cardinality/one}
    :db/cardinality       {:db/valueType   :db.type/ref
                           :db/cardinality :db.cardinality/one}
+   :db/doc               {:db/valueType   :db.type/string
+                          :db/cardinality :db.cardinality/one}
    :db/unique            {:db/valueType   :db.type/ref
                           :db/cardinality :db.cardinality/one}
    :db/isComponent       {:db/valueType   :db.type/boolean
@@ -52,8 +54,8 @@
    :db/noHistory         13
    :db/add               14
    :db/retract           15
-   :db.part/tx           16
-   :db.part/user         17
+   :db.part/user         16
+   :db.part/tx           17
    :db/excise            18
    :db.excise/attrs      19
    :db.excise/beforeT    20
@@ -61,15 +63,18 @@
    :db.alter/attribute   22
    :db.type/ref          23
    :db.type/keyword      24
-   :db.type/integer      25 ;; TODO: :db.type/long, to match Datomic?
-   :db.type/string       26
-   :db.type/boolean      27
-   :db.type/instant      28
-   :db.type/bytes        29
-   :db.cardinality/one   30
-   :db.cardinality/many  31
-   :db.unique/value      32
-   :db.unique/identity   33})
+   :db.type/long         25
+   :db.type/double       26
+   :db.type/string       27
+   :db.type/boolean      28
+   :db.type/instant      29
+   :db.type/bytes        30
+   :db.cardinality/one   31
+   :db.cardinality/many  32
+   :db.unique/value      33
+   :db.unique/identity   34
+   :db/doc               35
+   })
 
 (defn tx-data []
   (concat

src/datomish/transact/explode.cljc

@@ -34,14 +34,14 @@
 (declare explode-entity)
 
 (defn- explode-entity-a-v [db entity eid a v]
-  ;; a should be symbolic at this point.  Map it.  TODO: use ident/entid to ensure we have a symbolic attr.
-  (let [reverse?    (reverse-ref? a)
+  (let [a           (db/ident db a) ;; We expect a to be an ident, but it's legal to provide an entid.
+        a*          (db/entid db a)
+        reverse?    (reverse-ref? a)
         straight-a  (if reverse? (reverse-ref a) a)
-        straight-a* (get-in db [:idents straight-a] straight-a)
+        straight-a* (db/entid db straight-a)
         _           (when (and reverse? (not (ds/ref? (db/schema db) straight-a*)))
                       (raise "Bad attribute " a ": reverse attribute name requires {:db/valueType :db.type/ref} in schema"
-                             {:error :transact/syntax, :attribute a, :op entity}))
-        a*          (get-in db [:idents a] a)]
+                             {:error :transact/syntax, :attribute a, :op entity}))]
     (cond
       reverse?
       (explode-entity-a-v db entity v straight-a eid)
@@ -60,11 +60,19 @@
                 :op    entity }))
 
       (sequential? v)
-      (if (ds/multival? (db/schema db) a*) ;; dm/schema
-        (mapcat (partial explode-entity-a-v db entity eid a) v) ;; Allow sequences of nested maps, etc.  This does mean [[1]] will work.
-        (raise "Sequential values " v " but attribute " a " is :db.cardinality/one"
-               {:error :transact/entity-sequential-cardinality-one
-                :op    entity }))
+      (if (some nil? v)
+        ;; This is a hard one to track down, with a steep stack back in `transact/ensure-entity-form`, so
+        ;; we error specifically here rather than expanding further.
+        (raise "Sequential attribute value for " a " contains nil."
+               {:error :transact/sequence-contains-nil
+                :op entity
+                :attribute a
+                :value v})
+        (if (ds/multival? (db/schema db) a*) ;; dm/schema
+          (mapcat (partial explode-entity-a-v db entity eid a) v) ;; Allow sequences of nested maps, etc.  This does mean [[1]] will work.
+          (raise "Sequential values " v " but attribute " a " is :db.cardinality/one"
+                 {:error :transact/entity-sequential-cardinality-one
+                  :op    entity })))
 
       true
       [[:db/add eid a* v]])))

src/datomish/util.cljc

@@ -30,6 +30,14 @@
          ~expr
          (cond-let ~@rest)))))
 
+(defn var->sql-type-var
+  "Turns '?xyz into :_xyz_type_tag."
+  [x]
+  (if (and (symbol? x)
+           (str/starts-with? (name x) "?"))
+    (keyword (str "_" (subs (name x) 1) "_type_tag"))
+    (throw (ex-info (str x " is not a Datalog var.") {}))))
+
 (defn var->sql-var
   "Turns '?xyz into :xyz."
   [x]
@@ -38,17 +46,10 @@
     (keyword (subs (name x) 1))
     (throw (ex-info (str x " is not a Datalog var.") {}))))
 
-(defn conj-in
-  "Associates a value into a sequence in a nested associative structure, where
-  ks is a sequence of keys and v is the new value, and returns a new nested
-  structure.
-  If any levels do not exist, hash-maps will be created. If the destination
-  sequence does not exist, a new one is created."
-  {:static true}
-  [m [k & ks] v]
-  (if ks
-    (assoc m k (conj-in (get m k) ks v))
-    (assoc m k (conj (get m k) v))))
+(defn aggregate->sql-var
+  "Turns (:max 'column) into :%max.column."
+  [fn-kw x]
+  (keyword (str "%" (name fn-kw) "." (name x))))
 
 (defn concat-in
   {:static true}
@@ -57,6 +58,17 @@
     (assoc m k (concat-in (get m k) ks vs))
     (assoc m k (concat (get m k) vs))))
 
+(defn append-in
+  "Associates a value into a sequence in a nested associative structure, where
+  ks is a sequence of keys and v is the new value, and returns a new nested
+  structure.
+  Always puts the value last.
+  If any levels do not exist, hash-maps will be created. If the destination
+  sequence does not exist, a new one is created."
+  {:static true}
+  [m path v]
+  (concat-in m path [v]))
+
 (defmacro while-let [binding & forms]
   `(loop []
      (when-let ~binding
@@ -70,3 +82,5 @@
            (f (first xs) (first ys))
            (recur f (rest xs) (rest ys)))))
 
+(defn mapvals [f m]
+  (into (empty m) (map #(vector (first %) (f (second %))) m)))

test/datomish/api.cljc

@@ -20,14 +20,9 @@
 (defn <connect [uri]
   ;; Eventually, URI.  For now, just a plain path (no file://).
   (go-pair
-    (->
-      (sqlite/<sqlite-connection uri)
-      (<?)
-
-      (db-factory/<db-with-sqlite-connection)
-      (<?)
-
-      (transact/connection-with-db))))
+    (let [conn (<? (sqlite/<sqlite-connection uri))
+          db (<? (db-factory/<db-with-sqlite-connection conn))]
+      (transact/connection-with-db db))))
 
 (def <transact! transact/<transact!)
 
@@ -38,3 +33,11 @@
 (def id-literal db/id-literal)
 
 (def db transact/db)
+
+(def entid db/entid)
+
+(def ident db/ident)
+
+(def <q db/<?q)
+
+(def schema db/schema)

test/datomish/db_test.cljc

@@ -10,17 +10,20 @@
       [cljs.core.async.macros :as a :refer [go]]))
   (:require
    [datomish.api :as d]
+   [datomish.db.debug :refer [<datoms-after <transactions-after <shallow-entity <fulltext-values]]
    [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
+   [datomish.schema :as ds]
    [datomish.sqlite :as s]
    [datomish.sqlite-schema]
    [datomish.datom]
-   [datomish.db :as db]
-   #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
+   #?@(:clj [[datomish.jdbc-sqlite]
+             [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]
+   #?@(:cljs [[datomish.promise-sqlite]
+              [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]]
@@ -36,88 +39,46 @@
 (defn- tempids [tx]
   (into {} (map (juxt (comp :idx first) second) (:tempids tx))))
 
-(defn- <datoms-after [db tx]
-  (let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))]
-    (go-pair
-      (->>
-        (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx > ?" tx])
-        (<?)
-        (mapv #(vector (:e %) (get entids (:a %) (str "fail" (:a %))) (:v %)))
-        (filter #(not (= :db/txInstant (second %))))
-        (set)))))
-
-(defn- <datoms [db]
-  (<datoms-after db 0))
-
-(defn- <shallow-entity [db eid]
-  ;; TODO: make this actually be <entity.  Handle :db.cardinality/many and :db/isComponent.
-  (let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))]
-    (go-pair
-      (->>
-        (s/all-rows (:sqlite-connection db) ["SELECT a, v FROM datoms WHERE e = ?" eid])
-        (<?)
-        (mapv #(vector (entids (:a %)) (:v %)))
-        (reduce conj {})))))
-
-(defn- <transactions-after [db tx]
-  (let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))]
-    (go-pair
-      (->>
-        (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions WHERE tx > ? ORDER BY tx ASC, e, a, v, added" tx])
-        (<?)
-        (mapv #(vector (:e %) (entids (:a %)) (:v %) (:tx %) (:added %)))))))
-
-(defn- <transactions [db]
-  (<transactions-after db 0))
-
-(defn- <fulltext-values [db]
-  (go-pair
-    (->>
-      (s/all-rows (:sqlite-connection db) ["SELECT rowid, text FROM fulltext_values"])
-      (<?)
-      (mapv #(vector (:rowid %) (:text %))))))
-
-;; TODO: use reverse refs!
 (def test-schema
-  [{:db/id        (d/id-literal :test -1)
+  [{:db/id        (d/id-literal :db.part/user)
     :db/ident     :x
     :db/unique    :db.unique/identity
-    :db/valueType :db.type/integer}
-   {:db/id :db.part/db :db.install/attribute (d/id-literal :test -1)}
-   {:db/id        (d/id-literal :test -2)
+    :db/valueType :db.type/long
+    :db.install/_attribute :db.part/db}
+   {:db/id        (d/id-literal :db.part/user)
     :db/ident     :name
     :db/unique    :db.unique/identity
-    :db/valueType :db.type/string}
-   {:db/id :db.part/db :db.install/attribute (d/id-literal :test -2)}
-   {:db/id          (d/id-literal :test -3)
+    :db/valueType :db.type/string
+    :db.install/_attribute :db.part/db}
+   {:db/id          (d/id-literal :db.part/user)
     :db/ident       :y
     :db/cardinality :db.cardinality/many
-    :db/valueType   :db.type/integer}
-   {:db/id :db.part/db :db.install/attribute (d/id-literal :test -3)}
-   {:db/id          (d/id-literal :test -5)
+    :db/valueType   :db.type/long
+    :db.install/_attribute :db.part/db}
+   {:db/id          (d/id-literal :db.part/user)
     :db/ident       :aka
     :db/cardinality :db.cardinality/many
-    :db/valueType   :db.type/string}
-   {:db/id :db.part/db :db.install/attribute (d/id-literal :test -5)}
-   {:db/id        (d/id-literal :test -6)
+    :db/valueType   :db.type/string
+    :db.install/_attribute :db.part/db}
+   {:db/id        (d/id-literal :db.part/user)
     :db/ident     :age
-    :db/valueType :db.type/integer}
-   {:db/id :db.part/db :db.install/attribute (d/id-literal :test -6)}
-   {:db/id        (d/id-literal :test -7)
+    :db/valueType :db.type/long
+    :db.install/_attribute :db.part/db}
+   {:db/id        (d/id-literal :db.part/user)
     :db/ident     :email
     :db/unique    :db.unique/identity
-    :db/valueType :db.type/string}
-   {:db/id :db.part/db :db.install/attribute (d/id-literal :test -7)}
-   {:db/id        (d/id-literal :test -8)
+    :db/valueType :db.type/string
+    :db.install/_attribute :db.part/db}
+   {:db/id        (d/id-literal :db.part/user)
     :db/ident     :spouse
     :db/unique    :db.unique/value
-    :db/valueType :db.type/string}
-   {:db/id :db.part/db :db.install/attribute (d/id-literal :test -8)}
-   {:db/id          (d/id-literal :test -9)
+    :db/valueType :db.type/string
+    :db.install/_attribute :db.part/db}
+   {:db/id          (d/id-literal :db.part/user)
     :db/ident       :friends
     :db/cardinality :db.cardinality/many
-    :db/valueType   :db.type/ref}
-   {:db/id :db.part/db :db.install/attribute (d/id-literal :test -9)}
+    :db/valueType   :db.type/ref
+    :db.install/_attribute :db.part/db}
    ])
 
 (deftest-async test-add-one
@@ -381,10 +342,12 @@
   (with-tempfile [t (tempfile)]
     (let [conn (<? (d/<connect t))]
       (try
+        (is (= :test/ident (d/entid (d/db conn) :test/ident)))
+
         (let [report   (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/db -1) :db/ident :test/ident]]))
-              db-after (:db-after report)
-              tx       (:tx db-after)]
-          (is (= (:test/ident (db/idents db-after)) (get-in report [:tempids (d/id-literal :db.part/db -1)]))))
+              eid      (get-in report [:tempids (d/id-literal :db.part/db -1)])]
+          (is (= eid (d/entid (d/db conn) :test/ident)))
+          (is (= :test/ident (d/ident (d/db conn) eid))))
 
         ;; TODO: This should fail, but doesn't, due to stringification of :test/ident.
         ;; (is (thrown-with-msg?
@@ -417,7 +380,7 @@
               tx       (:tx db-after)]
 
           (testing "New ident is allocated"
-            (is (some? (get-in db-after [:idents :test/attr]))))
+            (is (some? (d/entid db-after :test/attr))))
 
           (testing "Schema is modified"
             (is (= (get-in db-after [:symbolic-schema :test/attr])
@@ -450,34 +413,54 @@
                   {:db/id :db.part/db :db.install/attribute (d/id-literal :db.part/db -2)}
                   ]
           tx0 (:tx (<? (d/<transact! conn schema)))]
+      (testing "Schema checks"
+               (is (ds/fulltext? (d/schema (d/db conn))
+                                 (d/entid (d/db conn) :test/fulltext))))
       (try
         (testing "Can add fulltext indexed datoms"
-          (let [r (<? (d/<transact! conn [[:db/add 101 :test/fulltext "test this"]]))]
+          (let [{tx1 :tx txInstant1 :txInstant}
+                (<? (d/<transact! conn [[:db/add 101 :test/fulltext "test this"]]))]
             (is (= (<? (<fulltext-values (d/db conn)))
                    [[1 "test this"]]))
             (is (= (<? (<datoms-after (d/db conn) tx0))
                    #{[101 :test/fulltext 1]})) ;; Values are raw; 1 is the rowid into fulltext_values.
-            ))
+            (is (= (<? (<transactions-after (d/db conn) tx0))
+                   [[101 :test/fulltext 1 tx1 1] ;; Values are raw; 1 is the rowid into fulltext_values.
+                    [tx1 :db/txInstant txInstant1 tx1 1]]))
 
-        (testing "Can replace fulltext indexed datoms"
-          (let [r (<? (d/<transact! conn [[:db/add 101 :test/fulltext "alternate thing"]]))]
-            (is (= (<? (<fulltext-values (d/db conn)))
-                   [[1 "test this"]
-                    [2 "alternate thing"]]))
-            (is (= (<? (<datoms-after (d/db conn) tx0))
-                   #{[101 :test/fulltext 2]})) ;; Values are raw; 2 is the rowid into fulltext_values.
-            ))
+            (testing "Can replace fulltext indexed datoms"
+              (let [{tx2 :tx txInstant2 :txInstant} (<? (d/<transact! conn [[:db/add 101 :test/fulltext "alternate thing"]]))]
+                (is (= (<? (<fulltext-values (d/db conn)))
+                       [[1 "test this"]
+                        [2 "alternate thing"]]))
+                (is (= (<? (<datoms-after (d/db conn) tx0))
+                       #{[101 :test/fulltext 2]})) ;; Values are raw; 2 is the rowid into fulltext_values.
+                (is (= (<? (<transactions-after (d/db conn) tx0))
+                       [[101 :test/fulltext 1 tx1 1] ;; Values are raw; 1 is the rowid into fulltext_values.
+                        [tx1 :db/txInstant txInstant1 tx1 1]
+                        [101 :test/fulltext 1 tx2 0] ;; Values are raw; 1 is the rowid into fulltext_values.
+                        [101 :test/fulltext 2 tx2 1] ;; Values are raw; 2 is the rowid into fulltext_values.
+                        [tx2 :db/txInstant txInstant2 tx2 1]]))
 
-        (testing "Can upsert keyed by fulltext indexed datoms"
-          (let [r (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user) :test/fulltext "alternate thing" :test/other "other"}]))]
-            (is (= (<? (<fulltext-values (d/db conn)))
-                   [[1 "test this"]
-                    [2 "alternate thing"]
-                    [3 "other"]]))
-            (is (= (<? (<datoms-after (d/db conn) tx0))
-                   #{[101 :test/fulltext 2] ;; Values are raw; 2, 3 are the rowids into fulltext_values.
-                     [101 :test/other 3]}))
-            ))
+                (testing "Can upsert keyed by fulltext indexed datoms"
+                  (let [{tx3 :tx txInstant3 :txInstant} (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user) :test/fulltext "alternate thing" :test/other "other"}]))]
+                    (is (= (<? (<fulltext-values (d/db conn)))
+                           [[1 "test this"]
+                            [2 "alternate thing"]
+                            [3 "other"]]))
+                    (is (= (<? (<datoms-after (d/db conn) tx0))
+                           #{[101 :test/fulltext 2] ;; Values are raw; 2, 3 are the rowids into fulltext_values.
+                             [101 :test/other 3]}))
+                    (is (= (<? (<transactions-after (d/db conn) tx0))
+                           [[101 :test/fulltext 1 tx1 1] ;; Values are raw; 1 is the rowid into fulltext_values.
+                            [tx1 :db/txInstant txInstant1 tx1 1]
+                            [101 :test/fulltext 1 tx2 0] ;; Values are raw; 1 is the rowid into fulltext_values.
+                            [101 :test/fulltext 2 tx2 1] ;; Values are raw; 2 is the rowid into fulltext_values.
+                            [tx2 :db/txInstant txInstant2 tx2 1]
+                            [101 :test/other 3 tx3 1] ;; Values are raw; 3 is the rowid into fulltext_values.
+                            [tx3 :db/txInstant txInstant3 tx3 1]]))
+
+                    ))))))
 
         (testing "Can re-use fulltext indexed datoms"
           (let [r (<? (d/<transact! conn [[:db/add 102 :test/other "test this"]]))]
@@ -632,3 +615,63 @@
 
         (finally
           (<? (d/<close conn)))))))
+
+(deftest-async test-next-eid
+  (with-tempfile [t (tempfile)]
+    (let [conn      (<? (d/<connect t))
+          {tx0 :tx} (<? (d/<transact! conn test-schema))]
+      (testing "entids are increasing, tx ids are larger than user ids"
+        (let [r1 (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Igor"}]))
+              r2 (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -2) :name "Oleg"}]))
+              e1 (get (tempids r1) -1)
+              e2 (get (tempids r2) -2)]
+          (is (< e1 (:tx r1)))
+          (is (< e2 (:tx r2)))
+          (is (< e1 e2))
+          (is (< (:tx r1) (:tx r2)))
+
+          ;; Close and re-open same DB.
+          (<? (d/<close conn))
+          (let [conn (<? (d/<connect t))]
+            (try
+              (testing "entid counters are persisted across re-opens"
+                (let [r3 (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -3) :name "Petr"}]))
+                      e3 (get (tempids r3) -3)]
+                  (is (< e3 (:tx r3)))
+                  (is (< e2 e3))
+                  (is (< (:tx r2) (:tx r3)))))
+
+              (finally
+                (<? (d/<close conn))))))))))
+
+(deftest-async test-unique-value
+  (with-tempfile [t (tempfile)]
+    (let [conn (<? (d/<connect t))]
+      (try
+        (let [tx0 (:tx (<? (d/<transact! conn [{:db/id                 (d/id-literal :db.part/user -1)
+                                                :db/ident              :test/x
+                                                :db/unique             :db.unique/value
+                                                :db/valueType          :db.type/long
+                                                :db.install/_attribute :db.part/db}
+                                               {:db/id                 (d/id-literal :db.part/user -2)
+                                                :db/ident              :test/y
+                                                :db/unique             :db.unique/value
+                                                :db/valueType          :db.type/long
+                                                :db.install/_attribute :db.part/db}])))]
+
+          (testing "can insert different :db.unique/value attributes with the same value"
+            (let [report1 (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :test/x 12345]]))
+                  eid1    (get-in report1 [:tempids (d/id-literal :db.part/user -1)])
+                  report2 (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -2) :test/y 12345]]))
+                  eid2    (get-in report2 [:tempids (d/id-literal :db.part/user -2)])]
+              (is (= (<? (<datoms-after (d/db conn) tx0))
+                     #{[eid1 :test/x 12345]
+                       [eid2 :test/y 12345]}))))
+
+          (testing "can't upsert a :db.unique/value field"
+            (is (thrown-with-msg?
+                  ExceptionInfo #"unique constraint"
+                  (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/x 12345 :test/y 99999}]))))))
+
+        (finally
+          (<? (d/<close conn)))))))

test/datomish/places/import_test.cljc

@@ -0,0 +1,79 @@
+;; 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.places.import-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
+   [taoensso.tufte :as tufte
+    #?(:cljs :refer-macros :clj :refer) [defnp p profiled profile]]
+   [datomish.api :as d]
+   [datomish.places.import :as pi]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
+   [datomish.sqlite :as s]
+   #?@(:clj [[datomish.jdbc-sqlite]
+             [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.promise-sqlite]
+              [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 [<! >!]]])))
+
+#?(:cljs
+   (def Throwable js/Error))
+
+(tufte/add-basic-println-handler! {})
+
+(deftest-async test-import
+  (with-tempfile [t (tempfile)]
+    (let [places (<? (s/<sqlite-connection "/tmp/places.sqlite"))
+          conn (<? (d/<connect t))]
+      (try
+        (let [report    (profile {:dynamic? true} (<? (pi/import-places conn places)))]
+
+          (is (= nil (count (:tx-data report)))))
+        (finally
+          (<? (d/<close conn)))))))
+
+(deftest-async test-import-repeat
+  ;; Repeated import is worst possible for the big joins to find datoms that already exist, because
+  ;; *every* datom added in the first import will match in the second.
+  (with-tempfile [t (tempfile)]
+    (let [places (<? (s/<sqlite-connection "/tmp/places.sqlite"))
+          conn (<? (d/<connect t))]
+      (try
+        (let [report0   (<? (pi/import-places conn places))
+              report    (profile {:dynamic? true} (<? (pi/import-places conn places)))]
+
+          (is (= nil (count (:tx-data report)))))
+
+        (finally
+          (<? (d/<close conn)))))))
+
+#_
+(defn <?? [pair-chan]
+  (datomish.pair-chan/consume-pair (clojure.core.async/<!! pair-chan)))
+
+#_ [
+    (def places (<?? (s/<sqlite-connection "/tmp/places.sqlite")))
+    (def conn (<?? (d/<connect "/tmp/testkb.sqlite")))
+    (def tx0 (:tx (<?? (d/<transact! conn places-schema-fragment))))
+
+    (tufte/add-basic-println-handler! {})
+    (def report (profile {:dynamic? true} (<?? (pi/import conn places))))
+
+    ;; Empty:
+    ;; "Elapsed time: 5451.610551 msecs"
+    ;; Reimport:
+    ;; "Elapsed time: 25600.358881 msecs"
+
+    ]

test/datomish/query_test.cljc

@@ -0,0 +1,56 @@
+;; 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.query-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.api :as d]
+   #?@(:clj [[datomish.jdbc-sqlite]
+             [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.promise-sqlite]
+              [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 [<! >!]]]))
+  #?(:clj
+     (:import [clojure.lang ExceptionInfo]))
+  #?(:clj
+     (:import [datascript.db DB])))
+
+#?(:cljs
+   (def Throwable js/Error))
+
+(def test-schema
+  [{:db/id        (d/id-literal :db.part/user)
+    :db/ident     :x
+    :db/unique    :db.unique/identity
+    :db/valueType :db.type/long
+    :db.install/_attribute :db.part/db}
+   ])
+
+(deftest-async test-q
+  (with-tempfile [t (tempfile)]
+    (let [conn      (<? (d/<connect t))
+          {tx0 :tx} (<? (d/<transact! conn test-schema))]
+      (try
+        (let [{tx1 :tx} (<? (d/<transact! conn [{:db/id 101 :x 505}]))]
+
+          (is (= (<? (d/<q (d/db conn)
+                           `[:find ?e ?a ?v ?tx :in $ :where
+                             [?e ?a ?v ?tx]
+                             [(> ?tx ~tx0)]
+                             [(!= ?a ~(d/entid (d/db conn) :db/txInstant))] ;; TODO: map ident->entid for values.
+                             ] {}))
+                 [[101 (d/entid (d/db conn) :x) 505 tx1]]))) ;; TODO: map entid->ident on egress.
+        (finally
+          (<? (d/<close conn)))))))

test/datomish/test.cljs

@@ -2,18 +2,25 @@
   (:require
    [doo.runner :refer-macros [doo-tests doo-all-tests]]
    [cljs.test :as t :refer-macros [is are deftest testing]]
+   datomish.places.import-test
    datomish.promise-sqlite-test
    datomish.db-test
+   datomish.query-test
    datomish.sqlite-user-version-test
+   datomish.tofinoish-test
    datomish.test.util
    datomish.test.transforms
    datomish.test.query
-   datomish.test-macros-test))
+   datomish.test-macros-test
+   ))
 
 (doo-tests
+  'datomish.places.import-test
   'datomish.promise-sqlite-test
   'datomish.db-test
+  'datomish.query-test
   'datomish.sqlite-user-version-test
+  'datomish.tofinoish-test
   'datomish.test.util
   'datomish.test.transforms
   'datomish.test.query

test/datomish/test/query.cljc

@@ -1,18 +1,34 @@
 (ns datomish.test.query
+  #?(: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.query.cc :as cc]
      [datomish.query.context :as context]
      [datomish.query.source :as source]
      [datomish.query.transforms :as transforms]
      [datomish.query :as query]
+     [datomish.db :as db]
+     [datomish.schema :as schema]
+     [datomish.transact :as transact]
+     [datomish.api :as d]
      #?@(:clj
-           [
-          [honeysql.core :as sql :refer [param]]
-          [clojure.test :as t :refer [is are deftest testing]]])
+           [[datomish.pair-chan :refer [go-pair <?]]
+            [datomish.jdbc-sqlite]
+            [datomish.test-macros :refer [deftest-db]]
+            [honeysql.core :as sql :refer [param]]
+            [tempfile.core :refer [tempfile with-tempfile]]
+            [clojure.test :as t :refer [is are deftest testing]]])
      #?@(:cljs
-           [
-          [honeysql.core :as sql :refer-macros [param]]
-          [cljs.test :as t :refer-macros [is are deftest testing]]])
-     ))
+           [[datomish.promise-sqlite]
+            [datomish.test-macros :refer-macros [deftest-db]]
+            [honeysql.core :as sql :refer-macros [param]]
+            [datomish.node-tempfile :refer [tempfile]]
+            [cljs.test :as t :refer-macros [is are deftest testing]]]))
+  #?(:clj
+       (:import [clojure.lang ExceptionInfo])))
 
 (defn- fgensym [s c]
   (symbol (str s c)))
@@ -25,144 +41,454 @@
       ([s]
        (fgensym s (dec (swap! counter inc)))))))
 
-(defn mock-source [db]
-  (source/map->DatomsSource
-    {:table :datoms
-     :fulltext-table :fulltext_values
-     :fulltext-view :all_datoms
-     :columns [:e :a :v :tx :added]
-     :attribute-transform transforms/attribute-transform-string
-     :constant-transform transforms/constant-transform-default
-     :table-alias (comp (make-predictable-gensym) name)
-     :make-constraints nil}))
+(def simple-schema
+  [{:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :db/txInstant
+    :db/valueType :db.type/long
+    :db/cardinality :db.cardinality/one}
+   {:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :foo/bar
+    :db/valueType :db.type/string
+    :db/cardinality :db.cardinality/many}
+   {:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :foo/int
+    :db/valueType :db.type/long
+    :db/cardinality :db.cardinality/one}
+   {:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :foo/str
+    :db/valueType :db.type/string
+    :db/cardinality :db.cardinality/many}])
 
-(defn- expand [find]
-  (let [context (context/->Context (mock-source nil) nil nil)
+(def page-schema
+  [{:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :page/loves
+    :db/valueType :db.type/ref
+    :db/cardinality :db.cardinality/many}
+   {:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :page/likes
+    :db/valueType :db.type/ref
+    :db/cardinality :db.cardinality/many}
+   {:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :page/url
+    :db/valueType :db.type/string
+    :db/unique :db.unique/identity
+    :db/cardinality :db.cardinality/one}
+   {:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :page/title
+    :db/valueType :db.type/string
+    :db/cardinality :db.cardinality/one}
+   {:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :page/starred
+    :db/valueType :db.type/boolean
+    :db/cardinality :db.cardinality/one}])
+
+(def aggregate-schema
+  [{:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :page/url
+    :db/valueType :db.type/string
+    :db/unique :db.unique/identity
+    :db/cardinality :db.cardinality/one}
+   {:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :foo/points
+    :db/valueType :db.type/long
+    :db/cardinality :db.cardinality/many}
+   {:db/id (d/id-literal :db.part/user)
+    :db.install/_attribute :db.part/db
+    :db/ident :foo/visitedAt
+    :db/valueType :db.type/instant
+    :db/cardinality :db.cardinality/many}])
+
+(def schema-with-page
+  (concat
+    simple-schema
+    page-schema))
+
+(defn mock-source [db]
+  (assoc (datomish.db/datoms-source db)
+         :table-alias (comp (make-predictable-gensym) name)))
+
+(defn conn->context [conn]
+  (context/make-context (mock-source (d/db conn))))
+
+(defn- expand [find conn]
+  (let [context (conn->context conn)
         parsed (query/parse find)]
     (query/find->sql-clause context parsed)))
 
-(deftest test-basic-join
-  (is (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
-          :modifiers [:distinct],
-          :from '[[:datoms datoms0]
-                  [:datoms datoms1]],
-          :where (list
-                   :and
-                   [:= :datoms1.e :datoms0.tx]
-                   [:= :datoms0.a "page/starred"]
-                   [:= :datoms0.v 1]
-                   [:= :datoms1.a "db/txInstant"]
-                   [:not
-                    (list :and (list :> :datoms1.e (sql/param :latest)))])}
-         (expand
-           '[:find ?timestampMicros ?page :in $ ?latest :where
-             [?page :page/starred true ?t]
-             [?t :db/txInstant ?timestampMicros]
-             (not [(> ?t ?latest)])]))))
+(defn- populate [find conn]
+  (let [context (conn->context conn)
+        parsed (query/parse find)]
+    (query/find-into-context context parsed)))
 
-(deftest test-pattern-not-join
-  (is (= '{:select ([:datoms1.v :timestampMicros] [:datoms0.e :page]),
-           :modifiers [:distinct],
-           :from [[:datoms datoms0]
-                  [:datoms datoms1]],
-           :where (:and
-                     [:= :datoms1.e :datoms0.tx]
-                     [:= :datoms0.a "page/starred"]
+(defn <initialize-with-schema [conn schema]
+  (go-pair
+    (let [tx (<? (d/<transact! conn schema))]
+      (let [idents (map :db/ident schema)
+            db (d/db conn)]
+        (into {}
+          (map (fn [ident]
+                 [ident (d/entid db ident)])
+               idents))))))
+
+(deftest-db test-type-extraction conn
+  ;; We expect to be able to look up the default types.
+  (is (integer? (d/entid (d/db conn) :db.type/ref)))
+  (is (integer? (d/entid (d/db conn) :db.type/long)))
+
+  ;; Add our own schema.
+  (<? (<initialize-with-schema conn simple-schema))
+  (testing "Variable entity."
+    (is (= (->
+             (populate '[:find ?e ?v :in $ :where [?e :foo/int ?v]] conn)
+             :cc :known-types)
+           {'?v :db.type/long
+            '?e :db.type/ref})))
+
+  (testing "Numeric entid."
+    (is (= (->
+             (populate '[:find ?v :in $ :where [6 :foo/int ?v]] conn)
+             :cc :known-types)
+           {'?v :db.type/long})))
+
+  (testing "Keyword entity."
+    (is (= (->
+             (populate '[:find ?v :in $ :where [:my/thing :foo/int ?v]] conn)
+             :cc :known-types)
+           {'?v :db.type/long}))))
+
+(deftest-db test-value-constant-constraint-descends-into-not-and-or conn
+  (let [attrs (<? (<initialize-with-schema conn simple-schema))]
+    (testing "Elision of types inside a join."
+      (is (= {:select '([:datoms0.e :e]
+                        [:datoms0.v :v]),
+               :modifiers [:distinct],
+               :from [[:datoms 'datoms0]],
+               :where (list :and
+                         [:= :datoms0.a (:foo/int attrs)]
+                         [:not
+                          [:exists
+                           {:select [1],
+                            :from [[:all_datoms 'all_datoms1]],
+                            :where (list :and
+                                      [:= :all_datoms1.e 15]
+                                      [:= :datoms0.v :all_datoms1.v])}]])}
+             (expand
+               '[:find ?e ?v :in $ :where
+                 [?e :foo/int ?v]
+                 (not [15 ?a ?v])]
+               conn))))
+
+    (testing "Type collisions inside :not."
+      (is (thrown-with-msg?
+            ExceptionInfo #"v already has type :db.type.long"
+            (expand
+              '[:find ?e ?v :in $ :where
+                [?e :foo/int ?v]
+                (not [15 :foo/str ?v])]
+              conn))))
+
+    (testing "Type collisions inside :or"
+      (is (thrown-with-msg?
+            ExceptionInfo #"v already has type :db.type.long"
+            (expand
+              '[:find ?e ?v :in $ :where
+                [?e :foo/int ?v]
+                (or
+                  [15 :foo/str ?v]
+                  [10 :foo/int ?v])]
+              conn))))))
+
+(deftest-db test-type-collision conn
+  (<? (<initialize-with-schema conn simple-schema))
+  (let [find '[:find ?e ?v :in $
+               :where
+               [?e :foo/int ?v]
+               [?x :foo/str ?v]]]
+     (is (thrown-with-msg?
+           ExceptionInfo #"v already has type :db.type.long"
+           (populate find conn)))))
+
+(deftest-db test-value-constant-constraint conn
+  (<? (<initialize-with-schema conn simple-schema))
+  (is (= {:select '([:all_datoms0.e :foo]),
+          :modifiers [:distinct],
+          :from '[[:all_datoms all_datoms0]],
+          :where (list :and
+                       (list :or
+                             [:= :all_datoms0.value_type_tag 0]
+                             ;; In CLJS, this can also be an `instant`.
+                             #?@(:cljs [[:= :all_datoms0.value_type_tag 4]])
+                             [:= :all_datoms0.value_type_tag 5])
+                       [:= :all_datoms0.v 99])}
+         (expand
+           '[:find ?foo :in $ :where
+             [?foo _ 99]]
+           conn))))
+
+(deftest-db test-value-constant-constraint-elided-using-schema conn
+  (let [attrs (<? (<initialize-with-schema conn schema-with-page))]
+    (testing "Our attributes were interned."
+      (is (integer? (d/entid (d/db conn) :foo/str)))
+      (is (integer? (d/entid (d/db conn) :page/starred))))
+
+    (testing "There's no need to produce value_type_tag constraints when the attribute is specified."
+      (is
+        (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
+            :modifiers [:distinct],
+            :from [[:datoms 'datoms0]
+                   [:datoms 'datoms1]],
+            :where (list :and
+                       ;; We don't need a type check on the range of page/starred...
+                       [:= :datoms0.a (:page/starred attrs)]
+                       [:= :datoms0.v 1]
+                       [:= :datoms1.a (:db/txInstant attrs)]
+                       [:not
+                        [:exists
+                         {:select [1],
+                          :from [[:datoms 'datoms2]],
+                          :where (list :and
+                                    [:= :datoms2.a (:foo/bar attrs)]
+                                    [:= :datoms0.e :datoms2.e])}]]
+                       [:= :datoms0.tx :datoms1.e])}
+           (expand
+             '[:find ?timestampMicros ?page :in $ ?latest :where
+               [?page :page/starred true ?t]
+               [?t :db/txInstant ?timestampMicros]
+               (not [?page :foo/bar _])]
+
+             conn))))))
+
+(deftest-db test-basic-join conn
+  ;; Note that we use a schema without :page/starred, so we
+  ;; don't know what type it is.
+  (let [attrs (<? (<initialize-with-schema conn simple-schema))]
+    (is (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
+            :modifiers [:distinct],
+            :from '([:datoms datoms0]
+                    [:datoms datoms1]),
+            :where (list
+                     :and
+                     ;; Note that :page/starred is literal, because
+                     ;; it's not present in the interned schema.
+                     [:= :datoms0.a :page/starred]
+                     [:= :datoms0.value_type_tag 1]   ; boolean
                      [:= :datoms0.v 1]
-                     [:= :datoms1.a "db/txInstant"]
+                     [:= :datoms1.a (:db/txInstant attrs)]
+                     [:not
+                      (list :and (list :> :datoms0.tx (sql/param :latest)))]
+                     [:= :datoms0.tx :datoms1.e])}
+           (expand
+             '[:find ?timestampMicros ?page :in $ ?latest :where
+               [?page :page/starred true ?t]
+               [?t :db/txInstant ?timestampMicros]
+               (not [(> ?t ?latest)])]
+             conn)))))
+
+(deftest-db test-pattern-not-join conn
+  (let [attrs (<? (<initialize-with-schema conn simple-schema))]
+    (is (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
+            :modifiers [:distinct],
+            :from [[:datoms 'datoms0]
+                   [:datoms 'datoms1]],
+            :where (list
+                     :and
+                     ;; Note that :page/starred is literal, because
+                     ;; it's not present in the interned schema.
+                     [:= :datoms0.a :page/starred]
+                     [:= :datoms0.value_type_tag 1]   ; boolean
+                     [:= :datoms0.v 1]
+                     [:= :datoms1.a (:db/txInstant attrs)]
                      [:not
                       [:exists
                        {:select [1],
-                        :from [[:datoms datoms2]],
-                        :where (:and
-                                  [:= :datoms2.a "foo/bar"]
-                                  [:= :datoms0.e :datoms2.e])}]])}
-         (expand
-           '[:find ?timestampMicros ?page :in $ ?latest :where
-             [?page :page/starred true ?t]
-             [?t :db/txInstant ?timestampMicros]
-             (not [?page :foo/bar _])]))))
+                        :from [[:datoms 'datoms2]],
+                        :where (list :and
+                                  [:= :datoms2.a (:foo/bar attrs)]
+                                  [:= :datoms0.e :datoms2.e])}]]
+                     [:= :datoms0.tx :datoms1.e])}
+           (expand
+             '[:find ?timestampMicros ?page :in $ ?latest :where
+               [?page :page/starred true ?t]
+               [?t :db/txInstant ?timestampMicros]
+               (not [?page :foo/bar _])]
+             conn)))))
 
 ;; Note that clause ordering is not directly correlated to the output: cross-bindings end up
 ;; at the front. The SQL engine will do its own analysis. See `clauses/expand-where-from-bindings`.
-(deftest test-not-clause-ordering-preserved
-  (is (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
-          :modifiers [:distinct],
-          :from '[[:datoms datoms0]
-                  [:datoms datoms1]],
-          :where (list
-                   :and
-                   [:= :datoms1.e :datoms0.tx]
-                   [:= :datoms0.a "page/starred"]
-                   [:= :datoms0.v 1]
-                   [:not
-                    (list :and (list :> :datoms0.tx (sql/param :latest)))]
-                   [:= :datoms1.a "db/txInstant"])}
-         (expand
-           '[:find ?timestampMicros ?page :in $ ?latest :where
-             [?page :page/starred true ?t]
-             (not [(> ?t ?latest)])
-             [?t :db/txInstant ?timestampMicros]]))))
-
-(deftest test-pattern-not-join-ordering-preserved
-  (is (= '{:select ([:datoms2.v :timestampMicros] [:datoms0.e :page]),
-           :modifiers [:distinct],
-           :from [[:datoms datoms0]
-                  [:datoms datoms2]],
-           :where (:and
-                     [:= :datoms2.e :datoms0.tx]
-                     [:= :datoms0.a "page/starred"]
+(deftest-db test-not-clause-ordering-preserved conn
+  (let [attrs (<? (<initialize-with-schema conn schema-with-page))]
+    (is (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
+            :modifiers [:distinct],
+            :from '[[:datoms datoms0]
+                    [:datoms datoms1]],
+            :where (list
+                     :and
+                     ;; We don't need a value tag constraint -- we know the range of the attribute.
+                     [:= :datoms0.a (:page/starred attrs)]
                      [:= :datoms0.v 1]
                      [:not
-                      [:exists
-                       {:select [1],
-                        :from [[:datoms datoms1]],
-                        :where (:and
-                                  [:= :datoms1.a "foo/bar"]
-                                  [:= :datoms0.e :datoms1.e])}]]
-                     [:= :datoms2.a "db/txInstant"]
+                      (list :and (list :> :datoms0.tx (sql/param :latest)))]
+                     [:= :datoms1.a (:db/txInstant attrs)]
+                     [:= :datoms0.tx :datoms1.e]
                      )}
-         (expand
-           '[:find ?timestampMicros ?page :in $ ?latest :where
-             [?page :page/starred true ?t]
-             (not [?page :foo/bar _])
-             [?t :db/txInstant ?timestampMicros]]))))
+           (expand
+             '[:find ?timestampMicros ?page :in $ ?latest :where
+               [?page :page/starred true ?t]
+               (not [(> ?t ?latest)])
+               [?t :db/txInstant ?timestampMicros]]
+             conn)))))
 
-(deftest test-single-or
-  (is (= '{:select ([:datoms1.e :page]),
-           :modifiers [:distinct],
-           :from ([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]),
-           :where (:and
-                     [:= :datoms1.e :datoms0.e]
-                     [:= :datoms1.e :datoms2.v]
-                     [:= :datoms0.a "page/url"]
-                     [:= :datoms0.v "http://example.com/"]
-                     [:= :datoms1.a "page/title"]
-                     [:= :datoms2.a "page/loves"])}
-         (expand
-           '[:find ?page :in $ ?latest :where
-             [?page :page/url "http://example.com/"]
-             [?page :page/title ?title]
-             (or
-               [?entity :page/loves ?page])]))))
+(deftest-db test-pattern-not-join-ordering-preserved conn
+  (let [attrs (<? (<initialize-with-schema conn schema-with-page))]
+    (is (= {:select '([:datoms2.v :timestampMicros] [:datoms0.e :page]),
+            :modifiers [:distinct],
+            :from [[:datoms 'datoms0]
+                   [:datoms 'datoms2]],
+            :where (list :and
+                     ;; We don't need a value tag constraint -- we know the range of the attribute.
+                      [:= :datoms0.a (:page/starred attrs)]
+                      [:= :datoms0.v 1]
+                      [:not
+                       [:exists
+                        {:select [1],
+                         :from [[:datoms 'datoms1]],
+                         :where (list :and
+                                   [:= :datoms1.a (:foo/bar attrs)]
+                                   [:= :datoms0.e :datoms1.e])}]]
+                      [:= :datoms2.a (:db/txInstant attrs)]
+                      [:= :datoms0.tx :datoms2.e])}
+           (expand
+             '[:find ?timestampMicros ?page :in $ ?latest :where
+               [?page :page/starred true ?t]
+               (not [?page :foo/bar _])
+               [?t :db/txInstant ?timestampMicros]]
+             conn)))))
 
-(deftest test-simple-or
-  (is (= '{:select ([:datoms1.e :page]),
-           :modifiers [:distinct],
-           :from ([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]),
-           :where (:and
-                     [:= :datoms1.e :datoms0.e]
-                     [:= :datoms1.e :datoms2.v]
-                     [:= :datoms0.a "page/url"]
-                     [:= :datoms0.v "http://example.com/"]
-                     [:= :datoms1.a "page/title"]
-                     (:or
-                        [:= :datoms2.a "page/likes"]
-                        [:= :datoms2.a "page/loves"]))}
-         (expand
-           '[:find ?page :in $ ?latest :where
-             [?page :page/url "http://example.com/"]
-             [?page :page/title ?title]
-             (or
-               [?entity :page/likes ?page]
-               [?entity :page/loves ?page])]))))
+(deftest-db test-single-or conn
+  (let [attrs (<? (<initialize-with-schema conn schema-with-page))]
+    (is (= {:select '([:datoms0.e :page]),
+            :modifiers [:distinct],
+            :from '([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]),
+            :where (list :and
+                      [:= :datoms0.a (:page/url attrs)]
+                      [:= :datoms0.v "http://example.com/"]
+                      [:= :datoms1.a (:page/title attrs)]
+                      [:= :datoms2.a (:page/loves attrs)]
+                      [:= :datoms0.e :datoms1.e]
+                      [:= :datoms0.e :datoms2.v])}
+           (expand
+             '[:find ?page :in $ ?latest :where
+               [?page :page/url "http://example.com/"]
+               [?page :page/title ?title]
+               (or
+                 [?entity :page/loves ?page])]
+             conn)))))
+
+(deftest-db test-simple-or conn
+  (let [attrs (<? (<initialize-with-schema conn schema-with-page))]
+    (is (= {:select '([:datoms0.e :page]),
+            :modifiers [:distinct],
+            :from '([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]),
+            :where (list :and
+                      [:= :datoms0.a (:page/url attrs)]
+                      [:= :datoms0.v "http://example.com/"]
+                      [:= :datoms1.a (:page/title attrs)]
+                      (list :or
+                         [:= :datoms2.a (:page/likes attrs)]
+                         [:= :datoms2.a (:page/loves attrs)])
+                      [:= :datoms0.e :datoms1.e]
+                      [:= :datoms0.e :datoms2.v])}
+           (expand
+             '[:find ?page :in $ ?latest :where
+               [?page :page/url "http://example.com/"]
+               [?page :page/title ?title]
+               (or
+                 [?entity :page/likes ?page]
+                 [?entity :page/loves ?page])]
+             conn)))))
+
+(defn tag-clauses [column input]
+  (let [codes (cc/->tag-codes input)]
+    (if (= 1 (count codes))
+      [:= column (first codes)]
+      (cons :or (map (fn [tag]
+                       [:= column tag])
+                     codes)))))
+
+(deftest-db test-url-tag conn
+  (let [attrs (<? (<initialize-with-schema conn schema-with-page))]
+    (is (= {:select '([:all_datoms0.e :page]
+                      [:datoms1.v :thing]),
+            :modifiers [:distinct],
+            :from '([:all_datoms all_datoms0]
+                    [:datoms datoms1]),
+            :where (list
+                     :and
+                     (tag-clauses :all_datoms0.value_type_tag "http://example.com/")
+                     [:= :all_datoms0.v "http://example.com/"]
+                     (list
+                       :or
+                       [:= :datoms1.a (:page/likes attrs)]
+                       [:= :datoms1.a (:page/loves attrs)])
+                     [:= :all_datoms0.e :datoms1.e])}
+           (expand
+             '[:find ?page ?thing :in $ ?latest :where
+               [?page _ "http://example.com/"]
+               (or
+                 [?page :page/likes ?thing]
+                 [?page :page/loves ?thing])]
+             conn)))))
+
+(deftest-db test-tag-projection conn
+  (let [attrs (<? (<initialize-with-schema conn schema-with-page))]
+    (is (= {:select '([:all_datoms0.e :page]
+                      [:all_datoms0.v :thing]
+                      [:all_datoms0.value_type_tag :_thing_type_tag]),
+            :modifiers [:distinct],
+            :from '([:all_datoms all_datoms0])}
+           (expand
+             '[:find ?page ?thing :in $ :where
+               [?page _ ?thing]]
+             conn)))))
+
+(deftest-db test-aggregates conn
+  (let [attrs (<? (<initialize-with-schema conn aggregate-schema))
+        context
+        (populate '[:find ?date (max ?v)
+                    :with ?e
+                    :in $ ?then
+                    :where
+                    [?e :foo/visitedAt ?date]
+                    [(> ?date ?then)]
+                    [?e :foo/points ?v]] conn)]
+
+    (is (= (:group-by-vars context)
+           ['?date '?e]))
+
+    (is (= {:select '([:inner.date :date]
+                      [:%max.inner.v :_max_v])
+            :modifiers [:distinct]
+            :from [[{:select '([:datoms0.v :date]
+                               [:datoms1.v :v]
+                               [:datoms0.e :e]),          ; Because we need to group on it.
+                     :modifiers [:distinct],
+                     :group-by '(:date :e),
+                     :from '([:datoms datoms0] [:datoms datoms1]),
+                     :where (list
+                              :and
+                              [:= :datoms0.a (:foo/visitedAt attrs)]
+                              (list :> :datoms0.v (sql/param :then))
+                              [:= :datoms1.a (:foo/points attrs)]
+                              [:= :datoms0.e :datoms1.e])} :inner]]}
+           (query/context->sql-clause context)))))

test/datomish/test/util.cljc

@@ -9,6 +9,13 @@
   (is (= :x (util/var->sql-var '?x)))
   (is (= :XX (util/var->sql-var '?XX))))
 
+#?(:cljs
+   (deftest test-integer?-js
+     (is (integer? 0))
+     (is (integer? 5))
+     (is (integer? 50000000000))
+     (is (not (integer? 5.1)))))
+
 #?(:cljs
    (deftest test-raise
      (let [caught

test/datomish/tofinoish_test.cljc

@@ -0,0 +1,266 @@
+;; 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.tofinoish-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.api :as d]
+   [datomish.util :as util]
+   #?@(:clj [[datomish.jdbc-sqlite]
+             [datomish.pair-chan :refer [go-pair <?]]
+             [tempfile.core :refer [tempfile with-tempfile]]
+             [datomish.test-macros :refer [deftest-async deftest-db]]
+             [clojure.test :as t :refer [is are deftest testing]]
+             [clojure.core.async :refer [go <! >!]]])
+   #?@(:cljs [[datomish.promise-sqlite]
+              [datomish.pair-chan]
+              [datomish.test-macros :refer-macros [deftest-async deftest-db]]
+              [datomish.node-tempfile :refer [tempfile]]
+              [cljs.test :as t :refer-macros [is are deftest testing async]]
+              [cljs.core.async :as a :refer [<! >!]]]))
+  #?(:clj
+     (:import [clojure.lang ExceptionInfo]))
+  #?(:clj
+     (:import [datascript.db DB])))
+
+#?(:cljs
+   (def Throwable js/Error))
+
+
+(def page-schema
+  [{:db/id (d/id-literal :db.part/user)
+    :db/ident              :page/url
+    :db/valueType          :db.type/string          ; Because not all URLs are java.net.URIs. For JS we may want to use /uri.
+    :db/cardinality        :db.cardinality/one
+    :db/unique             :db.unique/identity
+    :db/doc                "A page's URL."
+    :db.install/_attribute :db.part/db}
+   {:db/id (d/id-literal :db.part/user)
+    :db/ident              :page/title
+    :db/valueType          :db.type/string
+    :db/cardinality        :db.cardinality/one      ; We supersede as we see new titles.
+    :db/doc                "A page's title."
+    :db.install/_attribute :db.part/db}
+   {:db/id (d/id-literal :db.part/user)
+    :db/ident              :page/starred
+    :db/valueType          :db.type/boolean
+    :db/cardinality        :db.cardinality/one
+    :db/doc                "Whether the page is starred."
+    :db.install/_attribute :db.part/db}
+   {:db/id (d/id-literal :db.part/user)
+    :db/ident              :page/visit
+    :db/valueType          :db.type/ref
+    :db/cardinality        :db.cardinality/many
+    :db/doc                "A visit to the page."
+    :db.install/_attribute :db.part/db}])
+
+(def visit-schema
+  [{:db/id (d/id-literal :db.part/user)
+    :db/ident              :visit/visitAt
+    :db/valueType          :db.type/instant
+    :db/cardinality        :db.cardinality/many
+    :db/doc                "The instant of the visit."
+    :db.install/_attribute :db.part/db}])
+
+(def session-schema
+  [{:db/id (d/id-literal :db.part/user)
+    :db/ident              :session/startedFromAncestor
+    :db/valueType          :db.type/ref     ; To a session.
+    :db/cardinality        :db.cardinality/one
+    :db/doc                "The ancestor of a session."
+    :db.install/_attribute :db.part/db}
+   {:db/id (d/id-literal :db.part/user)
+    :db/ident              :session/startedInScope
+    :db/valueType          :db.type/string
+    :db/cardinality        :db.cardinality/one
+    :db/doc                "The parent scope of a session."
+    :db.install/_attribute :db.part/db}
+   {:db/id (d/id-literal :db.part/user)
+    :db/ident              :session/startReason
+    :db/valueType          :db.type/string    ; TODO: enum?
+    :db/cardinality        :db.cardinality/many
+    :db/doc                "The start reasons of a session."
+    :db.install/_attribute :db.part/db}
+   {:db/id (d/id-literal :db.part/user)
+    :db/ident              :session/endReason
+    :db/valueType          :db.type/string    ; TODO: enum?
+    :db/cardinality        :db.cardinality/many
+    :db/doc                "The end reasons of a session."
+    :db.install/_attribute :db.part/db}
+   {:db/id (d/id-literal :db.part/user)
+    :db/ident              :event/session
+    :db/valueType          :db.type/ref      ; To a session.
+    :db/cardinality        :db.cardinality/one
+    :db/doc                "The session in which a tx took place."
+    :db.install/_attribute :db.part/db}])
+
+(def tofino-schema (concat page-schema visit-schema session-schema))
+
+(defn instant [x]
+  #?(:cljs x)
+  #?(:clj (.getTime x)))
+
+(defn now []
+  #?(:cljs (js/Date.))
+  #?(:clj (java.util.Date.)))
+
+;; Returns the session ID.
+(defn <start-session [conn {:keys [ancestor scope reason]
+                            :or {reason "none"}}]
+  (let [id (d/id-literal :db.part/user -1)
+        base {:db/id                  id
+              :session/startedInScope (str scope)
+              :session/startReason    reason}
+        datoms
+        (if ancestor
+            [(assoc base :session/startedFromAncestor ancestor)
+             {:db/id         :db/tx
+              :event/session ancestor}]
+            [base])]
+
+    (go-pair
+      (->
+        (<? (d/<transact! conn datoms))
+        :tempids
+        (get id)))))
+
+(defn <end-session [conn {:keys [session reason]
+                          :or   {reason "none"}}]
+  (d/<transact!
+    conn
+    [{:db/id         :db/tx
+      :event/session session}                              ; So meta!
+     {:db/id             session
+      :session/endReason reason}]))
+
+(defn <active-sessions [db]
+  (d/<q
+    db
+    '[:find ?id ?reason ?ts :in $
+      :where
+      [?id :session/startReason ?reason ?tx]
+      [?tx :db/txInstant ?ts]
+      (not-join [?id]
+        [?id :session/endReason _])]
+    {}))
+
+(defn <ended-sessions [db]
+  (d/<q
+    db
+    '[:find ?id ?endReason ?ts :in $
+      :where
+      [?id :session/endReason ?endReason ?tx]
+      [?tx :db/txInstant ?ts]]
+    {}))
+
+;; TODO: return ID?
+(defn <add-visit [conn {:keys [url uri title session]}]
+  (let [visit (d/id-literal :db.part/user -1)
+        page (d/id-literal :db.part/user -2)]
+    (d/<transact!
+       conn
+       [{:db/id        :db/tx
+         :event/session session}
+        {:db/id        visit
+         :visit/visitAt (now)}
+        {:db/id        page
+         :page/url     (or uri url)
+         :page/title   title
+         :page/visit visit}])))
+
+(defn- third [x]
+  (nth x 2))
+
+(defn <visited [db
+               {:keys [limit]
+                :or {limit 10}}]
+  ;; Until we have aggregates -- (max lastVisited) -- we do this the hard
+  ;; way, grouping and maxing manually.
+  (let [descending-time (comp unchecked-negate instant third)]
+    (go-pair
+      (let [most-recent (fn [rows]
+                          (first (sort-by descending-time rows)))
+            row->map (fn [[uri title lastVisited]]
+                       {:uri uri :title title :lastVisited lastVisited})
+            raw (<?
+                 (d/<q
+                   db
+                   '[:find ?uri ?title ?time :in $
+                     :where
+                     [?page :page/url ?uri]
+                     [?page :page/title ?title]
+                     [?page :page/visit ?visit]
+                     [?visit :visit/visitAt ?time]]
+                   {}))]
+        (->>
+          raw
+          (sort-by first)
+          (partition-by first)
+          (map most-recent)
+          (sort-by descending-time)
+          (take limit)
+          (map row->map))))))
+
+(defn <find-title [db url]
+  ;; Until we support [:find ?title . :in…] we crunch this by hand.
+  (go-pair
+    (first
+      (first
+        (<?
+          (d/<q db
+                '[:find ?title :in $ ?url
+                  :where [?page :page/url ?url] [?page :page/title ?title]]
+                {:url url}))))))
+
+;; Ensure that we can grow the schema over time.
+(deftest-db test-schema-evolution conn
+  (<? (d/<transact! conn page-schema))
+  (<? (d/<transact! conn tofino-schema)))
+
+(deftest-db test-simple-sessions conn
+  (<? (d/<transact! conn tofino-schema))
+
+  ;; Start a session.
+  (let [session (<? (<start-session conn {:ancestor nil :scope "foo"}))]
+    (is (integer? session))
+
+    ;; Now it's active.
+    (let [active (<? (<active-sessions (d/db conn)))]
+      (is (= 1 (count active)))
+      (is (= (first (first active))
+             session)))
+
+    ;; There are no ended sessions yet.
+    (is (empty? (<? (<ended-sessions (d/db conn)))))
+
+    (let [earliest (instant (now))]
+      (<? (<add-visit conn {:uri "http://example.org/"
+                            :title "Example Philanthropy Old"
+                            :session session}))
+      (<? (<add-visit conn {:uri "http://example.com/"
+                            :title "Example Commercial"
+                            :session session}))
+      (<? (<add-visit conn {:uri "http://example.org/"
+                            :title "Example Philanthropy New"
+                            :session session}))
+      (let [latest (instant (now))
+            visited (<? (<visited (d/db conn) {:limit 3}))]
+        (is (= 2 (count visited)))
+        (is (= "http://example.org/" (:uri (first visited))))
+        (is (= "http://example.com/" (:uri (second visited))))
+        (is (<= earliest (instant (:lastVisited (first visited))) latest))
+        (is (<= earliest (instant (:lastVisited (second visited))) latest))
+        (is (>= (instant (:lastVisited (first visited))) (instant (:lastVisited (second visited)))))))
+
+    (is (= "Example Philanthropy New"
+           (<? (<find-title (d/db conn) "http://example.org/"))))
+
+    ;; If we end this one, then it's no longer active but is ended.
+    (<? (<end-session conn {:session session}))
+    (is (empty? (<? (<active-sessions (d/db conn)))))
+    (is (= 1 (count (<? (<ended-sessions (d/db conn))))))))