added tx-middleware capability and schema-middleware

src/datascript/db.cljc

@@ -26,7 +26,7 @@
           data (last fragments)]
       `(throw (ex-info (str ~@(map (fn [m#] (if (string? m#) m# (list 'pr-str m#))) msgs)) ~data)))))
 
-(defn #?@(:clj  [^Boolean seqable?]  
+(defn #?@(:clj  [^Boolean seqable?]
           :cljs [^boolean seqable?])
   [x]
   (and (not (string? x))
@@ -143,7 +143,7 @@
         IIndexed
         (-nth [this i] (nth-datom this i))
         (-nth [this i not-found] (nth-datom this i not-found))
-        
+
         IAssociative
         (-assoc [d k v] (assoc-datom d k v))
 
@@ -168,7 +168,7 @@
         (empty [d] (throw (UnsupportedOperationException. "empty is not supported on Datom")))
         (count [d] 5)
         (cons [d [k v]] (assoc-datom d k v))
-        
+
         clojure.lang.Indexed
         (nth [this i]           (nth-datom this i))
         (nth [this i not-found] (nth-datom this i not-found))
@@ -187,7 +187,7 @@
   ([e a v]          (Datom. e a v tx0 true))
   ([e a v tx]       (Datom. e a v tx true))
   ([e a v tx added] (Datom. e a v tx added)))
-  
+
 (defn datom? [x] (instance? Datom x))
 
 (defn- hash-datom [^Datom d]
@@ -431,7 +431,7 @@
                               (filter (fn [^Datom d] (= tx (.-tx d)))))
                          (btset/slice eavt (Datom. e nil nil nil nil))         ;; e _ _ _
                          (if (indexing? db a)                                  ;; _ a v tx
-                           (->> (btset/slice avet (Datom. nil a v nil nil))      
+                           (->> (btset/slice avet (Datom. nil a v nil nil))
                                 (filter (fn [^Datom d] (= tx (.-tx d)))))
                            (->> (btset/slice aevt (Datom. nil a nil nil nil))
                                 (filter (fn [^Datom d] (and (= v (.-v d))
@@ -600,10 +600,10 @@
 
 (defn ^DB init-db
   ([datoms] (init-db datoms default-schema))
-  ([datoms schema]
+  ([datoms schema & {:as options :keys [validate?] :or {validate? true}}]
     (if (empty? datoms)
       (empty-db schema)
-      (let [_ (validate-schema schema)
+      (let [_ (when validate? (validate-schema schema))
             rschema (rschema schema)
             indexed (:db/index rschema)
             #?@(:cljs
@@ -744,6 +744,9 @@
           :cljs [^boolean indexing?]) [db attr]
   (is-attr? db attr :db/index))
 
+(defn treat-idents-as-eids? [db]
+  true)
+
 (defn entid [db eid]
   {:pre [(db? db)]}
   (cond
@@ -761,6 +764,7 @@
           nil
         :else
           (:e (first (-datoms db :avet eid))))
+    (and (keyword? eid) (treat-idents-as-eids? db)) (:e (first (-datoms db :avet [:db/ident eid])))
     #?@(:cljs [(array? eid) (recur db (array-seq eid))])
     :else
       (raise "Expected number or lookup ref for entity id, got " eid
@@ -864,10 +868,10 @@
   (cond
     (keyword? attr)
     (= \_ (nth (name attr) 0))
-    
+
     (string? attr)
     (boolean (re-matches #"(?:([^/]+)/)?_([^/]+)" attr))
-   
+
     :else
     (raise "Bad attribute type: " attr ", expected keyword or string"
            {:error :transact/syntax, :attribute attr})))
@@ -884,7 +888,7 @@
      (if (= \_ (nth name 0))
        (if ns (str ns "/" (subs name 1)) (subs name 1))
        (if ns (str ns "/_" name) (str "_" name))))
-   
+
    :else
     (raise "Bad attribute type: " attr ", expected keyword or string"
            {:error :transact/syntax, :attribute attr})))
@@ -943,12 +947,12 @@
     (not (or (da/array? vs)
              (and (coll? vs) (not (map? vs)))))
     [vs]
-    
+
     ;; probably lookup ref
     (and (= (count vs) 2)
          (is-attr? db (first vs) :db.unique/identity))
     [vs]
-    
+
     :else vs))
 
 
@@ -1025,7 +1029,7 @@
     (transact-tx-data (assoc-in report [:tempids tempid] upserted-eid)
                       es)))
 
-(defn transact-tx-data [initial-report initial-es]
+(defn transact-tx-data* [initial-report initial-es]
   (when-not (or (nil? initial-es)
                 (sequential? initial-es))
     (raise "Bad transaction data " initial-es ", expected sequential collection"
@@ -1039,7 +1043,7 @@
           (-> report
               (assoc-in  [:tempids :db/current-tx] (current-tx report))
               (update-in [:db-after :max-tx] inc))
-        
+
         (map? entity)
           (let [old-eid (:db/id entity)]
             (cond-let
@@ -1048,13 +1052,13 @@
               (let [id (current-tx report)]
                 (recur (allocate-eid report old-eid id)
                        (cons (assoc entity :db/id id) entities)))
-             
+
               ;; lookup-ref => resolved | error
               (sequential? old-eid)
               (let [id (entid-strict db old-eid)]
                 (recur report
                        (cons (assoc entity :db/id id) entities)))
-             
+
               ;; upserted => explode | error
               [upserted-eid (upsert-eid db entity)]
               (if (and (neg-number? old-eid)
@@ -1063,7 +1067,7 @@
                 (retry-with-tempid initial-report initial-es old-eid upserted-eid)
                 (recur (allocate-eid report old-eid upserted-eid)
                        (concat (explode db (assoc entity :db/id upserted-eid)) entities)))
-             
+
               ;; resolved | allocated-tempid | tempid | nil => explode
               (or (number? old-eid)
                   (nil?    old-eid))
@@ -1072,10 +1076,10 @@
                               (neg? old-eid) (or (get (:tempids report) old-eid)
                                                  (next-eid db))
                               :else          old-eid)
-                    new-entity (assoc entity :db/id new-eid)]                
+                    new-entity (assoc entity :db/id new-eid)]
                 (recur (allocate-eid report old-eid new-eid)
                        (concat (explode db new-entity) entities)))
-             
+
               ;; trash => error
               :else
               (raise "Expected number or lookup ref for :db/id, got " old-eid
@@ -1163,7 +1167,7 @@
              :else
                (raise "Unknown operation at " entity ", expected :db/add, :db/retract, :db.fn/call, :db.fn/retractAttribute or :db.fn/retractEntity"
                       {:error :transact/syntax, :operation op, :tx-data entity})))
-       
+
        (datom? entity)
          (let [[e a v tx added] entity]
            (if added
@@ -1175,3 +1179,87 @@
                 {:error :transact/syntax, :tx-data entity})
        ))))
 
+(defn transact-tx-data [{:as initial-report :keys [tx-meta]} initial-es]
+  (let [middleware (or (:datascript.db/tx-middleware tx-meta) identity)]
+;;     (prn "tx-middleware" middleware)
+    ((middleware transact-tx-data*)
+     initial-report
+     initial-es)))
+
+(defn validate-schema-change [db-before db-after]
+  ;; TODO: insert optimized version of alexandergunnarson validation from posh
+  ;; ???: should we call from full databases or schema and datoms?
+  )
+
+(defn ^DB replace-schema
+  [db schema & {:as options :keys [validate?] :or {validate? true}}]
+  ;; ???: Can we make more performant by only updating :avet datom set when :db/index becomes active, rather than doing an entire init-db?
+;;   (prn "replacing-schema" schema)
+  (let [db-after (init-db (-datoms db :eavt []) schema)]
+    (when validate?
+      (validate-schema-change db db-after))
+    db-after))
+
+(defn schema-datom? [[e a v tx add?]]
+  ;; currently ignoring problematic valueTypes
+  (#{:db/ident :db/cardinality :db/unique :db/index :db/isComponent :db/valueType}
+    a))
+
+(defn supported-schema-value? [a v]
+  (case a
+    :db/valueType (= v :db.type/ref)
+    true))
+
+(defn resolve-ident [db ident-eid]
+  (let [resolved-eid (entid-strict db ident-eid)]
+    (-> (-search db [resolved-eid :db/ident])
+        first
+        :v)))
+
+(defn resolve-enum [db attr value]
+  ;; FIXME: hardcoded enums
+  (if (#{:db/cardinality :db/unique :db/valueType} attr)
+    (let [rident (resolve-ident db value)]
+;;       (prn "resolving to " rident " from " value " for " attr)
+      rident
+      )
+    value))
+
+(defn conj-schema-datom
+  ;; TODO: handle retractions
+  ([] (empty-db))
+  ([db] db)
+  ([db [eid attr value _ _]]
+   (let [attr-ident (resolve-ident db eid)
+         resolved-value (resolve-enum db attr value)]
+     (if (supported-schema-value? attr resolved-value)
+       (assoc-in db [:schema attr-ident attr]
+                 resolved-value)
+       db))))
+
+(defn schema-middleware [transact]
+  (fn [report txs]
+    (let [{:as report :keys [db-after tx-data]} (transact report txs)
+          db-after' (transduce
+                    (filter schema-datom?)
+                    conj-schema-datom
+                    db-after
+                    tx-data)]
+      (if (= (:schema db-after) (:schema db-after'))
+        report
+        (assoc report
+          :db-after (replace-schema db-after (:schema db-after')))))))
+
+(defn keep-meta-middleware
+  "tx-middleware to keep any meta-data on the db-value after a transaction."
+  [transact]
+  (fn [report txs]
+    (let [{:as report :keys [db-after db-before]} (transact report txs)]
+      (update-in
+        report
+        [:db-after]
+        with-meta
+        (into
+          (or (meta db-before) {})
+          (meta db-after))))))
+