0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-02-03 12:59:12 -05:00

Merge pull request #3550 from penpot/superalex-fix-union-operations

🐛 Fix union operations
This commit is contained in:
Alejandro 2023-08-24 06:53:39 +02:00 committed by GitHub
commit e1507755ba
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
3 changed files with 314 additions and 162 deletions

View file

@ -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

View file

@ -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]

View file

@ -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))]))