Lazy descendant walks in find-valid-parent-and-frame-ids

This commit is contained in:
Elena Torro
2026-05-04 17:48:19 +02:00
parent e29c579d78
commit 4ecf93cba6
2 changed files with 87 additions and 53 deletions

View File

@@ -482,65 +482,90 @@
;; or inside its main component if it's in a copy.
comps-nesting-loop?)))
(defn make-parent-validation-context
"Pre-compute the `children`-derived data used by
`find-valid-parent-and-frame-ids`. Build once per gesture and pass
the result as the optional `ctx` arg to that function so the
per-pointer-move call doesn't re-walk the dragged subtree on each
tick. Each cached value is a `delay`; only the ones that the
predicate path actually reaches are realized, and the result is
then memoized for every later call sharing the same context."
[objects children libraries]
(let [children-ids (set (map :id children))
top-children (remove #(contains? children-ids (:parent-id %)) children)
all-main? (every? ctk/main-instance? top-children)
get-variant-id (fn [shape]
(when (:component-id shape)
(-> (get-component-from-shape shape libraries)
:variant-id)))
descendants (delay (mapcat #(cfh/get-children-with-self objects %) children-ids))
any-variant-container-descendant (delay (some ctk/is-variant-container? @descendants))
descendants-variant-ids-set (delay (->> @descendants
(map get-variant-id)
set))
any-main-descendant
(delay
(some
(fn [shape]
(some ctk/main-instance? (cfh/get-children-with-self objects (:id shape))))
children))]
{:top-children top-children
:all-main? all-main?
:descendants descendants
:any-variant-container-descendant any-variant-container-descendant
:descendants-variant-ids-set descendants-variant-ids-set
:any-main-descendant any-main-descendant}))
(defn find-valid-parent-and-frame-ids
"Navigate trough the ancestors until find one that is valid. Returns [ parent-id frame-id ]"
([parent-id objects children]
(find-valid-parent-and-frame-ids parent-id objects children false nil))
(find-valid-parent-and-frame-ids parent-id objects children false nil nil))
([parent-id objects children pasting? libraries]
(letfn [(get-frame [parent-id]
(if (cfh/frame-shape? objects parent-id) parent-id (get-in objects [parent-id :frame-id])))]
(let [parent (get objects parent-id)
(find-valid-parent-and-frame-ids parent-id objects children pasting? libraries nil))
([parent-id objects children pasting? libraries ctx]
(letfn [(get-frame [pid]
(if (cfh/frame-shape? objects pid) pid (get-in objects [pid :frame-id])))]
;; The full-subtree walks dominate per-pointer-move cost when
;; dragging a layout with many component children. The predicates
;; below put cheap ascendant/parent-shape checks first so the
;; common drag case (pasting? = false, parent not a main instance,
;; no variant ancestors) skips deref entirely. When a `ctx` is
;; supplied, the delays inside it are SHARED across the whole
;; gesture — once realized for one parent in the walk, every
;; subsequent move and recur step reuses the cached result.
(let [{:keys [top-children all-main? any-variant-container-descendant
descendants-variant-ids-set any-main-descendant]}
(or ctx (make-parent-validation-context objects children libraries))]
;; We need to check only the top shapes
children-ids (set (map :id children))
top-children (remove #(contains? children-ids (:parent-id %)) children)
(loop [parent-id parent-id]
(let [parent (get objects parent-id)
;; We can always move the children to the parent they already have.
;; But if we are pasting, those are new items, so it is considered a change
no-changes?
(and (every? #(= parent-id (:parent-id %)) top-children)
(not pasting?))
;; We can always move the children to the parent they already have.
;; But if we are pasting, those are new items, so it is considered a change
no-changes?
(and (every? #(= parent-id (:parent-id %)) top-children)
(not pasting?))
;; Are all the top-children a main-instance of a component?
all-main?
(every? ctk/main-instance? top-children)
ascendants (cfh/get-parents-with-self objects parent-id)
any-main-ascendant (some ctk/main-instance? ascendants)
any-variant-container-ascendant (some ctk/is-variant-container? ascendants)]
ascendants (cfh/get-parents-with-self objects parent-id)
any-main-ascendant (some ctk/main-instance? ascendants)
any-variant-container-ascendant (some ctk/is-variant-container? ascendants)
get-variant-id (fn [shape]
(when (:component-id shape)
(-> (get-component-from-shape shape libraries)
:variant-id)))
descendants (mapcat #(cfh/get-children-with-self objects %) children-ids)
any-variant-container-descendant (some ctk/is-variant-container? descendants)
descendants-variant-ids-set (->> descendants
(map get-variant-id)
set)
any-main-descendant
(some
(fn [shape]
(some ctk/main-instance? (cfh/get-children-with-self objects (:id shape))))
children)]
(if (or no-changes?
(and (not (invalid-structure-for-component? objects parent children pasting? libraries))
;; If we are moving (not pasting) into a main component, no descendant can be main
(or pasting? (nil? any-main-descendant) (not (ctk/main-instance? parent)))
;; Don't allow variant-container inside variant container nor main
(or (not any-variant-container-descendant)
(and (not any-variant-container-ascendant) (not any-main-ascendant)))
;; If the parent is a variant-container, all the items should be main
(or (not (ctk/is-variant-container? parent)) all-main?)
;; If we are pasting, the parent can't be a "brother" of any of the pasted items,
;; so not have the same variant-id of any descendant
(or (not pasting?)
(not (ctk/is-variant? parent))
(not (contains? descendants-variant-ids-set (:variant-id parent))))))
[parent-id (get-frame parent-id)]
(recur (:parent-id parent) objects children pasting? libraries))))))
(if (or no-changes?
(and (not (invalid-structure-for-component? objects parent children pasting? libraries))
;; If we are moving (not pasting) into a main component, no descendant can be main
(or pasting? (not (ctk/main-instance? parent)) (nil? @any-main-descendant))
;; Don't allow variant-container inside variant container nor main
(or (and (not any-variant-container-ascendant) (not any-main-ascendant))
(not @any-variant-container-descendant))
;; If the parent is a variant-container, all the items should be main
(or (not (ctk/is-variant-container? parent)) all-main?)
;; If we are pasting, the parent can't be a "brother" of any of the pasted items,
;; so not have the same variant-id of any descendant
(or (not pasting?)
(not (ctk/is-variant? parent))
(not (contains? @descendants-variant-ids-set (:variant-id parent))))))
[parent-id (get-frame parent-id)]
(recur (:parent-id parent)))))))))
;; --- SHAPE UPDATE

View File

@@ -705,7 +705,16 @@
(rx/map #(array pos %)))))))]
(if (empty? shapes)
(rx/of (finish-transform))
(let [move-stream
(let [;; `shapes`/`objects`/`libraries` are stable for the
;; whole gesture, so the children-derived subtree
;; walks inside `find-valid-parent-and-frame-ids` only
;; need to happen once per gesture instead of per
;; pointer-move. Build the context here and thread it
;; into each call.
parent-validation-ctx
(ctn/make-parent-validation-context objects shapes libraries)
move-stream
(->> position
;; We ask for the snap position but we continue even if the result is not available
(rx/with-latest-from snap-delta)
@@ -720,7 +729,7 @@
(let [position (gpt/add from-position move-vector)
exclude-frames (if mod? exclude-frames exclude-frames-siblings)
target-frame (ctst/top-nested-frame objects position exclude-frames)
[target-frame _] (ctn/find-valid-parent-and-frame-ids target-frame objects shapes false libraries)
[target-frame _] (ctn/find-valid-parent-and-frame-ids target-frame objects shapes false libraries parent-validation-ctx)
flex-layout? (ctl/flex-layout? objects target-frame)
grid-layout? (ctl/grid-layout? objects target-frame)
drop-index (when flex-layout? (gslf/get-drop-index target-frame objects position))