Merge pull request #5 from codeboost/cursor-impl

Implement XITDBCursor

Author: codeboost

src/xitdb/db.clj

@@ -18,6 +18,17 @@
 ;; Avoid extra require in your ns
 (def materialize common/materialize)
 
+(defn open-database
+  "Opens database `filename`.
+  If `filename` is `:memory`, returns a memory based db.
+  open-mode can be `r` or `rw`."
+  [filename ^String open-mode]
+  (let [core   (if (= filename :memory)
+                 (CoreMemory. (RandomAccessMemory.))
+                 (CoreBufferedFile. (RandomAccessBufferedFile. (File. ^String filename) open-mode)))
+        hasher (Hasher. (MessageDigest/getInstance "SHA-1"))]
+    (Database. core hasher)))
+
 
 (defn ^WriteArrayList db-history [^Database db]
   (WriteArrayList. (.rootCursor db)))
@@ -42,17 +53,6 @@
   (append-context! history nil (fn [^WriteCursor cursor]
                                  (conversion/v->slot! cursor new-value))))
 
-(defn open-database
-  "Opens database `filename`.
-  If `filename` is `:memory`, returns a memory based db.
-  open-mode can be `r` or `rw`."
-  [filename ^String open-mode]
-  (let [core   (if (= filename :memory)
-                 (CoreMemory. (RandomAccessMemory.))
-                 (CoreBufferedFile. (RandomAccessBufferedFile. (File. ^String filename) open-mode)))
-        hasher (Hasher. (MessageDigest/getInstance "SHA-1"))]
-    (Database. core hasher)))
-
 (defn v->slot!
   "Converts a value to a slot which can be written to a cursor.
   For XITDB* types (which support ISlot), will return `-slot`,
@@ -63,35 +63,40 @@
     (conversion/v->slot! cursor v)))
 
 (defn xitdb-swap!
-  "Starts a new transaction and calls `f` with the value at root.
-  `f` will receive a XITDBWrite* type (db) and `args`.
+  "Starts a new transaction and calls `f` with the value at `base-keypath`.
+  If `base-keypath` is nil, will use the root cursor.
+  `f` will receive a XITDBWrite* type with the value at `base-keypath` and `args`.
   Actions on the XITDBWrite* type (like `assoc`) will mutate it.
-  Return value of `f` is written at (root) cursor.
+  Return value of `f` is written at `base-keypath` (or root) cursor.
   Returns the transaction history index."
-  [db f & args]
+  [db base-keypath f & args]
   (let [history (db-history db)
         slot (.getSlot history -1)]
     (append-context!
       history
       slot
       (fn [^WriteCursor cursor]
-        (let [obj (xtypes/read-from-cursor cursor true)]
+        (let [cursor (conversion/keypath-cursor cursor base-keypath)
+              obj (xtypes/read-from-cursor cursor true)]
           (let [retval (apply f (into [obj] args))]
             (.write cursor (v->slot! cursor retval))))))))
 
 (defn xitdb-swap-with-lock!
   "Performs the 'swap!' operation while locking `db.lock`.
   Returns the new value of the database.
   If the binding `*return-history?*` is true, returns
-  `[current-history-index db-before db-after]`."
-  [xitdb f & args]
+  `[current-history-index db-before db-after]`.
+  If `keypath` is not empty, the result of `f` will be written to the db at `keypath` rather
+  than db root.
+  Similarly, if `keypath` is not empty, the returned value will be the value at `keypath`."
+  [xitdb base-keypath f & args]
   (let [^ReentrantLock lock (.-lock xitdb)]
     (when (.isHeldByCurrentThread lock)
       (throw (IllegalStateException. "swap! should not be called from swap! or reset!")))
     (try
       (.lock lock)
       (let [old-value (when *return-history?* (deref xitdb))
-            index     (apply xitdb-swap! (into [(-> xitdb .rwdb) f] args))
+            index     (apply xitdb-swap! (into [(-> xitdb .rwdb) base-keypath f] args))
             new-value (deref xitdb)]
         (if *return-history?*
           [index old-value new-value]
@@ -146,16 +151,16 @@
         (.unlock lock))))
 
   (swap [this f]
-    (xitdb-swap-with-lock! this f))
+    (xitdb-swap-with-lock! this nil f))
 
   (swap [this f a]
-    (xitdb-swap-with-lock! this f a))
+    (xitdb-swap-with-lock! this nil f a))
 
   (swap [this f a1 a2]
-    (xitdb-swap-with-lock! this f a1 a2))
+    (xitdb-swap-with-lock! this nil f a1 a2))
 
   (swap [this f x y args]
-    (apply xitdb-swap-with-lock! (concat [this f x y] args))))
+    (apply xitdb-swap-with-lock! (concat [this nil f x y] args))))
 
 (defn xit-db
   "Returns a new XITDBDatabase which can be used to query and transact data.
@@ -178,4 +183,42 @@
       (->XITDBDatabase tldb rwdb (ReentrantLock.)))))
 
 
+(deftype XITDBCursor [xdb keypath]
+
+  java.io.Closeable
+  (close [this])
+
+  clojure.lang.IDeref
+  (deref [this]
+    (let [v (deref xdb)]
+      (get-in v keypath)))
+
+  clojure.lang.IAtom
+
+  (reset [this new-value]
+    (xitdb-swap-with-lock! xdb keypath (constantly new-value)))
+
+  (swap [this f]
+    (xitdb-swap-with-lock! xdb keypath  f))
+
+  (swap [this f a]
+    (xitdb-swap-with-lock! xdb keypath  f a))
+
+  (swap [this f a1 a2]
+    (xitdb-swap-with-lock! xdb keypath  f a1 a2))
+
+  (swap [this f x y args]
+    (apply xitdb-swap-with-lock! (concat [xdb keypath f x y] args))))
+
+(defn xdb-cursor [xdb keypath]
+  (cond
+    (instance? XITDBCursor xdb)
+    (XITDBCursor. (.-xdb xdb) (vec (concat (.-keypath xdb) keypath)))
+
+    (instance? XITDBDatabase xdb)
+    (XITDBCursor. xdb keypath)
+
+    :else
+    (throw (IllegalArgumentException. (str "xdb must be an instance of XITDBCursor or XITDBDatabase, got: " (type xdb))))))
+
 

src/xitdb/hash_map.clj

@@ -1,6 +1,7 @@
 (ns xitdb.hash-map
   (:require
     [xitdb.common :as common]
+    [xitdb.util.conversion :as conversion]
     [xitdb.util.operations :as operations])
   (:import
     [io.github.radarroark.xitdb
@@ -157,7 +158,7 @@
     (let [cursor (operations/map-read-cursor whm key)]
       (if (nil? cursor)
         not-found
-        (common/-read-from-cursor (operations/map-write-cursor whm key)))))
+        (common/-read-from-cursor (conversion/map-write-cursor whm key)))))
 
   clojure.lang.Seqable
   (seq [this]

src/xitdb/util/conversion.clj

@@ -4,11 +4,10 @@
   (:import
     [io.github.radarroark.xitdb
      Database Database$Bytes Database$Float Database$Int
-     ReadArrayList ReadCountedHashSet ReadCursor ReadHashMap ReadCountedHashMap
-     ReadHashSet Slot Tag WriteArrayList WriteCountedHashSet WriteCursor WriteCountedHashMap
+     ReadArrayList ReadCountedHashMap ReadCountedHashSet ReadCursor ReadHashMap
+     ReadHashSet Slot Tag WriteArrayList WriteCountedHashMap WriteCountedHashSet WriteCursor
      WriteHashMap WriteHashSet WriteLinkedArrayList]
     [java.io OutputStream OutputStreamWriter]
-    [java.nio ByteBuffer]
     [java.security DigestOutputStream]))
 
 (defn xit-tag->keyword
@@ -316,4 +315,65 @@
       nil
 
       :else
-      str)))
+      str)))
+
+(defn set-write-cursor
+  [^WriteHashSet whs key]
+  (let [hash-code (db-key-hash (-> whs .-cursor .-db) key)]
+    (.putCursor whs hash-code)))
+
+(defn map-write-cursor
+  "Gets a write cursor for the specified key in a WriteHashMap.
+  Creates the key if it doesn't exist."
+  [^WriteHashMap whm key]
+  (let [key-hash (db-key-hash (-> whm .cursor .db) key)]
+    (.putCursor whm key-hash)))
+
+(defn array-list-write-cursor
+  "Returns a cursor to slot i in the array list.
+  Throws if index is out of bounds."
+  [^WriteArrayList wal i]
+  (validation/validate-index-bounds i (.count wal) "Array list write cursor")
+  (.putCursor wal i))
+
+(defn linked-array-list-write-cursor
+  [^WriteLinkedArrayList wlal i]
+  (validation/validate-index-bounds i (.count wlal) "Linked array list write cursor")
+  (.putCursor wlal i))
+
+(defn write-cursor-for-key [cursor current-key]
+  (let [value-tag (some-> cursor .slot .tag)]
+    (cond
+      (= value-tag Tag/HASH_MAP)
+      (map-write-cursor (WriteHashMap. cursor) current-key)
+
+      (= value-tag Tag/COUNTED_HASH_MAP)
+      (map-write-cursor (WriteCountedHashMap. cursor) current-key)
+
+      (= value-tag Tag/HASH_SET)
+      (set-write-cursor (WriteHashSet. cursor) current-key)
+
+      (= value-tag Tag/COUNTED_HASH_SET)
+      (set-write-cursor (WriteCountedHashSet. cursor) current-key)
+
+      (= value-tag Tag/ARRAY_LIST)
+      (array-list-write-cursor (WriteArrayList. cursor) current-key)
+
+      (= value-tag Tag/LINKED_ARRAY_LIST)
+      (linked-array-list-write-cursor (WriteLinkedArrayList. cursor) current-key)
+
+      :else
+      (throw (IllegalArgumentException.
+               (format "Cannot get cursor to key '%s' for value with tag '%s'" current-key (xit-tag->keyword value-tag)))))))
+
+(defn keypath-cursor
+  "Recursively goes to keypath and returns the write cursor"
+  [^WriteCursor cursor keypath]
+  (if (empty? keypath)
+    cursor
+    (loop [cursor cursor
+           [current-key & remaining-keys] keypath]
+      (let [new-cursor (write-cursor-for-key cursor current-key)]
+        (if (empty? remaining-keys)
+          new-cursor
+          (recur new-cursor remaining-keys))))))

src/xitdb/util/operations.clj

@@ -3,7 +3,7 @@
     [xitdb.util.conversion :as conversion]
     [xitdb.util.validation :as validation])
   (:import
-    [io.github.radarroark.xitdb ReadArrayList ReadCountedHashMap ReadCountedHashSet ReadHashMap ReadHashSet ReadLinkedArrayList Tag WriteArrayList WriteCursor WriteHashMap WriteHashSet WriteLinkedArrayList]))
+    [io.github.radarroark.xitdb ReadArrayList ReadCountedHashMap ReadCountedHashSet ReadHashMap ReadHashSet ReadLinkedArrayList Tag WriteArrayList WriteCountedHashMap WriteCountedHashSet WriteCursor WriteHashMap WriteHashSet WriteLinkedArrayList]))
 
 ;; ============================================================================
 ;; Array List Operations
@@ -152,14 +152,6 @@
   (let [key-hash (conversion/db-key-hash (-> rhm .cursor .db) key)]
     (.getCursor rhm key-hash)))
 
-
-(defn map-write-cursor
-  "Gets a write cursor for the specified key in a WriteHashMap.
-  Creates the key if it doesn't exist."
-  [^WriteHashMap whm key]
-  (let [key-hash (conversion/db-key-hash (-> whm .cursor .db) key)]
-    (.putCursor whm key-hash)))
-
 ;; ============================================================================
 ;; Set Operations  
 ;; ============================================================================
@@ -286,4 +278,4 @@
           (if (reduced? new-result)
             @new-result
             (recur (inc i) new-result)))
-        result))))
+        result))))

src/xitdb/xitdb_types.clj

@@ -3,11 +3,11 @@
     [xitdb.array-list :as xarray-list]
     [xitdb.common :as common]
     [xitdb.hash-map :as xhash-map]
-    [xitdb.linked-list :as xlinked-list]
     [xitdb.hash-set :as xhash-set]
+    [xitdb.linked-list :as xlinked-list]
     [xitdb.util.conversion :as conversion])
   (:import
-    (io.github.radarroark.xitdb ReadCountedHashMap ReadCursor ReadHashMap Slot Tag WriteCursor WriteHashMap)))
+    [io.github.radarroark.xitdb ReadCursor Slot Tag WriteCursor]))
 
 (defn read-from-cursor
   "Reads the value at cursor and converts it to a Clojure type.

test/xitdb/cursor_test.clj

@@ -0,0 +1,27 @@
+(ns xitdb.cursor-test
+  (:require
+    [clojure.test :refer :all]
+    [xitdb.db :as xdb]))
+
+(deftest CursorTest
+  (with-open [db (xdb/xit-db :memory)]
+    (reset! db {:foo {:bar [1 2 3 {:hidden true} 5]}})
+    (let [cursor1 (xdb/xdb-cursor db [:foo :bar])
+          cursor2 (xdb/xdb-cursor db [:foo :bar 2])
+          cursor3 (xdb/xdb-cursor db [:foo :bar 3 :hidden])]
+      (testing "Cursors return the value at keypath"
+        (is (= [1 2 3 {:hidden true} 5] (xdb/materialize @cursor1)))
+        (is (= 3 @cursor2))
+        (is (= true @cursor3)))
+
+      (testing "reset! on the cursor changes the underlying database"
+        (reset! cursor3 :changed)
+        (is (= :changed @cursor3))
+        (is (= :changed (get-in @db [:foo :bar 3 :hidden])))
+        (is (= [1 2 3 {:hidden :changed} 5]) (xdb/materialize @cursor1)))
+
+      (testing "swap! mutates the value at cursor"
+        (swap! cursor1 assoc-in [3 :hidden] :changed-by-swap!)
+        (is (= [1 2 3 {:hidden :changed-by-swap!} 5]) (xdb/materialize @cursor1))
+        (is (= :changed-by-swap! @cursor3))
+        (is (= 3 @cursor2))))))