Extract IEncodeSQLite protocol and type-aware (but not schema-aware) <-SQLite factory.

src/datomish/db.cljc

@@ -248,12 +248,11 @@
 
   (<apply-db-ident-assertions [db added-idents merge]
     (go-pair
-      (let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
+      (let [exec     (partial s/execute! (:sqlite-connection db))]
-            exec     (partial s/execute! (:sqlite-connection db))]
         ;; TODO: batch insert.
         (doseq [[ident entid] added-idents]
           (<? (exec
-                ["INSERT INTO idents VALUES (?, ?)" (->SQLite ident) entid]))))
+                ["INSERT INTO idents VALUES (?, ?)" (sqlite-schema/->SQLite ident) entid]))))
 
       (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)))]
@@ -261,13 +260,12 @@
 
   (<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.
+      (let [exec     (partial s/execute! (:sqlite-connection db))]
-            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)])))))
+                  ["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)))]

src/datomish/db_factory.cljc

@@ -30,13 +30,12 @@
   "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)))))
+      (into {} (map (fn [row] [(sqlite-schema/<-SQLite :db.type/keyword (:ident row)) (:entid row)])) rows))))
 
 (defn <current-tx [sqlite-connection]
   "Find the largest tx written to the SQLite store.
@@ -51,7 +50,6 @@
   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
     (->>
       (->>
@@ -60,12 +58,13 @@
         (s/all-rows sqlite-connection))
       (<?)
 
-        (group-by (comp <-SQLite :ident))
+      (group-by (comp (partial sqlite-schema/<-SQLite :db.type/keyword) :ident))
       (map (fn [[ident rows]]
              [ident
               (into {} (map (fn [row]
-                                [(<-SQLite (:attr row)) (<-SQLite (:value row))]) rows))]))
+                              [(sqlite-schema/<-SQLite :db.type/keyword (:attr row))
-        (into {})))))
+                               (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

src/datomish/schema.cljc

@@ -5,7 +5,9 @@
 ;; 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]]))
 
 (defprotocol ISchema
   (attrs-by
@@ -94,14 +96,13 @@
                      :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/ref     { :valid? #(and (integer? %) (pos? %)) }
-   :db.type/keyword { :valid? keyword? :->SQLite str :<-SQLite #(keyword (subs % 1)) }
+   :db.type/keyword { :valid? keyword? }
-   :db.type/string  { :valid? string? :->SQLite identity :<-SQLite identity }
+   :db.type/string  { :valid? string? }
-   :db.type/boolean { :valid? #?(:clj #(instance? Boolean %) :cljs #(= js/Boolean (type %))) :->SQLite #(if % 1 0) :<-SQLite #(not= % 0) }
+   :db.type/boolean { :valid? #?(:clj #(instance? Boolean %) :cljs #(= js/Boolean (type %))) }
-   :db.type/integer { :valid? integer? :->SQLite identity :<-SQLite identity }
+   :db.type/integer { :valid? integer? }
-   :db.type/real    { :valid? #?(:clj float? :cljs number?) :->SQLite identity :<-SQLite identity }
+   :db.type/real    { :valid? #?(:clj float? :cljs number?) }
    })
 
 (defn #?@(:clj  [^Boolean ensure-valid-value]
@@ -124,7 +125,7 @@
     (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)
           (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 +137,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])]
+      (if (contains? value-type-map valueType)
-        (<-SQLite value)
+        (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/sqlite_schema.cljc

@@ -115,3 +115,52 @@
 
         (< 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)
+
+       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))
+
+       number
+       (->SQLite [x] x)]))
+
+(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/integer value
+    :db.type/real    value))