🎉 Simplify and fix compare children

This commit is contained in:
Pablo Alba 2024-03-04 17:44:34 +01:00 committed by Alejandro Alonso
parent 895fb3b480
commit c214d8b044
3 changed files with 64 additions and 58 deletions

View file

@ -190,12 +190,12 @@
(uuid/uuid (subs group 10))))) (uuid/uuid (subs group 10)))))
(defn match-swap-slot? (defn match-swap-slot?
[shape-inst shape-main] [shape-main shape-inst]
(let [slot-inst (get-swap-slot shape-inst) (let [slot-main (get-swap-slot shape-main)
slot-main (get-swap-slot shape-main)] slot-inst (get-swap-slot shape-inst)]
(when (some? slot-inst) (when (some? slot-inst)
(or (= slot-inst slot-main) (or (= slot-main slot-inst)
(= slot-inst (:id shape-main)))))) (= (:id shape-main) slot-inst)))))
(defn get-component-root (defn get-component-root
[component] [component]

View file

@ -292,11 +292,11 @@
(find-swap-slot ref-shape ref-container ref-file libraries))))))) (find-swap-slot ref-shape ref-container ref-file libraries)))))))
(defn match-swap-slot? (defn match-swap-slot?
[shape-inst shape-main page-inst page-main file libraries] [shape-main shape-inst page-inst page-main file libraries]
(let [slot-inst (find-swap-slot shape-inst page-inst file libraries) (let [slot-main (find-swap-slot shape-main page-main file libraries)
slot-main (find-swap-slot shape-main page-main file libraries)] slot-inst (find-swap-slot shape-inst page-inst file libraries)]
(or (= slot-inst slot-main) (or (= slot-main slot-inst)
(= slot-inst (:id shape-main))))) (= (:id shape-main) slot-inst))))
(defn get-component-shapes (defn get-component-shapes
"Retrieve all shapes of the component" "Retrieve all shapes of the component"

View file

@ -759,6 +759,13 @@
redirect-shaperef redirect-shaperef
components-v2)) components-v2))
swapped (fn [changes child-inst child-main]
(log/trace :msg "Match slot"
:child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))
:child-main (str (:name child-main) " " (pretty-uuid (:id child-main))))
;; For now we don't make any sync here.
changes)
moved (fn [changes child-inst child-main] moved (fn [changes child-inst child-main]
(log/trace :msg "Move" (log/trace :msg "Move"
:child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))
@ -777,6 +784,7 @@
only-inst only-inst
only-main only-main
both both
swapped
moved moved
false false
reset?)))) reset?))))
@ -933,6 +941,13 @@
redirect-shaperef redirect-shaperef
components-v2)) components-v2))
swapped (fn [changes child-inst child-main]
(log/trace :msg "Match slot"
:child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))
:child-main (str (:name child-main) " " (pretty-uuid (:id child-main))))
;; For now we don't make any sync here.
changes)
moved (fn [changes child-inst child-main] moved (fn [changes child-inst child-main]
(move-shape (move-shape
changes changes
@ -949,6 +964,7 @@
only-inst only-inst
only-main only-main
both both
swapped
moved moved
true true
true) true)
@ -969,7 +985,7 @@
;; ---- Operation generation helpers ---- ;; ---- Operation generation helpers ----
(defn- compare-children (defn- compare-children
[changes children-inst children-main only-inst-cb only-main-cb both-cb moved-cb inverse? reset?] [changes children-inst children-main only-inst-cb only-main-cb both-cb swapped-cb moved-cb inverse? reset?]
(log/trace :msg "Compare children") (log/trace :msg "Compare children")
(loop [children-inst (seq (or children-inst [])) (loop [children-inst (seq (or children-inst []))
children-main (seq (or children-main [])) children-main (seq (or children-main []))
@ -989,63 +1005,53 @@
(reduce only-inst-cb changes children-inst) (reduce only-inst-cb changes children-inst)
:else :else
(if (ctk/is-main-of? child-main child-inst) (if (or (ctk/is-main-of? child-main child-inst)
(ctk/match-swap-slot? child-main child-inst))
(recur (next children-inst) (recur (next children-inst)
(next children-main) (next children-main)
(both-cb changes child-inst child-main)) (if (or (ctk/is-main-of? child-main child-inst) reset?)
(both-cb changes child-inst child-main)
(swapped-cb changes child-inst child-main)))
(if (and (ctk/match-swap-slot? child-main child-inst) (not reset?)) (let [child-inst' (d/seek #(or (ctk/is-main-of? child-main %)
(do (ctk/match-swap-slot? child-main %))
(log/trace :msg "Match slot" children-inst)
:shape-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) child-main' (d/seek #(or (ctk/is-main-of? % child-inst)
:shape-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) (ctk/match-swap-slot? % child-inst))
(recur (next children-inst) children-main)]
(cond
(nil? child-inst')
(recur children-inst
(next children-main) (next children-main)
changes)) (only-main-cb changes child-main))
(let [child-inst' (d/seek #(ctk/is-main-of? child-main %) children-inst) (nil? child-main')
child-main' (d/seek #(ctk/is-main-of? % child-inst) children-main)] (recur (next children-inst)
(cond children-main
(nil? child-inst') (only-inst-cb changes child-inst))
(let [matching-inst (d/seek #(ctk/match-swap-slot? % child-main) children-inst)]
(if (and (some? matching-inst) (not reset?))
(do
(log/trace :msg "Match slot inst"
:shape-inst (str (:name child-inst') " " (pretty-uuid (:id child-inst')))
:shape-main (str (:name child-main) " " (pretty-uuid (:id child-main))))
(recur (remove #(= (:id %) (:id matching-inst)) children-inst)
(next children-main)
changes))
(recur children-inst
(next children-main)
(only-main-cb changes child-main))))
(nil? child-main') :else
(let [matching-main (d/seek #(ctk/match-swap-slot? child-inst %) children-main)] (if inverse?
(if (and (some? matching-main) (not reset?)) (let [is-main? (ctk/is-main-of? child-inst child-main')]
(do
(log/trace :msg "Match slot main"
:shape-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))
:shape-main (str (:name child-main') " " (pretty-uuid (:id child-main'))))
(recur (next children-inst)
(remove #(= (:id %) (:id matching-main)) children-inst)
changes))
(recur (next children-inst)
children-main
(only-inst-cb changes child-inst))))
:else
(if inverse?
(recur (next children-inst) (recur (next children-inst)
(remove #(= (:id %) (:id child-main')) children-main) (remove #(= (:id %) (:id child-main')) children-main)
(-> changes (cond-> changes
(both-cb child-inst child-main') is-main?
(moved-cb child-inst child-main'))) (both-cb child-inst child-main')
(not is-main?)
(swapped-cb child-inst child-main')
:always
(moved-cb child-inst child-main'))))
(let [is-main? (ctk/is-main-of? child-inst' child-main)]
(recur (remove #(= (:id %) (:id child-inst')) children-inst) (recur (remove #(= (:id %) (:id child-inst')) children-inst)
(next children-main) (next children-main)
(-> changes (cond-> changes
(both-cb child-inst' child-main) is-main?
(moved-cb child-inst' child-main)))))))))))) (both-cb child-inst' child-main)
(not is-main?)
(swapped-cb child-inst' child-main)
:always
(moved-cb child-inst' child-main))))))))))))
(defn- add-shape-to-instance (defn- add-shape-to-instance
[changes component-shape index component-page container root-instance root-main omit-touched? set-remote-synced?] [changes component-shape index component-page container root-instance root-main omit-touched? set-remote-synced?]