Neested serialization strategy based map (TransitMap, ObjectsMap)

objects_map2.clj

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC

(ns app.common.types.objects-map2
  "Implements a specialized map-like data structure for store an UUID =>
  OBJECT mappings. The main purpose of this data structure is be able
  to serialize it on fressian as byte-array and have the ability to
  decode each field separatelly without the need to decode the whole
  map from the byte-array.

  It works transparently, so no aditional dynamic vars are needed.  It
  only works by reference equality and the hash-code is calculated
  properly from each value."

  (:require
   #?(:clj [clojure.data.json :as json])
   #?(:clj [app.common.fressian :as fres])
   [clojure.core.protocols :as cp]
   [app.common.data :as d]
   [app.common.transit :as t]
   [app.common.uuid :as uuid]
   [app.common.buffer :as buf]
   [clojure.core :as c])
  #?(:clj
     (:import
      clojure.lang.Counted
      clojure.lang.IHashEq
      clojure.lang.IMapEntry
      clojure.lang.IObj
      clojure.lang.IPersistentCollection
      clojure.lang.IPersistentMap
      clojure.lang.Murmur3
      clojure.lang.RT
      clojure.lang.Seqable
      java.nio.ByteBuffer
      java.util.Iterator
      java.util.UUID)))

#?(:clj (set! *warn-on-reflection* true))

(def ^:dynamic *lazy* true)

(def RECORD-SIZE (+ 16 8))

(declare create)
(declare ^:private initialize)
(declare ^:private read-index)
(declare ^:private read-objects)
(declare ^:private do-compact)

(defprotocol IObjectsMap
  (-initialize [_] "read the header and initialize the the object map instance")
  (-compact [_])
  (-hash-for-key [_ key] "retrieve a hash for a key")
  (-get-buffer [_] "retrieve internal buffer"))


#?(:clj
   (deftype ObjectsMapEntry [key omap]
     clojure.lang.IMapEntry
     (key [_] key)
     (getKey [_] key)

     (val [_]
       (get omap key))
     (getValue [_]
       (get omap key))

     clojure.lang.IHashEq
     (hasheq [_]
       (-hash-for-key omap key))))

#?(:clj
   (deftype ObjectsMapIterator [^Iterator iterator omap]
     Iterator
     (hasNext [_]
       (.hasNext iterator))

     (next [_]
       (let [entry (.next iterator)]
         (ObjectsMapEntry. (key entry) omap)))))

#?(:clj
   (deftype ObjectsMap [metadata
                        ^:unsynchronized-mutable buffer
                        ^:unsynchronized-mutable header
                        ^:unsynchronized-mutable data
                        ^:unsynchronized-mutable initialized
                        ^:unsynchronized-mutable modified
                        ^:unsynchronized-mutable hash
                        ^:unsynchronized-mutable index
                        ^:unsynchronized-mutable cache]

     Object
     (hashCode [this]
       (.hasheq ^clojure.lang.IHashEq this))

     cp/Datafiable
     (datafy [this]
       {:buffer buffer
        :initialized initialized
        :modified modified
        :hash hash
        :index index
        :cache cache})

     IObjectsMap
     (-initialize [this]
       (locking this
         (when-not initialized
           (let [index' (read-index header)
                 cache' (if *lazy*
                          {}
                          (read-objects data index'))]
             (set! (.-index this) index')
             (set! (.-cache this) cache')
             (set! (.-initialized this) true)))))

     (-compact [this]
       (locking this
         (when modified
           (do-compact buffer header data index cache
                       (fn [buffer' header' data' index']
                         (set! (.-modified this) false)
                         (set! (.-buffer this) buffer')
                         (set! (.-header this) header')
                         (set! (.-data this) data')
                         (set! (.-index this) index'))))))

     (-hash-for-key [this key]
       (if (contains? cache key)
         (c/hash (get cache key))
         (let [pos (val (get index key))]
           (buf/read-int data pos))))

     (-get-buffer [this]
       (-compact this)
       buffer)

     json/JSONWriter
     (-write [this writter options]
       (json/-write (into {} this) writter options))

     clojure.lang.IHashEq
     (hasheq [this]
       (when-not hash
         (set! hash (Murmur3/hashUnordered this)))
       hash)

     clojure.lang.Seqable
     (seq [this]
       (when-not initialized (-initialize this))
       (RT/chunkIteratorSeq (.iterator ^Iterable this)))

     java.lang.Iterable
     (iterator [this]
       (when-not initialized (-initialize this))
       (ObjectsMapIterator. (.iterator ^Iterable index) this))

     IPersistentCollection
     (equiv [this other]
       (and (instance? ObjectsMap other)
            (= (count this) (count other))
            (reduce-kv (fn [result id _]
                         (let [this-val  (get this id)
                               other-val (get other id)
                               result    (= this-val other-val)]
                           (or result
                               (reduced false))))
                       true
                       index)))

     clojure.lang.IPersistentMap
     (cons [this o]
       (when-not initialized (-initialize this))
       (if (map-entry? o)
         (assoc this (key o) (val o))
         (if (vector? o)
           (assoc this (nth o 0) (nth o 1))
           (throw (UnsupportedOperationException. "invalid arguments to cons")))))

     (empty [_]
       (create))

     (containsKey [this key]
       (when-not initialized (-initialize this))
       (contains? index key))

     (entryAt [this key]
       (when-not initialized (-initialize this))
       (ObjectsMapEntry. this key))

     (valAt [this key]
       (when-not initialized (-initialize this))
       (locking this
         (if (contains? cache key)
           (get cache key)
           (if (contains? index key)
             (let [[size pos] (get index key)
                   bval       (buf/read-bytes data (+ pos 4) (- size 4))
                   oval       (t/decode bval)]
               (set! (.-cache this) (assoc cache key oval))
               oval)
             (do
               (set! (.-cache this) (assoc cache key nil))
               nil)))))

     (valAt [this key not-found]
       (when-not initialized (-initialize this))
       (if (.containsKey ^IPersistentMap index key)
         (.valAt this key)
         not-found))

     (assoc [this key val]
       (when-not initialized (-initialize this))
       (when-not (instance? UUID key)
         (throw (IllegalArgumentException. "key should be an instance of UUID")))
       (ObjectsMap. metadata
                    buffer
                    header
                    data
                    true
                    true
                    nil
                    (assoc index key nil)
                    (assoc cache key val)))


     (assocEx [_ _ _]
       (throw (UnsupportedOperationException. "method not implemented")))

     (without [this key]
       (when-not initialized (-initialize this))
       (ObjectsMap. metadata
                    buffer
                    header
                    data
                    true
                    true
                    nil
                    (dissoc index key)
                    (dissoc cache key)))

     clojure.lang.Counted
     (count [this]
       (when-not initialized (-initialize this))
       (count index))))

(defn- read-index
  [header]
  (persistent!
   (reduce (fn [result i]
             (let [offset (* i RECORD-SIZE)
                   key    (buf/read-uuid header (+ offset 0))
                   size   (buf/read-int header  (+ offset 16))
                   cpos   (buf/read-int header  (+ offset 20))]
               (assoc! result key (d/vec2 size cpos))))
           (transient {})
           (-> (/ (buf/size header) RECORD-SIZE)
               (long)
               (range)))))

(defn- read-objects
  [data index]
  (persistent!
   (reduce-kv (fn [result key [size pos]]
                (let [bbuf (buf/read-bytes data
                                           (+ pos 4)
                                           (- size 4))]
                  (assoc! result (t/decode bbuf))))
              (transient {})
              index)))

(defn- do-compact
  [buffer header data index cache update-fn]
  (let [[new-data new-hash data-size]
        (loop [entries (seq index)
               data-size 0
               new-data {}
               new-hash {}]
          (if-let [entry (first entries)]
            (let [[key [size :as entry-value]] entry]
              (if (nil? entry-value)
                (let [nval (get cache key)
                      hash (c/hash nval)
                      bval (t/encode nval)
                      size (+ (alength ^bytes bval) 4)]
                  (recur (rest entries)
                         (+ data-size size)
                         (assoc new-data key bval)
                         (assoc new-hash key hash)))
                (recur (rest entries)
                       (+ data-size ^long size)
                       new-data
                       new-hash)))

            [new-data new-hash data-size]))

        header-size
        (* (count index) RECORD-SIZE)

        buffer-size
        (+ 4 header-size data-size)

        buffer'
        (buf/allocate buffer-size)

        header'
        (buf/slice buffer' 4 header-size)

        data'
        (buf/slice buffer'
                   (+ 4 header-size)
                   data-size)

        index'
        (loop [entries  (seq index)
               position 0
               offset   0
               index    {}]
          (if-let [[key [size prev-pos :as value-entry]] (first entries)]
            (do
              (buf/write-uuid header' (+ offset 0) key)
              (buf/write-int header'  (+ offset 20) position)

              (if (nil? value-entry)
                (let [bval (get new-data key)
                      hval (get new-hash key)
                      size (+ (alength ^bytes bval) 4)]

                  (buf/write-int header' (+ offset 16) size)
                  (buf/write-int data' (+ position 0) hval)
                  (buf/write-bytes data' (+ position 4) bval (- size 4))
                  (recur (rest entries)
                         (+ position ^long size)
                         (+ offset ^long RECORD-SIZE)
                         (assoc index key (d/vec2 size position))))

                (do
                  (buf/write-int header' (+ offset 16) size)
                  (buf/copy-bytes data prev-pos size data' position)
                  (recur (rest entries)
                         (+ position ^long size)
                         (+ offset ^long RECORD-SIZE)
                         (assoc index key (d/vec2 size position))))))
            index))]

    (buf/write-int buffer' 0 header-size)

    (update-fn buffer' header' data' index')
    nil))

(defn from-buffer
  [buffer]
  (let [header-size (buf/read-int buffer 0)
        header      (buf/slice buffer 4 header-size)
        data        (buf/slice buffer
                               (+ 4 header-size)
                               (- (buf/size buffer)
                                  (+ 4 header-size)))]
    (ObjectsMap. {}
                 buffer
                 header
                 data
                 false
                 false
                 nil
                 nil
                 nil)))

(defn from-bytes
  [barray]
  (from-buffer (buf/wrap barray)))

(defn objects-map?
  [o]
  (instance? ObjectsMap o))

(defn create
  ([]
   (let [buf (buf/allocate 4)]
     (buf/write-i32 buf 0 0)
     (from-buffer buf)))
  ([other]
   (cond
     (objects-map? other)
     (let [buf (-get-buffer other)
           buf (buf/clone buf)]
       (from-buffer buf))

     :else
     (throw (UnsupportedOperationException. "invalid arguments")))))

(defn wrap
  [objects]
  (if (instance? ObjectsMap objects)
    objects
    (let [result (into (create) objects)]
      (-compact result)
      result)))

(fres/add-handlers!
 {:name "penpot/objects-map/v3"
  :class ObjectsMap
  :wfn (fn [n w o]
         (fres/write-tag! w n)
         (fres/write-bytes! w (.array ^ByteBuffer (-get-buffer o))))
  :rfn (fn [r]
         (-> r fres/read-object! from-bytes))})

(t/add-handlers!
 {:id "penpot/objects-map/v3"
  :class ObjectsMap
  :wfn (fn [^ObjectsMap o]
         (let [buffer (-get-buffer o)]
           #?(:cljs (js/Uint8Array. (.-buffer ^js/DataView buffer))
              :clj  (.array ^ByteBuffer buffer))))

  :rfn (fn [o]
         (from-bytes o))})

transit_map.cljc

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC

(ns app.common.types.transit-map
  (:require
   #?(:clj [app.common.fressian :as fres])
   #?(:clj [clojure.data.json :as json])
   [app.common.transit :as t]
   [clojure.core :as c]
   [clojure.core.protocols :as cp])
  #?(:clj
     (:import
      clojure.lang.RT

#?(:clj (set! *warn-on-reflection* true))

(declare create)

(defprotocol ITransitMap
  (^:no-doc initialize [this])
  (^:no-doc compact [this])
  (^:no-doc get-data [this] "retrieve internal data"))

#?(:cljs
   (deftype TransitMap [metadata cache
                        ^:mutable data
                        ^:mutable modified]
     Object
     (toString [this]
       (pr-str* this))
     (equiv [this other]
       (c/-equiv this other))
     (keys [this]
       (c/es6-iterator (keys this)))
     (entries [this]
       (c/es6-entries-iterator (seq this)))
     (values [this]
       (es6-iterator (vals this)))
     (has [this k]
       (c/contains? this k))
     (get [this k not-found]
       (c/-lookup this k not-found))
     (forEach [this f]
       (run! (fn [[k v]] (f v k)) this))

     cp/Datafiable
     (datafy [_]
       {:data data
        :cache cache
        :modified modified})

     ITransitMap
     (initialize [this]
       (if-not ^boolean cache
         (let [data' (t/decode-str data)]
           (set! (.-cache this) data')
           data)
         cache))

     (compact [this]
       (when-not ^boolean cache
         (set! (.-cache this) (t/decode-str data)))
       (when ^boolean modified
         (set! (.-modified this) false)
         (set! (.-data this) (t/encode-str cache)))
       this)

     (get-data [this]
       (compact this)
       data)

     c/IWithMeta
     (-with-meta [this new-meta]
       (if (identical? new-meta meta)
         this
         (TransitMap. new-meta
                      cache
                      data
                      modified)))

     c/IMeta
     (-meta [_] metadata)

     c/ICloneable
     (-clone [this]
       (compact this)
       (TransitMap. metadata {} data false))

     c/IIterable
     (-iterator [this]
       (c/seq-iter this))

     c/ICollection
     (-conj [this entry]
       (let [data (-> (initialize this)
                      (c/-conj entry))]
         (TransitMap. metadata data nil true)))

     c/IEmptyableCollection
     (-empty [_]
       (create))

     c/IEquiv
     (-equiv [this other]
       (-> (initialize this)
           (equiv-map other)))

     c/IHash
     (-hash [this]
       (c/-hash (initialize this)))

     c/ISeqable
     (-seq [this]
       (c/-seq (initialize this)))

     c/ICounted
     (-count [this]
       (c/-count (initialize this)))

     c/ILookup
     (-lookup [this k]
       (c/-lookup (initialize this) k))

     (-lookup [this k not-found]
       (c/-lookup (initialize this) k not-found))

     c/IAssociative
     (-assoc [this k v]
       (let [data (-> (initialize this)
                      (c/-assoc k v))]
         (TransitMap. metadata data nil true)))

     (-contains-key? [this k]
       (c/-contains-key? (initialize this) k))

     c/IFind
     (-find [this k]
       (c/-find (initialize this) k))

     c/IMap
     (-dissoc [this k]
       (let [data (-> (initialize this)
                      (c/-dissoc k))]
         (TransitMap. metadata data nil true)))

     c/IKVReduce
     (-kv-reduce [this f init]
       (c/-kv-reduce (initialize this) f init))

     c/IFn
     (-invoke [this k]
       (c/-lookup this k))
     (-invoke [this k not-found]
       (c/-lookup this k not-found))

     c/IPrintWithWriter
     (-pr-writer [this writer opts]
       (c/pr-sequential-writer
        writer
        (fn [item w _]
          (c/-write w (pr-str (c/-key item)))
          (c/-write w \space)
          (c/-write w (pr-str (c/-val item))))
        "#penpot/transit-map {" ", " "}"
        opts
        (seq this))))

   :clj
   (deftype TransitMap [metadata
                        ^:volatile-mutable cache
                        ^:unsynchronized-mutable data
                        ^:volatile-mutable modified]

     Object
     (hashCode [this]
       (.hasheq ^clojure.lang.IHashEq this))

     cp/Datafiable
     (datafy [_]
       {:data data
        :cache cache
        :modified modified})

     ITransitMap
     (initialize [this]
       (if-not ^boolean cache
         (let [data' (if (nil? data) {} (t/decode-str data))]
           (set! (.-cache this) data')
           data')
         cache))

     (compact [this]
       (when ^boolean modified
         (set! (.-modified this) false)
         (set! (.-data this) (t/encode-str cache)))
       this)

     (get-data [this]
       (compact this)
       data)

     json/JSONWriter
     (-write [this writter options]
       (json/-write (into {} this) writter options))

     clojure.lang.IHashEq
     (hasheq [this]
       (.hasheq ^clojure.lang.IHashEq (initialize this)))

     clojure.lang.Seqable
     (seq [this]
       (clojure.lang.RT/chunkIteratorSeq (.iterator ^Iterable this)))

     java.lang.Iterable
     (iterator [this]
       (.iterator ^java.lang.Iterable (initialize this)))

     clojure.lang.IPersistentCollection
     (equiv [this other]
       (and (instance? TransitMap other)
            (= (count this) (count other))
            (reduce-kv (fn [_ id this-val]
                         (let [other-val (get other id)
                               result    (= this-val other-val)]
                           (or result
                               (reduced false))))
                       true
                       cache)))

     clojure.lang.IPersistentMap
     (cons [this o]
       (let [data (.cons ^clojure.lang.IPersistentMap (initialize this) o)]
         (TransitMap. metadata data nil true)))

     (empty [_]
       (create))

     (containsKey [this key]
       (.containsKey ^clojure.lang.IPersistentMap (initialize this) key))

     (entryAt [this key]
       (.entryAt ^clojure.lang.IPersistentMap (initialize this) key))

     (valAt [this key]
       (.valAt ^clojure.lang.IPersistentMap (initialize this) key))

     (valAt [this key not-found]
       (.valAt ^clojure.lang.IPersistentMap (initialize this) key not-found))

     (assoc [this key val]
       (let [data (.assoc ^clojure.lang.IPersistentMap (initialize this) key val)]
         (TransitMap. metadata data nil true)))

     (assocEx [_ _ _]
       (throw (UnsupportedOperationException. "method not implemented")))

     (without [this key]
       (let [data (.without ^clojure.lang.IPersistentMap (initialize this) key)]
         (TransitMap. metadata data nil true)))

     clojure.lang.Counted
     (count [this]
       (.count ^clojure.lang.Counted (initialize this)))))

#?(:cljs (es6-iterable TransitMap))

(defn from-data
  [data]
  (TransitMap. {} nil data false))

(defn transit-map?
  [o]
  (instance? TransitMap o))

(defn create
  ([] (from-data nil))
  ([other]
   (cond
     (transit-map? other)
     (-> other get-data from-data)

     :else
     (throw #?(:clj (UnsupportedOperationException. "invalid arguments")
               :cljs (js/Error. "invalid arguments"))))))

(defn wrap
  [objects]
  (if (instance? TransitMap objects)
    objects
    (->> objects
         (into (create))
         #_(compact))))

#?(:clj
   (fres/add-handlers!
    {:name "penpot/transit-map/v2"
     :class TransitMap
     :wfn (fn [n w o]
            (fres/write-tag! w n)
            (fres/write-object! w (get-data o)))
     :rfn (fn [r]
            (-> r fres/read-object! from-data))}))

(t/add-handlers!
 {:id "penpot/transit-map/v2"
  :class TransitMap
  :wfn get-data
  :rfn from-data})