From 659c26339c23af0cadafd260aeebc55924e2ae30 Mon Sep 17 00:00:00 2001
From: Nick Alexander <nalexander@mozilla.com>
Date: Tue, 6 Sep 2016 12:03:03 -0700
Subject: [PATCH] Serialize and de-serialize non-keyword schema values
 correctly. Fixes #52.

---
 src/datomish/db.cljc                 | 15 ++++++++--
 src/datomish/db_factory.cljc         | 44 ++++++++++++++--------------
 src/datomish/schema.cljc             |  7 +++++
 src/datomish/sqlite_schema.cljc      |  6 ++--
 src/datomish/transact/bootstrap.cljc |  2 +-
 test/datomish/db_test.cljc           | 35 ++++++++++++++++++++++
 6 files changed, 80 insertions(+), 29 deletions(-)

diff --git a/src/datomish/db.cljc b/src/datomish/db.cljc
index 3e33ea4b..16b74700 100644
--- a/src/datomish/db.cljc
+++ b/src/datomish/db.cljc
@@ -656,12 +656,21 @@
 
   (<apply-db-install-assertions [db fragment merge]
     (go-pair
-      (let [exec (partial s/execute! (:sqlite-connection db))]
+      (let [schema         (.-schema db)
+            ->SQLite       (partial ds/->SQLite schema)
+            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-schema/->SQLite ident) (sqlite-schema/->SQLite attr) (sqlite-schema/->SQLite value)])))))
+            ;; This is a little sloppy.  We need to store idents as entids, since they're (mostly)
+            ;; :db.type/ref attributes.  So we use that entid passes through idents it doesn't
+            ;; recognize, and assuming that we have no :db.type/keyword values that match idents.
+            ;; This is safe for now.
+            (let [[v tag] (->SQLite (entid db attr) (entid db value))]
+              (<? (exec
+                    ["INSERT INTO schema VALUES (?, ?, ?, ?)"
+                     (sqlite-schema/->SQLite ident) (sqlite-schema/->SQLite attr)
+                     v tag]))))))
 
       (let [symbolic-schema (merge-with merge (:symbolic-schema db) fragment)
             schema          (ds/schema (into {} (map (fn [[k v]] [(entid db k) v]) symbolic-schema)))]
diff --git a/src/datomish/db_factory.cljc b/src/datomish/db_factory.cljc
index 1850b8d5..69a4a248 100644
--- a/src/datomish/db_factory.cljc
+++ b/src/datomish/db_factory.cljc
@@ -28,10 +28,7 @@
   Returns a map (keyword ident) -> (integer entid), like {:db/ident 0}."
 
   (go-pair
-    (let [rows (<? (->>
-                     {:select [:ident :entid] :from [:idents]}
-                     (s/format)
-                     (s/all-rows sqlite-connection)))]
+    (let [rows (<? (s/all-rows sqlite-connection ["SELECT ident, entid FROM idents"]))]
       (into {} (map (fn [row] [(sqlite-schema/<-SQLite :db.type/keyword (:ident row)) (:entid row)])) rows))))
 
 (defn <parts [sqlite-connection]
@@ -39,32 +36,35 @@
   Returns a map (keyword part) -> {:start integer :idx integer}, like {:db.part/user {start: 0x100 idx: 0x101}}."
 
   (go-pair
-    (let [rows (<? (->>
-                     {:select [:part :start :idx] :from [:parts]}
-                     (s/format)
-                     (s/all-rows sqlite-connection)))]
+    (let [rows (<? (s/all-rows sqlite-connection ["SELECT part, start, idx FROM parts"]))]
       (into {} (map (fn [row] [(sqlite-schema/<-SQLite :db.type/keyword (:part row)) (select-keys row [:start :idx])])) rows))))
 
-(defn <symbolic-schema [sqlite-connection]
+(defn <symbolic-schema [sqlite-connection idents]
   "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}}."
 
   (go-pair
-    (->>
+    (let [ident-map  (clojure.set/map-invert idents)
+          ref-tag    (sqlite-schema/->tag :db.type/ref)
+          kw<-SQLite (partial sqlite-schema/<-SQLite :db.type/keyword)]
       (->>
-        {:select [:ident :attr :value] :from [:schema]}
-        (s/format)
-        (s/all-rows sqlite-connection))
-      (<?)
+        (s/all-rows sqlite-connection ["SELECT ident, attr, value, value_type_tag FROM schema"])
+        (<?)
 
-      (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 {}))))
+        (group-by (comp kw<-SQLite :ident))
+        (map (fn [[ident rows]]
+               [ident
+                (into {} (map (fn [row]
+                                (let [tag (:value_type_tag row)
+                                      ;; We want a symbolic schema, but most of our values are
+                                      ;; :db.type/ref attributes.  Map those entids back to idents.
+                                      ;; This is ad-hoc since we haven't built a functional DB
+                                      ;; instance yet.
+                                      v   (if (= tag ref-tag) (get ident-map (:value row)) (:value row))]
+                                  [(kw<-SQLite (:attr row))
+                                   (sqlite-schema/<-tagged-SQLite tag v)])) rows))]))
+        (into {})))))
 
 (defn <initialize-connection [sqlite-connection]
   (go-pair
@@ -121,7 +121,7 @@
       ;; We just bootstrapped, or we are returning to an already bootstrapped DB.
       (let [idents          (<? (<idents sqlite-connection))
             parts           (<? (<parts sqlite-connection))
-            symbolic-schema (<? (<symbolic-schema sqlite-connection))]
+            symbolic-schema (<? (<symbolic-schema sqlite-connection idents))]
         (when-not bootstrapped?
           (when (not (= idents bootstrap/idents))
             (raise "After bootstrapping database, expected new materialized idents and old bootstrapped idents to be identical"
diff --git a/src/datomish/schema.cljc b/src/datomish/schema.cljc
index 98e2c5a8..b4524d7a 100644
--- a/src/datomish/schema.cljc
+++ b/src/datomish/schema.cljc
@@ -57,6 +57,13 @@
           :cljs [^boolean unique-value?]) [schema attr]
   (is-attr? schema attr :db.unique/value))
 
+(defn doc [schema attr]
+  (get-in (.-schema schema) [attr :db/doc]))
+
+(defn valueType [schema attr]
+  (let [schema (.-schema schema)]
+    (get-in schema [attr :db/valueType])))
+
 (defn schema? [x]
   (satisfies? ISchema x))
 
diff --git a/src/datomish/sqlite_schema.cljc b/src/datomish/sqlite_schema.cljc
index 1aee120c..c967cb1f 100644
--- a/src/datomish/sqlite_schema.cljc
+++ b/src/datomish/sqlite_schema.cljc
@@ -109,9 +109,9 @@
 
    ;; 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 schema (ident TEXT NOT NULL, attr TEXT NOT NULL, value BLOB NOT NULL, value_type_tag SMALLINT NOT NULL,
+   FOREIGN KEY (ident) REFERENCES idents (ident))"
+   "CREATE INDEX idx_schema_unique ON schema (ident, attr, value, value_type_tag)"
    "CREATE TABLE parts (part TEXT NOT NULL PRIMARY KEY, start INTEGER NOT NULL, idx INTEGER NOT NULL)"
    ])
 
diff --git a/src/datomish/transact/bootstrap.cljc b/src/datomish/transact/bootstrap.cljc
index 9a7f2e9a..91158a46 100644
--- a/src/datomish/transact/bootstrap.cljc
+++ b/src/datomish/transact/bootstrap.cljc
@@ -19,7 +19,7 @@
    ;;                       :db/cardinality :db.cardinality/many}
    :db/txInstant         {:db/valueType   :db.type/long
                           :db/cardinality :db.cardinality/one
-                          } ;; :db/index       true} TODO: Handle this using SQLite protocol.
+                          :db/index       true}
    :db/valueType         {:db/valueType   :db.type/ref
                           :db/cardinality :db.cardinality/one}
    :db/cardinality       {:db/valueType   :db.type/ref
diff --git a/test/datomish/db_test.cljc b/test/datomish/db_test.cljc
index 2c31441b..7ba72207 100644
--- a/test/datomish/db_test.cljc
+++ b/test/datomish/db_test.cljc
@@ -781,4 +781,39 @@
                    ;; [eid2 :test/ref eid1] is gone, since the ref eid1 is gone.
                    #{}))))))))
 
+;; We don't use deftest-db in order to be able to re-open an on disk file.
+(deftest-async test-reopen-schema
+  (with-tempfile [t (tempfile)]
+    (let [conn        (<? (d/<connect t))
+          test-schema [{:db/id                 (d/id-literal :db.part/user -1)
+                        :db/ident              :test/fulltext
+                        :db/cardinality        :db.cardinality/many
+                        :db/valueType          :db.type/string
+                        :db/fulltext           true
+                        :db/doc                "Documentation string"
+                        :db.install/_attribute :db.part/db}]
+          {tx0 :tx}   (<? (d/<transact! conn test-schema))]
+      (testing "Values in schema are correct initially"
+        (let [db     (d/db conn)
+              schema (d/schema db)]
+          (is (= true (ds/indexing? schema (d/entid db :db/txInstant))))
+          (is (= true (ds/fulltext? schema (d/entid db :test/fulltext))))
+          (is (= "Documentation string" (ds/doc schema (d/entid db :test/fulltext))))
+          (is (= :db.type/string (ds/valueType schema (d/entid db :test/fulltext))))))
+
+      ;; Close and re-open same DB.
+      (<? (d/<close conn))
+      (let [conn (<? (d/<connect t))]
+        (try
+          (testing "Boolean values in schema are correct after re-opening"
+            (let [db     (d/db conn)
+                  schema (d/schema db)]
+              (is (= true (ds/indexing? schema (d/entid db :db/txInstant))))
+              (is (= true (ds/fulltext? schema (d/entid db :test/fulltext))))
+              (is (= "Documentation string" (ds/doc schema (d/entid db :test/fulltext))))
+              (is (= :db.type/string (ds/valueType schema (d/entid db :test/fulltext))))))
+
+          (finally
+            (<? (d/<close conn))))))))
+
 #_ (time (t/run-tests))