From 3db3edaa64eba15e898442ed77434e14b5eaa58f Mon Sep 17 00:00:00 2001
From: Nick Alexander <nalexander@mozilla.com>
Date: Thu, 14 Jul 2016 12:18:39 -0700
Subject: [PATCH] Part 2: Clean up <transact!.

---
 src/datomish/db.cljc       | 228 +++++++++++++------------------------
 src/datomish/repl.clj      |   2 +-
 test/datomish/db_test.cljc |   2 +-
 test/datomish/test.cljs    |   2 +
 4 files changed, 83 insertions(+), 151 deletions(-)

diff --git a/src/datomish/db.cljc b/src/datomish/db.cljc
index 4f39b68e..5d34de0c 100644
--- a/src/datomish/db.cljc
+++ b/src/datomish/db.cljc
@@ -9,7 +9,7 @@
       [cljs.core.async.macros :refer [go]]))
   (:require
    [honeysql.core :as sql]
-   [datomish.util :as util :refer [raise]]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
    [datomish.sqlite :as s]
    [datomish.sqlite-schema :as sqlite-schema]
    #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
@@ -26,6 +26,10 @@
   IDB
   (close [db] (s/close (.-sqlite-connection db))))
 
+(defn db? [x]
+  (and (satisfies? IDB x)))
+
+;; TODO: implement support for DB parts?
 (def tx0 0x2000000)
 
 (defn <with-sqlite-connection [sqlite-connection]
@@ -35,33 +39,23 @@
     (map->DB {:sqlite-connection sqlite-connection
               :current-tx        (atom (dec tx0))}))) ;; TODO: get rid of dec.
 
-(defn- #?@(:clj  [^Boolean tx-id?]
-           :cljs [^boolean tx-id?])
-  [e]
-  (or (= e :db/current-tx)
-      (= e ":db/current-tx"))) ;; for datascript.js interop
+;; TODO: consider CLJS interop.
+(defn- tx-id? [e]
+  (= e :db/current-tx))
 
-(defrecord TxReport [;; db-before db-after
-                     tx-data tempids tx-meta])
-
-#?(:clj
-   (defmacro cond-let [& clauses]
-     (when-let [[test expr & rest] clauses]
-       `(~(if (vector? test) 'if-let 'if) ~test
-         ~expr
-         (cond-let ~@rest)))))
+;; TODO: write tx-meta to transaction.
+(defrecord TxReport [tx-data tempids tx-meta])
 
+;; TODO: persist max-tx and max-eid in SQLite.
 (defn <allocate-tx [db]
   (go-pair
     (swap! (:current-tx db) inc)))
 
+;; TODO: add fancy destructuring.
+;; TODO: handle reading.
 (deftype Datom [e a v tx added])
 
-;; printing and reading
-;; #datomic/DB {:schema <map>, :datoms <vector of [e a v tx]>}
-
-;; (defn ^Datom datom-from-reader [vec]
-;;   (apply datom vec))
+(defn datom? [x] (instance? Datom x))
 
 #?(:clj
    (defmethod print-method Datom [^Datom d, ^java.io.Writer w]
@@ -84,34 +78,31 @@
     (raise "Cannot store nil as a value at " at
            {:error :transact/syntax, :value v, :context at})))
 
+;; TODO: implement schemas.
 (defn multival? [db attr] false)
 
+;; TODO: implement schemas.
 (defn ref? [db attr] false)
 
 (defn <entid [db eid]
-  ;; {:pre [(db? db)]}
+  {:pre [(db? db)]}
   (go-pair
     (cond
-      (number? eid) eid
-      ;; (sequential? eid)
-      ;; (cond
-      ;;   (not= (count eid) 2)
-      ;;   (raise "Lookup ref should contain 2 elements: " eid
-      ;;          {:error :lookup-ref/syntax, :entity-id eid})
-      ;;   (not (is-attr? db (first eid) :db.unique/identity))
-      ;;   (raise "Lookup ref attribute should be marked as :db.unique/identity: " eid
-      ;;          {:error :lookup-ref/unique
-      ;;           :entity-id eid})
-      ;;   (nil? (second eid))
-      ;;   nil
-      ;;   :else
-      ;;   (:e (first (-datoms db :avet eid))))
+      (number? eid)
+      eid
+
+      (sequential? eid)
+      (raise "Lookup ref for entity id not yet supported, got " eid
+             {:error :entity-id/syntax
+              :entity-id eid})
+
       :else
       (raise "Expected number or lookup ref for entity id, got " eid
              {:error :entity-id/syntax
               :entity-id eid}))))
 
 (defn <entid-strict [db eid]
+  {:pre [(db? db)]}
   (go-pair
     (or (<? (<entid db eid))
         (raise "Nothing found for entity id " eid
@@ -119,6 +110,7 @@
                 :entity-id eid}))))
 
 (defn <entid-some [db eid]
+  {:pre [(db? db)]}
   (go-pair
     (when eid
       (<? (<entid-strict db eid)))))
@@ -126,22 +118,24 @@
 ;; TODO: handle _?
 (defn search->sql-clause [pattern]
   (merge
-    {:select [:e :a :v :tx] ;; TODO: generalize columns.
+    {:select [:*] ;; e :a :v :tx] ;; TODO: generalize columns.
      :from [:datoms]}
     (if-not (empty? pattern)
       {:where (cons :and (map #(vector := %1 (if (keyword? %2) (str %2) %2)) [:e :a :v :tx] pattern))} ;; TODO: use schema to intern a and v.
       {})))
 
 (defn <search [db pattern]
+  {:pre [(db? db)]}
   (go-pair
     ;; TODO: find a better expression of this pattern.
     (let [rows (<? (->>
                      (search->sql-clause pattern)
                      (sql/format)
                      (s/all-rows (:sqlite-connection db))))]
-      (map #(Datom. (:e %) (:a %) (:v %) (:tx %) true) rows))))
+      (mapv #(Datom. (:e %) (:a %) (:v %) (:tx %) true) rows))))
 
 (defn- <transact-report [db report datom]
+  {:pre [(db? db)]}
   (go-pair
     (let [exec (partial s/execute! (:sqlite-connection db))]
       ;; Append to transaction log.
@@ -154,11 +148,12 @@
               ["INSERT INTO datoms VALUES (?, ?, ?, ?, 0, 0)" (.-e datom) (str (.-a datom)) (.-v datom) (.-tx datom)]))
         (<? (exec
               ;; TODO: verify this is correct.
-              ["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" (.-e datom) (.-a datom) (.-v datom)])))
+              ["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" (.-e datom) (str (.-a datom)) (.-v datom)])))
       (-> report
           (update-in [:tx-data] conj datom)))))
 
 (defn- <transact-add [db report [_ e a v tx :as entity]]
+  {:pre [(db? db)]}
   (go-pair
     (validate-attr a entity)
     (validate-val  v entity)
@@ -180,6 +175,7 @@
           (<? (<transact-report db report datom)))))))
 
 (defn- <transact-retract [db report [_ e a v _ :as entity]] ;; TODO: think about retracting with tx.
+  {:pre [(db? db)]}
   (go-pair
     (let [tx (:current-tx report)]
       (if-let [e (<? (<entid db e))]
@@ -190,9 +186,14 @@
             (<? (<transact-report db report (Datom. e a v tx false)))
             report))
         report))))
+(defn- #?@(:clj  [^Boolean neg-number?]
+           :cljs [^boolean neg-number?])
+  [x]
+  (and (number? x) (neg? x)))
 
 (defn <transact-tx-data
   [db now initial-report initial-es]
+  {:pre [(db? db)]}
   (go-pair
     (when-not (or (nil? initial-es)
                   (sequential? initial-es))
@@ -203,101 +204,49 @@
       (let [[entity & entities] es]
         (cond
           (nil? entity)
+          ;; We're done!  Add transaction datom to the report.
           (let [current-tx (:current-tx report)]
             (<? (<transact-report db report (Datom. current-tx :db/txInstant now current-tx true)))
             (-> report
                 (assoc-in [:tempids :db/current-tx] current-tx)))
 
-          ;; (map? entity)
-          ;; (let [old-eid (:db/id entity)]
-          ;;   (cond-let
-          ;;     ;; :db/current-tx => tx
-          ;;     (tx-id? old-eid)
-          ;;     (let [id (current-tx report)]
-          ;;       (recur (allocate-eid report old-eid id)
-          ;;              (cons (assoc entity :db/id id) entities)))
-
-          ;;     ;; lookup-ref => resolved | error
-          ;;     (sequential? old-eid)
-          ;;     (let [id (entid-strict db old-eid)]
-          ;;       (recur report
-          ;;              (cons (assoc entity :db/id id) entities)))
-
-          ;;     ;; upserted => explode | error
-          ;;     [upserted-eid (upsert-eid db entity)]
-          ;;     (if (and (neg-number? old-eid)
-          ;;              (contains? (:tempids report) old-eid)
-          ;;              (not= upserted-eid (get (:tempids report) old-eid)))
-          ;;       (retry-with-tempid initial-report initial-es old-eid upserted-eid)
-          ;;       (recur (allocate-eid report old-eid upserted-eid)
-          ;;              (concat (explode db (assoc entity :db/id upserted-eid)) entities)))
-
-          ;;     ;; resolved | allocated-tempid | tempid | nil => explode
-          ;;     (or (number? old-eid)
-          ;;         (nil?    old-eid))
-          ;;     (let [new-eid (cond
-          ;;                     (nil? old-eid) (next-eid db)
-          ;;                     (neg? old-eid) (or (get (:tempids report) old-eid)
-          ;;                                        (next-eid db))
-          ;;                     :else          old-eid)
-          ;;           new-entity (assoc entity :db/id new-eid)]
-          ;;       (recur (allocate-eid report old-eid new-eid)
-          ;;              (concat (explode db new-entity) entities)))
-
-          ;;     ;; trash => error
-          ;;     :else
-          ;;     (raise "Expected number or lookup ref for :db/id, got " old-eid
-          ;;            { :error :entity-id/syntax, :entity entity })))
+          (map? entity)
+          (raise "Map entities are not yet supported, got " entity
+                 {:error :transact/syntax
+                  :op    entity })
 
           (sequential? entity)
           (let [[op e a v] entity]
             (cond
-              ;; (= op :db.fn/call)
-              ;; (let [[_ f & args] entity]
-              ;;   (recur report (concat (apply f db args) entities)))
+              (= op :db.fn/call)
+              (raise "DataScript's transactor functions are not yet supported, got " entity
+                     {:error :transact/syntax
+                      :op    entity })
 
-              ;; (= op :db.fn/cas)
-              ;; (let [[_ e a ov nv] entity
-              ;;       e (entid-strict db e)
-              ;;       _ (validate-attr a entity)
-              ;;       ov (if (ref? db a) (entid-strict db ov) ov)
-              ;;       nv (if (ref? db a) (entid-strict db nv) nv)
-              ;;       _ (validate-val nv entity)
-              ;;       datoms (<searchdb [e a])]
-              ;;   (if (multival? db a)
-              ;;     (if (some (fn [^Datom d] (= (.-v d) ov)) datoms)
-              ;;       (recur (transact-add report [:db/add e a nv]) entities)
-              ;;       (raise ":db.fn/cas failed on datom [" e " " a " " (map :v datoms) "], expected " ov
-              ;;              {:error :transact/cas, :old datoms, :expected ov, :new nv}))
-              ;;     (let [v (:v (first datoms))]
-              ;;       (if (= v ov)
-              ;;         (recur (transact-add report [:db/add e a nv]) entities)
-              ;;         (raise ":db.fn/cas failed on datom [" e " " a " " v "], expected " ov
-              ;;                {:error :transact/cas, :old (first datoms), :expected ov, :new nv })))))
+              (= op :db.fn/cas)
+              (raise "Datomic's compare-and-swap is not yet supported, got " entity
+                     {:error :transact/syntax
+                      :op    entity })
 
               (tx-id? e)
               (recur report (cons [op (:current-tx report) a v] entities))
 
-              ;; (and (ref? db a) (tx-id? v))
-              ;; (recur report (cons [op e a (current-tx report)] entities))
+              (and (ref? db a) (tx-id? v))
+              (recur report (cons [op e a (:current-tx report)] entities))
 
-              ;; (neg-number? e)
-              ;; (if (not= op :db/add)
-              ;;   (raise "Negative entity ids are resolved for :db/add only"
-              ;;          {:error :transact/syntax
-              ;;           :op    entity })
-              ;;   (let [upserted-eid  (when (is-attr? db a :db.unique/identity)
-              ;;                         (:e (first (-datoms db :avet [a v]))))
-              ;;         allocated-eid (get-in report [:tempids e])]
-              ;;     (if (and upserted-eid allocated-eid (not= upserted-eid allocated-eid))
-              ;;       (retry-with-tempid initial-report initial-es e upserted-eid)
-              ;;       (let [eid (or upserted-eid allocated-eid (next-eid db))]
-              ;;         (recur (allocate-eid report e eid) (cons [op eid a v] entities))))))
+              (neg-number? e)
+              (if (not= op :db/add)
+                (raise "Negative entity ids are resolved for :db/add only"
+                       {:error :transact/syntax
+                        :op    entity })
+                (raise "Negative entity ids are not yet supported, got " entity
+                       {:error :transact/syntax
+                        :op    entity }))
 
-              ;; (and (ref? db a) (neg-number? v))
-              ;; (if-let [vid (get-in report [:tempids v])]
-              ;;   (recur report (cons [op e a vid] entities))
-              ;;   (recur (allocate-eid report v (next-eid db)) es))
+              (and (ref? db a) (neg-number? v))
+              (raise "Negative entity ids are not yet supported, got " entity
+                     {:error :transact/syntax
+                      :op    entity })
 
               (= op :db/add)
               (recur (<? (<transact-add db report entity)) entities)
@@ -305,31 +254,24 @@
               (= op :db/retract)
               (recur (<? (<transact-retract db report entity)) entities)
 
-              ;; (= op :db.fn/retractAttribute)
-              ;; (if-let [e (entid db e)]
-              ;;   (let [_ (validate-attr a entity)
-              ;;         datoms (<search db [e a])]
-              ;;     (recur (reduce transact-retract-datom report datoms)
-              ;;            (concat (retract-components db datoms) entities)))
-              ;;   (recur report entities))
+              (= op :db.fn/retractAttribute)
+              (raise "DataScript's :db.fn/retractAttribute shortcut is not yet supported, got " entity
+                     {:error :transact/syntax
+                      :op    entity })
 
-              ;; (= op :db.fn/retractEntity)
-              ;; (if-let [e (entid db e)]
-              ;;   (let [e-datoms (<search db [e])
-              ;;         v-datoms (mapcat (fn [a] (<search db [nil a e])) (-attrs-by db :db.type/ref))]
-              ;;     (recur (reduce transact-retract-datom report (concat e-datoms v-datoms))
-              ;;            (concat (retract-components db e-datoms) entities)))
-              ;;   (recur report entities))
+              (= op :db.fn/retractEntity)
+              (raise "Datomic's :db.fn/retractEntity shortcut is not yet supported, got " entity
+                     {:error :transact/syntax
+                      :op    entity })
 
               :else
               (raise "Unknown operation at " entity ", expected :db/add, :db/retract, :db.fn/call, :db.fn/retractAttribute or :db.fn/retractEntity"
                      {:error :transact/syntax, :operation op, :tx-data entity})))
 
-          ;; (datom? entity)
-          ;; (let [[e a v tx added] entity]
-          ;;   (if added
-          ;;     (recur (transact-add report [:db/add e a v tx]) entities)
-          ;;     (recur report (cons [:db/retract e a v] entities))))
+          (datom? entity)
+          (raise "Datom entities are not yet supported, got " entity
+                 {:error :transact/syntax
+                  :op    entity })
 
           :else
           (raise "Bad entity type at " entity ", expected map or vector"
@@ -340,7 +282,7 @@
   ([db tx-data]
    (<transact! db tx-data nil 0xdeadbeef)) ;; TODO: timestamp!
   ([db tx-data tx-meta now]
-   ;; {:pre [(db/db? db)]}
+   {:pre [(db? db)]}
    (go-pair
      (let [current-tx (<? (<allocate-tx db))]
        (<? (<transact-tx-data db now
@@ -349,15 +291,3 @@
                                  :tx-data    []
                                  :tempids    {}
                                  :tx-meta    tx-meta}) tx-data))))))
-
-#_ (a/<!! (<transact! db []))
-
-#_ .
-
-
-
-#_ (def db (<?? (<with-sqlite-connection (<?? (s/<sqlite-connection "/Users/nalexander/test5.db")))))
-
-#_ (<?? (<transact! db [[:db/add 0 1 "test"]]))
-
-#_ (<?? (<transact! db [[:db/retract 0 1 "test"]]))
diff --git a/src/datomish/repl.clj b/src/datomish/repl.clj
index 50144fc3..086c175c 100644
--- a/src/datomish/repl.clj
+++ b/src/datomish/repl.clj
@@ -5,7 +5,7 @@
 (ns datomish.repl
   (:require
    [datomish.db :as db]
-   [datomish.util :as util :refer [raise]]
+   [datomish.util :as util :refer [raise cond-let]]
    [datomish.sqlite :as s]
    [datomish.jdbc-sqlite :as j]
    [tempfile.core]
diff --git a/test/datomish/db_test.cljc b/test/datomish/db_test.cljc
index 35253a0e..a62661f3 100644
--- a/test/datomish/db_test.cljc
+++ b/test/datomish/db_test.cljc
@@ -9,7 +9,7 @@
       [datomish.node-tempfile-macros :refer [with-tempfile]]
       [cljs.core.async.macros :as a :refer [go]]))
   (:require
-   [datomish.util :as util :refer [raise]]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
    [datomish.sqlite :as s]
    [datomish.db :as db]
    #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
diff --git a/test/datomish/test.cljs b/test/datomish/test.cljs
index 97eab507..b7327d03 100644
--- a/test/datomish/test.cljs
+++ b/test/datomish/test.cljs
@@ -3,6 +3,7 @@
    [doo.runner :refer-macros [doo-tests doo-all-tests]]
    [cljs.test :as t :refer-macros [is are deftest testing]]
    datomish.promise-sqlite-test
+   datomish.db-test
    datomish.sqlite-user-version-test
    datomish.test.util
    datomish.test.transforms
@@ -11,6 +12,7 @@
 
 (doo-tests
   'datomish.promise-sqlite-test
+  'datomish.db-test
   'datomish.sqlite-user-version-test
   'datomish.test.util
   'datomish.test.transforms