penpot/backend/src/app/util/pointer_map.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.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)])})