Extract IEncodeSQLite protocol and type-aware (but not schema-aware) <-SQLite factory.
This commit is contained in:
parent
655a6a1461
commit
0f7c1cad79
4 changed files with 84 additions and 37 deletions
|
@ -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)))]
|
||||||
|
|
|
@ -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-schema/<-SQLite :db.type/keyword (:ident row)) (:entid row)])) rows))))
|
||||||
(into {} (map (fn [row] [(<-SQLite (: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,21 +50,21 @@
|
||||||
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
|
(->>
|
||||||
(->>
|
(->>
|
||||||
(->>
|
{:select [:ident :attr :value] :from [:schema]}
|
||||||
{:select [:ident :attr :value] :from [:schema]}
|
(s/format)
|
||||||
(s/format)
|
(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
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Loading…
Reference in a new issue