From e16ec9c7195607b71836ac1b3fc25d89d563f34d Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Thu, 21 Nov 2024 15:25:52 +0100
Subject: [PATCH] :sparkles: Add facility for create anonymous objects

Speciailly designed to be work in plugins where code
is submited to hard deep freeze on the sandboxing
process.
---
 frontend/deps.edn                  |   2 +
 frontend/dev/user.clj              |  34 +++++
 frontend/scripts/repl              |   6 +
 frontend/src/app/plugins/file.cljs | 146 +++++++++---------
 frontend/src/app/util/object.cljc  | 235 +++++++++++++++++++++++++++++
 frontend/src/app/util/object.cljs  |  76 ----------
 6 files changed, 348 insertions(+), 151 deletions(-)
 create mode 100644 frontend/dev/user.clj
 create mode 100755 frontend/scripts/repl
 create mode 100644 frontend/src/app/util/object.cljc
 delete mode 100644 frontend/src/app/util/object.cljs

diff --git a/frontend/deps.edn b/frontend/deps.edn
index e847b4fbe..394c49bf3 100644
--- a/frontend/deps.edn
+++ b/frontend/deps.edn
@@ -43,7 +43,9 @@
   {:extra-paths ["dev"]
    :extra-deps
    {thheller/shadow-cljs {:mvn/version "2.28.18"}
+    com.bhauman/rebel-readline {:mvn/version "RELEASE"}
     org.clojure/tools.namespace {:mvn/version "RELEASE"}
+    criterium/criterium {:mvn/version "RELEASE"}
     cider/cider-nrepl {:mvn/version "0.48.0"}}}
 
   :shadow-cljs
diff --git a/frontend/dev/user.clj b/frontend/dev/user.clj
new file mode 100644
index 000000000..763c2a009
--- /dev/null
+++ b/frontend/dev/user.clj
@@ -0,0 +1,34 @@
+;; 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 user
+  (:require
+   [app.common.data :as d]
+   [app.common.pprint :as pp]
+   [clojure.java.io :as io]
+   [clojure.tools.namespace.repl :as repl]
+   [clojure.pprint :refer [pprint print-table]]
+   [clojure.repl :refer :all]
+   [clojure.walk :refer [macroexpand-all]]
+   [criterium.core  :as crit]))
+
+;; --- Benchmarking Tools
+
+(defmacro run-quick-bench
+  [& exprs]
+  `(crit/with-progress-reporting (crit/quick-bench (do ~@exprs) :verbose)))
+
+(defmacro run-quick-bench'
+  [& exprs]
+  `(crit/quick-bench (do ~@exprs)))
+
+(defmacro run-bench
+  [& exprs]
+  `(crit/with-progress-reporting (crit/bench (do ~@exprs) :verbose)))
+
+(defmacro run-bench'
+  [& exprs]
+  `(crit/bench (do ~@exprs)))
diff --git a/frontend/scripts/repl b/frontend/scripts/repl
new file mode 100755
index 000000000..bf9f4065f
--- /dev/null
+++ b/frontend/scripts/repl
@@ -0,0 +1,6 @@
+#!/usr/bin/env bash
+
+export OPTIONS="-A:dev -J-XX:-OmitStackTraceInFastThrow";
+
+set -ex
+exec clojure $OPTIONS -M -m rebel-readline.main
diff --git a/frontend/src/app/plugins/file.cljs b/frontend/src/app/plugins/file.cljs
index 07bedf5e7..ea7d9b1be 100644
--- a/frontend/src/app/plugins/file.cljs
+++ b/frontend/src/app/plugins/file.cljs
@@ -28,92 +28,88 @@
    [app.util.time :as dt]
    [beicon.v2.core :as rx]))
 
-(declare file-version-proxy)
-
-(deftype FileVersionProxy [$plugin $file $version $data]
-  Object
-  (restore
-    [_]
-    (cond
-      (not (r/check-permission $plugin "content:write"))
-      (u/display-not-valid :restore "Plugin doesn't have 'content:write' permission")
-
-      :else
-      (let [project-id (:current-project-id @st/state)]
-        (st/emit! (dwv/restore-version project-id $file $version :plugin)))))
-
-  (remove
-    [_]
-    (js/Promise.
-     (fn [resolve reject]
-       (cond
-         (not (r/check-permission $plugin "content:write"))
-         (u/reject-not-valid reject :remove "Plugin doesn't have 'content:write' permission")
-
-         :else
-         (->> (rp/cmd! :delete-file-snapshot {:id $version})
-              (rx/subs! #(resolve) reject))))))
-
-  (pin
-    [_]
-    (js/Promise.
-     (fn [resolve reject]
-       (cond
-         (not (r/check-permission $plugin "content:write"))
-         (u/reject-not-valid reject :pin "Plugin doesn't have 'content:write' permission")
-
-         (not= "system" (:created-by $data))
-         (u/reject-not-valid reject :pin "Only auto-saved versions can be pinned")
-
-         :else
-         (let [params  {:id $version
-                        :label (dt/format (:created-at $data) :date-full)}]
-           (->> (rx/zip (rp/cmd! :get-team-users {:file-id $file})
-                        (rp/cmd! :update-file-snapshot params))
-                (rx/subs! (fn [[users data]]
-                            (let [users (d/index-by :id users)]
-                              (resolve (file-version-proxy $plugin $file users data))))
-                          reject))))))))
-
 (defn file-version-proxy
   [plugin-id file-id users data]
   (let [data (atom data)]
-    (crc/add-properties!
-     (FileVersionProxy. plugin-id file-id (:id @data) data)
-     {:name "$plugin" :enumerable false :get (constantly plugin-id)}
-     {:name "$file" :enumerable false :get (constantly file-id)}
-     {:name "$version" :enumerable false :get (constantly (:id @data))}
-     {:name "$data" :enumerable false :get (constantly @data)}
+    (obj/reify {:name "FileVersionProxy"}
+      :$plugin  {:get (fn [] plugin-id) :enumerable false}
+      :$file    {:get (fn [] file-id) :enumerable false}
+      :$version {:get (fn [] (:id @data)) :enumerable false}
+      :$data    {:get (fn [] @data) :enumerable false}
 
-     {:name "label"
-      :get (fn [_] (:label @data))
-      :set
-      (fn [_ value]
+      :label
+      {:get #(:label @data)
+       :set
+       (fn [value]
+         (cond
+           (not (r/check-permission plugin-id "content:write"))
+           (u/display-not-valid :label "Plugin doesn't have 'content:write' permission")
+
+           (or (not (string? value)) (empty? value))
+           (u/display-not-valid :label value)
+
+           :else
+           (do (swap! data assoc :label value :created-by "user")
+               (->> (rp/cmd! :update-file-snapshot {:id (:id @data) :label value})
+                    (rx/take 1)
+                    (rx/subs! identity)))))}
+
+      :createdBy
+      {:get
+       (fn []
+         (when-let [user-data (get users (:profile-id @data))]
+           (user/user-proxy plugin-id user-data)))}
+
+      :createdAt
+      {:get #(.toJSDate ^js (:created-at @data))}
+
+      :isAutosave
+      {:get #(= "system" (:created-by @data))}
+
+      :restore
+      (fn []
         (cond
           (not (r/check-permission plugin-id "content:write"))
-          (u/display-not-valid :label "Plugin doesn't have 'content:write' permission")
-
-          (or (not (string? value)) (empty? value))
-          (u/display-not-valid :label value)
+          (u/display-not-valid :restore "Plugin doesn't have 'content:write' permission")
 
           :else
-          (do (swap! data assoc :label value :created-by "user")
-              (->> (rp/cmd! :update-file-snapshot {:id (:id @data) :label value})
-                   (rx/take 1)
-                   (rx/subs! identity)))))}
+          (let [project-id (:current-project-id @st/state)
+                version-id (get @data :id)]
+            (st/emit! (dwv/restore-version project-id file-id version-id :plugin)))))
 
-     {:name "createdBy"
-      :get (fn [_]
-             (when-let [user-data (get users (:profile-id @data))]
-               (user/user-proxy plugin-id user-data)))}
+      :remove
+      (fn []
+        (js/Promise.
+         (fn [resolve reject]
+           (cond
+             (not (r/check-permission plugin-id "content:write"))
+             (u/reject-not-valid reject :remove "Plugin doesn't have 'content:write' permission")
 
-     {:name "createdAt"
-      :get (fn [_]
-             (.toJSDate ^js (:created-at @data)))}
+             :else
+             (let [version-id (:id @data)]
+               (->> (rp/cmd! :delete-file-snapshot {:id version-id})
+                    (rx/subs! #(resolve) reject)))))))
 
-     {:name "isAutosave"
-      :get (fn [_]
-             (= "system" (:created-by @data)))})))
+      :pin
+      (fn []
+        (js/Promise.
+         (fn [resolve reject]
+           (cond
+             (not (r/check-permission plugin-id "content:write"))
+             (u/reject-not-valid reject :pin "Plugin doesn't have 'content:write' permission")
+
+             (not= "system" (:created-by @data))
+             (u/reject-not-valid reject :pin "Only auto-saved versions can be pinned")
+
+             :else
+             (let [params  {:id (:id @data)
+                            :label (dt/format (:created-at @data) :date-full)}]
+               (->> (rx/zip (rp/cmd! :get-team-users {:file-id file-id})
+                            (rp/cmd! :update-file-snapshot params))
+                    (rx/subs! (fn [[users data]]
+                                (let [users (d/index-by :id users)]
+                                  (resolve (file-version-proxy plugin-id file-id users @data))))
+                              reject))))))))))
 
 (deftype FileProxy [$plugin $id]
   Object
diff --git a/frontend/src/app/util/object.cljc b/frontend/src/app/util/object.cljc
new file mode 100644
index 000000000..b287650b5
--- /dev/null
+++ b/frontend/src/app/util/object.cljc
@@ -0,0 +1,235 @@
+;; 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.object
+  "A collection of helpers for work with javascript objects."
+  (:refer-clojure :exclude [set! new get merge clone contains? array? into-array reify])
+  #?(:cljs (:require-macros [app.util.object]))
+  (:require
+   [clojure.core :as c]))
+
+#?(:cljs
+   (defn array?
+     [o]
+     (.isArray js/Array o)))
+
+#?(:cljs
+   (defn into-array
+     [o]
+     (js/Array.from o)))
+
+#?(:cljs
+   (defn create [] #js {}))
+
+#?(:cljs
+   (defn get
+     ([obj k]
+      (when (some? obj)
+        (unchecked-get obj k)))
+     ([obj k default]
+      (let [result (get obj k)]
+        (if (undefined? result) default result)))))
+
+#?(:cljs
+   (defn contains?
+     [obj k]
+     (when (some? obj)
+       (js/Object.hasOwn obj k))))
+
+#?(:cljs
+   (defn clone
+     [a]
+     (js/Object.assign #js {} a)))
+
+#?(:cljs
+   (defn merge!
+     ([a b]
+      (js/Object.assign a b))
+     ([a b & more]
+      (reduce merge! (merge! a b) more))))
+
+#?(:cljs
+   (defn merge
+     ([a b]
+      (js/Object.assign #js {} a b))
+     ([a b & more]
+      (reduce merge! (merge a b) more))))
+
+#?(:cljs
+   (defn set!
+     [obj key value]
+     (unchecked-set obj key value)
+     obj))
+
+#?(:cljs
+   (defn unset!
+     [obj key]
+     (js-delete obj key)
+     obj))
+
+#?(:cljs
+   (def ^:private not-found-sym
+     (js/Symbol "not-found")))
+
+#?(:cljs
+   (defn update!
+     [obj key f & args]
+     (let [found (c/get obj key not-found-sym)]
+       (when-not ^boolean (identical? found not-found-sym)
+         (unchecked-set obj key (apply f found args)))
+       obj)))
+
+#?(:cljs
+   (defn ^boolean in?
+     [obj prop]
+     (js* "~{} in ~{}" prop obj)))
+
+#?(:cljs
+   (defn without-empty
+     [^js obj]
+     (when (some? obj)
+       (js* "Object.entries(~{}).reduce((a, [k,v]) => (v == null ? a : (a[k]=v, a)), {}) " obj))))
+
+(defmacro add-properties!
+  "Adds properties to an object using `.defineProperty`"
+  [rsym & properties]
+  (let [rsym       (with-meta rsym {:tag 'js})
+        getf-sym   (with-meta (gensym (str rsym "-get-fn-")) {:tag 'js})
+        setf-sym   (with-meta (gensym (str rsym "-set-fn-")) {:tag 'js})
+        this-sym   (with-meta (gensym (str rsym "-this-")) {:tag 'js})
+        target-sym (with-meta (gensym (str rsym "-target-")) {:tag 'js})]
+    `(let [~target-sym ~rsym]
+       ;; Creates the `.defineProperty` per property
+       ~@(for [params properties
+               :let [pname    (c/get params :name)
+                     get-expr (c/get params :get)
+                     set-expr (c/get params :set)
+                     this?    (c/get params :this true)
+                     enum?    (c/get params :enumerable true)
+                     conf?    (c/get params :configurable)
+                     writ?    (c/get params :writable)]]
+           `(let [~@(concat
+                     (when get-expr
+                       [getf-sym get-expr])
+                     (when set-expr
+                       [setf-sym set-expr]))]
+              (.defineProperty
+               js/Object
+               ~target-sym
+               ~pname
+               (cljs.core/js-obj
+                ~@(concat
+                   ["enumerable" (boolean enum?)]
+
+                   (when conf?
+                     ["configurable" true])
+
+                   (when (some? writ?)
+                     ["writable" true])
+
+                   (when get-expr
+                     (if this?
+                       ["get" `(fn [] (cljs.core/this-as ~this-sym (~getf-sym ~this-sym)))]
+                       ["get" getf-sym]))
+
+                   (when set-expr
+                     (if this?
+                       ["set" `(fn [v#] (cljs.core/this-as ~this-sym (~setf-sym ~this-sym v#)))]
+                       ["set" setf-sym])))))))
+
+       ;; Returns the object
+       ~target-sym)))
+
+(defn- collect-properties
+  [params]
+  (let [[tmeta params] (if (map? (first params))
+                         [(first params) (rest params)]
+                         [{} params])]
+    (loop [params (seq params)
+           props  []
+           defs   {}
+           curr   :start
+           ckey   nil]
+      (cond
+        (= curr :start)
+        (let [candidate (first params)]
+          (cond
+            (keyword? candidate)
+            (recur (rest params) props defs :property candidate)
+
+            (nil? candidate)
+            (recur (rest params) props defs :end nil)
+
+            :else
+            (recur (rest params) props defs :definition candidate)))
+
+        (= :end curr)
+        [tmeta props defs]
+
+        (= :property curr)
+        (let [definition (first params)]
+          (if (some? definition)
+            (let [definition (if (map? definition)
+                               (assoc definition :name (name ckey) :this false)
+                               (-> {:enumerable false}
+                                   (c/merge (meta definition))
+                                   (assoc :name (name ckey))
+                                   (assoc :this false)
+                                   (assoc :get `(fn [] ~definition))))]
+              (recur (rest params)
+                     (conj props definition)
+                     defs
+                     :start
+                     nil))
+            (let [hint (str "expected property definition for: " curr)]
+              (throw (ex-info hint {:key curr})))))
+
+        (= :definition curr)
+        (let [[params props defs curr ckey]
+              (loop [params params
+                     defs   (update defs ckey #(or % []))]
+                (let [candidate (first params)
+                      params    (rest params)]
+                  (cond
+                    (nil? candidate)
+                    [params props defs :end]
+
+                    (keyword? candidate)
+                    [params props defs :property candidate]
+
+                    (symbol? candidate)
+                    [params props defs :definition candidate]
+
+                    :else
+                    (recur params (update defs ckey conj candidate)))))]
+          (recur params props defs curr ckey))
+
+        :else
+        (throw (ex-info "invalid params" {}))))))
+
+(defmacro reify
+  "A domain specific variation of reify that creates anonymous objects
+  on demand with the ability to assign protocol implementations and
+  custom properties"
+  [& params]
+  (let [[tmeta properties definitions] (collect-properties params)
+        obj-sym    (gensym "obj-")]
+    `(let [~obj-sym (cljs.core/js-obj)]
+       (add-properties! ~obj-sym
+                        ~@(when-let [tname (:name tmeta)]
+                            [`{:name ~'js/Symbol.toStringTag
+                               :this false
+                               :enumerable false
+                               :get (fn [] ~tname)}])
+                        ~@properties)
+       (let [~obj-sym ~(if-let [definitions (seq definitions)]
+                         `(cljs.core/specify! ~obj-sym
+                            ~@(mapcat (fn [[k v]] (cons k v)) definitions))
+                         obj-sym)]
+
+         (cljs.core/specify! ~obj-sym
+           cljs.core/IMeta
+           (~'-meta [_#] ~tmeta))))))
diff --git a/frontend/src/app/util/object.cljs b/frontend/src/app/util/object.cljs
deleted file mode 100644
index 6066eb952..000000000
--- a/frontend/src/app/util/object.cljs
+++ /dev/null
@@ -1,76 +0,0 @@
-;; 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.object
-  "A collection of helpers for work with javascript objects."
-  (:refer-clojure :exclude [set! new get merge clone contains? array? into-array]))
-
-(defn array?
-  [o]
-  (.isArray js/Array o))
-
-(defn into-array
-  [o]
-  (js/Array.from o))
-
-(defn create [] #js {})
-
-(defn get
-  ([obj k]
-   (when (some? obj)
-     (unchecked-get obj k)))
-  ([obj k default]
-   (let [result (get obj k)]
-     (if (undefined? result) default result))))
-
-(defn contains?
-  [obj k]
-  (when (some? obj)
-    (js/Object.hasOwn obj k)))
-
-(defn clone
-  [a]
-  (js/Object.assign #js {} a))
-
-(defn merge!
-  ([a b]
-   (js/Object.assign a b))
-  ([a b & more]
-   (reduce merge! (merge! a b) more)))
-
-(defn merge
-  ([a b]
-   (js/Object.assign #js {} a b))
-  ([a b & more]
-   (reduce merge! (merge a b) more)))
-
-(defn set!
-  [obj key value]
-  (unchecked-set obj key value)
-  obj)
-
-(defn unset!
-  [obj key]
-  (js-delete obj key)
-  obj)
-
-(def ^:private not-found-sym (js/Symbol "not-found"))
-
-(defn update!
-  [obj key f & args]
-  (let [found (get obj key not-found-sym)]
-    (when-not ^boolean (identical? found not-found-sym)
-      (unchecked-set obj key (apply f found args)))
-    obj))
-
-(defn ^boolean in?
-  [obj prop]
-  (js* "~{} in ~{}" prop obj))
-
-(defn without-empty
-  [^js obj]
-  (when (some? obj)
-    (js* "Object.entries(~{}).reduce((a, [k,v]) => (v == null ? a : (a[k]=v, a)), {}) " obj)))