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

This commit is contained in:
Nick Alexander 2016-08-05 17:57:37 -07:00 committed by Richard Newman
parent 655a6a1461
commit 0f7c1cad79
4 changed files with 84 additions and 37 deletions

View file

@ -248,12 +248,11 @@
(<apply-db-ident-assertions [db added-idents merge] (<apply-db-ident-assertions [db added-idents merge]
(go-pair (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. ;; TODO: batch insert.
(doseq [[ident entid] added-idents] (doseq [[ident entid] added-idents]
(<? (exec (<? (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)) (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)))] 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] (<apply-db-install-assertions [db fragment merge]
(go-pair (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. ;; TODO: batch insert.
(doseq [[ident attr-map] fragment] (doseq [[ident attr-map] fragment]
(doseq [[attr value] attr-map] (doseq [[attr value] attr-map]
(<? (exec (<? (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) (let [symbolic-schema (merge-with merge (:symbolic-schema db) fragment)
schema (ds/schema (into {} (map (fn [[k v]] [(entid db k) v]) symbolic-schema)))] schema (ds/schema (into {} (map (fn [[k v]] [(entid db k) v]) symbolic-schema)))]

View file

@ -30,13 +30,12 @@
"Read the ident map materialized view from the given SQLite store. "Read the ident map materialized view from the given SQLite store.
Returns a map (keyword ident) -> (integer entid), like {:db/ident 0}." 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 (go-pair
(let [rows (<? (->> (let [rows (<? (->>
{:select [:ident :entid] :from [:idents]} {:select [:ident :entid] :from [:idents]}
(s/format) (s/format)
(s/all-rows sqlite-connection)))] (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] (defn <current-tx [sqlite-connection]
"Find the largest tx written to the SQLite store. "Find the largest tx written to the SQLite store.
@ -51,7 +50,6 @@
Returns a map (keyword ident) -> (map (keyword attribute -> keyword value)), like Returns a map (keyword ident) -> (map (keyword attribute -> keyword value)), like
{:db/ident {:db/cardinality :db.cardinality/one}}." {: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 (go-pair
(->> (->>
(->> (->>
@ -60,12 +58,13 @@
(s/all-rows sqlite-connection)) (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]] (map (fn [[ident rows]]
[ident [ident
(into {} (map (fn [row] (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] (defn <initialize-connection [sqlite-connection]
(go-pair (go-pair

View file

@ -5,7 +5,9 @@
;; Purloined from DataScript. ;; Purloined from DataScript.
(ns datomish.schema (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 (defprotocol ISchema
(attrs-by (attrs-by
@ -94,14 +96,13 @@
:key k :key k
:value v})))) :value v}))))
;; TODO: consider doing this with a protocol and extending the underlying Clojure(Script) types.
(def value-type-map (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] (defn #?@(:clj [^Boolean ensure-valid-value]
@ -124,7 +125,7 @@
(if-let [valueType (get-in schema [attr :db/valueType])] (if-let [valueType (get-in schema [attr :db/valueType])]
(if-let [valid? (get-in value-type-map [valueType :valid?])] (if-let [valid? (get-in value-type-map [valueType :valid?])]
(if (valid? value) (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 (raise "Invalid value for attribute " attr ", expected " valueType " but got " value
{:error :schema/valueType, :attribute attr, :value value})) {:error :schema/valueType, :attribute attr, :value value}))
(raise "Unknown valueType for attribute " attr ", expected one of " (sorted-set (keys value-type-map)) (raise "Unknown valueType for attribute " attr ", expected one of " (sorted-set (keys value-type-map))
@ -136,8 +137,8 @@
{:pre [(schema? schema)]} {:pre [(schema? schema)]}
(let [schema (.-schema schema)] (let [schema (.-schema schema)]
(if-let [valueType (get-in schema [attr :db/valueType])] (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)) (raise "Unknown valueType for attribute " attr ", expected one of " (sorted-set (keys value-type-map))
{:error :schema/valueType, :attribute attr})) {:error :schema/valueType, :attribute attr}))
(raise "Unknown attribute " attr ", expected one of " (sorted-set (keys schema)) (raise "Unknown attribute " attr ", expected one of " (sorted-set (keys schema))

View file

@ -115,3 +115,52 @@
(< v current-version) (< v current-version)
(<? (<update-from-version db v)))))) (<? (<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))