From 4637aced8c1730b7d315732530f919cfe09ff774 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 2 Dec 2025 17:31:11 +0100 Subject: [PATCH] :sparkles: Add support auto decoding and validation syntax for obj/reify --- frontend/src/app/util/object.cljc | 235 +++++++++++++----- frontend/test/frontend_tests/runner.cljs | 2 + .../test/frontend_tests/util_object_test.cljs | 113 +++++++++ 3 files changed, 282 insertions(+), 68 deletions(-) create mode 100644 frontend/test/frontend_tests/util_object_test.cljs diff --git a/frontend/src/app/util/object.cljc b/frontend/src/app/util/object.cljc index d7404b8702..bb37d05c9f 100644 --- a/frontend/src/app/util/object.cljc +++ b/frontend/src/app/util/object.cljc @@ -4,12 +4,17 @@ ;; ;; Copyright (c) KALEIDOS INC +#_:clj-kondo/ignore (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 class]) #?(:cljs (:require-macros [app.util.object])) (:require - [clojure.core :as c])) + [app.common.json :as json] + [app.common.schema :as sm] + [clojure.core :as c] + [cuerdas.core :as str] + [rumext.v2.util :as mfu])) #?(:cljs (defn array? @@ -138,55 +143,139 @@ ~constructor-sym))) -(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?)] +#?(:clj + (defmacro add-properties! + "Adds properties to an object using `.defineProperty`" + [rsym & properties] + (let [rsym (with-meta rsym {:tag 'js}) - (when conf? - ["configurable" true]) + this-sym (with-meta (gensym (str rsym "-this-")) {:tag 'js}) + target-sym (with-meta (gensym (str rsym "-target-")) {:tag 'js}) - (when (some? writ?) - ["writable" true]) + make-sym + (fn [pname prefix] + (-> (gensym (str "prop-" prefix "-" (str/slug pname) "-")) + (with-meta {:tag 'js}))) - (when get-expr - (if this? - ["get" `(fn [] (cljs.core/this-as ~this-sym (~getf-sym ~this-sym)))] - ["get" getf-sym])) + make-sym + (memoize make-sym) - (when set-expr - (if this? - ["set" `(fn [v#] (cljs.core/this-as ~this-sym (~setf-sym ~this-sym v#)))] - ["set" setf-sym]))))))) + bindings + (->> properties + (mapcat (fn [params] + (let [pname (c/get params :name) + get-expr (c/get params :get) + set-expr (c/get params :set) + fn-expr (c/get params :fn) + schema-n (c/get params :schema) + wrap (c/get params :wrap) + schema-1 (c/get params :schema-1) + this? (c/get params :this false) - ;; Returns the object - ~target-sym))) + fn-sym + (-> (gensym (str "internal-fn-" (str/slug pname) "-")) + (with-meta {:tag 'function})) + + coercer-sym + (-> (gensym (str "coercer-fn-" (str/slug pname) "-")) + (with-meta {:tag 'function})) + + wrap-sym + (-> (gensym (str "wrap-fn-" (str/slug pname) "-")) + (with-meta {:tag 'function}))] + + (concat + (when wrap + [wrap-sym wrap]) + + (when get-expr + [(make-sym pname "get-fn") + (if this? + `(fn [] + (let [~this-sym (~'js* "this") + ~fn-sym ~get-expr] + (.call ~fn-sym ~this-sym ~this-sym))) + get-expr)]) + + (when set-expr + [(make-sym pname "set-fn") + (if this? + `(fn [v#] + (let [~this-sym (~'js* "this") + ~fn-sym ~set-expr] + (.call ~fn-sym ~this-sym ~this-sym v#))) + set-expr)]) + + (when fn-expr + (concat + (when schema-1 + [coercer-sym `(sm/coercer ~schema-1)]) + (when schema-n + [coercer-sym `(sm/coercer ~schema-n)]) + + [(make-sym pname "get-fn") + `(fn [] + (let [~this-sym (~'js* "this") + ~fn-sym ~fn-expr + ~fn-sym ~(if this? + `(.bind ~fn-sym ~this-sym ~this-sym) + `(.bind ~fn-sym ~this-sym)) + + ~@(if schema-1 + [fn-sym `(fn* [param#] + (let [param# (json/->clj param#) + param# (~coercer-sym param#)] + (~fn-sym param#)))] + []) + ~@(if schema-n + [fn-sym `(fn* [] + (let [params# (into-array (cljs.core/js-arguments)) + params# (mfu/bean params#) + params# (~coercer-sym params#)] + (apply ~fn-sym params#)))] + []) + ~@(if wrap + [fn-sym `(~wrap-sym ~fn-sym)] + [])] + + ~fn-sym))])))))))] + + `(let [~target-sym ~rsym + ~@bindings] + ;; 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) + fn-expr (c/get params :fn) + enum? (c/get params :enumerable true) + conf? (c/get params :configurable) + writ? (c/get params :writable)]] + `(.defineProperty + js/Object + ~target-sym + ~pname + (cljs.core/js-obj + ~@(concat + ["enumerable" (boolean enum?)] + + (when conf? + ["configurable" true]) + + (when (some? writ?) + ["writable" true]) + + (when (or get-expr) + ["get" (make-sym pname "get-fn")]) + + (when fn-expr + ["get" (make-sym pname "get-fn")]) + + (when set-expr + ["set" (make-sym pname "set-fn")]))))) + + ;; Returns the object + ~target-sym)))) (defn- collect-properties [params] @@ -218,17 +307,20 @@ (let [definition (first params)] (if (some? definition) (let [definition (if (map? definition) - (c/merge {:this false} (assoc definition :name (name ckey))) + (c/merge {:wrap (:wrap tmeta)} definition) (-> {:enumerable false} (c/merge (meta definition)) - (assoc :name (name ckey)) - (assoc :this false) - (assoc :get `(fn [] ~definition))))] + (assoc :wrap (:wrap tmeta)) + (assoc :fn definition) + (dissoc :get :set))) + definition (assoc definition :name (name ckey))] + (recur (rest params) (conj props definition) defs :start nil)) + (let [hint (str "expected property definition for: " curr)] (throw (ex-info hint {:key curr}))))) @@ -270,23 +362,30 @@ 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)} - `{:name type-symbol - :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)] + (let [[tmeta properties definitions] + (collect-properties params) - (cljs.core/specify! ~obj-sym))))) + f-sym + (gensym "to-string-") + + type-name + (or (c/get tmeta :name) (str (gensym "anonymous"))) + + obj-sym + (gensym "obj-")] + + `(let [~obj-sym (cljs.core/js-obj) + ~f-sym (fn [] ~type-name)] + (add-properties! ~obj-sym + {:name ~'js/Symbol.toStringTag + :enumerable false + :get ~f-sym} + {:name (js/Symbol.for "penpot.reify:type") + :enumerable false + :get ~f-sym} + ~@properties) + + ~(if-let [definitions (seq definitions)] + `(cljs.core/specify! ~obj-sym + ~@(mapcat (fn [[k v]] (cons k v)) definitions)) + obj-sym)))) diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs index 704600a35f..ff67188e9b 100644 --- a/frontend/test/frontend_tests/runner.cljs +++ b/frontend/test/frontend_tests/runner.cljs @@ -16,6 +16,7 @@ [frontend-tests.tokens.logic.token-actions-test] [frontend-tests.tokens.logic.token-data-test] [frontend-tests.tokens.style-dictionary-test] + [frontend-tests.util-object-test] [frontend-tests.util-range-tree-test] [frontend-tests.util-simple-math-test] [frontend-tests.worker-snap-test])) @@ -45,6 +46,7 @@ 'frontend-tests.tokens.logic.token-actions-test 'frontend-tests.tokens.logic.token-data-test 'frontend-tests.tokens.style-dictionary-test + 'frontend-tests.util-object-test 'frontend-tests.util-range-tree-test 'frontend-tests.util-simple-math-test 'frontend-tests.worker-snap-test)) diff --git a/frontend/test/frontend_tests/util_object_test.cljs b/frontend/test/frontend_tests/util_object_test.cljs new file mode 100644 index 0000000000..3ef04cb402 --- /dev/null +++ b/frontend/test/frontend_tests/util_object_test.cljs @@ -0,0 +1,113 @@ +;; 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 frontend-tests.util-object-test + (:require + [app.common.schema :as sm] + [app.util.object :as obj] + [cljs.pprint :refer [pprint]] + [cljs.test :as t])) + +(t/deftest getters-and-setters + (let [val (volatile! nil) + obj (obj/reify {:name "Foo"} + :value + {:get (fn [] @val) + :set (fn [o] (vswap! val (constantly o)))})] + + (t/is (nil? (.-value obj))) + (set! (.-value obj) 2) + (t/is (= 2 (.-value obj))) + (t/is (= 2 @val)))) + +(t/deftest getters-and-setters-access-this + (let [val (volatile! nil) + obj (obj/reify {:name "Foo"} + :value + {:get (fn [] + (this-as self + self)) + :set (fn [o] + (this-as self + (vreset! val self)))})] + + (t/is (identical? obj (.-value obj))) + (set! (.-value obj) 1) + (t/is (identical? obj @val)))) + +(t/deftest getters-and-setters-access-explicit-this + (let [val1 (volatile! nil) + val2 (volatile! nil) + obj (obj/reify {:name "Foo"} + :value + {:this true + :get (fn [this] + (this-as self (vreset! val1 self)) + (vreset! val2 this) + this) + :set (fn [this o] + (this-as self (vreset! val1 self)) + (vreset! val2 this))})] + + (t/is (identical? obj (.-value obj))) + (t/is (identical? obj @val1)) + (t/is (identical? obj @val2)) + + (vreset! val1 nil) + (vreset! val2 nil) + (set! (.-value obj) 1) + + (t/is (identical? obj @val1)) + (t/is (identical? obj @val2)))) + +(t/deftest functions-with-map-syntax + (let [val (volatile! nil) + obj (obj/reify {:name "Foo"} + :sum + {:fn (fn [a b] + (this-as self (vreset! val self)) + (+ a b))})] + + (t/is (= 3 (.sum obj 1 2))) + (t/is (identical? obj @val)))) + +(t/deftest functions-with-short-syntax + (let [val (volatile! nil) + obj (obj/reify {:name "Foo"} + :sum + (fn [a b] + (this-as self (vreset! val self)) + (+ a b)))] + + (t/is (= 3 (.sum obj 1 2))) + (t/is (identical? obj @val)))) + +(t/deftest functions-with-schema + (let [val (volatile! nil) + obj (obj/reify {:name "Foo"} + :sum + {:schema [:cat ::sm/int ::sm/int] + :fn (fn [a b] + (this-as self (vreset! val self)) + (+ a b))})] + (t/is (= 3 (.sum obj 1 2))) + (t/is (= 3 (.sum obj 1 "2"))) + + (t/is (true? (.propertyIsEnumerable obj "sum"))) + (t/is (thrown-with-msg? js/Error + #"check error" + (.sum obj 1 "a"))))) + +(t/deftest non-enumerable-props + (let [val (volatile! nil) + obj (obj/reify {:name "Foo"} + :sum + {:enumerable false + :fn (fn [a b] + (this-as self (vreset! val self)) + (+ a b))})] + + (t/is (false? (.propertyIsEnumerable obj "sum")))))