mirror of
https://github.com/penpot/penpot.git
synced 2026-10-30 14:30:37 +00:00
🔧 Validate changes immediately after processing them
This commit is contained in:
Andrés Moya
parent
980ed0a719
commit
0300a39a23
@ -6,6 +6,7 @@
|
||||
|
||||
(ns app.common.files.changes
|
||||
(:require
|
||||
#?(:cljs [app.common.files.validate :as val])
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
@ -444,7 +445,14 @@
|
||||
[:map {:title "SetTokensSource"}
|
||||
[:type [:= :set-tokens-source]]
|
||||
[:file-id ::sm/uuid]
|
||||
[:library-id [:maybe ::sm/uuid]]]]])
|
||||
[:library-id [:maybe ::sm/uuid]]]]
|
||||
|
||||
[:validate-shapes
|
||||
[:map {:title "ValidateShapesChange"}
|
||||
[:type [:= :validate-shapes]]
|
||||
[:page-id ::sm/uuid]
|
||||
[:shape-ids [:vector ::sm/uuid]]
|
||||
[:context :string]]]])
|
||||
|
||||
(def schema:changes
|
||||
[:sequential {:gen/max 5 :gen/min 1} schema:change])
|
||||
@ -480,7 +488,7 @@
|
||||
to the processor backend."
|
||||
nil)
|
||||
|
||||
(defmulti process-change (fn [_ change] (:type change)))
|
||||
(defmulti process-change (fn [_ change _] (:type change)))
|
||||
(defmulti process-operation (fn [_ op] (:type op)))
|
||||
|
||||
;; Changes Processing Impl
|
||||
@ -512,22 +520,25 @@
|
||||
|
||||
(defn process-changes
|
||||
([data items]
|
||||
(process-changes data items true))
|
||||
(process-changes data items true {}))
|
||||
|
||||
([data items verify?]
|
||||
(process-changes data items verify? {}))
|
||||
|
||||
([data items verify? libraries]
|
||||
;; When verify? false we spec the schema validation. Currently used
|
||||
;; to make just 1 validation even if the changes are applied twice
|
||||
(when verify?
|
||||
(check-changes items))
|
||||
|
||||
(binding [*touched-changes* (volatile! #{})]
|
||||
(let [result (reduce #(or (process-change %1 %2) %1) data items)]
|
||||
(let [result (reduce #(or (process-change %1 %2 libraries) %1) data items)]
|
||||
(reduce process-touched-change result @*touched-changes*)))))
|
||||
|
||||
;; --- Comment Threads
|
||||
|
||||
(defmethod process-change :set-comment-thread-position
|
||||
[data {:keys [page-id comment-thread-id position frame-id]}]
|
||||
[data {:keys [page-id comment-thread-id position frame-id]} _]
|
||||
(d/update-in-when data [:pages-index page-id]
|
||||
(fn [page]
|
||||
(if (and position frame-id)
|
||||
@ -540,7 +551,7 @@
|
||||
;; --- Guides
|
||||
|
||||
(defmethod process-change :set-guide
|
||||
[data {:keys [page-id id params]}]
|
||||
[data {:keys [page-id id params]} _]
|
||||
(if (nil? params)
|
||||
(d/update-in-when data [:pages-index page-id]
|
||||
(fn [page]
|
||||
@ -556,7 +567,7 @@
|
||||
;; --- Flows
|
||||
|
||||
(defmethod process-change :set-flow
|
||||
[data {:keys [page-id id params]}]
|
||||
[data {:keys [page-id id params]} _]
|
||||
(if (nil? params)
|
||||
(d/update-in-when data [:pages-index page-id]
|
||||
(fn [page]
|
||||
@ -572,7 +583,7 @@
|
||||
;; --- Grids
|
||||
|
||||
(defmethod process-change :set-default-grid
|
||||
[data {:keys [page-id grid-type params]}]
|
||||
[data {:keys [page-id grid-type params]} _]
|
||||
(if (nil? params)
|
||||
(d/update-in-when data [:pages-index page-id]
|
||||
(fn [page]
|
||||
@ -609,7 +620,7 @@
|
||||
(update state :media-refs into xform media-refs)))
|
||||
|
||||
(defmethod process-change :add-obj
|
||||
[data {:keys [id obj page-id component-id frame-id parent-id index ignore-touched]}]
|
||||
[data {:keys [id obj page-id component-id frame-id parent-id index ignore-touched]} _]
|
||||
;; NOTE: we only perform hard validation on backend
|
||||
#?(:clj (validate-shape obj page-id))
|
||||
|
||||
@ -644,7 +655,7 @@
|
||||
objects))
|
||||
|
||||
(defmethod process-change :mod-obj
|
||||
[data {:keys [page-id component-id] :as change}]
|
||||
[data {:keys [page-id component-id] :as change} _]
|
||||
(if page-id
|
||||
(d/update-in-when data [:pages-index page-id :objects] process-operations change)
|
||||
(d/update-in-when data [:components component-id :objects] process-operations change)))
|
||||
@ -674,19 +685,19 @@
|
||||
objects))
|
||||
|
||||
(defmethod process-change :reorder-children
|
||||
[data {:keys [page-id component-id] :as change}]
|
||||
[data {:keys [page-id component-id] :as change} _]
|
||||
(if page-id
|
||||
(d/update-in-when data [:pages-index page-id :objects] process-children-reordering change)
|
||||
(d/update-in-when data [:components component-id :objects] process-children-reordering change)))
|
||||
|
||||
(defmethod process-change :del-obj
|
||||
[data {:keys [page-id component-id id ignore-touched]}]
|
||||
[data {:keys [page-id component-id id ignore-touched]} _]
|
||||
(if page-id
|
||||
(d/update-in-when data [:pages-index page-id] ctst/delete-shape id ignore-touched)
|
||||
(d/update-in-when data [:components component-id] ctst/delete-shape id ignore-touched)))
|
||||
|
||||
(defmethod process-change :fix-obj
|
||||
[data {:keys [page-id component-id id] :as params}]
|
||||
[data {:keys [page-id component-id id] :as params} _]
|
||||
(letfn [(fix-container [container]
|
||||
(case (:fix params :broken-children)
|
||||
:broken-children (ctst/fix-broken-children container id)
|
||||
@ -698,7 +709,7 @@
|
||||
(d/update-in-when data [:components component-id] fix-container))))
|
||||
|
||||
(defmethod process-change :reg-objects
|
||||
[data {:keys [page-id component-id shapes]}]
|
||||
[data {:keys [page-id component-id shapes]} _]
|
||||
;; FIXME: Improve performance
|
||||
(letfn [(reg-objects [objects]
|
||||
(let [lookup (d/getf objects)
|
||||
@ -755,7 +766,7 @@
|
||||
|
||||
(defmethod process-change :mov-objects
|
||||
;; FIXME: ignore-touched is no longer used, so we can consider it deprecated
|
||||
[data {:keys [parent-id shapes index page-id component-id #_ignore-touched after-shape allow-altering-copies syncing]}]
|
||||
[data {:keys [parent-id shapes index page-id component-id #_ignore-touched after-shape allow-altering-copies syncing]} _]
|
||||
(letfn [(calculate-invalid-targets [objects shape-id]
|
||||
(let [reduce-fn #(into %1 (calculate-invalid-targets objects %2))]
|
||||
(->> (get-in objects [shape-id :shapes])
|
||||
@ -870,7 +881,7 @@
|
||||
(d/update-in-when data [:components component-id :objects] move-objects))))
|
||||
|
||||
(defmethod process-change :add-page
|
||||
[data {:keys [id name page]}]
|
||||
[data {:keys [id name page]} _]
|
||||
(when (and id name page)
|
||||
(ex/raise :type :conflict
|
||||
:hint "id+name or page should be provided, never both"))
|
||||
@ -880,7 +891,7 @@
|
||||
(ctpl/add-page data page)))
|
||||
|
||||
(defmethod process-change :mod-page
|
||||
[data {:keys [id] :as params}]
|
||||
[data {:keys [id] :as params} _]
|
||||
(d/update-in-when data [:pages-index id]
|
||||
(fn [page]
|
||||
(let [name (get params :name)
|
||||
@ -917,7 +928,7 @@
|
||||
(dissoc :pixel-grid-opacity))))))
|
||||
|
||||
(defmethod process-change :set-plugin-data
|
||||
[data {:keys [object-type object-id page-id namespace key value]}]
|
||||
[data {:keys [object-type object-id page-id namespace key value]} _]
|
||||
(letfn [(update-fn [data]
|
||||
(if (some? value)
|
||||
(assoc-in data [:plugin-data namespace key] value)
|
||||
@ -943,83 +954,83 @@
|
||||
(d/update-in-when data [:components object-id] update-fn))))
|
||||
|
||||
(defmethod process-change :del-page
|
||||
[data {:keys [id]}]
|
||||
[data {:keys [id]} _]
|
||||
(ctpl/delete-page data id))
|
||||
|
||||
(defmethod process-change :mov-page
|
||||
[data {:keys [id index]}]
|
||||
[data {:keys [id index]} _]
|
||||
(update data :pages d/insert-at-index index [id]))
|
||||
|
||||
(defmethod process-change :add-color
|
||||
[data {:keys [color]}]
|
||||
[data {:keys [color]} _]
|
||||
(ctl/add-color data color))
|
||||
|
||||
(defmethod process-change :mod-color
|
||||
[data {:keys [color]}]
|
||||
[data {:keys [color]} _]
|
||||
(ctl/set-color data color))
|
||||
|
||||
(defmethod process-change :del-color
|
||||
[data {:keys [id]}]
|
||||
[data {:keys [id]} _]
|
||||
(ctl/delete-color data id))
|
||||
|
||||
;; -- Media
|
||||
|
||||
(defmethod process-change :add-media
|
||||
[data {:keys [object]}]
|
||||
[data {:keys [object]} _]
|
||||
(update data :media assoc (:id object) object))
|
||||
|
||||
(defmethod process-change :mod-media
|
||||
[data {:keys [object]}]
|
||||
[data {:keys [object]} _]
|
||||
(d/update-in-when data [:media (:id object)] merge object))
|
||||
|
||||
(defmethod process-change :del-media
|
||||
[data {:keys [id]}]
|
||||
[data {:keys [id]} _]
|
||||
(d/update-when data :media dissoc id))
|
||||
|
||||
;; -- Components
|
||||
|
||||
(defmethod process-change :add-component
|
||||
[data params]
|
||||
[data params _]
|
||||
(ctkl/add-component data params))
|
||||
|
||||
(defmethod process-change :mod-component
|
||||
[data params]
|
||||
[data params _]
|
||||
(ctkl/mod-component data params))
|
||||
|
||||
(defmethod process-change :del-component
|
||||
[data {:keys [id skip-undelete? delta]}]
|
||||
[data {:keys [id skip-undelete? delta]} _]
|
||||
(ctf/delete-component data id skip-undelete? delta))
|
||||
|
||||
(defmethod process-change :restore-component
|
||||
[data {:keys [id page-id]}]
|
||||
[data {:keys [id page-id]} _]
|
||||
(ctf/restore-component data id page-id))
|
||||
|
||||
(defmethod process-change :purge-component
|
||||
[data {:keys [id]}]
|
||||
[data {:keys [id]} _]
|
||||
(ctf/purge-component data id))
|
||||
|
||||
;; -- Typography
|
||||
|
||||
(defmethod process-change :add-typography
|
||||
[data {:keys [typography]}]
|
||||
[data {:keys [typography]} _]
|
||||
(ctyl/add-typography data typography))
|
||||
|
||||
(defmethod process-change :mod-typography
|
||||
[data {:keys [typography]}]
|
||||
[data {:keys [typography]} _]
|
||||
(ctyl/update-typography data (:id typography) merge typography))
|
||||
|
||||
(defmethod process-change :del-typography
|
||||
[data {:keys [id]}]
|
||||
[data {:keys [id]} _]
|
||||
(ctyl/delete-typography data id))
|
||||
|
||||
;; -- Design Tokens
|
||||
|
||||
(defmethod process-change :set-tokens-lib
|
||||
[data {:keys [tokens-lib]}]
|
||||
[data {:keys [tokens-lib]} _]
|
||||
(assoc data :tokens-lib tokens-lib))
|
||||
|
||||
(defmethod process-change :set-token
|
||||
[data {:keys [set-id token-id attrs]}]
|
||||
[data {:keys [set-id token-id attrs]} _]
|
||||
(-> (cfo/ensure-tokens-lib data)
|
||||
(cfo/update-tokens-lib
|
||||
(fn [lib']
|
||||
@ -1036,7 +1047,7 @@
|
||||
(ctob/make-token (merge prev-token attrs)))))))))
|
||||
|
||||
(defmethod process-change :set-token-set
|
||||
[data {:keys [id attrs]}]
|
||||
[data {:keys [id attrs]} _]
|
||||
(-> (cfo/ensure-tokens-lib data)
|
||||
(cfo/update-tokens-lib
|
||||
(fn [lib']
|
||||
@ -1051,7 +1062,7 @@
|
||||
(ctob/update-set lib' id (fn [_] (ctob/make-token-set attrs))))))))
|
||||
|
||||
(defmethod process-change :set-token-theme
|
||||
[data {:keys [id attrs]}]
|
||||
[data {:keys [id attrs]} _]
|
||||
(-> (cfo/ensure-tokens-lib data)
|
||||
(cfo/update-tokens-lib
|
||||
(fn [lib']
|
||||
@ -1069,7 +1080,7 @@
|
||||
(ctob/make-token-theme (merge prev-token-theme attrs)))))))))
|
||||
|
||||
(defmethod process-change :set-tokens-status
|
||||
[data {:keys [theme-ids set-ids]}]
|
||||
[data {:keys [theme-ids set-ids]} _]
|
||||
(-> (cfo/ensure-tokens-lib data)
|
||||
(cfo/update-tokens-status ctos/set-tokens-status theme-ids set-ids)))
|
||||
|
||||
@ -1081,30 +1092,63 @@
|
||||
:active-set-ids set-ids))))
|
||||
|
||||
(defmethod process-change :rename-token-set-group
|
||||
[data {:keys [set-group-path set-group-fname]}]
|
||||
[data {:keys [set-group-path set-group-fname]} _]
|
||||
(-> (cfo/ensure-tokens-lib data)
|
||||
(cfo/update-tokens-lib ctob/rename-set-group set-group-path set-group-fname)))
|
||||
|
||||
(defmethod process-change :move-token-set
|
||||
[data {:keys [from-path to-path before-path before-group] :as changes}]
|
||||
[data {:keys [from-path to-path before-path before-group] :as changes} _]
|
||||
(-> (cfo/ensure-tokens-lib data)
|
||||
(cfo/update-tokens-lib ctob/move-set from-path to-path before-path before-group)))
|
||||
|
||||
(defmethod process-change :move-token-set-group
|
||||
[data {:keys [from-path to-path before-path before-group]}]
|
||||
[data {:keys [from-path to-path before-path before-group]} _]
|
||||
(-> (cfo/ensure-tokens-lib data)
|
||||
(cfo/update-tokens-lib ctob/move-set-group from-path to-path before-path before-group)))
|
||||
|
||||
;; === Design Tokens configuration
|
||||
;; --- Design Tokens configuration
|
||||
|
||||
(defmethod process-change :set-base-font-size
|
||||
[data {:keys [base-font-size]}]
|
||||
[data {:keys [base-font-size]} _]
|
||||
(ctf/set-base-font-size data base-font-size))
|
||||
|
||||
(defmethod process-change :set-tokens-source
|
||||
[data {:keys [library-id]}]
|
||||
[data {:keys [library-id]} _]
|
||||
(cfo/set-tokens-source data library-id))
|
||||
|
||||
;; --- Validate Shapes
|
||||
|
||||
#?(:clj
|
||||
(defmethod process-change :validate-shapes
|
||||
[data _ _]
|
||||
data))
|
||||
|
||||
#?(:cljs
|
||||
(defmethod process-change :validate-shapes
|
||||
[data {:keys [page-id shape-ids context]} libraries]
|
||||
(if libraries
|
||||
(println "Validating shapes: \n"
|
||||
" page-id:" (str page-id) "\n"
|
||||
" shape-ids:" (str shape-ids) "\n"
|
||||
" context:" context)
|
||||
(let [file {:data data :id uuid/zero}
|
||||
errors (reduce (fn [acc shape-id]
|
||||
(if-let [page (ctpl/get-page data page-id)]
|
||||
(let [page-errors (val/validate-shape shape-id file page libraries)]
|
||||
(if (seq page-errors)
|
||||
(into acc page-errors)
|
||||
acc))
|
||||
acc))
|
||||
[]
|
||||
shape-ids)]
|
||||
(when (seq errors)
|
||||
(ex/raise :type :validation
|
||||
:code :referential-integrity
|
||||
:hint (str "error on validating shapes: " context)
|
||||
:details errors))
|
||||
data))
|
||||
data))
|
||||
|
||||
;; === Operations
|
||||
|
||||
(def decode-shape-attrs
|
||||
|
||||
@ -1254,7 +1254,6 @@
|
||||
[changes]
|
||||
(::page-id (meta changes)))
|
||||
|
||||
|
||||
(defn set-text-content
|
||||
[changes id content prev-content]
|
||||
(assert-page-id! changes)
|
||||
@ -1275,3 +1274,12 @@
|
||||
(-> changes
|
||||
(update :redo-changes conj redo-change)
|
||||
(update :undo-changes conj undo-change))))
|
||||
|
||||
;; Validate Shapes
|
||||
|
||||
(defn validate-shapes
|
||||
[changes page-id shape-ids context]
|
||||
(update changes :redo-changes conj {:type :validate-shapes
|
||||
:page-id page-id
|
||||
:shape-ids (vec shape-ids)
|
||||
:context context}))
|
||||
|
||||
@ -294,8 +294,11 @@
|
||||
duplicated-parent?
|
||||
(->> ids-map vals (some #(= % (:parent-id first-shape))))
|
||||
|
||||
grid-parent?
|
||||
(and (ctsl/grid-layout? objects (:parent-id first-shape)) (not duplicated-parent?))
|
||||
|
||||
changes
|
||||
(if (and (ctsl/grid-layout? objects (:parent-id first-shape)) (not duplicated-parent?))
|
||||
(if grid-parent?
|
||||
(let [target-cell (-> position meta :cell)
|
||||
|
||||
[row column]
|
||||
@ -317,7 +320,19 @@
|
||||
changes
|
||||
(reduce #(pcb/add-object %1 %2 {:ignore-touched true})
|
||||
changes
|
||||
(rest new-shapes))]
|
||||
(rest new-shapes))
|
||||
|
||||
ids-to-validate (cond-> [(:id first-shape)]
|
||||
grid-parent?
|
||||
(conj (:parent-id first-shape)))
|
||||
|
||||
changes (if (seq ids-to-validate)
|
||||
(pcb/validate-shapes changes
|
||||
(:id page)
|
||||
ids-to-validate
|
||||
(str "generate-instantiate-component: " component-id
|
||||
" under parent-id" (or parent-id " root")))
|
||||
changes)]
|
||||
|
||||
[new-shape changes])))
|
||||
|
||||
@ -3140,7 +3155,6 @@
|
||||
;; we calculate a new one because the components will have created new shapes.
|
||||
ids-map (into {} (map #(vector % (uuid/next))) all-ids)
|
||||
|
||||
|
||||
;; If there is an alt-duplication we change to root
|
||||
;; For variants so the copy is made as a child of root
|
||||
;; This is because inside a variant-container can't be a copy
|
||||
@ -3152,7 +3166,6 @@
|
||||
(assoc :parent-id uuid/zero :frame-id uuid/zero)))
|
||||
shapes)
|
||||
|
||||
|
||||
changes (-> changes
|
||||
(pcb/with-page page)
|
||||
(pcb/with-objects all-objects)
|
||||
@ -3182,7 +3195,20 @@
|
||||
(comp
|
||||
(filter #(= :add-obj (:type %)))
|
||||
(map #(vector (:old-id %) (-> % :obj :id))))
|
||||
(:redo-changes changes))]
|
||||
(:redo-changes changes))
|
||||
|
||||
copied-components
|
||||
(ctn/get-all-instance-roots (:objects page) ids)
|
||||
|
||||
ids-to-validate
|
||||
(map #(get ids-map % %) copied-components)
|
||||
|
||||
changes (if (seq ids-to-validate)
|
||||
(pcb/validate-shapes changes
|
||||
(:id page)
|
||||
ids-to-validate
|
||||
(cond-> (str "generate-duplicate-changes: " ids)))
|
||||
changes)]
|
||||
|
||||
(-> changes
|
||||
(generate-duplicate-flows shapes page ids-map)
|
||||
|
||||
@ -84,7 +84,7 @@
|
||||
(reduce check-shape changes mod-obj-changes)))
|
||||
|
||||
(defn generate-update-shapes
|
||||
[changes ids update-fn objects {:keys [attrs changed-sub-attr changed-item-index ignore-tree ignore-touched with-objects? translation? skip-grid-reassignment?]}]
|
||||
[changes ids update-fn objects {:keys [attrs changed-sub-attr changed-item-index ignore-tree ignore-touched with-objects? translation? skip-grid-reassignment? extra-context]}]
|
||||
(let [changes (reduce
|
||||
(fn [changes id]
|
||||
(let [opts {:attrs attrs
|
||||
@ -105,7 +105,19 @@
|
||||
(pcb/reorder-grid-children ids))
|
||||
|
||||
(not ignore-touched)
|
||||
(generate-unapply-tokens objects changed-sub-attr changed-item-index))]
|
||||
(generate-unapply-tokens objects changed-sub-attr changed-item-index))
|
||||
|
||||
page-id (pcb/get-page-id changes)
|
||||
modified-components (ctn/get-all-instance-roots objects ids)
|
||||
|
||||
changes (if (and page-id (seq modified-components))
|
||||
(pcb/validate-shapes changes
|
||||
page-id
|
||||
modified-components
|
||||
(cond-> (str "generate-update-shapes: " ids " " attrs)
|
||||
(some? extra-context)
|
||||
(str " \n -> from " extra-context)))
|
||||
changes)]
|
||||
changes))
|
||||
|
||||
(defn- generate-update-shape-flags
|
||||
@ -257,8 +269,8 @@
|
||||
page-id (pcb/get-page-id changes)
|
||||
page (or (pcb/get-page changes)
|
||||
(ctpl/get-page data page-id))
|
||||
|
||||
ids (cfh/clean-loops objects ids)
|
||||
|
||||
in-component-copy?
|
||||
(fn [shape-id]
|
||||
;; Look for shapes that are inside a component copy, but are
|
||||
@ -267,7 +279,7 @@
|
||||
;; If we want to specifically allow altering the copies, this is
|
||||
;; a special case, like a component swap, in which case we want
|
||||
;; to delete the old shape
|
||||
(let [shape (get objects shape-id)]
|
||||
(let [shape (get objects shape-id)]
|
||||
(and (ctn/has-any-copy-parent? objects shape)
|
||||
(not allow-altering-copies))))
|
||||
|
||||
@ -446,7 +458,19 @@
|
||||
(into []
|
||||
(remove #(and (ctsi/has-destination %)
|
||||
(id-to-delete? (:destination %))))
|
||||
interactions))))))]
|
||||
interactions))))))
|
||||
|
||||
modified-components (ctn/get-all-instance-roots objects (disj all-parents uuid/zero))
|
||||
;; There is no need to validate deleted objects. Probably also no need to validate hidden or unmasked objects,
|
||||
;; but we may think of it
|
||||
|
||||
changes (if (seq modified-components)
|
||||
(pcb/validate-shapes changes
|
||||
page-id
|
||||
modified-components
|
||||
(str "generate-delete-shapes: " ids))
|
||||
changes)]
|
||||
|
||||
[all-parents changes])))
|
||||
|
||||
|
||||
|
||||
@ -216,6 +216,62 @@
|
||||
:else
|
||||
(get-instance-root objects (get objects (:parent-id shape)))))
|
||||
|
||||
(defn get-all-instance-roots
|
||||
"Given a list of shape ids and an objects tree, returns a set with the
|
||||
ids of the instance roots related to each of the shapes (see
|
||||
ctk/instance-root?).
|
||||
|
||||
For each shape, first look up: if the shape itself or any of its
|
||||
ancestors is an instance root, only that root is added. If not, look
|
||||
down the descendants of the shape with a depth-first search: each
|
||||
instance root found is added, and its own subtree is skipped, while
|
||||
the search continues with the other descendants."
|
||||
[objects shape-ids]
|
||||
(let [visited (volatile! #{})
|
||||
result (volatile! #{})]
|
||||
(letfn [(search-up
|
||||
;; Returns true if the shape is already covered: it has an
|
||||
;; instance root at or above it (that is added to the
|
||||
;; result), or it was visited by a previous search. A shape
|
||||
;; is marked as visited only after a root has been found at
|
||||
;; or above it, so a failed search never blocks the
|
||||
;; downward search of the shapes below.
|
||||
[shape-id]
|
||||
(when-not (contains? @visited shape-id)
|
||||
(let [shape (get objects shape-id)]
|
||||
(cond
|
||||
(nil? shape)
|
||||
false
|
||||
|
||||
(ctk/instance-root? shape)
|
||||
(do (vswap! visited conj shape-id)
|
||||
(vswap! result conj shape-id)
|
||||
true)
|
||||
|
||||
(cfh/root? shape)
|
||||
false
|
||||
|
||||
:else
|
||||
(when (search-up (:parent-id shape))
|
||||
(vswap! visited conj shape-id)
|
||||
true)))))
|
||||
|
||||
(search-down
|
||||
[shape-id]
|
||||
(when-not (contains? @visited shape-id)
|
||||
(vswap! visited conj shape-id)
|
||||
(let [shape (get objects shape-id)]
|
||||
(when-not (nil? shape)
|
||||
(if (ctk/instance-root? shape)
|
||||
(vswap! result conj shape-id)
|
||||
(run! search-down (:shapes shape)))))))]
|
||||
|
||||
(doseq [shape-id shape-ids]
|
||||
(when-not (search-up shape-id)
|
||||
(search-down shape-id)))
|
||||
|
||||
@result)))
|
||||
|
||||
(defn find-component-main
|
||||
"If the shape is a component main instance or is inside one, return that instance.
|
||||
Uses an iterative loop with cycle detection to prevent stack overflow on circular
|
||||
|
||||
@ -154,3 +154,200 @@
|
||||
shape-b (make-shape id-b :parent-id id-a)
|
||||
objects (objects-map shape-a shape-b)]
|
||||
(t/is (nil? (ctc/find-component-main objects shape-a false))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Tests – get-all-instance-roots
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- make-tree
|
||||
"Build an objects map from a seq of [id parent-id attrs] triples. The
|
||||
:shapes of each parent are filled from the triples, in order. A nil
|
||||
parent-id means that the shape has no parent in the map."
|
||||
[specs]
|
||||
(let [children (reduce (fn [acc [id parent-id]]
|
||||
(cond-> acc
|
||||
(some? parent-id)
|
||||
(update parent-id (fnil conj []) id)))
|
||||
{}
|
||||
specs)]
|
||||
(->> specs
|
||||
(map (fn [[id parent-id attrs]]
|
||||
(apply make-shape id
|
||||
:parent-id parent-id
|
||||
:shapes (get children id [])
|
||||
(mapcat identity attrs))))
|
||||
(apply objects-map))))
|
||||
|
||||
(def ^:private root-attrs {:component-root true
|
||||
:component-id (uuid/next)})
|
||||
|
||||
(t/deftest get-all-instance-roots-empty-and-missing
|
||||
(t/testing "no ids returns an empty set"
|
||||
(t/is (= #{} (ctc/get-all-instance-roots {} []))))
|
||||
|
||||
(t/testing "ids that are not in objects return an empty set"
|
||||
(t/is (= #{} (ctc/get-all-instance-roots {} [(uuid/next)])))))
|
||||
|
||||
(t/deftest get-all-instance-roots-no-roots
|
||||
(t/testing "returns an empty set when there is no instance root above or below"
|
||||
(let [[a b c] (repeatedly 3 uuid/next)
|
||||
objects (make-tree [[a root-id]
|
||||
[b a]
|
||||
[c b]])]
|
||||
(doseq [id [a b c]]
|
||||
(t/is (= #{} (ctc/get-all-instance-roots objects [id])))))))
|
||||
|
||||
(t/deftest get-all-instance-roots-self-is-root
|
||||
(t/testing "a shape that is an instance root returns itself"
|
||||
(let [[a] (repeatedly 1 uuid/next)
|
||||
objects (make-tree [[a root-id root-attrs]])]
|
||||
(t/is (= #{a} (ctc/get-all-instance-roots objects [a])))))
|
||||
|
||||
(t/testing "does not look down when the shape itself is an instance root"
|
||||
(let [[a b] (repeatedly 2 uuid/next)
|
||||
objects (make-tree [[a root-id root-attrs]
|
||||
[b a root-attrs]])]
|
||||
(t/is (= #{a} (ctc/get-all-instance-roots objects [a]))))))
|
||||
|
||||
(t/deftest get-all-instance-roots-ancestor-is-root
|
||||
(t/testing "finds the instance root among the ancestors"
|
||||
(let [[a b c d] (repeatedly 4 uuid/next)
|
||||
objects (make-tree [[a root-id root-attrs]
|
||||
[b a]
|
||||
[c b]
|
||||
[d c]])]
|
||||
(doseq [id [b c d]]
|
||||
(t/is (= #{a} (ctc/get-all-instance-roots objects [id]))))))
|
||||
|
||||
(t/testing "returns the nearest ancestor root when there are several"
|
||||
(let [[a b c d] (repeatedly 4 uuid/next)
|
||||
objects (make-tree [[a root-id root-attrs]
|
||||
[b a root-attrs]
|
||||
[c b]
|
||||
[d c]])]
|
||||
(t/is (= #{b} (ctc/get-all-instance-roots objects [d])))))
|
||||
|
||||
(t/testing "does not look down when an ancestor is an instance root"
|
||||
(let [[a b c d] (repeatedly 4 uuid/next)
|
||||
objects (make-tree [[a root-id root-attrs]
|
||||
[b a]
|
||||
[c b root-attrs]
|
||||
[d b root-attrs]])]
|
||||
(t/is (= #{a} (ctc/get-all-instance-roots objects [b]))))))
|
||||
|
||||
(t/deftest get-all-instance-roots-descendant-roots
|
||||
(t/testing "finds an instance root below a shape without roots above"
|
||||
(let [[a b c] (repeatedly 3 uuid/next)
|
||||
objects (make-tree [[a root-id]
|
||||
[b a]
|
||||
[c b root-attrs]])]
|
||||
(t/is (= #{c} (ctc/get-all-instance-roots objects [a])))
|
||||
(t/is (= #{c} (ctc/get-all-instance-roots objects [b])))))
|
||||
|
||||
(t/testing "finds a root that is a direct child of the starting shape"
|
||||
(let [[a b] (repeatedly 2 uuid/next)
|
||||
objects (make-tree [[a root-id]
|
||||
[b a root-attrs]])]
|
||||
(t/is (= #{b} (ctc/get-all-instance-roots objects [a])))))
|
||||
|
||||
(t/testing "finds roots in several branches"
|
||||
(let [[a b c d e f] (repeatedly 6 uuid/next)
|
||||
objects (make-tree [[a root-id]
|
||||
[b a]
|
||||
[c b root-attrs]
|
||||
[d a root-attrs]
|
||||
[e a]
|
||||
[f e root-attrs]])]
|
||||
(t/is (= #{c d f} (ctc/get-all-instance-roots objects [a])))))
|
||||
|
||||
(t/testing "skips the subtree of a found root and continues with the siblings"
|
||||
(let [[a b c d e f] (repeatedly 6 uuid/next)
|
||||
objects (make-tree [[a root-id]
|
||||
[b a root-attrs]
|
||||
[c b root-attrs] ; nested in b, must be skipped
|
||||
[d c root-attrs] ; nested in c, must be skipped
|
||||
[e a]
|
||||
[f e root-attrs]])]
|
||||
(t/is (= #{b f} (ctc/get-all-instance-roots objects [a])))))
|
||||
|
||||
(t/testing "skips a root nested in a non-root shape inside another root"
|
||||
(let [[a b c d] (repeatedly 4 uuid/next)
|
||||
objects (make-tree [[a root-id]
|
||||
[b a root-attrs]
|
||||
[c b]
|
||||
[d c root-attrs]])]
|
||||
(t/is (= #{b} (ctc/get-all-instance-roots objects [a]))))))
|
||||
|
||||
(t/deftest get-all-instance-roots-page-root
|
||||
(t/testing "searching from the page root finds the top level instance roots"
|
||||
(let [[a b c d] (repeatedly 4 uuid/next)
|
||||
objects (assoc (make-tree [[a root-id root-attrs]
|
||||
[b a root-attrs]
|
||||
[c root-id]
|
||||
[d c root-attrs]])
|
||||
root-id
|
||||
(assoc (root-shape) :shapes [a c]))]
|
||||
(t/is (= #{a d} (ctc/get-all-instance-roots objects [root-id]))))))
|
||||
|
||||
(t/deftest get-all-instance-roots-several-ids
|
||||
(t/testing "returns the union of the roots of every id"
|
||||
(let [[a b c d e] (repeatedly 5 uuid/next)
|
||||
objects (make-tree [[a root-id root-attrs] ; root with up search
|
||||
[b a]
|
||||
[c root-id] ; no root above
|
||||
[d c root-attrs] ; found down from c
|
||||
[e root-id]])] ; nothing
|
||||
(t/is (= #{a d} (ctc/get-all-instance-roots objects [b c e])))))
|
||||
|
||||
(t/testing "ids that overlap in the same tree do not duplicate or lose roots"
|
||||
(let [[a b c d] (repeatedly 4 uuid/next)
|
||||
objects (make-tree [[a root-id]
|
||||
[b a]
|
||||
[c b root-attrs]
|
||||
[d a root-attrs]])]
|
||||
(t/is (= #{c d} (ctc/get-all-instance-roots objects [a b c d])))
|
||||
(t/is (= #{c d} (ctc/get-all-instance-roots objects [b a d c])))
|
||||
(t/is (= #{c d} (ctc/get-all-instance-roots objects [a a])))))
|
||||
|
||||
(t/testing "a shape below an already searched shape is not searched again"
|
||||
(let [[a b c d] (repeatedly 4 uuid/next)
|
||||
objects (make-tree [[a root-id]
|
||||
[b a]
|
||||
[c b root-attrs]
|
||||
[d a root-attrs]])]
|
||||
(t/is (= #{c d} (ctc/get-all-instance-roots objects [a b])))
|
||||
(t/is (= #{c d} (ctc/get-all-instance-roots objects [b a])))))
|
||||
|
||||
(t/testing "a child of a shape with a root above does not search down"
|
||||
(let [[a b c d] (repeatedly 4 uuid/next)
|
||||
objects (make-tree [[a root-id root-attrs]
|
||||
[b a]
|
||||
[c b root-attrs]
|
||||
[d b]])]
|
||||
(t/is (= #{a} (ctc/get-all-instance-roots objects [b d])))
|
||||
(t/is (= #{a} (ctc/get-all-instance-roots objects [d b])))))
|
||||
|
||||
(t/testing "siblings without a root above are both searched down"
|
||||
(let [[a b c d e] (repeatedly 5 uuid/next)
|
||||
objects (make-tree [[a root-id]
|
||||
[b a]
|
||||
[c b root-attrs]
|
||||
[d a]
|
||||
[e d root-attrs]])]
|
||||
(t/is (= #{c e} (ctc/get-all-instance-roots objects [b d])))
|
||||
(t/is (= #{c e} (ctc/get-all-instance-roots objects [c e])))))
|
||||
|
||||
(t/testing "a shape inside a root and a shape outside any root"
|
||||
(let [[a b c d] (repeatedly 4 uuid/next)
|
||||
objects (make-tree [[a root-id root-attrs]
|
||||
[b a]
|
||||
[c root-id]
|
||||
[d c]])]
|
||||
(t/is (= #{a} (ctc/get-all-instance-roots objects [b d]))))))
|
||||
|
||||
(t/deftest get-all-instance-roots-cycles
|
||||
(t/testing "does not loop on circular children references"
|
||||
(let [[a b] (repeatedly 2 uuid/next)
|
||||
objects (objects-map (make-shape a :shapes [b])
|
||||
(make-shape b :shapes [a]))]
|
||||
(t/is (= #{} (ctc/get-all-instance-roots objects [a]))))))
|
||||
|
||||
@ -105,12 +105,14 @@
|
||||
(wasm.api/process-objects shapes)
|
||||
(wasm.api/request-render "sync-wasm-structural-changes"))))))
|
||||
|
||||
(defn- apply-changes-localy
|
||||
(defn- apply-changes-locally
|
||||
[{:keys [file-id redo-changes ignore-wasm?] :as commit} pending]
|
||||
(ptk/reify ::apply-changes-localy
|
||||
(ptk/reify ::apply-changes-locally
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(let [undo-changes
|
||||
(let [libraries (dsh/lookup-libraries state)
|
||||
|
||||
undo-changes
|
||||
(if pending
|
||||
(->> pending
|
||||
(map :undo-changes)
|
||||
@ -128,8 +130,8 @@
|
||||
|
||||
apply-changes
|
||||
(fn [fdata]
|
||||
(let [fdata (cpc/process-changes fdata undo-changes false)
|
||||
fdata (cpc/process-changes fdata redo-changes false)
|
||||
(let [fdata (cpc/process-changes fdata undo-changes false libraries)
|
||||
fdata (cpc/process-changes fdata redo-changes false libraries)
|
||||
pids (into #{} xf:map-page-id redo-changes)]
|
||||
(reduce #(ctst/update-object-indices %1 %2) fdata pids)))]
|
||||
|
||||
@ -202,7 +204,7 @@
|
||||
(let [pending (when-not local?
|
||||
(get-pending-commits state))]
|
||||
(rx/concat
|
||||
(rx/of (apply-changes-localy commit pending))
|
||||
(rx/of (apply-changes-locally commit pending))
|
||||
(if pending
|
||||
(rx/concat
|
||||
(->> (rx/from (reverse pending))
|
||||
|
||||
@ -193,7 +193,8 @@
|
||||
layout-initializer (get-layout-initializer type from-frame? calculate-params?)]
|
||||
|
||||
(rx/of (dwu/start-undo-transaction undo-id)
|
||||
(dwsh/update-shapes [id] layout-initializer {:with-objects? true})
|
||||
(dwsh/update-shapes [id] layout-initializer {:with-objects? true
|
||||
:extra-context (str "create-layout-from-id: " id)})
|
||||
(dwsh/update-shapes (dm/get-prop parent :shapes) #(dissoc % :constraints-h :constraints-v))
|
||||
(ptk/data-event :layout/update {:ids [id]})
|
||||
(dwu/commit-undo-transaction undo-id))))))
|
||||
|
||||
@ -211,7 +211,7 @@
|
||||
{:as props
|
||||
:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id
|
||||
ignore-touched undo-group with-objects? changed-sub-attr changed-item-index translation?
|
||||
skip-grid-reassignment? skip-component-sync? resize-ids]
|
||||
skip-grid-reassignment? skip-component-sync? resize-ids extra-context]
|
||||
:or {reg-objects? false
|
||||
save-undo? true
|
||||
stack-undo? false
|
||||
@ -251,7 +251,8 @@
|
||||
:ignore-touched ignore-touched
|
||||
:with-objects? with-objects?
|
||||
:translation? translation?
|
||||
:skip-grid-reassignment? skip-grid-reassignment?})
|
||||
:skip-grid-reassignment? skip-grid-reassignment?
|
||||
:extra-context extra-context})
|
||||
(cond-> undo-group
|
||||
(pcb/set-undo-group undo-group))
|
||||
(pcb/set-translation? translation?)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user