🎉 Add generic PointerMap abstraction

backend/src/app/util/pointer_map.clj

@@ -0,0 +1,224 @@
+;; 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.util.pointer-map
+  (:require
+   [app.common.logging :as l]
+   [app.common.transit :as t]
+   [app.common.uuid :as uuid]
+   [app.util.fressian :as fres]
+   [app.util.time :as dt]
+   [clojure.core :as c])
+  (:import
+   clojure.lang.Counted
+   clojure.lang.IDeref
+   clojure.lang.IHashEq
+   clojure.lang.IObj
+   clojure.lang.IPersistentCollection
+   clojure.lang.IPersistentMap
+   clojure.lang.PersistentArrayMap
+   clojure.lang.PersistentHashMap
+   clojure.lang.Seqable
+   java.util.List))
+
+(def ^:dynamic *load-fn* nil)
+(def ^:dynamic *tracked* nil)
+(def ^:dynamic *metadata* {})
+
+(declare create)
+
+(defprotocol IPointerMap
+  (get-id [_])
+  (load! [_])
+  (modified? [_])
+  (clone [_]))
+
+(deftype PointerMap [id mdata
+                     ^:unsynchronized-mutable odata
+                     ^:unsynchronized-mutable modified?
+                     ^:unsynchronized-mutable loaded?]
+
+  IPointerMap
+  (load! [_]
+    (l/trace :hint "pointer-map:load" :id id)
+    (set! loaded? true)
+
+    (when-not *load-fn*
+      (throw (UnsupportedOperationException. "load is not supported when *load-fn* is not bind")))
+
+    (when-let [data (*load-fn* id)]
+      (set! odata data))
+    (or odata {}))
+
+  (modified? [_] modified?)
+  (get-id [_] id)
+
+  (clone [this]
+    (when-not loaded? (load! this))
+    (let [mdata (assoc mdata :created-at (dt/now))
+          id    (uuid/next)
+          pmap  (PointerMap. id
+                             mdata
+                             odata
+                             true
+                             true)]
+      (some-> *tracked* (swap! assoc id pmap))
+      pmap))
+
+  IDeref
+  (deref [this]
+    (when-not loaded? (load! this))
+    (or odata {}))
+
+  ;; We don't need to load the data for calculate hash because this
+  ;; map has specific behavior
+  IHashEq
+  (hasheq [_] (hash id))
+
+  Object
+  (hashCode [this]
+    (.hasheq ^IHashEq this))
+
+  IObj
+  (meta [_]
+    (or mdata {}))
+
+  (withMeta [_ mdata']
+    (let [pmap (PointerMap. id mdata' odata (not= mdata mdata') loaded?)]
+      (some-> *tracked* (swap! assoc id pmap))
+      pmap))
+
+  Seqable
+  (seq [this]
+    (when-not loaded? (load! this))
+    (.seq ^Seqable odata))
+
+  IPersistentCollection
+  (equiv [this other]
+    (identical? this other))
+
+  IPersistentMap
+  (cons [this o]
+    (when-not loaded? (load! 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 loaded? (load! this))
+    (contains? odata key))
+
+  (entryAt [this key]
+    (when-not loaded? (load! this))
+    (.entryAt ^IPersistentMap odata key))
+
+  (valAt [this key]
+    (when-not loaded? (load! this))
+    (.valAt ^IPersistentMap odata key))
+
+  (valAt [this key not-found]
+    (when-not loaded? (load! this))
+    (.valAt ^IPersistentMap odata key not-found))
+
+  (assoc [this key val]
+    (when-not loaded? (load! this))
+    (let [odata (assoc odata key val)
+          mdata (assoc mdata :created-at (dt/now))
+          id    (if modified? id (uuid/next))
+          pmap  (PointerMap. id
+                             mdata
+                             odata
+                             true
+                             true)]
+      (some-> *tracked* (swap! assoc id pmap))
+      pmap))
+
+  (assocEx [_ _ _]
+    (throw (UnsupportedOperationException. "method not implemented")))
+
+  (without [this key]
+    (when-not loaded? (load! this))
+    (let [odata (dissoc odata key)
+          mdata (assoc mdata :created-at (dt/now))
+          id    (if modified? id (uuid/next))
+          pmap  (PointerMap. id
+                             mdata
+                             odata
+                             true
+                             true)]
+      (some-> *tracked* (swap! assoc id pmap))
+      pmap))
+
+  Counted
+  (count [this]
+    (when-not loaded? (load! this))
+    (count odata))
+
+  Iterable
+  (iterator [this]
+    (when-not loaded? (load! this))
+    (.iterator ^Iterable odata)))
+
+(defn create
+  ([]
+   (let [id    (uuid/next)
+         mdata (assoc *metadata* :created-at (dt/now))
+         pmap  (PointerMap. id mdata {} true true)]
+     (some-> *tracked* (swap! assoc id pmap))
+     pmap))
+  ([id mdata]
+   (let [pmap (PointerMap. id mdata {} false false)]
+     (some-> *tracked* (swap! assoc id pmap))
+     pmap)))
+
+(defn pointer-map?
+  [o]
+  (instance? PointerMap o))
+
+(defn wrap
+  [data]
+  (if (pointer-map? data)
+    (do
+      (some-> *tracked* (swap! assoc (get-id data) data))
+      data)
+    (into (create) data)))
+
+(fres/add-handlers!
+ {:name "penpot/experimental/pointer-map/v2"
+  :class PointerMap
+  :wfn (fn [n w o]
+         (fres/write-tag! w n 3)
+         (let [id (get-id o)]
+           (fres/write-int! w (uuid/get-word-high id))
+           (fres/write-int! w (uuid/get-word-low id)))
+         (fres/begin-closed-list! w)
+         (loop [items (-> o meta seq)]
+           (when-let [^clojure.lang.MapEntry item (first items)]
+             (fres/write-object! w (.key item) true)
+             (fres/write-object! w (.val item))
+             (recur (rest items))))
+         (fres/end-list! w))
+  :rfn (fn [r]
+         (let [msb (fres/read-object! r)
+               lsb (fres/read-object! r)
+               kvs (fres/read-object! r)]
+           (create (uuid/custom msb lsb)
+                   (if (< (.size ^List kvs) 16)
+                     (PersistentArrayMap. (.toArray ^List kvs))
+                     (PersistentHashMap/create (seq kvs))))))})
+
+(t/add-handlers!
+ {:id "penpot/pointer"
+  :class PointerMap
+  :wfn (fn [val]
+         [(get-id val) (meta val)])})
+
+