From 7a90c43a5a8411a23c9d889dd4a221965a29d0ce Mon Sep 17 00:00:00 2001
From: Nick Alexander <nalexander@mozilla.com>
Date: Wed, 27 Jul 2016 21:15:57 -0700
Subject: [PATCH] Map valueTypes to SQLite encodings.

In the future, we might add a layer of indirection, hashing values to
avoid duplicating storage, or sorting URLs, or handling fulltext indexed
values differently, or ...
---
 src/datomish/db.cljc       | 69 +++++++++++++++++++++-----------------
 src/datomish/schema.cljc   | 27 ++++++++++++++-
 test/datomish/db_test.cljc | 32 ++++++++++++++++++
 3 files changed, 96 insertions(+), 32 deletions(-)

diff --git a/src/datomish/db.cljc b/src/datomish/db.cljc
index 85f11740..d9dc9ee6 100644
--- a/src/datomish/db.cljc
+++ b/src/datomish/db.cljc
@@ -70,14 +70,14 @@
     [db]
     "TODO: document this interface."))
 
-;; TODO: handle _?
-(defn search->sql-clause [pattern]
-  (merge
-    {:select [:*] ;; e :a :v :tx] ;; TODO: generalize columns.
-     :from [:datoms]}
-    (if-not (empty? pattern)
-      {:where (cons :and (map #(vector := %1 (if (keyword? %2) (str %2) %2)) [:e :a :v :tx] pattern))} ;; TODO: use schema to process v.
-      {})))
+(defn db? [x]
+  (and (satisfies? IDB x)))
+
+(defn- row->Datom [schema row]
+  (let [e (:e row)
+        a (:a row)
+        v (:v row)]
+    (Datom. e a (ds/<-SQLite schema a v) (:tx row) (:added row))))
 
 (defrecord DB [sqlite-connection schema idents current-tx]
   ;; idents is map {ident -> entid} of known idents.  See http://docs.datomic.com/identity.html#idents.
@@ -94,33 +94,43 @@
 
   ;; TODO: use q for searching?  Have q use this for searching for a single pattern?
   (<eavt [db pattern]
-    (go-pair
-      ;; TODO: find a better expression of this pattern.
-      (let [rows (<? (->>
-                       (search->sql-clause pattern)
-                       (sql/format)
-                       (s/all-rows (:sqlite-connection db))))]
-        (mapv #(Datom. (:e %) (:a %) (:v %) (:tx %) true) rows)))) ;; TODO: map values according to schema.
+    (let [[e a v tx] pattern
+          v (and v (ds/->SQLite schema a v))] ;; We assume e and a are always given.
+      (go-pair
+        (->>
+          {:select [:*] ;; e :a :v :tx] ;; TODO: generalize columns.
+           :from [:datoms]
+           :where (cons :and (map #(vector := %1 %2) [:e :a :v :tx] (take-while (comp not nil?) [e a v tx])))} ;; Must drop nils.
+          (sql/format)
+
+          (s/all-rows (:sqlite-connection db))
+          (<?)
+
+          (mapv (partial row->Datom (.-schema db))))))) ;; TODO: understand why (schema db) fails.
 
   (<avet [db pattern]
-    (go-pair
-      ;; TODO: find a better expression of this pattern.
-      (let [[a v] pattern
-            rows (<? (->>
-                       {:select [:*] :from [:datoms] :where [:and [:= :a a] [:= :v v]]}
-                       (sql/format)
-                       (s/all-rows (:sqlite-connection db))))]
-        (mapv #(Datom. (:e %) (:a %) (:v %) (:tx %) true) rows)))) ;; TODO: map values according to schema.
+    (let [[a v] pattern
+          v (ds/->SQLite schema a v)]
+      (go-pair
+        (->>
+          {:select [:*] :from [:datoms] :where [:and [:= :a a] [:= :v v]]}
+          (sql/format)
+
+          (s/all-rows (:sqlite-connection db))
+          (<?)
+
+          (mapv (partial row->Datom (.-schema db))))))) ;; TODO: understand why (schema db) fails.
 
   (<apply-datoms [db datoms]
     (go-pair
       (let [exec (partial s/execute! (:sqlite-connection db))]
         ;; TODO: batch insert, batch delete.
         (doseq [datom datoms]
-          (let [[e a v tx added] datom]
+          (let [[e a v tx added] datom
+                v (ds/->SQLite (.-schema db) a v)] ;; TODO: understand why (schema db) fails.
             ;; Append to transaction log.
             (<? (exec
-                  ["INSERT INTO transactions VALUES (?, ?, ?, ?, ?)" e a v tx added]))
+                  ["INSERT INTO transactions VALUES (?, ?, ?, ?, ?)" e a v tx (if added 1 0)]))
             ;; Update materialized datom view.
             (if (.-added datom)
               (<? (exec
@@ -144,9 +154,6 @@
 
   (close-db [db] (s/close (.-sqlite-connection db))))
 
-(defn db? [x]
-  (and (satisfies? IDB x)))
-
 (defprotocol IConnection
   (close
     [conn]
@@ -215,7 +222,7 @@
 (defn <idents [sqlite-connection]
   (go-pair
     (let [rows (<? (->>
-                     {:select [:e :v] :from [:datoms] :where [:= :a ":db/ident"]} ;; TODO: don't stringify?
+                     {:select [:e :v] :from [:datoms] :where [:= :a ":db/ident"]} ;; TODO: use raw entid.
                      (sql/format)
                      (s/all-rows sqlite-connection)))]
       (into {} (map #(-> {(keyword (:v %)) (:e %)})) rows))))
@@ -228,7 +235,7 @@
    (go-pair
      (when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
        (raise "Could not ensure current SQLite schema version."))
-     (let [idents (into (<? (<idents sqlite-connection)) {:db/txInstant 100 :db/ident 101 :x 102 :y 103 :name 104 :aka 105})] ;; TODO: pre-populate idents and SQLite tables?
+     (let [idents (into (<? (<idents sqlite-connection)) {:db/txInstant 100 :db/ident 101 :x 102 :y 103 :name 104 :aka 105 :test/kw 106})] ;; TODO: pre-populate idents and SQLite tables?
        (map->DB
          {:sqlite-connection sqlite-connection
           :idents            idents
@@ -365,7 +372,7 @@
       (vec (for [[op & entity] (:entities report)]
              (into [op] (for [field entity]
                           (if (lookup-ref? field)
-                            (first (<? (<eavt db field))) ;; TODO improve this
+                            (first (<? (<eavt db field))) ;; TODO improve this -- this should be avet, shouldn't it?
                             field)))))
       (assoc-in report [:entities])))) ;; TODO: meta.
 
diff --git a/src/datomish/schema.cljc b/src/datomish/schema.cljc
index aa258c9a..ddff77b4 100644
--- a/src/datomish/schema.cljc
+++ b/src/datomish/schema.cljc
@@ -83,7 +83,7 @@
 ;; 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 name :<-SQLite keyword }
+   :db.type/keyword { :valid? keyword? :->SQLite str :<-SQLite #(keyword (subs % 1)) }
    :db.type/string  { :valid? string? :->SQLite identity :<-SQLite identity }
    :db.type/boolean { :valid? #(instance? Boolean %) :->SQLite #(if % 1 0) :<-SQLite #(if (= % 1) true false) }
    :db.type/integer { :valid? integer? :->SQLite identity :<-SQLite identity }
@@ -104,6 +104,31 @@
       (raise "Unknown attribute " attr ", expected one of " (sorted-set (keys schema))
              {:error :schema/valueType, :attribute attr}))))
 
+(defn ->SQLite [schema attr value]
+  {:pre [(schema? schema)]}
+  (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)
+          (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))
+               {:error :schema/valueType, :attribute attr}))
+      (raise "Unknown attribute " attr ", expected one of " (sorted-set (keys schema))
+             {:error :schema/valueType, :attribute attr}))))
+
+(defn <-SQLite [schema attr value]
+  {: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)
+        (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))
+             {:error :schema/valueType, :attribute attr}))))
+
 (defn- validate-schema [schema]
   (doseq [[a kv] schema]
     (when-not (:db/valueType kv)
diff --git a/test/datomish/db_test.cljc b/test/datomish/db_test.cljc
index 63dc8b47..7ec2d5ee 100644
--- a/test/datomish/db_test.cljc
+++ b/test/datomish/db_test.cljc
@@ -184,3 +184,35 @@
 
         (finally
           (<? (dm/close-db db)))))))
+
+(deftest-async test-valueType-keyword
+  (with-tempfile [t (tempfile)]
+    (let [c    (<? (s/<sqlite-connection t))
+          db   (<? (dm/<db-with-sqlite-connection c
+                                                  (merge test-schema {:test/kw {:db/unique :db.unique/identity
+                                                                                :db/valueType :db.type/keyword}})))
+          conn (dm/connection-with-db db)
+          now  -1]
+      (try
+        (let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :test/kw :test/kw1]] now))
+              eid (get-in report [:tempids (dm/id-literal :db.part/user -1)])]
+          (is (= (<? (<datoms db))
+                 #{[eid :test/kw ":test/kw1"]})) ;; Value is raw.
+
+          (testing "Adding the same value compares existing values correctly."
+            (<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw1]] now))
+            (is (= (<? (<datoms db))
+                   #{[eid :test/kw ":test/kw1"]}))) ;; Value is raw.
+
+          (testing "Upserting retracts existing value correctly."
+            (<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw2]] now))
+            (is (= (<? (<datoms db))
+                   #{[eid :test/kw ":test/kw2"]}))) ;; Value is raw.
+
+          (testing "Retracting compares values correctly."
+            (<? (dm/<transact! conn [[:db/retract eid :test/kw :test/kw2]] now))
+            (is (= (<? (<datoms db))
+                   #{}))))
+
+        (finally
+          (<? (dm/close-db db)))))))