Filtered databases support via filter

.gitignore

@@ -12,3 +12,4 @@ web/*.js
 perf
 release-js/datascript*.js
 release-js/npm-*
+web/target-cljs

CHANGELOG.md

@@ -5,6 +5,7 @@
 - Added missing aggregate funs: `avg`, `median`, `variance`, `stddev` and `count-distinct` (issue #42, thx [@montyxcantsin](https://github.com/montyxcantsin))
 - `min` and `max` aggregates use comparator instead of default js `<` comparison
 - Fixed a bug when fn inside a query on empty relation returned non-empty result
+- Filtered DB support via `filter`
 
 # 0.6.0
 

README.md

@@ -169,6 +169,7 @@ The following features are supported:
 * Database “mutations” via `transact!`
 * Callback-based analogue to txReportQueue via `listen!`
 * Direct index lookup and iteration via `datoms` and `seek-datoms`
+* Filtered databases via `filter`
 
 Query engine features:
 

project.clj

@@ -36,7 +36,7 @@
             :source-paths ["src" "test"]
             :compiler {
               :output-to     "web/datascript.js"
-              :output-dir    "web/out"
+              :output-dir    "web/target-cljs"
               :optimizations :none
               :source-map    true
             }}

src/datascript.cljs

@@ -1,4 +1,5 @@
 (ns datascript
+  (:refer-clojure :exclude [filter])
   (:require
     [datascript.core :as dc]
     [datascript.query :as dq]
@@ -15,9 +16,11 @@
 (def ^:const tx0 dc/tx0)
 
 (defn- refs [schema]
-  (->> schema
-    (filter (fn [[_ v]] (= (:db/valueType v) :db.type/ref)))
-    (mapv first)))
+  (reduce-kv (fn [acc attr v]
+               (if (= (:db/valueType v) :db.type/ref)
+                 (conj acc attr)
+                 acc))
+             #{} schema))
 
 (defn empty-db [& [schema]]
   (dc/map->DB {
@@ -46,22 +49,43 @@
       :max-tx  max-tx
       :refs    (refs schema)})))
 
+(defn is-filtered [db]
+  (instance? dc/FilteredDB db))
 
-(defn create-conn [& [schema]]
-  (atom (empty-db schema)
-        :meta { :listeners  (atom {}) }))
+(defn filter [db pred]
+  (if (is-filtered db)
+    (let [u (.-unfiltered-db db)]
+      (dc/FilteredDB. u #(and (pred u %) ((.-pred db) %))))
+    (dc/FilteredDB. db #(pred db %))))
 
 (defn with [db tx-data & [tx-meta]]
-  (dc/transact-tx-data (dc/map->TxReport
-                         { :db-before db
-                           :db-after  db
-                           :tx-data   []
-                           :tempids   {}
-                           :tx-meta   tx-meta}) tx-data))
+  (if (is-filtered db)
+    (throw (js/Error. "Filtered DB cannot be modified"))
+    (dc/transact-tx-data (dc/map->TxReport
+                           { :db-before db
+                             :db-after  db
+                             :tx-data   []
+                             :tempids   {}
+                             :tx-meta   tx-meta}) tx-data)))
 
 (defn db-with [db tx-data]
   (:db-after (with db tx-data)))
 
+(defn datoms [db index & cs]
+  (dc/-datoms db index cs))
+
+(defn seek-datoms [db index & cs]
+  (dc/-seek-datoms db index cs))
+
+(defn index-range [db attr start end]
+  (dc/-index-range db attr start end))
+
+;; Conn
+
+(defn create-conn [& [schema]]
+  (atom (empty-db schema)
+        :meta { :listeners  (atom {}) }))
+
 (defn -transact! [conn tx-data tx-meta]
   (let [report (atom nil)]
     (swap! conn (fn [db]
@@ -85,21 +109,6 @@
 (defn unlisten! [conn key]
   (swap! (:listeners (meta conn)) dissoc key))
 
-(defn- components->pattern [index [c0 c1 c2 c3]]
-  (case index
-    :eavt (dc/Datom. c0 c1 c2 c3 nil)
-    :aevt (dc/Datom. c1 c0 c2 c3 nil)
-    :avet (dc/Datom. c2 c0 c1 c3 nil)))
-
-(defn datoms [db index & cs]
-  (btset/slice (get db index) (components->pattern index cs)))
-
-(defn seek-datoms [db index & cs]
-  (btset/slice (get db index) (components->pattern index cs) (dc/Datom. nil nil nil nil nil)))
-
-(defn index-range [db attr start end]
-  (btset/slice (:avet db) (dc/Datom. nil attr start nil nil)
-                          (dc/Datom. nil attr end nil nil)))
 
 ;; printing and reading
 ;; #datomic/DB {:schema <map>, :datoms <vector of [e a v tx]>}
@@ -115,25 +124,34 @@
 (defn datom-from-reader [[e a v tx added]]
   (datom e a v tx added))
 
-(extend-type dc/DB
-  IPrintWithWriter
+(defn pr-db [db w opts]
+  (-write w "#datascript/DB {")
+  (-write w ":schema ")
+  (pr-writer (dc/-schema db) w opts)
+  (-write w ", :datoms ")
+  (pr-sequential-writer w
+    (fn [d w opts]
+      (pr-sequential-writer w pr-writer "[" " " "]" opts [(.-e d) (.-a d) (.-v d) (.-tx d)]))
+    "[" " " "]" opts (dc/-datoms db :eavt []))
+  (-write w "}"))
+
+(extend-protocol IPrintWithWriter
+  dc/DB
+  (-pr-writer [db w opts]
+    (pr-db db w opts))
+
+  dc/FilteredDB
   (-pr-writer [db w opts]
-    (-write w "#datascript/DB {")
-    (-write w ":schema ")
-    (pr-writer (.-schema db) w opts)
-    (-write w ", :datoms ")
-    (pr-sequential-writer w
-      (fn [d w opts]
-        (pr-sequential-writer w pr-writer "[" " " "]" opts [(.-e d) (.-a d) (.-v d) (.-tx d)]))
-      "[" " " "]" opts (.-eavt db))
-    (-write w "}")))
+    (pr-db db w opts)))
 
 (defn db-from-reader [{:keys [schema datoms]}]
   (init-db (map (fn [[e a v tx]] (dc/Datom. e a v tx true)) datoms) schema))
 
+
 ;; Datomic compatibility layer
 
 (def last-tempid (atom -1000000))
+
 (defn tempid
   ([part]
     (if (= part :db.part/tx)
@@ -143,6 +161,7 @@
     (if (= part :db.part/tx)
       :db/current-tx
       x)))
+
 (defn resolve-tempid [_db tempids tempid]
   (get tempids tempid))
 

src/datascript/core.cljs

@@ -33,6 +33,15 @@
 (defprotocol ISearch
   (-search [data pattern]))
 
+(defprotocol IIndexAccess
+  (-datoms [db index components])
+  (-seek-datoms [db index components])
+  (-index-range [db attr start end]))
+
+(defprotocol IDB
+  (-schema [db])
+  (-refs [db]))
+
 (defn- cmp [o1 o2]
   (if (and o1 o2)
     (compare o1 o2)
@@ -126,12 +135,20 @@
     (- (.-e d1) (.-e d2))
     (- (.-tx d1) (.-tx d2))))
 
-
+(defn- components->pattern [index [c0 c1 c2 c3]]
+  (case index
+    :eavt (Datom. c0 c1 c2 c3 nil)
+    :aevt (Datom. c1 c0 c2 c3 nil)
+    :avet (Datom. c2 c0 c1 c3 nil)))
 
 (defrecord DB [schema eavt aevt avet max-eid max-tx refs]
   Object
   (toString [this]
     (pr-str* this))
+
+  IDB
+  (-schema [_] schema)
+  (-refs   [_] refs)
 
   ISearch
   (-search [_ [e a v tx]]
@@ -157,9 +174,43 @@
       (filter #(and (= v (.-v %)) (= tx (.-tx %))) eavt) ;; _ _ v tx
       (filter #(= v (.-v %)) eavt)                       ;; _ _ v _
       (filter #(= tx (.-tx %)) eavt)                     ;; _ _ _ tx
-      eavt])))                                           ;; _ _ _ _
+      eavt]))                                            ;; _ _ _ _
+
+  IIndexAccess
+  (-datoms [this index cs]
+    (btset/slice (get this index) (components->pattern index cs)))
 
-(defn- equiv-index [x y]
+  (-seek-datoms [this index cs]
+    (btset/slice (get this index) (components->pattern index cs) (Datom. nil nil nil nil nil)))
+
+  (-index-range [_ attr start end]
+    (btset/slice avet (Datom. nil attr start nil nil)
+                      (Datom. nil attr end nil nil))))
+
+(defrecord FilteredDB [unfiltered-db pred]
+  Object
+  (toString [this]
+    (pr-str* this))
+
+  IDB
+  (-schema [_] (-schema unfiltered-db))
+  (-refs   [_] (-refs unfiltered-db))
+
+  ISearch
+  (-search [_ pattern]
+    (filter pred (-search unfiltered-db pattern)))
+
+  IIndexAccess
+  (-datoms [_ index cs]
+    (filter pred (-datoms unfiltered-db index cs)))
+
+  (-seek-datoms [_ index cs]
+    (filter pred (-seek-datoms unfiltered-db index cs)))
+
+  (-index-range [_ attr start end]
+    (filter pred (-index-range unfiltered-db attr start end))))
+
+(defn- -equiv-index [x y]
   (and (= (count x) (count y))
     (loop [xs (seq x)
            ys (seq y)]
@@ -168,25 +219,30 @@
         (= (first xs) (first ys)) (recur (next xs) (next ys))
         :else false))))
 
+(defn- -hash-db [db]
+  (or (.-__hash db)
+      (set! (.-__hash db) (hash-coll (-datoms db :eavt [])))))
+
+(defn- -equiv-db [this other]
+  (and (or (instance? DB other) (instance? FilteredDB other))
+       (= (-schema this) (-schema other))
+       (-equiv-index (-datoms this :eavt []) (-datoms other :eavt []))))
+
 (extend-type DB
-  IHash
-  (-hash [this]
-    (or (.-__hash this)
-        (set! (.-__hash this) (hash-coll (.-eavt this)))))
-  IEquiv
-  (-equiv [this other]
-    (and (instance? DB other)
-         (= (.-schema this) (.-schema other))
-         (equiv-index (.-eavt this) (.-eavt other)))))
+  IHash (-hash [this] (-hash-db this))
+  IEquiv (-equiv [this other] (-equiv-db this other)))
 
+(extend-type FilteredDB
+  IHash (-hash [this] (-hash-db this))
+  IEquiv (-equiv [this other] (-equiv-db this other)))
 
 (defrecord TxReport [db-before db-after tx-data tempids tx-meta])
 
 (defn multival? [db attr]
-  (= (get-in db [:schema attr :db/cardinality]) :db.cardinality/many))
+  (= (get-in (-schema db) [attr :db/cardinality]) :db.cardinality/many))
 
 (defn ref? [db attr]
-  (= (get-in db [:schema attr :db/valueType]) :db.type/ref))
+  (contains? (-refs db) attr))
 
 ;;;;;;;;;; Transacting
 
@@ -342,5 +398,5 @@
 
             (= op :db.fn/retractEntity)
               (let [e-datoms (-search db [e])
-                    v-datoms (mapcat (fn [a] (-search db [nil a e])) (.-refs db))]
+                    v-datoms (mapcat (fn [a] (-search db [nil a e])) (-refs db))]
                 (recur (reduce transact-retract-datom report (concat e-datoms v-datoms)) entities)))))))

src/datascript/query.cljs

@@ -299,7 +299,7 @@
                                ['$ clause])
         source   (get (:sources context) source-sym)]
     (cond
-      (instance? dc/DB source)
+      (satisfies? dc/ISearch source)
         (lookup-pattern-db source pattern)
       :else
         (lookup-pattern-coll source pattern))))

test/test/datascript.cljs

@@ -1,6 +1,6 @@
 (ns test.datascript
   (:require-macros
-    [cemerick.cljs.test :refer (is deftest with-test run-tests testing test-var)])
+    [cemerick.cljs.test :refer (is are deftest with-test run-tests testing test-var)])
   (:require
     [datascript.core :as dc]
     [datascript :as d]
@@ -967,5 +967,61 @@
     (binding [cljs.reader/*tag-table* (atom {"datascript/DB" d/db-from-reader})]
       (is (= db (cljs.reader/read-string (pr-str db)))))))
 
+(deftest test-filter-db
+  (let [db (-> (d/empty-db {:aka { :db/cardinality :db.cardinality/many }})
+               (d/db-with [{:db/id 1
+                            :name  "Petr"
+                            :email "petya@spb.ru"
+                            :aka   ["I" "Great"]
+                            :password "<SECRET>"}
+                           {:db/id 2
+                            :name  "Ivan"
+                            :aka   ["Terrible" "IV"]
+                            :password "<PROTECTED>"}
+                           {:db/id 3
+                            :name  "Nikolai"
+                            :aka   ["II"]
+                            :password "<UNKWOWN>"}
+                           ]))
+        remove-pass (fn [_ datom] (not= :password (.-a datom)))
+        remove-ivan (fn [_ datom] (not= 2 (.-e datom)))
+        long-akas   (fn [udb datom] (or (not= :aka (.-a datom))
+                                        ;; has just 1 aka
+                                        (<= (count (:aka (d/entity udb (.-e datom)))) 1)
+                                        ;; or aka longer that 4 chars
+                                        (>= (count (.-v datom)) 4)))]
+
+    (are [_db _res] (= (d/q '[:find ?v :where [_ :password ?v]] _db) _res)
+      db                        #{["<SECRET>"] ["<PROTECTED>"] ["<UNKWOWN>"]}
+      (d/filter db remove-pass) #{}
+      (d/filter db remove-ivan) #{["<SECRET>"] ["<UNKWOWN>"]}
+      (-> db (d/filter remove-ivan) (d/filter remove-pass)) #{})
+
+    (are [_db _res] (= (d/q '[:find ?v :where [_ :aka ?v]] _db) _res)
+      db                        #{["I"] ["Great"] ["Terrible"] ["IV"] ["II"]}
+      (d/filter db remove-pass) #{["I"] ["Great"] ["Terrible"] ["IV"] ["II"]}
+      (d/filter db remove-ivan) #{["I"] ["Great"] ["II"]}
+      (d/filter db long-akas)   #{["Great"] ["Terrible"] ["II"]}
+      (-> db (d/filter remove-ivan) (d/filter long-akas)) #{["Great"] ["II"]}
+      (-> db (d/filter long-akas) (d/filter remove-ivan)) #{["Great"] ["II"]})
+
+    (testing "Entities"
+      (is (= (:password (d/entity db 1)) "<SECRET>"))
+      (is (= (:password (d/entity (d/filter db remove-pass) 1) ::not-found) ::not-found))
+      (is (= (:aka (d/entity db 2)) #{"Terrible" "IV"}))
+      (is (= (:aka (d/entity (d/filter db long-akas) 2)) #{"Terrible"})))
+
+    (testing "Index access"
+      (is (= (map :v (d/datoms db :aevt :password))
+             ["<SECRET>" "<PROTECTED>" "<UNKWOWN>"]))
+      (is (= (map :v (d/datoms (d/filter db remove-pass) :aevt :password))
+             [])))
+
+    (testing "equiv and hash"
+      (is (= (d/db-with db [[:db.fn/retractEntity 2]])
+             (d/filter db remove-ivan)))
+      (is (= (hash (d/db-with db [[:db.fn/retractEntity 2]]))
+             (hash (d/filter db remove-ivan)))))))
+
 ;; (t/test-ns 'test.datascript)