Add :db.fn/retractAttribute and :db.fn/retractEntity. Fixes #46. r=rnewman

src/datomish/db.cljc

@@ -172,15 +172,64 @@
      :table-alias source/gensym-table-alias
      :make-constraints nil}))
 
+;; TODO: make this not do the tx_lookup.  We could achieve this by having additional special values
+;; of added0, or by separating the tx_lookup table into before and after tables.
+(defn- retractAttributes->queries [eas tx]
+  (let [where-part
+        "(e = ? AND a = ?)"
+
+        repeater (memoize (fn [n] (interpose " OR " (repeat n where-part))))]
+    (map
+      (fn [chunk]
+        (cons
+          (apply str
+                 "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag)
+                SELECT e, a, v, ?, 0, value_type_tag, v, value_type_tag
+                FROM datoms
+                WHERE "
+                 (repeater (count chunk)))
+          (cons
+            tx
+            (mapcat (fn [[_ e a]]
+                      [e a])
+                    chunk))))
+      (partition-all (quot (dec max-sql-vars) 2) eas))))
+
+;; TODO: make this not do the tx_lookup.  We could achieve this by having additional special values
+;; of added0, or by separating the tx_lookup table into before and after tables.
+(defn- retractEntities->queries [es tx]
+  (let [ref-tag (sqlite-schema/->tag :db.type/ref)
+
+        ;; TODO: include index_vaet flag here, so we can use that index to speed up the deletion.
+        where-part
+        (str "e = ? OR (v = ? AND value_type_tag = " ref-tag ")") ;; Retract the entity and all refs to the entity.
+
+        repeater (memoize (fn [n] (interpose " OR " (repeat n where-part))))]
+    (map
+      (fn [chunk]
+        (cons
+          (apply str
+                 "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag)
+                SELECT e, a, v, ?, 0, value_type_tag, v, value_type_tag
+                FROM datoms
+                WHERE "
+                 (repeater (count chunk)))
+          (cons
+            tx
+            (mapcat (fn [[_ e]]
+                      [e e])
+                    chunk))))
+      (partition-all (quot (dec max-sql-vars) 2) es))))
+
 (defn- retractions->queries [retractions tx fulltext? ->SQLite]
   (let
-    [f-q
-     "WITH vv AS (SELECT rowid FROM fulltext_values WHERE text = ?)
+      [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)
+       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]]
@@ -394,7 +443,7 @@
           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
@@ -431,9 +480,12 @@
         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)}))
+    ;; Belt and braces.  At this point, we should have already errored out if op is not known.
+    (let [known #{:db/retract :db/add :db.fn/retractAttribute :db.fn/retractEntity}]
+      (when-not (clojure.set/subset? (keys operations) known)
+        (let [unknown (apply dissoc operations known)]
+          (raise (str "Unknown operations " (apply sorted-set (keys unknown)))
+                 {:error :transact/syntax, :operations (apply sorted-set (keys unknown))}))))
 
     ;; 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
@@ -441,6 +493,14 @@
     ;; 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 [eas (:db.fn/retractAttribute operations)]
+      (swap!
+        queries concat (retractAttributes->queries eas tx)))
+
+    (when-let [es (:db.fn/retractEntity operations)]
+      (swap!
+        queries concat (retractEntities->queries es tx)))
+
     (when-let [retractions (:db/retract operations)]
       (swap!
         queries concat (retractions->queries retractions tx fulltext? ->SQLite)))

src/datomish/db_factory.cljc

@@ -97,7 +97,6 @@
                                                new))]
           (let [exec (partial s/execute! (:sqlite-connection db))
                 part->vector (fn [[part {:keys [start idx]}]]
-                               (println "part->vector" part start idx)
                                [(sqlite-schema/->SQLite part) start idx])]
             ;; TODO: allow inserting new parts.
             ;; TODO: think more carefully about allocating new parts and bitmasking part ranges.

src/datomish/test_macros.cljc

@@ -5,8 +5,7 @@
 (ns datomish.test-macros
   #?(:cljs
      (:require-macros
-        [datomish.test-macros]
-        [datomish.node-tempfile-macros]))
+      [datomish.test-macros]))
   (:require
    [datomish.pair-chan]))
 
@@ -44,16 +43,8 @@
 (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)))))))))
+     (let [~conn-var (datomish.pair-chan/<? (datomish.api/<connect ""))]
+       (try
+         ~@body
+         (finally
+           (datomish.pair-chan/<? (datomish.api/<close ~conn-var)))))))

src/datomish/transact.cljc

@@ -119,12 +119,13 @@
     entity))
 
 (defn maybe-ident->entid [db [op e a v tx :as orig]]
+  ;; We have to handle all ops, including those when a or v are not defined.
   (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 (if (and a (ds/kw? (db/schema db) a)) ;; TODO: decide if this is best.  We could also check for ref and numeric types.
             v
             (db/entid db v))]
-    (when-not (integer? a)
+    (when (and a (not (integer? a)))
       (raise "Unknown attribute " a
              {:form orig :attribute a}))
     [op e a v tx]))
@@ -138,34 +139,63 @@
     ;; n.b., this must not be symbolic -- it's inserted after we map idents -> entids.
     [:db/add tx (db/entid db :db/txInstant) txInstant]))
 
-(defn ensure-entity-form [[op e a v & rest :as entity]]
-  (cond
-    (not (sequential? entity))
+(defn ensure-entity-form [entity]
+  (when-not (sequential? entity)
     (raise "Bad entity " entity ", should be sequential at this point"
-           {:error :transact/bad-entity, :entity entity})
+           {:error :transact/bad-entity, :entity entity}))
 
-    (not (contains? #{:db/add :db/retract} op))
-    (raise "Unrecognized operation " op " expected one of :db/add :db/retract at this point"
-           {:error :transact/bad-operation :entity entity })
+  (let [[op] entity]
+    (case op
+      (:db/add :db/retract)
+      (let [[_ e a v & rest] entity]
+        (cond
+          (nil? e)
+          (raise "Bad entity: nil e in " entity
+                 {:error :transact/bad-entity :entity entity })
 
-    (nil? e)
-    (raise "Bad entity: nil e in " entity
-           {:error :transact/bad-entity :entity entity })
+          (nil? a)
+          (raise "Bad entity: nil a in " entity
+                 {:error :transact/bad-entity :entity entity })
 
-    (nil? a)
-    (raise "Bad entity: nil a in " entity
-           {:error :transact/bad-entity :entity entity })
+          (nil? v)
+          (raise "Bad entity: nil v in " entity
+                 {:error :transact/bad-entity :entity entity })
 
-    (nil? v)
-    (raise "Bad entity: nil v in " entity
-           {:error :transact/bad-entity :entity entity })
+          (some? rest)
+          (raise "Bad entity: too long " entity
+                 {:error :transact/bad-entity :entity entity })))
 
-    (some? rest)
-    (raise "Bad entity: too long " entity
-           {:error :transact/bad-entity :entity entity })
+      :db.fn/retractAttribute
+      (let [[_ e a & rest] entity]
+        (cond
+          (nil? e)
+          (raise "Bad entity: nil e in " entity
+                 {:error :transact/bad-entity :entity entity })
 
-    true
-    entity))
+          (nil? a)
+          (raise "Bad entity: nil a in " entity
+                 {:error :transact/bad-entity :entity entity })
+
+          (some? rest)
+          (raise "Bad entity: too long " entity
+                 {:error :transact/bad-entity :entity entity })))
+
+      :db.fn/retractEntity
+      (let [[_ e & rest] entity]
+        (cond
+          (nil? e)
+          (raise "Bad entity: nil e in " entity
+                 {:error :transact/bad-entity :entity entity })
+
+          (some? rest)
+          (raise "Bad entity: too long " entity
+                 {:error :transact/bad-entity :entity entity })))
+
+      ;; Default
+      (raise "Unrecognized operation " op " expected one of :db/add :db/retract :db/fn.retractAttribute :db/fn.retractEntity at this point"
+             {:error :transact/bad-operation :entity entity })))
+
+  entity)
 
 (defn- tx-instant? [db [op e a & _]]
   (and (= op :db/add)
@@ -373,7 +403,8 @@
   (go-pair
     (let [schema (db/schema db)]
       (doseq [[op e a v] (:entities report)]
-        (ds/ensure-valid-value schema a v)))
+        (if (and e a v)
+          (ds/ensure-valid-value schema a v))))
     report))
 
 (defn <transact-tx-data