Merge pull request #1 from codeboost/counted-types

Counted types

Author: codeboost

deps.edn

@@ -1,6 +1,6 @@
 {:paths ["src" "test"]
  :deps  {org.clojure/clojure        {:mvn/version "1.12.0"}
-         io.github.radarroark/xitdb {:mvn/version "0.16.0"}}
+         io.github.radarroark/xitdb {:mvn/version "0.20.0"}}
 
  :aliases
  {:test

src/xitdb/array_list.clj

@@ -132,7 +132,6 @@
     (.count wal))
 
   (cons [this o]
-    ;;TODO: Figure out if it is correct to append to the end
     (operations/array-list-append-value! wal (common/unwrap o))
     this)
 

src/xitdb/db.clj

@@ -1,5 +1,6 @@
 (ns xitdb.db
   (:require
+    [xitdb.common :as common]
     [xitdb.util.conversion :as conversion]
     [xitdb.xitdb-types :as xtypes])
   (:import
@@ -47,6 +48,15 @@
         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`,
+  for all other types `conversion/v->slot!`"
+  [^WriteCursor cursor v]
+  (if (satisfies? common/ISlot v)
+    (common/-slot v)
+    (conversion/v->slot! cursor v)))
+
 (defn xitdb-swap!
   "Returns history index."
   [db f & args]
@@ -58,7 +68,7 @@
       (fn [^WriteCursor cursor]
         (let [obj (xtypes/read-from-cursor cursor true)]
           (let [retval (apply f (into [obj] args))]
-            (.write cursor (conversion/v->slot! cursor retval))))))))
+            (.write cursor (v->slot! cursor retval))))))))
 
 (defn xitdb-swap-with-lock!
   "Performs the 'swap!' operation while locking `db.lock`.

src/xitdb/hash_map.clj

@@ -1,10 +1,11 @@
 (ns xitdb.hash-map
   (:require
     [xitdb.common :as common]
-    [xitdb.util.conversion :as conversion]
     [xitdb.util.operations :as operations])
   (:import
-    [io.github.radarroark.xitdb ReadCursor ReadHashMap WriteCursor WriteHashMap]))
+    [io.github.radarroark.xitdb
+     ReadCountedHashMap ReadCursor ReadHashMap
+     WriteCountedHashMap WriteCursor WriteHashMap]))
 
 (defn map-seq
   [rhm]
@@ -18,14 +19,14 @@
     (.valAt this key nil))
 
   (valAt [this key not-found]
-    (let [cursor (.getCursor rhm (conversion/db-key key))]
+    (let [cursor (operations/map-read-cursor rhm key)]
       (if (nil? cursor)
         not-found
         (common/-read-from-cursor cursor))))
 
   clojure.lang.Associative
   (containsKey [this key]
-    (not (nil? (.getCursor rhm (conversion/db-key key)))))
+    (operations/map-contains-key? rhm key))
 
   (entryAt [this key]
     (let [v (.valAt this key nil)]
@@ -185,4 +186,11 @@
 (defn xhash-map [^ReadCursor read-cursor]
   (->XITDBHashMap (ReadHashMap. read-cursor)))
 
+(defn xwrite-hash-map-counted [^WriteCursor write-cursor]
+  (->XITDBWriteHashMap (WriteCountedHashMap. write-cursor)))
+
+(defn xhash-map-counted [^ReadCursor read-cursor]
+  (->XITDBHashMap (ReadCountedHashMap. read-cursor)))
+
+
 

src/xitdb/hash_set.clj

@@ -4,20 +4,22 @@
     [xitdb.util.conversion :as conversion]
     [xitdb.util.operations :as operations])
   (:import
-    [io.github.radarroark.xitdb ReadHashMap WriteCursor WriteHashMap]))
+    [io.github.radarroark.xitdb
+     ReadCountedHashSet ReadCursor ReadHashSet
+     WriteCountedHashSet WriteCursor WriteHashSet]))
 
 (defn set-seq
   [rhm]
   "The cursors used must implement the IReadFromCursor protocol."
-  (map val (operations/map-seq rhm #(common/-read-from-cursor %))))
+  (operations/set-seq rhm common/-read-from-cursor))
 
-(deftype XITDBHashSet [^ReadHashMap rhm]
+(deftype XITDBHashSet [^ReadHashSet rhs]
   clojure.lang.IPersistentSet
   (disjoin [_ k]
     (throw (UnsupportedOperationException. "XITDBHashSet is read-only")))
 
   (contains [this k]
-    (not (nil? (.getCursor rhm (conversion/db-key (if (nil? k) 0 (.hashCode k)))))))
+    (operations/set-contains? rhs k))
 
   (get [this k]
     (when (.contains this k)
@@ -36,11 +38,11 @@
          (every? #(.contains this %) other)))
 
   (count [_]
-    (operations/map-item-count rhm))
+    (operations/set-item-count rhs))
 
   clojure.lang.Seqable
   (seq [_]
-    (set-seq rhm))
+    (set-seq rhs))
 
   clojure.lang.ILookup
   (valAt [this k]
@@ -68,7 +70,7 @@
 
   common/IUnwrap
   (-unwrap [_]
-    rhm)
+    rhs)
 
   Object
   (toString [this]
@@ -84,26 +86,26 @@
     (into #{} (map common/materialize (seq this)))))
 
 ;; Writable version of the set
-(deftype XITDBWriteHashSet [^WriteHashMap whm]
+(deftype XITDBWriteHashSet [^WriteHashSet whs]
   clojure.lang.IPersistentSet
-  (disjoin [this k]
-    (operations/map-dissoc-key! whm (.hashCode k))
+  (disjoin [this v]
+    (operations/set-disj-value! whs (common/unwrap v))
     this)
 
-  (contains [this k]
-    (operations/map-contains-key? whm (.hashCode k)))
+  (contains [this v]
+    (operations/set-contains? whs (common/unwrap v)))
 
   (get [this k]
-    (when (.contains this k)
+    (when (.contains this (common/unwrap k))
       k))
 
   clojure.lang.IPersistentCollection
   (cons [this o]
-    (operations/set-assoc-value! whm (common/unwrap o))
+    (operations/set-assoc-value! whs (common/unwrap o))
     this)
 
   (empty [this]
-    (operations/set-empty! whm)
+    (operations/set-empty! whs)
     this)
 
   (equiv [this other]
@@ -112,11 +114,11 @@
          (every? #(.contains this %) other)))
 
   (count [_]
-    (operations/map-item-count whm))
+    (operations/set-item-count whs))
 
   clojure.lang.Seqable
   (seq [_]
-    (set-seq whm))
+    (set-seq whs))
 
   clojure.lang.ILookup
   (valAt [this k]
@@ -129,20 +131,25 @@
 
   common/ISlot
   (-slot [_]
-    (-> whm .cursor .slot))
+    (-> whs .cursor .slot))
 
   common/IUnwrap
   (-unwrap [_]
-    whm)
+    whs)
 
   Object
   (toString [_]
     (str "XITDBWriteHashSet")))
 
 ;; Constructor functions
 (defn xwrite-hash-set [^WriteCursor write-cursor]
-  (let [whm (operations/init-hash-set! write-cursor)]
-    (->XITDBWriteHashSet whm)))
+  (->XITDBWriteHashSet (WriteHashSet. write-cursor)))
+
+(defn xhash-set [^ReadCursor read-cursor]
+  (->XITDBHashSet (ReadHashSet. read-cursor)))
+
+(defn xwrite-hash-set-counted [^WriteCursor write-cursor]
+  (->XITDBWriteHashSet (WriteCountedHashSet. write-cursor)))
 
-(defn xhash-set [^ReadHashMap read-cursor]
-  (->XITDBHashSet (ReadHashMap. read-cursor)))
+(defn xhash-set-counted [^ReadCursor cursor]
+  (->XITDBHashSet (ReadCountedHashSet. cursor)))

src/xitdb/util/conversion.clj

@@ -2,7 +2,12 @@
   (:require
     [xitdb.util.validation :as validation])
   (:import
-    [io.github.radarroark.xitdb Database$Float Database$Bytes Database$Int Database$Uint ReadArrayList ReadCursor ReadHashMap ReadLinkedArrayList Slot WriteArrayList WriteCursor WriteHashMap Tag WriteLinkedArrayList]))
+    [io.github.radarroark.xitdb
+     Database Database$Bytes Database$Float Database$Int
+     ReadArrayList ReadCountedHashSet ReadCursor ReadHashMap ReadCountedHashMap
+     ReadHashSet Slot Tag WriteArrayList WriteCountedHashSet WriteCursor WriteCountedHashMap
+     WriteHashMap WriteHashSet WriteLinkedArrayList]
+    [java.nio ByteBuffer]))
 
 (defn xit-tag->keyword
   "Converts a XitDB Tag enum to a corresponding Clojure keyword."
@@ -26,7 +31,7 @@
   {:keyword     "kw"
    :boolean     "bl"
    :key-integer "ki"
-   :nil         "nl"
+   :nil         "nl"                                        ;; TODO: Could use Tag/NONE instead
    :inst        "in"
    :date        "da"})
 
@@ -46,6 +51,18 @@
       (name key))
     key))
 
+(defn db-key-hash
+  "Returns a byte array representing the stable hash digest of (Clojure) value `v`.
+  Uses the MessageDigest from the database."
+  ^bytes [^Database jdb v]
+  (if (nil? v)
+    (byte-array (-> jdb .-header .hashSize))
+    (let [hash-code (hash v)
+          buffer    (ByteBuffer/allocate Integer/BYTES)
+          _         (.putInt buffer hash-code)
+          bytes     (.array buffer)]
+      (.digest (.md jdb) bytes))))
+
 (defn ^Slot primitive-for
   "Converts a Clojure primitive value to its corresponding XitDB representation.
   Handles strings, keywords, integers, booleans, and floats.
@@ -105,13 +122,30 @@
     (instance? WriteHashMap v)
     (-> ^WriteHashMap v .cursor .slot)
 
-    ;;TODO: Confirm that it is correct to return the Read slots
     (instance? ReadHashMap v)
     (-> ^ReadHashMap v .cursor .slot)
 
+    (instance? ReadCountedHashMap v)
+    (-> ^ReadCountedHashMap v .cursor .slot)
+
+    (instance? WriteCountedHashMap v)
+    (-> ^WriteCountedHashMap v .cursor .slot)
+
     (instance? ReadArrayList v)
     (-> ^ReadArrayList v .cursor .slot)
 
+    (instance? ReadHashSet v)
+    (-> ^ReadHashSet v .cursor .slot)
+
+    (instance? ReadCountedHashSet v)
+    (-> ^ReadCountedHashSet v .cursor .slot)
+
+    (instance? WriteHashSet v)
+    (-> ^WriteHashSet v .cursor .slot)
+
+    (instance? WriteCountedHashSet v)
+    (-> ^WriteCountedHashSet v .cursor .slot)
+
     (map? v)
     (do
       (.write cursor nil)
@@ -141,14 +175,14 @@
   [k]
   (cond
     (integer? k)
-    (database-bytes (str k) "ki") ;integer keys are stored as strings with 'ki' format tag
+    (database-bytes (str k) "ki")                           ;integer keys are stored as strings with 'ki' format tag
     :else
     (primitive-for k)))
 
 (defn read-bytes-with-format-tag [^ReadCursor cursor]
   (let [bytes-obj (.readBytesObject cursor nil)
-        str (String. (.value bytes-obj))
-        fmt-tag (some-> bytes-obj .formatTag String.)]
+        str       (String. (.value bytes-obj))
+        fmt-tag   (some-> bytes-obj .formatTag String.)]
     (cond
 
       (= fmt-tag (fmt-tag-value :keyword))
@@ -228,34 +262,27 @@
         (.append write-list (primitive-for v))))
     (.-cursor write-list)))
 
-;; Forward declarations for mutual dependencies
-(declare map-assoc-value!)
-(declare init-hash-set!)
-(declare set-assoc-value!)
-
 (defn ^WriteCursor map->WriteHashMapCursor!
   "Writes a Clojure map to a XitDB WriteHashMap.
   Returns the cursor of the created WriteHashMap."
   [^WriteCursor cursor m]
-  (let [whm (WriteHashMap. cursor)]
+  (let [whm (WriteCountedHashMap. cursor)]
     (doseq [[k v] m]
-      (let [cursor (.putCursor whm (db-key k))]
+      (let [hash-value (db-key-hash (-> cursor .db) k)
+            key-cursor (.putKeyCursor whm hash-value)
+            cursor     (.putCursor whm hash-value)]
+        (.writeIfEmpty key-cursor (v->slot! key-cursor k))
         (.write cursor (v->slot! cursor v))))
     (.-cursor whm)))
 
 (defn ^WriteCursor set->WriteCursor!
-  "Creates a hash-map and associates the internal key :is-set? to 1.
-  Map is keyed by the .hashCode of the value, valued by the value :)"
+  "Writes a Clojure set `s` to a XitDB WriteHashSet.
+  Returns the cursor of the created WriteHashSet."
   [^WriteCursor cursor s]
-  (let [whm (WriteHashMap. cursor)
-        ;; Mark as set
-        is-set-key (db-key :%xitdb_set)]
-    (-> whm
-        (.putCursor is-set-key)
-        (.write (primitive-for 1)))
-    ;; Add values  
+  (let [whm (WriteCountedHashSet. cursor)
+        db  (-> cursor .db)]
     (doseq [v s]
-      (let [hash-code (if v (.hashCode v) 0)
-            cursor (.putCursor whm (db-key hash-code))]
-        (.write cursor (v->slot! cursor v))))
+      (let [hash-code (db-key-hash db v)
+            cursor    (.putCursor whm hash-code)]
+        (.writeIfEmpty cursor (v->slot! cursor v))))
     (.-cursor whm)))