Nativestore Test

├── circle.yml ├── .gitignore ├── resources └── test │ └── index.html ├── test ├── nativestore │ ├── runner.cljs │ └── internal.cljs ├── phantomjs-shims.js └── phantomjs.js ├── src └── nativestore │ ├── dfns.cljs │ ├── core.cljs │ └── heap.cljs ├── project.clj └── README.md /circle.yml: -------------------------------------------------------------------------------- 1 | test: 2 | override: 3 | - lein with-profiles base,test cljsbuild test -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | pom.xml.asc 3 | *jar 4 | /lib/ 5 | /classes/ 6 | /target/ 7 | /checkouts/ 8 | .lein-deps-sum 9 | .lein-repl-history 10 | .lein-plugins/ 11 | .lein-failures 12 | /.nrepl-port 13 | resources/test/js 14 | -------------------------------------------------------------------------------- /resources/test/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Nativestore Test 11 | 12 | 13 | 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /test/nativestore/runner.cljs: -------------------------------------------------------------------------------- 1 | (ns nativestore.runner 2 | (:require [nativestore.internal] 3 | [nativestore.core] 4 | [cljs.test :refer-macros [run-tests] :as test])) 5 | 6 | (set! *print-newline* false) 7 | (set-print-fn! #(js/console.log %)) 8 | 9 | (def report (atom nil)) 10 | 11 | (defn run-all-tests 12 | [] 13 | (.log js/console "Running all tests") 14 | (run-tests (test/empty-env) 15 | 'nativestore.internal) 16 | (test/successful? @report)) 17 | 18 | (defmethod cljs.test/report [:cljs.test/default :end-run-tests] [m] 19 | (if (test/successful? m) 20 | (println "cljs.test/report -> Tests Succeeded!") 21 | (do 22 | (reset! report m) 23 | (println "cljs.test/report -> Tests Failed :(") 24 | (prn m)))) 25 | 26 | -------------------------------------------------------------------------------- /test/phantomjs-shims.js: -------------------------------------------------------------------------------- 1 | (function() { 2 | 3 | var Ap = Array.prototype; 4 | var slice = Ap.slice; 5 | var Fp = Function.prototype; 6 | 7 | if (!Fp.bind) { 8 | // PhantomJS doesn't support Function.prototype.bind natively, so 9 | // polyfill it whenever this module is required. 10 | Fp.bind = function(context) { 11 | var func = this; 12 | var args = slice.call(arguments, 1); 13 | 14 | function bound() { 15 | var invokedAsConstructor = func.prototype && (this instanceof func); 16 | return func.apply( 17 | // Ignore the context parameter when invoking the bound function 18 | // as a constructor. Note that this includes not only constructor 19 | // invocations using the new keyword but also calls to base class 20 | // constructors such as BaseClass.call(this, ...) or super(...). 21 | !invokedAsConstructor && context || this, 22 | args.concat(slice.call(arguments)) 23 | ); 24 | } 25 | 26 | // The bound function must share the .prototype of the unbound 27 | // function so that any object created by one constructor will count 28 | // as an instance of both constructors. 29 | bound.prototype = func.prototype; 30 | 31 | return bound; 32 | }; 33 | } 34 | 35 | })(); 36 | -------------------------------------------------------------------------------- /src/nativestore/dfns.cljs: -------------------------------------------------------------------------------- 1 | (ns derive.dfns 2 | (:require [clojure.core.reducers :as r]) 3 | (:refer-clojure :exclude [filter map mapcat count remove sort sort-by])) 4 | 5 | (extend-protocol IReduce 6 | array 7 | (-reduce 8 | ([coll f] 9 | (areduce coll i r (f) (f r (aget coll i)))) 10 | ([coll f start] 11 | (areduce coll i r start (f r (aget coll i)))))) 12 | 13 | (defn js-conj 14 | ([] #js []) 15 | ([val] #js [val]) 16 | ([arry val] (do (.push arry val) arry))) 17 | 18 | (extend-protocol ITransientCollection 19 | array 20 | (-conj! [arry val] (js-conj arry val)) 21 | (-persistent! [tcoll] tcoll)) 22 | 23 | (defn count 24 | ([f coll] 25 | (reduce #(inc %1) 0 coll))) 26 | 27 | (defn reduce->> 28 | [coll & forms] 29 | (r/reduce (last forms) ((apply comp (reverse (butlast forms))) coll))) 30 | 31 | (defn reducec->> 32 | [coll & forms] 33 | (if (> (cljs.core/count forms) 0) 34 | (r/reduce js-conj #js [] ((apply comp (reverse forms)) coll)) 35 | (r/reduce js-conj #js [] coll))) 36 | 37 | (defn sort 38 | ([coll] (.sort coll compare)) 39 | ([comp coll] (.sort coll comp))) 40 | 41 | (defn sort-by 42 | ([keyfn coll] (.sort coll #(compare (keyfn %1) (keyfn %2)))) 43 | ([keyfn comp coll] (.sort coll #(comp (keyfn %1) (keyfn %2))))) 44 | 45 | 46 | ;; 47 | ;; Non-reduce native helpers 48 | ;; 49 | 50 | (defn sort-in-place [arry f] 51 | (.sort arry f)) 52 | -------------------------------------------------------------------------------- /test/phantomjs.js: -------------------------------------------------------------------------------- 1 | var system = require('system'); 2 | var url,args; 3 | 4 | if (phantom.version.major > 1) { 5 | args = system.args; 6 | if (args.length < 2) { 7 | system.stderr.write('Expected a target URL parameter.'); 8 | phantom.exit(1); 9 | } 10 | url = args[1]; 11 | } else { 12 | args = phantom.args; 13 | if (args.length < 1) { 14 | system.stderr.write('Expected a target URL parameter.'); 15 | phantom.exit(1); 16 | } 17 | url = args[0]; 18 | } 19 | 20 | var page = require('webpage').create(); 21 | 22 | page.onConsoleMessage = function (message) { 23 | console.log("Console: " + message); 24 | }; 25 | 26 | console.log("Loading URL: " + url); 27 | 28 | page.open(url, function (status) { 29 | if (status != "success") { 30 | console.log('Failed to open ' + url); 31 | phantom.exit(1); 32 | } 33 | console.log('Opened ' + url); 34 | 35 | var result = page.evaluate(function () { 36 | return nativestore.runner.run_all_tests(); 37 | }); 38 | 39 | // NOTE: PhantomJS 1.4.0 has a bug that prevents the exit codes 40 | // below from being returned properly. :( 41 | // 42 | // http://code.google.com/p/phantomjs/issues/detail?id=294 43 | 44 | if ( result ) { 45 | console.log("PhantomJS runner: Success."); 46 | phantom.exit(0); 47 | } else { 48 | console.log("PhantomJS runner: *** Tests failed! ***"); 49 | phantom.exit(1); 50 | } 51 | }); 52 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.vitalreactor/nativestore "0.2.3-SNAPSHOT" 2 | :description "A client-side, in-memory, indexed data store." 3 | :url "http://github.com/vitalreactor/nativestore" 4 | :license {:name "MIT License" 5 | :url "http://github.com/vitalreactor/derive/blob/master/LICENSE"} 6 | :dependencies [[org.clojure/clojure "1.7.0"] 7 | [org.clojure/clojurescript "1.8.51"] 8 | [prismatic/schema "0.2.6"] 9 | [com.vitalreactor/derive "0.2.1"]] 10 | :plugins [[lein-cljsbuild "1.1.2"]] 11 | :hooks [leiningen.cljsbuild] 12 | :profiles {:dev {:dependencies [[org.clojure/tools.nrepl "0.2.4"]] 13 | :source-paths ["src" "test"]}} 14 | :cljsbuild {:builds 15 | [ {:id "test" 16 | :source-paths ["src" "test"] 17 | :compiler {:main orchestra.runner 18 | :output-to "resources/test/js/testable.js" 19 | :output-dir "resources/test/js/out" 20 | :source-map "resources/test/js/testable.js.map" 21 | :asset-path "/js/out" 22 | :parallel-build true 23 | :optimizations :whitespace 24 | :recompile-dependents false 25 | :pretty-print true}}] 26 | :test-commands {"all" ["phantomjs" "test/phantomjs.js" "resources/test/index.html"]}}) 27 | 28 | -------------------------------------------------------------------------------- /test/nativestore/internal.cljs: -------------------------------------------------------------------------------- 1 | (ns nativestore.internal 2 | (:require [cljs.test :as t :refer-macros [deftest is]] 3 | [clojure.set :as set] 4 | [derive.core :refer-macros [defnd with-tracked-dependencies]] 5 | [derive.core :as d] 6 | [nativestore.core :as store])) 7 | 8 | (defn insert-population [store] 9 | (doto store 10 | (store/insert! #js {:id 1 :type "user" :name "Fred" :income 10}) 11 | (store/insert! #js {:id 2 :type "user" :name "Zoe" :income 10}) 12 | (store/insert! #js {:id 3 :type "user" :name "Apple" :income 20}) 13 | (store/insert! #js {:id 4 :type "user" :name "Flora" :income 20}) 14 | (store/insert! #js {:id 5 :type "user" :name "Flora" :income 10}) 15 | (store/insert! #js {:id 6 :type "super" :name "George" :income 5}))) 16 | 17 | (deftest native-type 18 | (is (store/read-only? (store/native true))) 19 | (is (not (store/read-only? (store/native false)))) 20 | (let [sample (store/native false)] 21 | )) 22 | 23 | (deftest basic-store 24 | (let [store (store/create)] 25 | (store/ensure-index store :name :name) 26 | (->> (store/compound-index [:income :name] [compare compare]) 27 | (store/ensure-index store :income-alpha)) 28 | (insert-population store) 29 | (is (= (:name (get store 1)) "Fred")) 30 | (is (= (:name (store 1)) "Fred")) 31 | 32 | ;; With a DB index 33 | (is (= (set (mapv :id (store/cursor store))) #{1 2 3 4 5 6})) 34 | 35 | ;; With a simple index 36 | (is (= (set (mapv :id (store/cursor store :name "Flora" "Flora"))) #{4 5})) 37 | (is (= (set (mapv :id (store/fetch store :name "Flora"))) #{4 5})) 38 | 39 | ;; With a compound index 40 | (is (= (mapv :id (store/cursor store :income-alpha)) [6 5 1 2 3 4])) 41 | (is (= (mapv :id (store/cursor store :income-alpha #js [10 "Fred"] #js [20 "Apple"])) 42 | [1 2 3])) 43 | 44 | ;; Test deletion 45 | (store/delete! store 2) 46 | (is (nil? (store 2))) 47 | (is (= (mapv :id (store/cursor store :income-alpha)) [6 5 1 3 4])))) 48 | 49 | (deftest references 50 | (let [store (store/create)] 51 | (doto store 52 | (store/insert! #js {:id 1 :type :account :name "Ian" :friend (store/reference store 2)}) 53 | (store/insert! #js {:id 2 :type :account :name "Fred" :friend (store/reference store 3)}) 54 | (store/insert! #js {:id 3 :type :account :name "Pam" 55 | :children #js [(store/reference store 4) (store/reference store 5)]}) 56 | (store/insert! #js {:id 4 :type :account :name "Jack"}) 57 | (store/insert! #js {:id 5 :type :account :name "Jill"})) 58 | (is (= (:name (:friend (store 1))) (:name (store 2)))) 59 | (is (= (:name (:friend (store 2))) (:name (store 3)))) 60 | (is (= (:name (get-in (store 1) [:friend :friend])) "Pam")) 61 | (is (= (mapv :name (:children (store 3))) ["Jack" "Jill"])))) 62 | 63 | 64 | (defnd income [store value] 65 | (mapv :id (store/cursor store :income value value))) 66 | 67 | (defnd by-name [store nam] 68 | (mapv :id (store/cursor store :name nam nam))) 69 | 70 | (deftest derive-integration 71 | (let [store (store/create)] 72 | (store/ensure-index store :name :name) 73 | (store/ensure-index store :income :income) 74 | (insert-population store) 75 | (with-tracked-dependencies [(fn [a b] nil)] 76 | (is (= (count (by-name store "Flora")) 2)) 77 | (is (= (count (by-name store "Apple")) 1)) 78 | (is (= (count (income store 10)) 3)) 79 | (is (= (count (income store 20)) 2)) 80 | (is (= (count (income store 5)) 1)) 81 | (is (= (count (income store 0)) 0))))) 82 | 83 | 84 | ;(deftest multi-index 85 | ; (let [idx (store/multi-index :a comparator)] 86 | ; (store/insert! idx (js-obj :a [1 2] :name "one-two")) 87 | ; (store/insert! idx (js-obj :a [3 4] :name "three-four")) 88 | ; (store/insert! idx (js-obj :a [2 4] :name "even")) 89 | ; (is (= (set (into [] (store/cursor idx 2 3))) 90 | ; #{"one-two" "three-four" "even"})))) 91 | 92 | 93 | (deftest clear-db 94 | (let [store (store/create)] 95 | (store/ensure-index store :name :name) 96 | (insert-population store) 97 | (is (= (:id (store 2)) 2) 98 | (is (= (count (by-name store "Flora")) 2))) 99 | (store/clear! store) 100 | (is (nil? (:id (store 2)))) 101 | (is (= (count (by-name store "Flora")) 0)))) 102 | 103 | 104 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | NativeStore 2 | =========== 3 | 4 | NativeStore is an explicitly indexed in-memory datastore for managing 5 | native objects. It supports the 6 | [Derive](http://github.com/vitalreactor/derive) library's dependency 7 | tracking protocol. 8 | 9 | NativeStore is best thought of as an in-memory heap with database-like 10 | semantics on which one or more ordered indexes can be defined. 11 | Objects can be insert!'ed and remove!'ed. Insert operations have 12 | upsert-merge semantics, combining the key-value set of the new object 13 | with the existing state. The transaction! function enables you to 14 | perform a set of updates and inform listeners of the aggregate updates 15 | rather than on each primitive insert! operation. 16 | 17 | ## Tutorial 18 | 19 | The best way to become familiar with native store 20 | 21 | ```clj 22 | user=> (require '[nativestore.core :as store]) 23 | ``` 24 | 25 | ### Store Interface 26 | 27 | NativeStore indexes a heap of native javascript objects uniquely 28 | identified by a root key "id". It has a simple public API. 29 | 30 | Add, removing, and retrieve objects: 31 | 32 | ```clj 33 | (let [store (store/create)] ;; Returns a mutable store object 34 | (store/insert! store obj) ;; Insert object in DB and return 35 | (store/delete! store id) ;; Delete object by ID 36 | (store/transact! store fn) ;; Batch multiple inserts/deletes 37 | (get store id) ;; Return object for id 38 | (store id) ;; A store implements IKeywordLookup 39 | ``` 40 | 41 | Declare and use an index on the store. Objects that return nil when 42 | passed to key-fn are not indexed. 43 | 44 | ```clj 45 | (store/ensure-index store name key-fn) ;; Declare an index with default sorting on key 46 | (store/ensure-index store name key-fn comparator-fn) 47 | (store/ensure-index store name index) ;; Add an explicit index (see below) 48 | ``` 49 | 50 | You'll want to use the explicit index form for things like compound 51 | indexes. An ordered index is the default. 52 | 53 | ```clj 54 | user=> (->> (store/ordered-index (store/field-key :lastname) compare) 55 | (store/ensure-index store :lastname)) 56 | 57 | user=> (->> (store/compound-index [:lastname :age] [compare >]) 58 | (store/ensure-index store :name-age)) 59 | ``` 60 | 61 | ### Store Cursors 62 | 63 | Indexes are based on the Closure library's binary search operation 64 | over arrays or standard JS object hashes. The only public interface 65 | to indexes is a Cursor object. A Cursor maintains pointers into the 66 | materialized array index and provides read-only access to the collection. 67 | 68 | Cursors are reducable (implement IReduce) so you can use them with 69 | transducers and standard seq operations such as map, into, etc. They 70 | do not, however, implement the seq protocol as they are a wrapper 71 | around a native read-only array. Cursors are not guaranteed to be 72 | valid across transaction/insert! boundaries so should be used in 73 | contexts with finite extent. 74 | 75 | ```clj 76 | (store/cursor store) ;; A collection over the whole store 77 | (store/cursor store index-name) ;; A collection over the whole index 78 | (store/cursor store index-name start) ;; Collection over index starting at start 79 | (store/cursor store index-name start end) ;; Range over the index 80 | ``` 81 | 82 | Some examples of use: 83 | 84 | ```clj 85 | (store/insert! store #js {:id 1 :firstname "Joe" :lastname "Smith"}) 86 | (store/insert! store #js {:id 2 :firstname "Fred" :lastname "Savage"}) 87 | (store/insert! store #js {:id 3 :firstname "Larry" :lastname "Stooge"}) 88 | (store/insert! store #js {:id 4 :firstname "Curly" :lastname "Stooge"}) 89 | (store/insert! store #js {:id 5 :firstname "Mo" :lastname "Stooge"}) 90 | (store/insert! store #js {:id 6 :firstname "Reginald" :lastname "Quince"}) 91 | 92 | (->> (store/cursor :name) 93 | (into [])) 94 | 95 | (let [xform (comp (map :firstname) (map count))] 96 | (into [] xform (store/cursor :name))) 97 | 98 | 99 | (defn running-avg 100 | "Reducing function for computing the running average (mutates)" 101 | ([] (js-obj "sum" 0 "cnt" 0)) 102 | ([avg] (/ (aget avg "sum") (aget avg "cnt"))) 103 | ([avg val] 104 | (aset avg "sum" (+ (aget avg "sum") val)) 105 | (aset avg "cnt" (inc (aget avg "cnt"))) 106 | avg)) 107 | 108 | (defn td-avg-string-len 109 | "Transducer that computes average string length of a collection" 110 | [key coll] 111 | (let [xform (comp (map key) (remove empty?) (map count))] 112 | (->> (transduce xform running-avg coll) 113 | (running-avg)))) 114 | 115 | (->> (store/cursor :name) 116 | (td-avg-string-len :firstname)) 117 | ``` 118 | 119 | ### The Native Type 120 | 121 | When you add an object to a store, NativeStore upgrades its type to native 122 | which operates just like a native object, but adds a few features 123 | and protocol implementations. 124 | 125 | ```clj 126 | user=> (def obj (as-native #js {:firstname "John" :lastname "Smith" :age 23})) 127 | #native {:firstname "John" :lastname "Smith" :age 23} 128 | 129 | user=> (:firstname obj) ;; Keyword access 130 | "John" 131 | 132 | user=> (obj :firstname) ;; Map-like interface 133 | "John" 134 | 135 | user=> (assoc obj :firstname "Fred") ;; via shallow clone 136 | #native {:firstname "Fred" :lastname "Smith" :age 23} 137 | 138 | user=> obj 139 | #native {:firstname "John" :lastname "Smith" :age 23} 140 | 141 | user=> (assoc! obj :firstname "Johnny") ;; mutating 142 | #native {:firstname "Johnny" :lastname "Smith" :age 23} 143 | 144 | user=> obj 145 | #native {:firstname "Johnny" :lastname "Smith" :age 23} 146 | 147 | user=> (store 1) 148 | #native {:id 1 :firstname "Joe" :lastname "Smith"} 149 | 150 | user=> (assoc! (store 1) :firstname "Joseph") 151 | ;; ERROR! The store returns read only natives 152 | 153 | user=> (assoc (store 1) :firstname "Joseph") 154 | #native {:id 1 :firstname "Joeseph" :lastname "Smith"} 155 | 156 | ``` 157 | 158 | Native objects support the common clojurescript interfaces countable, 159 | assocable, transient, and lookup. Standard assoc operations return 160 | _shallow_ clones of objects with the new change. assoc! is 161 | an abstraction over aset. 162 | 163 | Native objects stored in the store are marked read-only on insertion. 164 | When native objects are cloned the read-only setting is cleared, 165 | allowing assoc'ed copies to be freely mutated by downstream code. The 166 | database state object can be updated by calling insert! on the 167 | store with the mutated object. 168 | 169 | The intent with Native objects is to encourage the use of Clojure 170 | idioms on native objects so we can enforce constraints like read-only 171 | (to avoid pernicious changes to the datastore) and dependency tracking 172 | when accessing referenced objects. 173 | 174 | ## References 175 | 176 | We also provide a Reference type to simplify modeling state that has a 177 | relational or graph-like structure. When the clojure API is used to 178 | access a Native attribute, if the resulting value implements the 179 | IReference protocol, the reference is followed and the referenced 180 | value returned instead. This is implemented as a deftype which 181 | maintains a reference to the store value and the root ID to lookup 182 | ("id"). 183 | 184 | References are usually setup at import time: 185 | 186 | ```clj 187 | user=> (store/insert! store #js {:id 104 :firstname "Sally" :lastname "Smith" 188 | :father (store/reference 101)}) 189 | user=> (store/insert! store #js {:id 105 :firstname "Johnny" :lastname "Smith" 190 | :father (store/reference 101)}) 191 | user=> (store/insert! store 192 | #js {:id 101 :firstname "Joe" :lastname "Smith" 193 | :children [(store/reference store 104) 194 | (store/reference store 105)]}) 195 | ``` 196 | 197 | References are supported by the keyword access protocol and unpacked when 198 | read by looking up the current value of the object in the database. 199 | 200 | ```clj 201 | user=> (get-in (store 104) [:father :firstname]) 202 | "Joe" 203 | 204 | user=> (mapv :firstname (:children (store 101))) 205 | ["Sally" "Johnny"] 206 | ``` 207 | 208 | # Derive Integration 209 | 210 | One of the design goals for NativeStore was to provide a foundation for 211 | the concepts in the [Derive](http://github.com/vitalreactor/derive) library. 212 | Because maintaining copies of mutable objects can be error prone, we would like 213 | to carefully bound the lifecycle of a set of queried objects so they are not 214 | used again unless they are guaranteed to be "current". (Datomic-style immutable value 215 | semantics are not a goal of NativeStore, although history and recoverability 216 | may be -- see below). 217 | 218 | Derive helps us define functions using the macro `defnd` that always 219 | return a value computed from the latest state of the database, but 220 | without recomputing the result each time. Instead, the function 221 | subscribes to updates from the database and invalidates results iff 222 | the query result would depend on the latest changes. 223 | 224 | ```clj 225 | (defnd note-view [store note-id] 226 | (let [note (store note-id)] 227 | (-> note 228 | (update-in :content render-markdown) ;; make a copy 229 | (assoc! :last-edited (date-str (:last-edited note)))))) 230 | ``` 231 | 232 | This function memoizes the result of the call along with the dependencies of 233 | the query (here just the note-id) reported by the store during the execution 234 | of the defnd's body. Callers of defnd, such as an Om render method, can use 235 | `on-changes` to capture dynamic dependences and invoke a callback when any 236 | of those dependencies change. e.g. 237 | 238 | ```clj 239 | (render [_] 240 | (derive/on-changes [(derive/om-subscribe-handler owner) #(om/refresh! owner)] 241 | (render-note (note-view (om/get-shared owner :store) note-id)))) 242 | ``` 243 | 244 | The Om subscription handler manages storing the handler and clearing 245 | it when a new callback is being subscribed. You can also implement a 246 | will-unmount handler using `derive/om-unsubscribe-component` to 247 | unregister the callback when the component is re-rendered or unmounted 248 | to avoid memory leaks. The refresh function is called when new 249 | dependencies are written. 250 | 251 | Here is a more complete derive function involving copying and mutation 252 | of the retrieved data. 253 | 254 | ``` 255 | (defnd note-view [store note-id] 256 | (let [note (db note-id) 257 | sender (:sender note)] ;; via native refs 258 | (-> note 259 | (assoc :note-class (f-of-note note) ;; ensure a copy 260 | (update-in! :date human-readable) ;; mutation 261 | (assoc! :content escape-content))))) ;; mutation 262 | ``` 263 | 264 | Overwriting the original note would pullute the DB in an untrackable 265 | way so is an error (via the read-only flag on natives) but the copy is 266 | mutable. Attribute references that use the reference object also 267 | participate in the dependency tracking protocol. 268 | 269 | 270 | # Caveat emptor 271 | 272 | The immutable abstraction of NativeStore is not rigorously enforced. 273 | Some critical things you should keep in mind: 274 | 275 | - Transactions are not ACID. They are Consistent and Isolated (by 276 | virtue of javascript's single-threadedness). While side effects are 277 | computed atomically, they are not strictly Atomic as errors will 278 | leave the database in an inconsistent state. There are no 279 | persistence or Durability guarantees either. 280 | - It is currently an error to mutate a database object within a transaction 281 | function without calling insert! to update the indices. In the future 282 | we will track reads and conservatively assume that the transaction 283 | side effects any object it touches. 284 | - Native objects may not be mutated outside transactions unless they are 285 | first copied. This is to inhibit side effects to the DB outside of transaction 286 | functions and insert!/remove!. 287 | - Object identity is retained across inserts (changes are written into 288 | the original object), but code should not depend on identity or '=' 289 | remaining valid across transactions. 290 | - Database cursors are invalidated by transactions. There are 291 | currently no checks for cursor invalidation, so it is best to use 292 | cursors in contexts with finite extent. 293 | - Conventions are only enforced if you stick to clojure interfaces. 294 | aget, aset, and direct member access bypass reference resolution, 295 | read-only enforcemenet, etc. However, if you kow what you are doing 296 | you can still access values using constructs like (aget native 297 | "field") and get near-optimal read performance on natives. 298 | - The store does not currently maintain historical versioning or a 299 | transaction log, although future versions are likely to support these 300 | features to enable efficient snapshotting and restoration of system 301 | state. 302 | 303 | All these tradeoffs may be reconsidered in future revisions of the 304 | NativeStore. NativeStore should be considered at an Alpha level of 305 | completeness. 306 | 307 | Use NativeStore responsibly. We emphasized performance with 308 | reasonable flexiblity and safety. Adherence to the conventions 309 | mentioned above is crucial to avoid misusing the tool and creating 310 | difficult to track down bugs. 311 | 312 | 313 | 314 | 315 | 316 | -------------------------------------------------------------------------------- /src/nativestore/core.cljs: -------------------------------------------------------------------------------- 1 | (ns nativestore.core 2 | (:require [goog.object :as gobj] 3 | [goog.array :as garr] 4 | [derive.core :as d :refer-macros [with-tracked-dependencies defnd]])) 5 | 6 | ;; 7 | ;; Legacy JS wrappers 8 | ;; 9 | 10 | (defn js-strkey [x] 11 | (cond 12 | (string? x) x 13 | (keyword? x) (name x) 14 | :else (str x))) 15 | 16 | (defn js-lookup 17 | ([o k] 18 | (aget o (js-strkey k))) 19 | ([o k not-found] 20 | (let [s (js-strkey k)] 21 | (if-let [res (aget o s)] 22 | res 23 | not-found)))) 24 | 25 | (defn js-copy 26 | [o] 27 | (let [t (js/goog.typeOf o)] 28 | (cond (= t "array") (garr/clone o) 29 | :else (gobj/clone o)))) 30 | 31 | (defn js-assoc 32 | ([o k v] 33 | (do (aset o (js-strkey k) v) 34 | o)) 35 | ([o k v & more] 36 | (js-assoc o k v) 37 | (if more 38 | (recur o (first more) (second more) (nnext more)) 39 | o))) 40 | 41 | (defn js-dissoc 42 | [o k & more] 43 | (js-delete o (js-strkey k)) 44 | (if more 45 | (recur o (first more) (next more)) 46 | o)) 47 | 48 | ;; 49 | ;; Store protocols 50 | ;; ============================ 51 | 52 | ;; + ILookup 53 | (defprotocol IStore 54 | (insert! [store obj]) ;; shallow merge upsert of native objects 55 | (delete! [store id])) ;; delete, only need primary ID in submitted object 56 | 57 | ;; CompFn(KeyFn(obj)) -> value, obj 58 | (defprotocol IIndex 59 | (key-fn [idx]) 60 | (index! [idx obj]) 61 | (unindex! [idx obj])) 62 | 63 | (defprotocol IClearable 64 | (clear! [idx])) 65 | 66 | (defprotocol ISortedIndex 67 | (comparator-fn [idx])) 68 | 69 | (defprotocol IScannable 70 | (-get-cursor [idx] [idx start] [idx start end])) 71 | 72 | (defprotocol IIndexedStore 73 | (add-index! [store name index]) 74 | (rem-index! [store name]) 75 | (get-index [store name])) 76 | 77 | (defprotocol ITransactionalStore 78 | (-transact! [store f args])) 79 | 80 | ;; 81 | ;; Native Dependencies 82 | ;; ============================ 83 | 84 | ;; A dependency representation is: 85 | ;; 86 | ;; #js { root: #js [ ...] 87 | ;; : #js [start end] } 88 | ;; 89 | ;; The root is a sorted list of object IDs (reference traversal or direct lookups) 90 | ;; The remaining index lookups maintain value ranges traversed 91 | ;; These become set intersection and range overlap calculations when testing 92 | ;; for the impact of a transaction 93 | ;; 94 | ;; The left side dependency is mutated and returned by all operations 95 | ;; 96 | 97 | (defn- sorted-insert! 98 | "Mutates r1. Keep list of merged IDs in sorted order" 99 | [r1 r2] 100 | (goog.array.forEach r2 (fn [v i a] (goog.array.binaryInsert r1 v)))) 101 | 102 | (defn- merge-range! 103 | "Mutates r1. The updated range becomes the union of the two ranges" 104 | [compfn range1 range2] 105 | (let [r1s (aget range1 0) 106 | r1e (aget range1 1) 107 | r2s (aget range2 0) 108 | r2e (aget range2 1)] 109 | (when (< (compfn r2s r1s) 0) 110 | (aset range1 0 r2s)) 111 | (when (> (compfn r2e r1e) 0) 112 | (aset range1 1 r2e)))) 113 | 114 | (defn- merge-index! 115 | "Merge the index range or root set" 116 | [nset idx range1 range2] 117 | #_(println "idx: " (type idx) "r1: " range1 "r2: " range2 "\n") 118 | (if (nil? idx) ; root? 119 | (sorted-insert! range1 range2) 120 | (merge-range! (comparator-fn idx) range1 range2))) 121 | 122 | (defn- intersect? 123 | "Do two sorted sets of integers intersect?" 124 | [set1 set2] 125 | #_(println "Intersect? " set1 set2) 126 | (let [len1 (if (nil? set1) 0 (alength set1)) 127 | len2 (if (nil? set2) 0 (alength set2))] 128 | (loop [i 0 j 0] 129 | (if (or (== i len1) (== j len2)) 130 | false 131 | (let [v1 (aget set1 i) 132 | v2 (aget set2 j)] 133 | (cond (= v1 v2) true 134 | (> (compare v1 v2) 0) (recur i (inc j)) 135 | :default (recur (inc i) j))))))) 136 | 137 | ;; (0 10) (2 2) => true 138 | ;; (10 20) (5 5) => false 139 | ;; (10 20) (0 10) => true 140 | ;; (10 20) (0 nil) => true 141 | ;; (10 nil) (20 20) => true 142 | (defn- overlap? 143 | "Does the interval of other overlap this?" 144 | [compfn range1 range2] 145 | (let [r1s (aget range1 0) 146 | r1e (aget range1 1) 147 | r2s (aget range2 0) 148 | r2e (aget range2 1) 149 | res (not (or (if (nil? r1e) (< (compfn r2e r1s) 0) (> (compfn r2s r1e) 0)) 150 | (if (nil? r2e) (< (compfn r1e r2s) 0) (< (compfn r2e r1s) 0))))] 151 | #_(println "Overlap? " range1 range2 res) 152 | res)) 153 | 154 | 155 | (defn- match-index? 156 | [nset idx this-range other-range] 157 | #_(println "Matching index: " this-range " " other-range "\n") 158 | (if (nil? idx) ; root? 159 | (intersect? this-range other-range) 160 | (overlap? (comparator-fn idx) this-range other-range))) 161 | 162 | (deftype NativeDependencySet [store deps] 163 | IPrintWithWriter 164 | (-pr-writer [native writer opts] 165 | (-write writer (str "#ndep [" (pr-str deps) "]"))) 166 | 167 | IHash 168 | (-hash [o] 169 | (goog/getUid o)) 170 | 171 | IEquiv 172 | (-equiv [o other] 173 | (if (instance? NativeDependencySet other) 174 | (== (-hash o) (-hash other)) 175 | false)) 176 | 177 | d/IDependencySet 178 | (merge-deps [nset other] 179 | #_(println "NSet merge: " (type store) deps other "\n") 180 | (let [fdeps (if (nil? (.-deps other)) other (.-deps other))] 181 | (goog.object.forEach 182 | fdeps (fn [v k] 183 | (if-let [mine (aget deps k)] 184 | (merge-index! nset (get-index store k) mine v) 185 | (aset deps k (js-copy v))))) 186 | nset)) 187 | 188 | (match-deps [nset other] 189 | (let [fdeps (if (nil? (.-deps other)) other (.-deps other))] 190 | #_(println "Matching: " deps fdeps "\n") 191 | (goog.object.some 192 | fdeps (fn [v k o] #_(println "matching-key: " k "\n") 193 | (when-let [local (aget deps k)] 194 | (match-index? nset (get-index store k) local v))))))) 195 | 196 | 197 | (defn make-dependencies 198 | ([store] (NativeDependencySet. store #js {})) 199 | ([store init] (NativeDependencySet. store init))) 200 | 201 | (defn inform-tracker 202 | ([store deps] 203 | (when (d/tracking?) 204 | (inform-tracker d/*tracker* store deps))) 205 | ([tracker store deps] 206 | (let [dset (make-dependencies store deps)] 207 | #_(.log js/console "Informing tracker: " dset " t? " d/*tracker* "\n") 208 | (d/depends! tracker store dset)))) 209 | 210 | ;; 211 | ;; Instance protocols 212 | ;; ============================ 213 | 214 | (def ^{:doc "Inside a transaction?" 215 | :dynamic true} 216 | *transaction* nil) 217 | 218 | ;; A reference wraps a lookup into a store 219 | ;; Objects implementing ILookup can test for a 220 | ;; IReference and dereference it. 221 | 222 | (defprotocol IReference 223 | (resolve-ref [ref]) 224 | (reference-id [ref]) 225 | (reference-db [ref])) 226 | 227 | (deftype NativeReference [store id] 228 | IPrintWithWriter 229 | (-pr-writer [native writer opts] 230 | (-write writer (str "#ref [" id "]"))) 231 | 232 | IEquiv 233 | (-equiv [ref other] 234 | (and (= store (.-store other)) 235 | (= id (.-id other)))) 236 | 237 | IReference 238 | (resolve-ref [_] (get store id)) 239 | (reference-id [_] id) 240 | (reference-db [_] store)) 241 | 242 | (declare native?) 243 | 244 | (defn reference [db obj] 245 | (NativeReference. 246 | db (cond (or (string? obj) (number? obj) (not (native? obj))) 247 | obj 248 | (native? obj) 249 | (let [id ((key-fn (.-root db)) obj)] 250 | (assert id "native object must have an id") 251 | id)))) 252 | 253 | (defn identity? [n1 n2] 254 | (= (aget n1 "id") (aget n2 "id"))) 255 | 256 | ;; 257 | ;; Low level methods 258 | ;; 259 | 260 | ;; Mutation can only be done on Natives in 261 | ;; a transaction or on copies of Natives generated 262 | ;; via copying assoc or clone 263 | 264 | (defprotocol IReadOnly 265 | (-read-only? [_])) 266 | 267 | (defprotocol INative) 268 | 269 | (deftype Native [__keyset ^:mutable __ro] 270 | INative 271 | 272 | ICloneable 273 | (-clone [this] 274 | (let [clone (Native. (volatile! @__keyset) false)] 275 | (doseq [key @__keyset] 276 | (aset clone (name key) (aget this (name key)))) 277 | clone)) 278 | 279 | IEmptyableCollection 280 | (-empty [_] (Native. (volatile! #{}) false)) 281 | 282 | IReadOnly 283 | (-read-only? [_] __ro) 284 | 285 | ICounted 286 | (-count [native] 287 | (count @__keyset)) 288 | 289 | ILookup 290 | (-lookup [native k] 291 | (-lookup native k nil)) 292 | (-lookup [native k not-found] 293 | (assert (keyword? k)) 294 | (let [v (aget native (name k))] 295 | (cond 296 | (nil? v) not-found 297 | (array? v) (if (satisfies? IReference (aget v 0)) 298 | (amap v i ret (resolve-ref (aget v i))) 299 | v) 300 | (satisfies? IReference v) (resolve-ref v) 301 | :default v))) 302 | 303 | ITransientAssociative 304 | (-assoc! [native k v] 305 | (assert (keyword? k)) 306 | (when (and (-read-only? native) (not *transaction*)) 307 | (throw (js/Error. "Cannot mutate store values outside transact!: "))) 308 | (vswap! __keyset conj k) 309 | (aset native (name k) v) 310 | native) 311 | 312 | ITransientCollection 313 | (-conj! [native [k v]] 314 | (assert (keyword? k)) 315 | (-assoc! native k v)) 316 | 317 | ITransientMap 318 | (-dissoc! [native k] 319 | (assert (keyword? k)) 320 | (when (and (-read-only? native) (not *transaction*)) 321 | (throw (js/Error. "Cannot mutate store values outside transact!: "))) 322 | (vswap! __keyset disj k) 323 | (js-delete native (name k)) 324 | native) 325 | 326 | IAssociative 327 | (-assoc [native k v] 328 | (assert (keyword? k)) 329 | (let [new (clone native)] 330 | (-assoc! new k v))) 331 | 332 | IMap 333 | (-dissoc [native k] 334 | (assert (keyword? k)) 335 | (let [new (clone native)] 336 | (-dissoc! new k))) 337 | 338 | ICollection 339 | (-conj [native [k v]] 340 | (assert (keyword? k)) 341 | (-assoc native k v)) 342 | 343 | ISeqable 344 | (-seq [native] 345 | (map (fn [k] [(keyword k) (aget native (name k))]) @__keyset)) 346 | 347 | IEncodeClojure 348 | (-js->clj [native opts] 349 | native) 350 | 351 | IPrintWithWriter 352 | (-pr-writer [native writer opts] 353 | (-write writer "#native ") 354 | (print-map (-seq native) 355 | pr-writer writer opts))) 356 | 357 | (defn native 358 | "Return a fresh native, optionally with the read-only set" 359 | ([] (native false)) 360 | ([ro?] (Native. (volatile! #{}) ro?))) 361 | 362 | (defn native? 363 | "Is this object a #native?" 364 | [native] 365 | (satisfies? INative native)) 366 | 367 | (defn to-native 368 | "Copying conversion function, will return 369 | a fresh, writable, #native" 370 | [obj] 371 | (cond (native? obj) (clone obj) 372 | (object? obj) (let [native (native false)] 373 | (goog.object.forEach obj (fn [v k] (-assoc! native (keyword k) v))) 374 | native) 375 | (seqable? obj) (let [native (native false)] 376 | (doseq [key (keys obj)] 377 | (-assoc! native (keyword key) (get obj (name key))))) 378 | :default (throw js/Error (str "Trying to convert unknown object type" (type obj))))) 379 | 380 | (defn read-only! 381 | [native] 382 | {:pre [(native? native)]} 383 | (set! (.-__ro native) true) 384 | native) 385 | 386 | (defn read-only? 387 | [native] 388 | {:pre [(native? native)]} 389 | (-read-only? native)) 390 | 391 | (defn writeable! 392 | [native] 393 | {:pre [(native? native)]} 394 | (set! (.-__ro native) false) 395 | native) 396 | 397 | 398 | 399 | ;; 400 | ;; Native object store 401 | ;; ============================ 402 | 403 | (defn- upsert-merge 404 | "Only called from internal methods" 405 | ([o1 o2] 406 | ;; allow updates 407 | (binding [*transaction* (if *transaction* *transaction* true)] 408 | (doseq [k (keys o2)] 409 | (let [kstr (name k)] 410 | (if-not (nil? (aget o2 kstr)) 411 | (-assoc! o1 k (aget o2 kstr)) 412 | (-dissoc! o1 k))))) 413 | o1) 414 | ([o1 o2 & more] 415 | (apply upsert-merge (upsert-merge o1 o2) more))) 416 | 417 | ;; Return a cursor for walking a range of the index 418 | (deftype Cursor [idx start end ^:mutable valid? empty?] 419 | IReduce 420 | (-reduce [this f] 421 | (-reduce this f (f))) 422 | (-reduce [this f init] 423 | (if empty? 424 | init 425 | (let [a (or (.-arry idx) (aget idx "arry"))] 426 | (loop [i start ret init] 427 | (if (<= i end) 428 | (recur (inc i) (f ret (aget a i))) 429 | ret))))) 430 | 431 | ISeqable 432 | (-seq [this] 433 | (seq (into [] this)))) 434 | 435 | 436 | ;(deftype WrappedCursor [idx start end ^:mutable valid?] 437 | ; IReduce 438 | ; (-reduce [this f] 439 | ; (-reduce this f (f))) 440 | ; (-reduce [this f init] 441 | ; (let [a (.-arry idx)] 442 | ; (loop [i start ret init] 443 | ; (if (<= i end) 444 | ; (recur (inc i) (f ret (aget a i))) 445 | ; ret))))) 446 | 447 | ;; Hash KV Index, meant to be for a root store index (unique keys) 448 | ;; - Merging upsert against existing if keyfn output matches 449 | ;; - Nil values in provided object deletes keys 450 | ;; - Original object maintains identity 451 | (deftype HashIndex [keyfn hashmap] 452 | ILookup 453 | (-lookup [idx val] 454 | (-lookup idx val nil)) 455 | (-lookup [idx val not-found] 456 | (js-lookup hashmap val not-found)) 457 | 458 | IFn 459 | (-invoke [idx k] 460 | (-lookup idx k)) 461 | (-invoke [idx k not-found] 462 | (-lookup idx k not-found)) 463 | 464 | ICounted 465 | (-count [idx] (alength (js-keys hashmap))) 466 | 467 | IIndex 468 | (key-fn [idx] keyfn) 469 | (index! [idx obj] 470 | (let [key (keyfn obj) 471 | old (js-lookup hashmap key)] 472 | (js-assoc hashmap key (if old (upsert-merge old obj) obj)))) 473 | (unindex! [idx obj] 474 | (let [key (keyfn obj)] 475 | (js-dissoc hashmap key obj))) 476 | 477 | IClearable 478 | (clear! [idx] 479 | (goog.array.clear hashmap)) 480 | 481 | IScannable 482 | (-get-cursor [idx] 483 | (let [vals (js-obj "arry" (goog.object.getValues (.-hashmap idx)))] 484 | (Cursor. vals 0 (dec (alength (aget vals "arry"))) true false))) 485 | (-get-cursor [idx start] 486 | (assert false "Hash index does not support range queries")) 487 | (-get-cursor [idx start end] 488 | (assert false "Hash index does not support range queries"))) 489 | 490 | (defn root-index [] 491 | (HashIndex. #(aget % "id") #js {})) 492 | 493 | ;; KV index using binary search/insert/remove on array 494 | ;; - Always inserts new objects in sorted order 495 | ;; - Matches on object identity for unindex! 496 | (deftype BinaryIndex [keyfn compfn arry] 497 | ILookup 498 | (-lookup [idx val] 499 | (-lookup idx val nil)) 500 | (-lookup [idx val not-found] 501 | (let [index (goog.array.binarySearch arry val #(compfn %1 (keyfn %2)))] 502 | (if (>= index 0) 503 | (loop [end index] 504 | (if (= (compfn val (keyfn (aget arry end))) 0) 505 | (recur (inc end)) 506 | (goog.array.slice arry index end))) 507 | not-found))) 508 | 509 | IFn 510 | (-invoke [idx k] 511 | (-lookup idx k)) 512 | (-invoke [idx k not-found] 513 | (-lookup idx k not-found)) 514 | 515 | IIndex 516 | (key-fn [idx] keyfn) 517 | (index! [idx obj] 518 | (let [loc (goog.array.binarySearch arry obj #(compfn (keyfn %1) (keyfn %2)))] 519 | (if (>= loc 0) 520 | (goog.array.insertAt arry obj loc) 521 | (goog.array.insertAt arry obj (- (inc loc))))) 522 | idx) 523 | (unindex! [idx obj] 524 | (let [loc (goog.array.indexOf arry obj)] 525 | (when (>= loc 0) 526 | (goog.array.removeAt arry loc))) 527 | idx) 528 | 529 | IClearable 530 | (clear! [idx] 531 | (goog.array.clear arry)) 532 | 533 | ISortedIndex 534 | (comparator-fn [idx] compfn) 535 | 536 | IScannable 537 | (-get-cursor [idx] 538 | (Cursor. idx 0 (dec (alength (.-arry idx))) true false)) 539 | (-get-cursor [idx start] 540 | (let [head (goog.array.binarySearch arry start #(compfn %1 (keyfn %2))) 541 | head (if (>= head 0) head (- (inc head)))] 542 | (Cursor. idx head (dec (alength (.-arry idx))) true false))) 543 | (-get-cursor [idx start end] 544 | (let [headidx (goog.array.binarySearch arry start #(compfn %1 (keyfn %2))) 545 | head (if (>= headidx 0) headidx (- (inc headidx))) 546 | tailidx (goog.array.binarySearch arry end #(compfn %1 (keyfn %2))) 547 | tail (if (>= tailidx 0) tailidx (- (inc tailidx))) 548 | tail (if (not (>= tail (alength (.-arry idx)))) 549 | (loop [tail tail] 550 | (let [next (keyfn (aget arry tail)) 551 | c (compfn end next)] 552 | (if (= c 0) 553 | (if (not= (inc tail) (alength (.-arry idx))) 554 | (recur (inc tail)) 555 | tail) 556 | (dec tail)))) 557 | tail)] 558 | (let [empty? (and (= head tail) (and (< tailidx 0) (< headidx 0)))] 559 | (Cursor. idx head tail true empty?))))) 560 | 561 | (defn ordered-index [keyfn compfn] 562 | (BinaryIndex. keyfn compfn (array))) 563 | 564 | ;; (deftype MultiIndex [keyfn bidx] 565 | ;; IIndex 566 | ;; (key-fn [idx] keyfn) 567 | ;; (index! [idx obj] 568 | ;; (let [vals (keyfn obj) 569 | ;; len (alength vals)] 570 | ;; (loop [i (alength vals)] 571 | ;; (when (< i len) 572 | ;; (index! bidx (array (aget vals i) obj)) 573 | ;; (recur (inc i)))))) 574 | ;; (unindex! [idx obj] 575 | ;; (let [arry (aget bidx "arry") 576 | ;; find (fn [obj] (goog.array.findIndex arry #(= (aget % 1) obj)))] 577 | ;; (loop [loc (find obj)] 578 | ;; (when (>= loc 0) 579 | ;; (goog.array.removeAt arry loc) 580 | ;; (recur (find obj)))))) 581 | 582 | ;; ISortedIndex 583 | ;; (comparator-fn [idx] 584 | ;; (comparator-fn bidx)) 585 | 586 | ;; IScannable 587 | ;; (-get-cursor [idx] 588 | ;; (let [cur (-get-cursor bidx)] 589 | ;; (WrappedCursor. (aget cur "idx") 590 | ;; (aget cur "start") 591 | ;; (aget cur "end") 592 | ;; #(aget % 1) 593 | ;; (aget cur "valid?")))) 594 | 595 | ;; (-get-cursor [idx start] 596 | ;; (let [cur (-get-cursor bidx start)] 597 | ;; (WrappedCursor. (aget cur "idx") 598 | ;; (aget cur "start") 599 | ;; (aget cur "end") 600 | ;; #(aget % 1) 601 | ;; (aget cur "valid?")))) 602 | 603 | ;; (-get-cursor [idx start end] 604 | ;; (let [cur (-get-cursor bidx start end)] 605 | ;; (WrappedCursor. (aget cur "idx") 606 | ;; (aget cur "start") 607 | ;; (aget cur "end") 608 | ;; #(aget % 1) 609 | ;; (aget cur "valid?"))))) 610 | 611 | ;; (defn multi-index [keyfn compfn] 612 | ;; (MultiIndex. keyfn (ordered-index #(aget val 0) compfn))) 613 | 614 | (defn compound-key-fn 615 | "Return a js array key for compound ordering" 616 | [keyfns] 617 | (let [cnt (count keyfns)] 618 | (fn [obj] 619 | (let [vals (new js/Array cnt)] 620 | (loop [i 0 keyfns keyfns] 621 | (if (empty? keyfns) 622 | vals 623 | (if-let [val ((first keyfns) obj)] 624 | (do (aset vals i val) 625 | (recur (inc i) (rest keyfns))) 626 | nil))))))) 627 | 628 | (defn compound-comparator 629 | "Compare two compound keys using the array of comparators" 630 | [comps] 631 | (let [cnt (count comps)] 632 | (fn [akey1 akey2] 633 | (loop [i 0 comps comps ans 0] 634 | (if-not (empty? comps) 635 | (let [comp (first comps) 636 | res (comp (aget akey1 i) (aget akey2 i))] 637 | (if (= res 0) 638 | (recur (inc i) (rest comps) res) 639 | res)) 640 | ans))))) 641 | 642 | (defn compound-index [keyfns compfns] 643 | (BinaryIndex. (compound-key-fn keyfns) (compound-comparator compfns) (array))) 644 | 645 | (defn- as-ro-native 646 | "Ensure submitted object is a native and set to read-only state" 647 | [obj] 648 | (if (native? obj) 649 | (read-only! obj) 650 | (let [native (to-native obj)] 651 | (read-only! native)))) 652 | 653 | (defn- update-listeners 654 | "Use this to update store listeners when write dependencies 655 | have been accumulatd" 656 | [result dmap] 657 | #_(.log js/console "Notifying listeners" dmap) 658 | (let [[store deps] (first dmap)] 659 | #_(.log js/console " Notifying store" store deps) 660 | (when store 661 | (d/notify-listeners store deps)))) 662 | 663 | ;; A native, indexed, mutable/transactional store 664 | ;; - Always performs a merging upsert 665 | ;; - Secondary index doesn't index objects for key-fn -> nil 666 | (deftype NativeStore [root indices tx-listeners ^:mutable listeners] 667 | IPrintWithWriter 668 | (-pr-writer [native writer opts] 669 | (-write writer (str "#NativeStore[]"))) 670 | 671 | ILookup 672 | (-lookup [store id] 673 | (-lookup store id nil)) 674 | (-lookup [store id not-found] 675 | (inform-tracker store (js-obj "root" (array id))) 676 | (-lookup root id not-found)) 677 | 678 | ICounted 679 | (-count [store] (-count root)) 680 | 681 | IFn 682 | (-invoke [store k] 683 | (-lookup store k nil)) 684 | (-invoke [store k not-found] 685 | (-lookup store k not-found)) 686 | 687 | IStore 688 | (insert! [store obj] 689 | ;; 1) Transactional by default or participates in wrapping transaction 690 | ;; Transaction listeners get a log of all side effects per transaction 691 | ;; 692 | ;; 2) Track side effects against indices, etc and forward to enclosing 693 | ;; transaction if present or notify active dependency listeners 694 | #_(.log js/console "Called insert!\n") 695 | ;; reuse this for writes instead of reads 696 | (with-tracked-dependencies [update-listeners] 697 | (let [obj (as-ro-native obj)] 698 | (let [key ((key-fn root) obj) 699 | _ (assert key "Must have an ID field") 700 | names (js-keys indices) 701 | old (get root key) 702 | oldref (when old (js-copy old))] 703 | ;; Unindex 704 | (when old 705 | (doseq [iname names] 706 | (let [idx (aget indices iname) 707 | ikey ((key-fn idx) old)] 708 | (when-not (or (nil? ikey) (= ikey false)) 709 | (inform-tracker store (js-obj (name iname) (array ikey ikey))) 710 | (unindex! idx old))))) 711 | ;; Merge-update the root 712 | #_(println "Informing tracker of root: " (js-obj "root" (array key)) "\n") 713 | (inform-tracker store (js-obj "root" (array key))) 714 | (index! root obj) ;; merging upsert 715 | (let [new (get root key)] 716 | ;; Re-insert 717 | (doseq [iname names] 718 | (let [idx (aget indices iname) 719 | ikey ((key-fn idx) new)] 720 | (when-not (or (nil? ikey) (= ikey false)) 721 | (inform-tracker store (js-obj (name iname) (array ikey ikey))) 722 | (index! idx new)))) 723 | ;; Update listeners 724 | (if *transaction* 725 | (.push *transaction* #js [:insert oldref new]) 726 | (-notify-watches store nil #js [#js [:insert oldref new]])))) 727 | store))) 728 | 729 | (delete! [store id] 730 | (with-tracked-dependencies [update-listeners] 731 | (when-let [old (get root id)] 732 | (doseq [iname (js-keys indices)] 733 | (let [idx (aget indices iname) 734 | ikey ((key-fn idx) old)] 735 | (when-not (or (nil? ikey) (= ikey false)) 736 | (inform-tracker store (js-obj (name iname) (array ikey ikey))) 737 | (unindex! idx old)))) 738 | (inform-tracker store (js-obj "root" (array id))) 739 | (unindex! root old) 740 | (if *transaction* 741 | (.push *transaction* #js [:delete old]) 742 | (-notify-watches store nil #js [:delete old]))) 743 | store)) 744 | 745 | IClearable 746 | (clear! [store] 747 | ;; Invalidate all listeners 748 | (d/force-invalidation store) 749 | ;; Cleanly remove data by reverse-walking the root 750 | (doseq [obj (seq (-get-cursor root))] 751 | (delete! store ((key-fn root) obj))) 752 | ;; Ensure we've cleared everything (e.g. dependency ordering problems) 753 | (doseq [iname (js-keys indices)] 754 | (clear! (aget indices iname))) 755 | (clear! root) 756 | store) 757 | 758 | IIndexedStore 759 | (add-index! [store iname index] 760 | (assert (not (get-index store iname))) 761 | (js-assoc indices iname index) 762 | store) 763 | (rem-index! [store iname] 764 | (assert (get-index store iname)) 765 | (js-dissoc indices iname) 766 | store) 767 | (get-index [store iname] 768 | (if (or (string? iname) (keyword? iname)) 769 | (js-lookup indices (name iname)) 770 | iname)) 771 | 772 | ITransactionalStore 773 | (-transact! [store f args] 774 | ;; TODO: separate process so we ignore read deps in transactions? 775 | (with-tracked-dependencies [update-listeners true] 776 | (binding [*transaction* #js []] 777 | (let [result (apply f store args)] 778 | (-notify-watches store nil *transaction*))))) 779 | 780 | IWatchable 781 | (-notify-watches [store _ txs] 782 | (doseq [name (js-keys tx-listeners)] 783 | (let [listener (aget tx-listeners name)] 784 | (listener nil txs))) 785 | store) 786 | (-add-watch [store key f] 787 | (js-assoc tx-listeners key f) 788 | store) 789 | (-remove-watch [store key] 790 | (js-dissoc tx-listeners key) 791 | store) 792 | 793 | d/IDependencySource 794 | (subscribe! [this listener] 795 | (set! listeners (update-in listeners [nil] (fnil conj #{}) listener))) 796 | (subscribe! [this listener deps] 797 | (set! listeners (update-in listeners [deps] (fnil conj #{}) listener))) 798 | (unsubscribe! [this listener] 799 | (let [old-set (get listeners nil) 800 | new-set (disj listeners listener)] 801 | (if (empty? new-set) 802 | (set! listeners (dissoc listeners nil)) 803 | (set! listeners (assoc listeners nil new-set))))) 804 | (unsubscribe! [this listener deps] 805 | (let [old-set (get listeners deps) 806 | new-set (when (set? old-set) (disj old-set listener))] 807 | (if (empty? new-set) 808 | (set! listeners (dissoc listeners deps)) 809 | (set! listeners (assoc listeners deps new-set))))) 810 | (empty-deps [this] (make-dependencies this))) 811 | 812 | 813 | (defn transact! [store f & args] 814 | (-transact! store f args)) 815 | 816 | (defn create [] 817 | (NativeStore. (root-index) #js {} #js {} {})) 818 | 819 | 820 | ;; 821 | ;; External interface 822 | ;; 823 | 824 | (defn fetch 825 | ([store key] 826 | (get store key)) 827 | ([store index key] 828 | (-> (get-index store index) (get key)))) 829 | 830 | (defn- first-val [idx] 831 | ((key-fn idx) (aget (.-arry idx) 0))) 832 | 833 | (defn- last-val [idx] 834 | ((key-fn idx) (aget (.-arry idx) (- (alength (.-arry idx)) 1)))) 835 | 836 | (defn cursor 837 | "Walk the entire store, or an index" 838 | ([store] 839 | ;; NOTE: No dependencies on whole DB 840 | (-get-cursor (.-root store))) 841 | ([store index] 842 | (let [iname (name index) 843 | index (get-index store iname)] 844 | (assert index (str "Index " iname " is not defined.")) 845 | (inform-tracker store (js-obj iname (array))) 846 | (-get-cursor index))) 847 | ([store index start] 848 | (let [iname (name index) 849 | index (get-index store index)] 850 | (assert index (str "Index " iname " is not defined.")) 851 | (inform-tracker store (js-obj iname (array start))) ;; shorthand 852 | (-get-cursor index start))) 853 | ([store index start end] 854 | (let [iname (name index) 855 | index (get-index store index)] 856 | (assert index (str "Index " iname " is not defined.")) 857 | (inform-tracker store (js-obj iname (array start end))) 858 | (-get-cursor index start end)))) 859 | 860 | (defn field-key [field] 861 | (let [f (name field)] 862 | (fn [obj] 863 | (aget obj f)))) 864 | 865 | (defn type-field-key [type field] 866 | (let [t (name type) 867 | f (name field)] 868 | (fn [obj] 869 | (when (= t (aget obj "type")) 870 | (aget obj f))))) 871 | 872 | (defn ensure-index 873 | ([store iname key comp] 874 | (when-not (get-index store iname) 875 | (add-index! store iname (ordered-index (if (fn? key) key (field-key key)) comp)))) 876 | ([store iname key-or-idx] 877 | (if (or (keyword? key-or-idx) (symbol? key-or-idx)) 878 | (ensure-index store iname key-or-idx compare) 879 | (when-not (get-index store iname) 880 | (add-index! store iname key-or-idx))))) ;; key is an index 881 | 882 | (comment 883 | (def store (native-store)) 884 | (add-index! store :name (ordered-index (field-key :name) compare)) 885 | (insert! store #js {:id 1 :type "user" :name "Fred"}) 886 | (insert! store #js {:id 2 :type "user" :name "Zoe"}) 887 | (insert! store #js {:id 3 :type "user" :name "Apple"}) 888 | (insert! store #js {:id 4 :type "user" :name "Flora"}) 889 | (insert! store #js {:id 5 :type "user" :name "Flora"}) 890 | (insert! store #js {:id 6 :type "tracker" :measure 2700}) 891 | (println "Get by ID" (get store 1)) 892 | (println "Get by index" (-> (get-index store :name) (get "Flora"))) 893 | (println (js->clj (r/reduce (cursor store :name) (d/map :id))))) ;; object #6 is not indexed! 894 | 895 | 896 | 897 | -------------------------------------------------------------------------------- /src/nativestore/heap.cljs: -------------------------------------------------------------------------------- 1 | (ns nativestore.heap 2 | (:require [goog.object :as gobj] 3 | [goog.array :as garr] 4 | [derive.core :as d :refer-macros [with-tracked-dependencies defnd]])) 5 | 6 | ;; 7 | ;; Legacy JS wrappers 8 | ;; 9 | 10 | (defn js-strkey [x] 11 | (cond 12 | (string? x) x 13 | (keyword? x) (name x) 14 | :else (str x))) 15 | 16 | (defn js-lookup 17 | ([o k] 18 | (aget o (js-strkey k))) 19 | ([o k not-found] 20 | (let [s (js-strkey k)] 21 | (if-let [res (aget o s)] 22 | res 23 | not-found)))) 24 | 25 | (defn js-copy 26 | [o] 27 | (let [t (js/goog.typeOf o)] 28 | (cond (= t "array") (garr/clone o) 29 | :else (gobj/clone o)))) 30 | 31 | (defn js-assoc 32 | ([o k v] 33 | (do (aset o (js-strkey k) v) 34 | o)) 35 | ([o k v & more] 36 | (js-assoc o k v) 37 | (if more 38 | (recur o (first more) (second more) (nnext more)) 39 | o))) 40 | 41 | (defn js-dissoc 42 | [o k & more] 43 | (js-delete o (js-strkey k)) 44 | (if more 45 | (recur o (first more) (next more)) 46 | o)) 47 | 48 | ;; 49 | ;; Store protocols 50 | ;; ============================ 51 | 52 | ;; + ILookup 53 | (defprotocol IStore 54 | (insert! [store obj]) ;; shallow merge upsert of native objects 55 | (delete! [store id])) ;; delete, only need primary ID in submitted object 56 | 57 | ;; CompFn(KeyFn(obj)) -> value, obj 58 | (defprotocol IIndex 59 | (key-fn [idx]) 60 | (index! [idx obj]) 61 | (unindex! [idx obj])) 62 | 63 | (defprotocol IClearable 64 | (clear! [idx])) 65 | 66 | (defprotocol ISortedIndex 67 | (comparator-fn [idx])) 68 | 69 | (defprotocol IScannable 70 | (-get-cursor [idx] [idx start] [idx start end])) 71 | 72 | (defprotocol IIndexedStore 73 | (add-index! [store name index]) 74 | (rem-index! [store name]) 75 | (get-index [store name])) 76 | 77 | (defprotocol ITransactionalStore 78 | (-transact! [store f args])) 79 | 80 | ;; 81 | ;; Native Dependencies 82 | ;; ============================ 83 | 84 | ;; A dependency representation is: 85 | ;; 86 | ;; #js { root: #js [ ...] 87 | ;; : #js [start end] } 88 | ;; 89 | ;; The root is a sorted list of object IDs (reference traversal or direct lookups) 90 | ;; The remaining index lookups maintain value ranges traversed 91 | ;; These become set intersection and range overlap calculations when testing 92 | ;; for the impact of a transaction 93 | ;; 94 | ;; The left side dependency is mutated and returned by all operations 95 | ;; 96 | 97 | (defn- sorted-insert! 98 | "Mutates r1. Keep list of merged IDs in sorted order" 99 | [r1 r2] 100 | (goog.array.forEach r2 (fn [v i a] (goog.array.binaryInsert r1 v)))) 101 | 102 | (defn- merge-range! 103 | "Mutates r1. The updated range becomes the union of the two ranges" 104 | [compfn range1 range2] 105 | (let [r1s (aget range1 0) 106 | r1e (aget range1 1) 107 | r2s (aget range2 0) 108 | r2e (aget range2 1)] 109 | (when (< (compfn r2s r1s) 0) 110 | (aset range1 0 r2s)) 111 | (when (> (compfn r2e r1e) 0) 112 | (aset range1 1 r2e)))) 113 | 114 | (defn- merge-index! 115 | "Merge the index range or root set" 116 | [nset idx range1 range2] 117 | #_(println "idx: " (type idx) "r1: " range1 "r2: " range2 "\n") 118 | (if (nil? idx) ; root? 119 | (sorted-insert! range1 range2) 120 | (merge-range! (comparator-fn idx) range1 range2))) 121 | 122 | (defn- intersect? 123 | "Do two sorted sets of integers intersect?" 124 | [set1 set2] 125 | #_(println "Intersect? " set1 set2) 126 | (let [len1 (if (nil? set1) 0 (alength set1)) 127 | len2 (if (nil? set2) 0 (alength set2))] 128 | (loop [i 0 j 0] 129 | (if (or (== i len1) (== j len2)) 130 | false 131 | (let [v1 (aget set1 i) 132 | v2 (aget set2 j)] 133 | (cond (= v1 v2) true 134 | (> (compare v1 v2) 0) (recur i (inc j)) 135 | :default (recur (inc i) j))))))) 136 | 137 | ;; (0 10) (2 2) => true 138 | ;; (10 20) (5 5) => false 139 | ;; (10 20) (0 10) => true 140 | ;; (10 20) (0 nil) => true 141 | ;; (10 nil) (20 20) => true 142 | (defn- overlap? 143 | "Does the interval of other overlap this?" 144 | [compfn range1 range2] 145 | (let [r1s (aget range1 0) 146 | r1e (aget range1 1) 147 | r2s (aget range2 0) 148 | r2e (aget range2 1) 149 | res (not (or (if (nil? r1e) (< (compfn r2e r1s) 0) (> (compfn r2s r1e) 0)) 150 | (if (nil? r2e) (< (compfn r1e r2s) 0) (< (compfn r2e r1s) 0))))] 151 | #_(println "Overlap? " range1 range2 res) 152 | res)) 153 | 154 | 155 | (defn- match-index? 156 | [nset idx this-range other-range] 157 | #_(println "Matching index: " this-range " " other-range "\n") 158 | (if (nil? idx) ; root? 159 | (intersect? this-range other-range) 160 | (overlap? (comparator-fn idx) this-range other-range))) 161 | 162 | (deftype NativeDependencySet [store deps] 163 | IPrintWithWriter 164 | (-pr-writer [native writer opts] 165 | (-write writer (str "#ndep [" (pr-str deps) "]"))) 166 | 167 | IHash 168 | (-hash [o] 169 | (goog/getUid o)) 170 | 171 | IEquiv 172 | (-equiv [o other] 173 | (if (instance? NativeDependencySet other) 174 | (== (-hash o) (-hash other)) 175 | false)) 176 | 177 | d/IDependencySet 178 | (merge-deps [nset other] 179 | #_(println "NSet merge: " (type store) deps other "\n") 180 | (let [fdeps (if (nil? (.-deps other)) other (.-deps other))] 181 | (goog.object.forEach 182 | fdeps (fn [v k] 183 | (if-let [mine (aget deps k)] 184 | (merge-index! nset (get-index store k) mine v) 185 | (aset deps k (js-copy v))))) 186 | nset)) 187 | 188 | (match-deps [nset other] 189 | (let [fdeps (if (nil? (.-deps other)) other (.-deps other))] 190 | #_(println "Matching: " deps fdeps "\n") 191 | (goog.object.some 192 | fdeps (fn [v k o] #_(println "matching-key: " k "\n") 193 | (when-let [local (aget deps k)] 194 | (match-index? nset (get-index store k) local v))))))) 195 | 196 | 197 | (defn make-dependencies 198 | ([store] (NativeDependencySet. store #js {})) 199 | ([store init] (NativeDependencySet. store init))) 200 | 201 | (defn inform-tracker 202 | ([store deps] 203 | (when (d/tracking?) 204 | (inform-tracker d/*tracker* store deps))) 205 | ([tracker store deps] 206 | (let [dset (make-dependencies store deps)] 207 | (.log js/console "Informing tracker: " dset " t? " d/*tracker* "\n") 208 | (d/depends! tracker store dset)))) 209 | 210 | ;; 211 | ;; Instance protocols 212 | ;; ============================ 213 | 214 | (def ^{:doc "Inside a transaction?" 215 | :dynamic true} 216 | *transaction* nil) 217 | 218 | ;; A reference wraps a lookup into a store 219 | ;; Objects implementing ILookup can test for a 220 | ;; IReference and dereference it. 221 | 222 | (defprotocol IReference 223 | (resolve-ref [ref]) 224 | (reference-id [ref]) 225 | (reference-db [ref])) 226 | 227 | (deftype HeapReference [store id] 228 | IDeref 229 | (-deref [ref] 230 | (resolve-ref ref)) 231 | 232 | IPrintWithWriter 233 | (-pr-writer [native writer opts] 234 | (-write writer (str "#ref [" id "]"))) 235 | 236 | IEquiv 237 | (-equiv [ref other] 238 | (and (= store (.-store other)) 239 | (= id (.-id other)))) 240 | 241 | IReference 242 | (resolve-ref [_] (get store id)) 243 | (reference-id [_] id) 244 | (reference-db [_] store)) 245 | 246 | (declare heap-map? heap-map-store heap-id -store) 247 | 248 | (defn reference 249 | "Return a reference to value in store, if using the 1-arity version 250 | the argument must be a heap map" 251 | ([value] 252 | (assert (heap-map? value)) 253 | (HeapReference. (-store value) (-wrapped-value value))) 254 | ([store value] 255 | (HeapReference. 256 | store 257 | (if (map? value) 258 | (heap-id store value) 259 | value)))) 260 | 261 | (defn identity? [n1 n2] 262 | (= (aget n1 "id") (aget n2 "id"))) 263 | 264 | 265 | ;; 266 | ;; Heap Store 267 | ;; ============================ 268 | 269 | ;; Return a cursor for walking a range of the index 270 | (deftype Cursor [idx start end ^:mutable valid? empty?] 271 | IReduce 272 | (-reduce [this f] 273 | (-reduce this f (f))) 274 | (-reduce [this f init] 275 | (if empty? 276 | init 277 | (let [a (or (.-arry idx) (aget idx "arry"))] 278 | (loop [i start ret init] 279 | (if (<= i end) 280 | (recur (inc i) (f ret (aget a i))) 281 | ret))))) 282 | ISeqable 283 | (-seq [this] 284 | (seq (into [] this)))) 285 | 286 | 287 | ;(deftype WrappedCursor [idx start end ^:mutable valid?] 288 | ; IReduce 289 | ; (-reduce [this f] 290 | ; (-reduce this f (f))) 291 | ; (-reduce [this f init] 292 | ; (let [a (.-arry idx)] 293 | ; (loop [i start ret init] 294 | ; (if (<= i end) 295 | ; (recur (inc i) (f ret (aget a i))) 296 | ; ret))))) 297 | 298 | ;; Hash KV Index, meant to be for a root store index (unique keys) 299 | ;; - Merging upsert against existing if keyfn output matches 300 | ;; - Nil values in provided object deletes keys 301 | ;; - Original object maintains identity 302 | (deftype HashIndex [keyfn hashmap] 303 | ILookup 304 | (-lookup [idx val] 305 | (-lookup idx val nil)) 306 | (-lookup [idx val not-found] 307 | (js-lookup hashmap val not-found)) 308 | 309 | IFn 310 | (-invoke [idx k] 311 | (-lookup idx k)) 312 | (-invoke [idx k not-found] 313 | (-lookup idx k not-found)) 314 | 315 | ICounted 316 | (-count [idx] (alength (js-keys hashmap))) 317 | 318 | IIndex 319 | (key-fn [idx] keyfn) 320 | (index! [idx obj] 321 | (let [key (keyfn obj)] 322 | (js-assoc hashmap key obj))) 323 | (unindex! [idx obj] 324 | (let [key (keyfn obj)] 325 | (js-dissoc hashmap key obj))) 326 | 327 | IClearable 328 | (clear! [idx] 329 | (goog.array.clear hashmap)) 330 | 331 | IScannable 332 | (-get-cursor [idx] 333 | (let [vals (js-obj "arry" (goog.object.getValues (.-hashmap idx)))] 334 | (Cursor. vals 0 (dec (alength (aget vals "arry"))) true false))) 335 | (-get-cursor [idx start] 336 | (assert false "Hash index does not support range queries")) 337 | (-get-cursor [idx start end] 338 | (assert false "Hash index does not support range queries"))) 339 | 340 | (defn root-index [] 341 | (HashIndex. :id #js {})) 342 | 343 | ;; KV index using binary search/insert/remove on array 344 | ;; - Always inserts new objects in sorted order 345 | ;; - Matches on object identity for unindex! 346 | (deftype BinaryIndex [keyfn compfn arry] 347 | ILookup 348 | (-lookup [idx val] 349 | (-lookup idx val nil)) 350 | (-lookup [idx val not-found] 351 | (let [index (goog.array.binarySearch arry val #(compfn %1 (keyfn %2)))] 352 | (if (>= index 0) 353 | (loop [end index] 354 | (if (= (compfn val (keyfn (aget arry end))) 0) 355 | (recur (inc end)) 356 | (goog.array.slice arry index end))) 357 | not-found))) 358 | 359 | IFn 360 | (-invoke [idx k] 361 | (-lookup idx k)) 362 | (-invoke [idx k not-found] 363 | (-lookup idx k not-found)) 364 | 365 | IIndex 366 | (key-fn [idx] keyfn) 367 | (index! [idx obj] 368 | (let [loc (goog.array.binarySearch arry obj #(compfn (keyfn %1) (keyfn %2)))] 369 | (if (>= loc 0) 370 | (goog.array.insertAt arry obj loc) 371 | (goog.array.insertAt arry obj (- (inc loc))))) 372 | idx) 373 | (unindex! [idx obj] 374 | (let [loc (goog.array.indexOf arry obj)] 375 | (when (>= loc 0) 376 | (goog.array.removeAt arry loc))) 377 | idx) 378 | 379 | IClearable 380 | (clear! [idx] 381 | (goog.array.clear arry)) 382 | 383 | ISortedIndex 384 | (comparator-fn [idx] compfn) 385 | 386 | IScannable 387 | (-get-cursor [idx] 388 | (Cursor. idx 0 (dec (alength (.-arry idx))) true false)) 389 | (-get-cursor [idx start] 390 | (let [head (goog.array.binarySearch arry start #(compfn %1 (keyfn %2))) 391 | head (if (>= head 0) head (- (inc head)))] 392 | (Cursor. idx head (dec (alength (.-arry idx))) true false))) 393 | (-get-cursor [idx start end] 394 | (let [headidx (goog.array.binarySearch arry start #(compfn %1 (keyfn %2))) 395 | head (if (>= headidx 0) headidx (- (inc headidx))) 396 | tailidx (goog.array.binarySearch arry end #(compfn %1 (keyfn %2))) 397 | tail (if (>= tailidx 0) tailidx (- (inc tailidx))) 398 | tail (if (not (>= tail (alength (.-arry idx)))) 399 | (loop [tail tail] 400 | (let [next (keyfn (aget arry tail)) 401 | c (compfn end next)] 402 | (if (= c 0) 403 | (if (not= (inc tail) (alength (.-arry idx))) 404 | (recur (inc tail)) 405 | tail) 406 | (dec tail)))) 407 | tail)] 408 | (let [empty? (and (= head tail) (and (< tailidx 0) (< headidx 0)))] 409 | (Cursor. idx head tail true empty?))))) 410 | 411 | (defn ordered-index [keyfn compfn] 412 | (BinaryIndex. keyfn compfn (array))) 413 | 414 | ;; (deftype MultiIndex [keyfn bidx] 415 | ;; IIndex 416 | ;; (key-fn [idx] keyfn) 417 | ;; (index! [idx obj] 418 | ;; (let [vals (keyfn obj) 419 | ;; len (alength vals)] 420 | ;; (loop [i (alength vals)] 421 | ;; (when (< i len) 422 | ;; (index! bidx (array (aget vals i) obj)) 423 | ;; (recur (inc i)))))) 424 | ;; (unindex! [idx obj] 425 | ;; (let [arry (aget bidx "arry") 426 | ;; find (fn [obj] (goog.array.findIndex arry #(= (aget % 1) obj)))] 427 | ;; (loop [loc (find obj)] 428 | ;; (when (>= loc 0) 429 | ;; (goog.array.removeAt arry loc) 430 | ;; (recur (find obj)))))) 431 | 432 | ;; ISortedIndex 433 | ;; (comparator-fn [idx] 434 | ;; (comparator-fn bidx)) 435 | 436 | ;; IScannable 437 | ;; (-get-cursor [idx] 438 | ;; (let [cur (-get-cursor bidx)] 439 | ;; (WrappedCursor. (aget cur "idx") 440 | ;; (aget cur "start") 441 | ;; (aget cur "end") 442 | ;; #(aget % 1) 443 | ;; (aget cur "valid?")))) 444 | 445 | ;; (-get-cursor [idx start] 446 | ;; (let [cur (-get-cursor bidx start)] 447 | ;; (WrappedCursor. (aget cur "idx") 448 | ;; (aget cur "start") 449 | ;; (aget cur "end") 450 | ;; #(aget % 1) 451 | ;; (aget cur "valid?")))) 452 | 453 | ;; (-get-cursor [idx start end] 454 | ;; (let [cur (-get-cursor bidx start end)] 455 | ;; (WrappedCursor. (aget cur "idx") 456 | ;; (aget cur "start") 457 | ;; (aget cur "end") 458 | ;; #(aget % 1) 459 | ;; (aget cur "valid?"))))) 460 | 461 | ;; (defn multi-index [keyfn compfn] 462 | ;; (MultiIndex. keyfn (ordered-index #(aget val 0) compfn))) 463 | 464 | (defn compound-key-fn 465 | "Return a js array key for compound ordering" 466 | [keyfns] 467 | (let [cnt (count keyfns)] 468 | (fn [obj] 469 | (let [vals (new js/Array cnt)] 470 | (loop [i 0 keyfns keyfns] 471 | (if (empty? keyfns) 472 | vals 473 | (if-let [val ((first keyfns) obj)] 474 | (do (aset vals i val) 475 | (recur (inc i) (rest keyfns))) 476 | nil))))))) 477 | 478 | (defn compound-comparator 479 | "Compare two compound keys using the array of comparators" 480 | [comps] 481 | (let [cnt (count comps)] 482 | (fn [akey1 akey2] 483 | (loop [i 0 comps comps ans 0] 484 | (if-not (empty? comps) 485 | (let [comp (first comps) 486 | res (comp (aget akey1 i) (aget akey2 i))] 487 | (if (= res 0) 488 | (recur (inc i) (rest comps) res) 489 | res)) 490 | ans))))) 491 | 492 | (defn compound-index [keyfns compfns] 493 | (BinaryIndex. (compound-key-fn keyfns) (compound-comparator compfns) (array))) 494 | 495 | (defn- update-listeners 496 | "Use this to update store listeners when write dependencies 497 | have been accumulatd" 498 | [result dmap] 499 | #_(.log js/console "Notifying listeners" dmap) 500 | (let [[store deps] (first dmap)] 501 | #_(.log js/console " Notifying store" store deps) 502 | (when store 503 | (d/notify-listeners store deps)))) 504 | 505 | (defprotocol IHeapMap 506 | (-store [this]) 507 | (-wrapped-value [this])) 508 | 509 | (defn heap-map? 510 | [value] 511 | (satisfies? value IHeapMap)) 512 | 513 | (defn heap-map-store 514 | [value] 515 | (-store value)) 516 | 517 | (defn wrapped-value 518 | [value] 519 | (-wrapped-value value)) 520 | 521 | (declare TransientHeapMap) 522 | 523 | ;; An element stored in a heap store is wrapped in the HeapMap 524 | ;; interface which is like a clojure map in all ways except it 525 | ;; allows for graph-like traversal across references within 526 | ;; the heap while participating in the derive protocol. 527 | (deftype HeapMap [store value] 528 | IHeapMap 529 | (-store [this] 530 | store) 531 | (-wrapped-value [this] 532 | value) 533 | 534 | ILookup 535 | (-lookup [this k] 536 | (-lookup value k nil)) 537 | (-lookup [this k not-found] 538 | (let [v (-lookup value k ::not-found)] 539 | (cond (= v ::not-found) 540 | not-found 541 | (sequential? v) 542 | (if (satisfies? IReference (first v)) 543 | (mapv resolve-ref v) 544 | v) 545 | (satisfies? IReference v) 546 | (resolve-ref v) 547 | :else v))) 548 | 549 | ICloneable 550 | (-clone [this] (HeapMap. store (-clone value))) 551 | 552 | IWithMeta 553 | (-with-meta [this meta] (HeapMap. store (-with-meta value meta))) 554 | 555 | IMeta 556 | (-meta [this] (-meta value)) 557 | 558 | ICollection 559 | (-conj [this entry] (HeapMap. store (-conj value entry))) 560 | 561 | IEmptyableCollection 562 | (-empty [this] (HeapMap. store (-empty value))) 563 | 564 | ;; Should we be equivalent with plain values? (yes for now) 565 | IEquiv 566 | (-equiv [this other] 567 | (if (heap-map? other) 568 | (and (-equiv store (-store other)) 569 | (-equiv (-wrapped-value value) (-wrapped-value other))) 570 | (-equiv value other))) 571 | 572 | IHash 573 | (-hash [this] (hash value)) 574 | 575 | ICounted 576 | (-count [_] (-count value)) 577 | 578 | IFn 579 | (-invoke [this k] 580 | (-lookup this k)) 581 | (-invoke [this k not-found] 582 | (-lookup this k not-found)) 583 | 584 | ;; NOTE: Do we want to maintain the heap wrapper abstraction on sub-values? 585 | ISeqable 586 | (-seq [this] 587 | (-seq value)) 588 | 589 | IAssociative 590 | (-contains-key? [_ k] 591 | (-contains-key? value k)) 592 | (-assoc [_ k v] 593 | (HeapMap. store (-assoc value k v))) 594 | 595 | IEditableCollection 596 | (-as-transient [this] 597 | (TransientHeapMap. store (transient value) true)) 598 | 599 | IMap 600 | (-dissoc [_ k] 601 | (HeapMap. store (-dissoc value k))) 602 | 603 | IKVReduce 604 | (-kv-reduce [_ f init] 605 | (-kv-reduce value f init)) 606 | 607 | IPrintWithWriter 608 | (-pr-writer [_ writer opts] 609 | (-pr-writer value writer opts))) 610 | 611 | (defn as-heap-map 612 | [store value] 613 | (assert (map? value)) 614 | (if (heap-map? value) 615 | (do (assert (identical? store (-store value))) 616 | value) 617 | (HeapMap. store value))) 618 | 619 | (deftype TransientHeapMap [store ^:mutable tvalue ^:mutable edit] 620 | IHeapMap 621 | (-store [this] 622 | store) 623 | (-wrapped-value [this] 624 | tvalue) 625 | 626 | ITransientCollection 627 | (-conj! [this elt] 628 | (if edit 629 | (set! tvalue (-conj! tvalue elt)) 630 | (throw (js/Error. "conj! after persistent!"))) 631 | this) 632 | (-persistent! [this] 633 | (if edit 634 | (do (set! edit nil) 635 | (HeapMap. store (-persistent! tvalue))) 636 | (throw (js/Error. "persistent! called more than once")))) 637 | 638 | ITransientAssociative 639 | (-assoc! [this k v] 640 | (if edit 641 | (set! tvalue (-assoc! tvalue k v)) 642 | (throw (js/Error. "assoc! after persistent!"))) 643 | this) 644 | 645 | ITransientMap 646 | (-dissoc! [this k] 647 | (if edit 648 | (set! tvalue (-dissoc! tvalue k)) 649 | (throw (js/Error. "assoc! after persistent!"))) 650 | this) 651 | 652 | ILookup 653 | (-lookup [value k] 654 | (-lookup value k nil)) 655 | (-lookup [value k not-found] 656 | (let [v (-lookup tvalue k ::not-found)] 657 | (cond (= v ::not-found) 658 | not-found 659 | (sequential? v) 660 | (if (satisfies? IReference (first v)) 661 | (mapv resolve-ref v) 662 | v) 663 | (satisfies? IReference v) 664 | (resolve-ref v) 665 | :else v))) 666 | 667 | ICounted 668 | (-count [_] (-count tvalue)) 669 | 670 | IFn 671 | (-invoke [this k] 672 | (-lookup this k)) 673 | (-invoke [this k not-found] 674 | (-lookup this k not-found))) 675 | 676 | 677 | ;; An Indexed Mutable Heap Store 678 | ;; - Any object added gains special keyword access supporting 679 | ;; reference resolution when accessing keyword attributes 680 | ;; - Stores any object, but generally clojurescript objects 681 | ;; - Will maintain secondary (e.g. sorted) indexes on object attributes 682 | ;; - Secondary index doesn't index objects for key-fn -> nil 683 | (deftype HeapStore [root indices tx-listeners ^:mutable listeners] 684 | IPrintWithWriter 685 | (-pr-writer [native writer opts] 686 | (-write writer (str "#HeapStore[]"))) 687 | 688 | ILookup 689 | (-lookup [store id] 690 | (-lookup store id nil)) 691 | (-lookup [store id not-found] 692 | (inform-tracker store (js-obj "root" (array id))) 693 | (-lookup root id not-found)) 694 | 695 | ICounted 696 | (-count [store] (-count root)) 697 | 698 | IFn 699 | (-invoke [store k] 700 | (-lookup store k nil)) 701 | (-invoke [store k not-found] 702 | (-lookup store k not-found)) 703 | 704 | IStore 705 | (insert! [store value] 706 | ;; 1) Transactional by default or participates in wrapping transaction 707 | ;; Transaction listeners get a log of all side effects per transaction 708 | ;; 709 | ;; 2) Track side effects against indices, etc and forward to enclosing 710 | ;; transaction if present or notify active dependency listeners 711 | #_(.log js/console "Called insert!\n") 712 | ;; reuse this for writes instead of reads 713 | (with-tracked-dependencies [update-listeners] 714 | (let [key ((key-fn root) value) 715 | _ (assert key "Must have an ID field") 716 | names (js-keys indices) 717 | old (get root key)] 718 | ;; Unindex 719 | (when old 720 | (doseq [iname names] 721 | (let [idx (aget indices iname) 722 | ikey ((key-fn idx) old)] 723 | (when-not (or (nil? ikey) (= ikey false)) 724 | (inform-tracker store (js-obj (name iname) (array ikey ikey))) 725 | (unindex! idx old))))) 726 | ;; Update the root value at key 727 | #_(println "Informing tracker of root: " (js-obj "root" (array key)) "\n") 728 | (inform-tracker store (js-obj "root" (array key))) 729 | (index! root (as-heap-value store value)) 730 | (let [new (get root key)] 731 | ;; Re-insert 732 | (doseq [iname names] 733 | (let [idx (aget indices iname) 734 | ikey ((key-fn idx) new)] 735 | (when-not (or (nil? ikey) (= ikey false)) 736 | (inform-tracker store (js-obj (name iname) (array ikey ikey))) 737 | (index! idx new)))) 738 | ;; Update listeners 739 | (if *transaction* 740 | (.push *transaction* #js [:insert old new]) 741 | (-notify-watches store nil [[:insert old new]])))) 742 | store)) 743 | 744 | (delete! [store id] 745 | (with-tracked-dependencies [update-listeners] 746 | (when-let [old (get root id)] 747 | (doseq [iname (js-keys indices)] 748 | (let [idx (aget indices iname) 749 | ikey ((key-fn idx) old)] 750 | (when-not (or (nil? ikey) (= ikey false)) 751 | (inform-tracker store (js-obj (name iname) (array ikey ikey))) 752 | (unindex! idx old)))) 753 | (inform-tracker store (js-obj "root" (array id))) 754 | (unindex! root old) 755 | (if *transaction* 756 | (.push *transaction* #js [:delete old]) 757 | (-notify-watches store nil #js [:delete old]))) 758 | store)) 759 | 760 | IClearable 761 | (clear! [store] 762 | ;; Invalidate all listeners 763 | (d/force-invalidation store) 764 | ;; Cleanly remove data by reverse-walking the root 765 | (doseq [obj (seq (-get-cursor root))] 766 | (delete! store ((key-fn root) obj))) 767 | ;; Ensure we've cleared everything (e.g. dependency ordering problems) 768 | (doseq [iname (js-keys indices)] 769 | (clear! (aget indices iname))) 770 | (clear! root) 771 | store) 772 | 773 | IIndexedStore 774 | (add-index! [store iname index] 775 | (assert (not (get-index store iname))) 776 | (js-assoc indices iname index) 777 | store) 778 | (rem-index! [store iname] 779 | (assert (get-index store iname)) 780 | (js-dissoc indices iname) 781 | store) 782 | (get-index [store iname] 783 | (if (or (string? iname) (keyword? iname)) 784 | (js-lookup indices (name iname)) 785 | iname)) 786 | 787 | ITransactionalStore 788 | (-transact! [store f args] 789 | ;; TODO: separate process so we ignore read deps in transactions? 790 | (with-tracked-dependencies [update-listeners true] 791 | (binding [*transaction* #js []] 792 | (let [result (apply f store args)] 793 | (-notify-watches store nil *transaction*))))) 794 | 795 | IWatchable 796 | (-notify-watches [store _ txs] 797 | (doseq [name (js-keys tx-listeners)] 798 | (let [listener (aget tx-listeners name)] 799 | (listener nil txs))) 800 | store) 801 | (-add-watch [store key f] 802 | (js-assoc tx-listeners key f) 803 | store) 804 | (-remove-watch [store key] 805 | (js-dissoc tx-listeners key) 806 | store) 807 | 808 | d/IDependencySource 809 | (subscribe! [this listener] 810 | (set! listeners (update-in listeners [nil] (fnil conj #{}) listener)) 811 | this) 812 | (subscribe! [this listener deps] 813 | (set! listeners (update-in listeners [deps] (fnil conj #{}) listener)) 814 | this) 815 | (unsubscribe! [this listener] 816 | (let [old-set (get listeners nil) 817 | new-set (disj listeners listener)] 818 | (if (empty? new-set) 819 | (set! listeners (dissoc listeners nil)) 820 | (set! listeners (assoc listeners nil new-set)))) 821 | this) 822 | (unsubscribe! [this listener deps] 823 | (let [old-set (get listeners deps) 824 | new-set (when (set? old-set) (disj old-set listener))] 825 | (if (empty? new-set) 826 | (set! listeners (dissoc listeners deps)) 827 | (set! listeners (assoc listeners deps new-set)))) 828 | this) 829 | (empty-deps [this] (make-dependencies this))) 830 | 831 | (defn transact! [store f & args] 832 | (-transact! store f args)) 833 | 834 | (defn create [] 835 | (HeapStore. (root-index) #js {} #js {} {})) 836 | 837 | (defn heap-id 838 | ([value] 839 | (assert (heap-map? value) "Only HeapMaps have values for the 1-arity call") 840 | (heap-id (-store value) (-wrapped-value value))) 841 | ([store value] 842 | ((key-fn (.-root store)) value))) 843 | ;; 844 | ;; External interface 845 | ;; 846 | 847 | (defn fetch 848 | ([store key] 849 | (get store key)) 850 | ([store index key] 851 | (-> (get-index store index) (get key)))) 852 | 853 | (defn- first-val [idx] 854 | ((key-fn idx) (aget (.-arry idx) 0))) 855 | 856 | (defn- last-val [idx] 857 | ((key-fn idx) (aget (.-arry idx) (- (alength (.-arry idx)) 1)))) 858 | 859 | (defn cursor 860 | "Walk the entire store, or an index" 861 | ([store] 862 | ;; NOTE: No dependencies on whole DB 863 | (-get-cursor (.-root store))) 864 | ([store index] 865 | (let [iname (name index) 866 | index (get-index store iname)] 867 | (assert index (str "Index " iname " is not defined.")) 868 | (inform-tracker store (js-obj iname (array))) 869 | (-get-cursor index))) 870 | ([store index start] 871 | (let [iname (name index) 872 | index (get-index store index)] 873 | (assert index (str "Index " iname " is not defined.")) 874 | (inform-tracker store (js-obj iname (array start))) ;; shorthand 875 | (-get-cursor index start))) 876 | ([store index start end] 877 | (let [iname (name index) 878 | index (get-index store index)] 879 | (assert index (str "Index " iname " is not defined.")) 880 | (inform-tracker store (js-obj iname (array start end))) 881 | (-get-cursor index start end)))) 882 | 883 | (defn ensure-index 884 | ([store iname key comp] 885 | (when-not (get-index store iname) 886 | (add-index! store iname (ordered-index key comp)))) 887 | ([store iname key-or-idx] 888 | (if (or (keyword? key-or-idx) (symbol? key-or-idx)) 889 | (ensure-index store iname key-or-idx compare) 890 | (when-not (get-index store iname) 891 | (add-index! store iname key-or-idx))))) ;; key is an index 892 | 893 | (comment 894 | (def store (create)) 895 | (add-index! store :name (ordered-index (field-key :name) compare)) 896 | (insert! store #js {:id 1 :type "user" :name "Fred"}) 897 | (insert! store #js {:id 2 :type "user" :name "Zoe"}) 898 | (insert! store #js {:id 3 :type "user" :name "Apple"}) 899 | (insert! store #js {:id 4 :type "user" :name "Flora"}) 900 | (insert! store #js {:id 5 :type "user" :name "Flora"}) 901 | (insert! store #js {:id 6 :type "tracker" :measure 2700}) 902 | (println "Get by ID" (get store 1)) 903 | (println "Get by index" (-> (get-index store :name) (get "Flora"))) 904 | (println (js->clj (r/reduce (cursor store :name) (d/map :id))))) ;; object #6 is not indexed! 905 | 906 | 907 | 908 | --------------------------------------------------------------------------------