diff --git a/src/datomish/db.cljc b/src/datomish/db.cljc index cd6a83a3..85f11740 100644 --- a/src/datomish/db.cljc +++ b/src/datomish/db.cljc @@ -207,6 +207,11 @@ ;; TODO: implement support for DB parts? (def tx0 0x2000000) +(def default-schema + {:db/txInstant {:db/valueType :db.type/integer} + :db/ident {:db/valueType :db.type/keyword} + }) + (defn > @@ -223,11 +228,11 @@ (go-pair (when-not (= sqlite-schema/current-version (DB {:sqlite-connection sqlite-connection :idents idents - :schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) schema))) + :schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) (merge schema default-schema)))) :current-tx tx0}))))) (defn connection-with-db [db] @@ -288,6 +293,8 @@ [op e a v (or tx current-tx)])) (defn preprocess [db report] + {:pre [(db? db) (report? report)]} + (let [initial-es (conj (or (:entities report) []) (tx-entity db))] (when-not (sequential? initial-es) (raise "Bad transaction data " initial-es ", expected sequential collection" @@ -351,6 +358,8 @@ (defn > (vec (for [[op & entity] (:entities report)] @@ -409,21 +418,29 @@ simple allocations." [db report] + {:pre [(db? db) (report? report)]} + (go-pair (let [keyfn (fn [[op e a v tx]] (if (and (id-literal? e) (not-any? id-literal? [a v tx])) (- 5) (- (count (filter id-literal? [e a v tx]))))) - initial-report (dissoc report :entities) ;; TODO. + initial-report (assoc report :entities []) ;; TODO. initial-entities (sort-by keyfn (:entities report))] (loop [report initial-report es initial-entities] + (if (report? initial-report) + (update report :tempids #(into {} (filter (comp not temp-literal? first) %))) + (raise "fail" {:initial-report report})) + (let [[[op e a v tx :as entity] & entities] es] (cond (nil? entity) ;; We can add :db.part/temp id-literals; remove them. - (update report :tempids #(into {} (filter (comp not temp-literal? first) %))) + (if (report? report) + (update report :tempids #(into {} (filter (comp not temp-literal? first) %))) + (raise "fail" {:report report})) (and (not= op :db/add) (not (empty? (filter id-literal? [e a v tx])))) @@ -438,9 +455,7 @@ (let [upserted-eid (:e (first (> initial-report + (->> report (preprocess db) (SQLite identity :<-SQLite identity } + :db.type/keyword { :valid? keyword? :->SQLite name :<-SQLite keyword } + :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 } + :db.type/real { :valid? float? :->SQLite identity :<-SQLite identity } + }) + +(defn #?@(:clj [^Boolean ensure-valid-value] + :cljs [^boolean ensure-valid-value]) [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?])] + (when-not (valid? 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- validate-schema [schema] (doseq [[a kv] schema] + (when-not (:db/valueType kv) + (throw (ex-info (str "Bad attribute specification for " a ": should have {:db/valueType ...}") + {:error :schema/validation + :attribute a + :key :db/valueType}))) (let [comp? (:db/isComponent kv false)] (validate-schema-key a :db/isComponent (:db/isComponent kv) #{true false}) (when (and comp? (not= (:db/valueType kv) :db.type/ref)) @@ -86,7 +119,7 @@ :attribute a :key :db/isComponent})))) (validate-schema-key a :db/unique (:db/unique kv) #{:db.unique/value :db.unique/identity}) - (validate-schema-key a :db/valueType (:db/valueType kv) #{:db.type/ref}) + (validate-schema-key a :db/valueType (:db/valueType kv) (set (keys value-type-map))) (validate-schema-key a :db/cardinality (:db/cardinality kv) #{:db.cardinality/one :db.cardinality/many})) schema) diff --git a/test/datomish/db_test.cljc b/test/datomish/db_test.cljc index 62f6618d..63dc8b47 100644 --- a/test/datomish/db_test.cljc +++ b/test/datomish/db_test.cljc @@ -53,20 +53,30 @@ (defn tx [report] (get-in report [:db-after :current-tx])) +(def test-schema + {:x {:db/unique :db.unique/identity + :db/valueType :db.type/integer} + :y {:db/cardinality :db.cardinality/many + :db/valueType :db.type/integer} + :name {:db/unique :db.unique/identity + :db/valueType :db.type/string} + :aka {:db/cardinality :db.cardinality/many + :db/valueType :db.type/string}}) + (deftest-async test-add-one (with-tempfile [t (tempfile)] (let [c (