From 0782382ee1520b1771376ae06e4611e674e6f088 Mon Sep 17 00:00:00 2001 From: Alejandro Alonso Date: Wed, 23 Aug 2023 09:54:58 +0200 Subject: [PATCH 1/3] :bug: Fix union operations --- frontend/src/app/main/data/workspace/bool.cljs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/frontend/src/app/main/data/workspace/bool.cljs b/frontend/src/app/main/data/workspace/bool.cljs index 2b7871261..1c0f1053c 100644 --- a/frontend/src/app/main/data/workspace/bool.cljs +++ b/frontend/src/app/main/data/workspace/bool.cljs @@ -11,6 +11,7 @@ [app.common.pages.changes-builder :as pcb] [app.common.pages.helpers :as cph] [app.common.path.shapes-to-path :as stp] + [app.common.types.shape :as cts] [app.common.types.shape.layout :as ctl] [app.common.uuid :as uuid] [app.main.data.workspace.changes :as dch] @@ -45,6 +46,7 @@ :name name :shapes (->> shapes (mapv :id))} (merge head-data) + (cts/setup-shape) (gsh/update-bool-selrect shapes objects))] [bool-shape (cph/get-position-on-parent objects (:id head))])) From e4ec954b8c408bbf6676b835e26fdf0e123f33d2 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Wed, 23 Aug 2023 18:34:10 +0200 Subject: [PATCH 2/3] :bug: Fix incorrect impl of without-keys for records --- common/src/app/common/data.cljc | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/common/src/app/common/data.cljc b/common/src/app/common/data.cljc index bf74b198b..ba08d0c73 100644 --- a/common/src/app/common/data.cljc +++ b/common/src/app/common/data.cljc @@ -236,12 +236,9 @@ "Return a map without the keys provided in the `keys` parameter." [data keys] - (persistent! - (reduce dissoc! - (if (editable-collection? data) - (transient data) - (transient {})) - keys))) + (if (editable-collection? data) + (persistent! (reduce dissoc! (transient data) keys)) + (reduce dissoc data keys))) (defn remove-at-index "Takes a vector and returns a vector with an element in the From 3292e7b923efd3b38a6a16bacf66caf0b003e7cd Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Wed, 23 Aug 2023 18:36:34 +0200 Subject: [PATCH 3/3] :bug: Make clj/jvm record impl behave the same as cljs/js --- common/src/app/common/record.cljc | 465 ++++++++++++++++++++---------- 1 file changed, 309 insertions(+), 156 deletions(-) diff --git a/common/src/app/common/record.cljc b/common/src/app/common/record.cljc index e8abbfc70..c551fbbaf 100644 --- a/common/src/app/common/record.cljc +++ b/common/src/app/common/record.cljc @@ -7,7 +7,10 @@ (ns app.common.record "A collection of helpers and macros for defien a penpot customized record types." (:refer-clojure :exclude [defrecord assoc! clone]) - #?(:cljs (:require-macros [app.common.record]))) + #?(:cljs (:require-macros [app.common.record])) + #?(:clj + (:import java.util.Map + java.util.Map$Entry))) #_:clj-kondo/ignore (defmacro caching-hash @@ -35,190 +38,340 @@ fields))) #?(:clj - (defn emit-extend - [env tagname fields impls] - (let [base-fields (mapv #(with-meta % nil) fields) - fields (conj base-fields '$meta '$extmap (with-meta '$hash {:mutable true})) - key-sym (gensym "key-") - val-sym (gensym "val-") - this-sym (with-meta (gensym "this-") {:tag tagname}) - other-sym (gensym "other-") - pr-open (str "#" (-> env :ns :name) "." (name tagname) "{")] - (concat impls - ['cljs.core/ICloneable - `(~'-clone [~this-sym] - (new ~tagname ~@(generate-field-access this-sym val-sym fields))) + (defn emit-impl-js + [tagname base-fields] + (let [fields (conj base-fields '$meta '$extmap (with-meta '$hash {:mutable true})) + key-sym (gensym "key-") + val-sym (gensym "val-") + this-sym (with-meta 'this {:tag tagname})] + ['cljs.core/ICloneable + `(~'-clone [~this-sym] + (new ~tagname ~@(generate-field-access this-sym val-sym fields))) - 'IHash - `(~'-hash [~this-sym] - (caching-hash ~this-sym - (fn [coll#] - (bit-xor - ~(hash (str tagname)) - (cljs.core/hash-unordered-coll coll#))) - (. ~this-sym ~'-$hash))) + 'IHash + `(~'-hash [~this-sym] + (caching-hash ~this-sym + (fn [coll#] + (bit-xor + ~(hash (str tagname)) + (cljs.core/hash-unordered-coll coll#))) + (. ~this-sym ~'-$hash))) - 'cljs.core/IEquiv - `(~'-equiv [~this-sym ~other-sym] - (and (some? ~other-sym) - (identical? (.-constructor ~this-sym) - (.-constructor ~other-sym)) - ~@(map (fn [field] - `(= (.. ~this-sym ~(property-symbol field)) - (.. ~(with-meta other-sym {:tag tagname}) ~(property-symbol field)))) - base-fields) - (= (. ~this-sym ~'-$extmap) - (. ~(with-meta other-sym {:tag tagname}) ~'-$extmap)))) + 'cljs.core/IEquiv + `(~'-equiv [~this-sym ~val-sym] + (and (some? ~val-sym) + (identical? (.-constructor ~this-sym) + (.-constructor ~val-sym)) + ~@(map (fn [field] + `(= (.. ~this-sym ~(property-symbol field)) + (.. ~(with-meta val-sym {:tag tagname}) ~(property-symbol field)))) + base-fields) + (= (. ~this-sym ~'-$extmap) + (. ~(with-meta val-sym {:tag tagname}) ~'-$extmap)))) - 'cljs.core/IMeta - `(~'-meta [~this-sym] (. ~this-sym ~'-$meta)) + 'cljs.core/IMeta + `(~'-meta [~this-sym] (. ~this-sym ~'-$meta)) - 'cljs.core/IWithMeta - `(~'-with-meta [~this-sym ~val-sym] - (new ~tagname ~@(->> (replace {'$meta val-sym} fields) - (generate-field-access this-sym val-sym)))) + 'cljs.core/IWithMeta + `(~'-with-meta [~this-sym ~val-sym] + (new ~tagname ~@(->> (replace {'$meta val-sym} fields) + (generate-field-access this-sym val-sym)))) - 'cljs.core/ILookup - `(~'-lookup - ([~this-sym k#] - (cljs.core/-lookup ~this-sym k# nil)) - ([~this-sym ~key-sym else#] - (case ~key-sym - ~@(mapcat (fn [f] [(keyword f) `(. ~this-sym ~(property-symbol f))]) - base-fields) - (cljs.core/get (. ~this-sym ~'-$extmap) ~key-sym else#)))) + 'cljs.core/ILookup + `(~'-lookup [~this-sym k#] + (cljs.core/-lookup ~this-sym k# nil)) - 'cljs.core/ICounted - `(~'-count [~this-sym] - (+ ~(count base-fields) (count (. ~this-sym ~'-$extmap)))) + `(~'-lookup [~this-sym ~key-sym else#] + (case ~key-sym + ~@(mapcat (fn [f] [(keyword f) `(. ~this-sym ~(property-symbol f))]) + base-fields) + (cljs.core/get (. ~this-sym ~'-$extmap) ~key-sym else#))) - 'cljs.core/ICollection - `(~'-conj [~this-sym ~val-sym] - (if (vector? ~val-sym) - (cljs.core/-assoc ~this-sym (cljs.core/-nth ~val-sym 0) (cljs.core/-nth ~val-sym 1)) - (reduce cljs.core/-conj ~this-sym ~val-sym))) + 'cljs.core/ICounted + `(~'-count [~this-sym] + (+ ~(count base-fields) (count (. ~this-sym ~'-$extmap)))) - 'cljs.core/IAssociative - `(~'-contains-key? [~this-sym ~key-sym] - ~(if (seq base-fields) - `(case ~key-sym - (~@(map keyword base-fields)) true - (contains? (. ~this-sym ~'-$extmap) ~key-sym)) - `(contains? (. ~this-sym ~'-$extmap) ~key-sym))) + 'cljs.core/ICollection + `(~'-conj [~this-sym ~val-sym] + (if (vector? ~val-sym) + (cljs.core/-assoc ~this-sym (cljs.core/-nth ~val-sym 0) (cljs.core/-nth ~val-sym 1)) + (reduce cljs.core/-conj ~this-sym ~val-sym))) - `(~'-assoc [~this-sym ~key-sym ~val-sym] - (case ~key-sym - ~@(mapcat (fn [fld] - [(keyword fld) `(new ~tagname ~@(->> (replace {fld val-sym '$hash nil} fields) - (generate-field-access this-sym val-sym)))]) - base-fields) - (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields) - (generate-field-access this-sym val-sym)) - (assoc (. ~this-sym ~'-$extmap) ~key-sym ~val-sym) nil))) + 'cljs.core/IAssociative + `(~'-contains-key? [~this-sym ~key-sym] + ~(if (seq base-fields) + `(case ~key-sym + (~@(map keyword base-fields)) true + (contains? (. ~this-sym ~'-$extmap) ~key-sym)) + `(contains? (. ~this-sym ~'-$extmap) ~key-sym))) - 'cljs.core/ITransientAssociative - `(~'-assoc! [~this-sym ~key-sym ~val-sym] - (let [key# (if (keyword? ~key-sym) - (.-fqn ~(with-meta key-sym {:tag `cljs.core/Keyword})) - ~key-sym)] - (case ~key-sym - ~@(mapcat - (fn [f] - [(keyword f) `(set! (. ~this-sym ~(property-symbol f)) ~val-sym)]) - base-fields) + `(~'-assoc [~this-sym ~key-sym ~val-sym] + (case ~key-sym + ~@(mapcat (fn [fld] + [(keyword fld) `(new ~tagname ~@(->> (replace {fld val-sym '$hash nil} fields) + (generate-field-access this-sym val-sym)))]) + base-fields) + (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields) + (generate-field-access this-sym val-sym)) + (assoc (. ~this-sym ~'-$extmap) ~key-sym ~val-sym) nil))) - (set! (. ~this-sym ~'-$extmap) (cljs.core/assoc (. ~this-sym ~'-$extmap) ~key-sym ~val-sym))) + 'cljs.core/ITransientAssociative + `(~'-assoc! [~this-sym ~key-sym ~val-sym] + (let [key# (if (keyword? ~key-sym) + (.-fqn ~(with-meta key-sym {:tag `cljs.core/Keyword})) + ~key-sym)] + (case ~key-sym + ~@(mapcat + (fn [f] + [(keyword f) `(set! (. ~this-sym ~(property-symbol f)) ~val-sym)]) + base-fields) - ~this-sym)) + (set! (. ~this-sym ~'-$extmap) (cljs.core/assoc (. ~this-sym ~'-$extmap) ~key-sym ~val-sym))) - 'cljs.core/IMap - `(~'-dissoc [~this-sym ~key-sym] - (case ~key-sym - (~@(map keyword base-fields)) - (cljs.core/-assoc ~this-sym ~key-sym nil) + ~this-sym)) - (let [extmap1# (. ~this-sym ~'-$extmap) - extmap2# (dissoc extmap1# ~key-sym)] - (if (identical? extmap1# extmap2#) - ~this-sym - (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields) - (generate-field-access this-sym val-sym)) - (not-empty extmap2#) - nil))))) + 'cljs.core/IMap + `(~'-dissoc [~this-sym ~key-sym] + (case ~key-sym + (~@(map keyword base-fields)) + (cljs.core/-assoc ~this-sym ~key-sym nil) - 'cljs.core/ISeqable - `(~'-seq [~this-sym] - (seq (concat [~@(map (fn [f] - `(cljs.core/MapEntry. - ~(keyword f) - (. ~this-sym ~(property-symbol f)) - nil)) - base-fields)] - (. ~this-sym ~'-$extmap)))) + (let [extmap1# (. ~this-sym ~'-$extmap) + extmap2# (dissoc extmap1# ~key-sym)] + (if (identical? extmap1# extmap2#) + ~this-sym + (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields) + (generate-field-access this-sym val-sym)) + (not-empty extmap2#) + nil))))) - 'cljs.core/IIterable - `(~'-iterator [~this-sym] - (cljs.core/RecordIter. 0 ~this-sym ~(count base-fields) + 'cljs.core/ISeqable + `(~'-seq [~this-sym] + (seq (concat [~@(map (fn [f] + `(cljs.core/MapEntry. + ~(keyword f) + (. ~this-sym ~(property-symbol f)) + nil)) + base-fields)] + (. ~this-sym ~'-$extmap)))) + + 'cljs.core/IIterable + `(~'-iterator [~this-sym] + (cljs.core/RecordIter. 0 ~this-sym ~(count base-fields) [~@(map keyword base-fields)] (if (. ~this-sym ~'-$extmap) (cljs.core/-iterator (. ~this-sym ~'-$extmap)) (cljs.core/nil-iter)))) - 'cljs.core/IKVReduce - `(~'-kv-reduce [~this-sym f# init#] - (reduce (fn [ret# [~key-sym v#]] (f# ret# ~key-sym v#)) init# ~this-sym)) + 'cljs.core/IKVReduce + `(~'-kv-reduce [~this-sym f# init#] + (reduce (fn [ret# [~key-sym v#]] (f# ret# ~key-sym v#)) init# ~this-sym))]))) - 'cljs.core/IPrintWithWriter - `(~'-pr-writer [~this-sym writer# opts#] - (let [pr-pair# (fn [keyval#] - (cljs.core/pr-sequential-writer writer# (~'js* "cljs.core.pr_writer") - "" " " "" opts# keyval#))] - (cljs.core/pr-sequential-writer - writer# pr-pair# ~pr-open ", " "}" opts# - (concat [~@(for [f base-fields] - `(vector ~(keyword f) (. ~this-sym ~(property-symbol f))))] - (. ~this-sym ~'-$extmap))))) +#?(:clj + (defn emit-impl-jvm + [tagname base-fields] + (let [fields (conj base-fields '$meta '$extmap (with-meta '$hash {:unsynchronized-mutable true})) + key-sym 'key + val-sym 'val + this-sym (with-meta 'this {:tag tagname})] - ])))) + ['clojure.lang.MapEquivalence + 'clojure.lang.IPersistentMap + + `(~'equiv [~this-sym ~'other] + (and (instance? java.util.Map ~'other) (= (.count ~this-sym) (.size ^Map ~'other)) + (every? (fn [^clojure.lang.MapEntry e#] + (let [k# (.key e#)] + (and (.containsKey ^Map ~'other k#) + (= (.val e#) (.get ^Map ~'other k#))))) + (.seq ~this-sym)))) + + `(~'entryAt [~this-sym ~key-sym] + (let [v# (.valAt ~this-sym ~key-sym ::not-found)] + (when (not= v# ::not-found) + (clojure.lang.MapEntry. ~key-sym v#)))) + + `(~'valAt [~this-sym ~key-sym] + (.valAt ~this-sym ~key-sym nil)) + + `(~'valAt [~this-sym ~key-sym ~'not-found] + (case ~key-sym + ~@(mapcat (fn [f] [(keyword f) `(. ~this-sym ~(property-symbol f))]) base-fields) + (clojure.core/get (. ~this-sym ~'-$extmap) ~key-sym ~'not-found))) + + `(~'count [~this-sym] + (+ ~(count base-fields) (count (. ~this-sym ~'-$extmap)))) + + + `(~'empty [~this-sym] + (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields) + (generate-field-access this-sym nil)) + nil nil)) + + `(~'cons [~this-sym ~val-sym] + (if (instance? java.util.Map$Entry ~val-sym) + (let [^Map$Entry e# ~val-sym] + (.assoc ~this-sym (.getKey e#) (.getValue e#))) + (if (instance? clojure.lang.IPersistentVector ~val-sym) + (if (= 2 (count ~val-sym)) + (.assoc ~this-sym (nth ~val-sym 0) (nth ~val-sym 1)) + (throw (IllegalArgumentException. + "Vector arg to map conj must be a pair"))) + (reduce (fn [^clojure.lang.IPersistentMap m# + ^java.util.Map$Entry e#] + (.assoc m# (.getKey e#) (.getValue e#))) + ~this-sym + ~val-sym)))) + + `(~'assoc [~this-sym ~key-sym ~val-sym] + (case ~key-sym + ~@(mapcat (fn [fld] + [(keyword fld) `(new ~tagname ~@(->> (replace {fld val-sym '$hash nil} fields) + (generate-field-access this-sym val-sym)))]) + base-fields) + (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields) + (generate-field-access this-sym val-sym)) + (assoc (. ~this-sym ~'-$extmap) ~key-sym ~val-sym) + nil))) + + `(~'without [~this-sym ~key-sym] + (case ~key-sym + (~@(map keyword base-fields)) + (.assoc ~this-sym ~key-sym nil) + + (if-let [extmap1# (. ~this-sym ~'-$extmap)] + (let [extmap2# (.without ^clojure.lang.IPersistentMap extmap1# ~key-sym)] + (if (identical? extmap1# extmap2#) + ~this-sym + (new ~tagname ~@(->> (remove #{'$extmap '$hash} fields) + (generate-field-access this-sym val-sym)) + (not-empty extmap2#) + nil))) + ~this-sym))) + + `(~'seq [~this-sym] + (seq (concat [~@(map (fn [f] + `(clojure.lang.MapEntry/create + ~(keyword f) + (. ~this-sym ~(property-symbol f)))) + base-fields)] + (. ~this-sym ~'-$extmap)))) + + `(~'iterator [~this-sym] + (clojure.lang.SeqIterator. (.seq ~this-sym))) + + 'clojure.lang.IFn + `(~'invoke [~this-sym ~key-sym] + (.valAt ~this-sym ~key-sym)) + + `(~'invoke [~this-sym ~key-sym ~'not-found] + (.valAt ~this-sym ~key-sym ~'not-found)) + + 'java.util.Map + `(~'size [~this-sym] + (clojure.core/count ~this-sym)) + + `(~'containsKey [~this-sym ~key-sym] + ~(if (seq base-fields) + `(case ~key-sym + (~@(map keyword base-fields)) true + (contains? (. ~this-sym ~'-$extmap) ~key-sym)) + `(contains? (. ~this-sym ~'-$extmap) ~key-sym))) + + `(~'isEmpty [~this-sym] + (zero? (count ~this-sym))) + + `(~'keySet [~this-sym] + (throw (UnsupportedOperationException. "not implemented"))) + + `(~'entrySet [~this-sym] + (throw (UnsupportedOperationException. "not implemented"))) + + `(~'get [~this-sym ~key-sym] + (.valAt ~this-sym ~key-sym)) + + `(~'containsValue [~this-sym ~val-sym] + (throw (UnsupportedOperationException. "not implemented"))) + + `(~'values [~this-sym] + (map val (.seq ~this-sym))) + + 'java.lang.Object + `(~'equals [~this-sym other#] + (.equiv ~this-sym other#)) + + `(~'hashCode [~this-sym] + (clojure.lang.APersistentMap/mapHash ~this-sym)) + + 'clojure.lang.IHashEq + `(~'hasheq [~this-sym] + (clojure.core/hash-unordered-coll ~this-sym)) + + 'clojure.lang.IObj + `(~'meta [~this-sym] + (. ~this-sym ~'-$meta)) + + `(~'withMeta [~this-sym ~val-sym] + (new ~tagname ~@(->> (replace {'$meta val-sym} fields) + (generate-field-access this-sym val-sym)))) + ]))) (defmacro defrecord [rsym fields & impls] - (let [param (gensym "param-") - ks (map keyword fields)] - (if (:ns &env) - `(do - (deftype ~rsym ~(into fields ['$meta '$extmap '$hash])) - (extend-type ~rsym ~@(emit-extend &env rsym fields impls)) + (let [param (gensym "param-") + ks (map keyword fields) + fields' (mapv #(with-meta % nil) fields) + nsname (if (:ns &env) + (-> &env :ns :name) + (str *ns*)) + ident (str "#" nsname "." (name rsym))] - (defn ~(with-meta (symbol (str "pos->" rsym)) - (assoc (meta rsym) :factory :positional)) - [~@fields] - (new ~rsym ~@(conj fields nil nil nil))) + `(do + (deftype ~rsym ~(into fields ['$meta '$extmap '$hash]) + ~@(if (:ns &env) + (emit-impl-js rsym fields') + (emit-impl-jvm rsym fields')) + ~@impls - (defn ~(with-meta (symbol (str 'map-> rsym)) - (assoc (meta rsym) :factory :map)) - [~param] - (let [exclude# #{~@ks} - extmap# (reduce-kv (fn [acc# k# v#] - (if (contains? exclude# k#) - acc# - (assoc acc# k# v#))) - {} - ~param)] - (new ~rsym - ~@(for [k ks] - `(get ~param ~k)) - nil - (not-empty extmap#) - nil))) - ~rsym) + ~@(when (:ns &env) + ['cljs.core/IPrintWithWriter + `(~'-pr-writer [~'this writer# opts#] + (let [pr-pair# (fn [keyval#] + (cljs.core/pr-sequential-writer writer# (~'js* "cljs.core.pr_writer") + "" " " "" opts# keyval#))] + (cljs.core/pr-sequential-writer + writer# pr-pair# ~(str ident "{") ", " "}" opts# + (concat [~@(for [f fields'] + `(vector ~(keyword f) (. ~'this ~(property-symbol f))))] + (. ~'this ~'-$extmap)))))])) - `(do - (clojure.core/defrecord ~rsym ~fields ~@impls) - (defn ~(with-meta (symbol (str "pos->" rsym)) - (assoc (meta rsym) :factory :positional)) - [~@(map (fn [f] (vary-meta f dissoc :tag)) fields)] - (new ~rsym ~@(conj fields nil nil))))))) + ~@(when-not (:ns &env) + [`(defmethod print-method ~rsym [o# ^java.io.Writer w#] + (.write w# ~(str "#" nsname "." (name rsym))) + (print-method (into {} o#) w#))]) + + (defn ~(with-meta (symbol (str "pos->" rsym)) + (assoc (meta rsym) :factory :positional)) + [~@fields'] + (new ~rsym ~@(conj fields nil nil nil))) + + (defn ~(with-meta (symbol (str 'map-> rsym)) + (assoc (meta rsym) :factory :map)) + [~param] + (let [exclude# #{~@ks} + extmap# (reduce-kv (fn [acc# k# v#] + (if (contains? exclude# k#) + acc# + (assoc acc# k# v#))) + {} + ~param)] + (new ~rsym + ~@(for [k ks] + `(get ~param ~k)) + nil + (not-empty extmap#) + nil))) + ~rsym))) (defmacro clone [ssym]