Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-02-01 20:09:04 -05:00
Code Issues Activity

🔧 Refactor debug traces in libraries module

Browse source
This commit is contained in:
Andrés Moya 2024-04-09 17:30:19 +02:00
parent fd92437f7d
commit 41a46fe56a
2 changed files with 206 additions and 154 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

91
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -14,7 +14,7 @@
[app.common.files.libraries-helpers :as cflh] [app.common.files.libraries-helpers :as cflh]
[app.common.files.shapes-helpers :as cfsh] [app.common.files.shapes-helpers :as cfsh]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.logging :as log] ;; [app.common.logging :as log]
[app.common.types.color :as ctc] [app.common.types.color :as ctc]
[app.common.types.component :as ctk] [app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl] [app.common.types.components-list :as ctkl]
@ -51,26 +51,28 @@
[cuerdas.core :as str] [cuerdas.core :as str]
[potok.v2.core :as ptk])) [potok.v2.core :as ptk]))
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default ;; ;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
(log/set-level! :warn) ;; (log/set-level! :debug)
(defn- log-changes (defn- log-changes
[changes file] [changes file]
(let [extract-change (let [extract-change
(fn [change] (fn [change]
(let [shape (when (:id change) (let [shape (if-let [obj (:obj change)]
(cond obj
(:page-id change) (when (:id change)
(get-in file [:pages-index (cond
(:page-id change) (:page-id change)
:objects (get-in file [:pages-index
(:id change)]) (:page-id change)
(:component-id change) :objects
(get-in file [:components (:id change)])
(:component-id change) (:component-id change)
:objects (get-in file [:components
(:id change)]) (:component-id change)
:else nil)) :objects
(:id change)])
:else nil)))
prefix (if (:component-id change) "[C] " "[P] ") prefix (if (:component-id change) "[C] " "[P] ")
@ -711,7 +713,7 @@
(ptk/reify ::sync-head (ptk/reify ::sync-head
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(log/info :msg "SYNC-head of shape" :id (str id)) (dwlh/dbg-warn "SYNC-HEAD of shape" :id id)
(let [file (wsh/get-local-file state) (let [file (wsh/get-local-file state)
file-full (wsh/get-local-file-full state) file-full (wsh/get-local-file-full state)
libraries (wsh/get-libraries state) libraries (wsh/get-libraries state)
@ -733,9 +735,7 @@
(pcb/with-objects (:objects container)) (pcb/with-objects (:objects container))
(dwlh/generate-sync-shape-direct file-full libraries container (:id head) false components-v2))] (dwlh/generate-sync-shape-direct file-full libraries container (:id head) false components-v2))]
(log/debug :msg "SYNC-head finished" :js/rchanges (log-changes (dwlh/dbg-info "SYNC-HEAD finished" :rchanges (dwlh/dbg-obj (log-changes (:redo-changes changes) file)))
(:redo-changes changes)
file))
(rx/of (dch/commit-changes changes)))))) (rx/of (dch/commit-changes changes))))))
(defn reset-component (defn reset-component
@ -747,7 +747,7 @@
(ptk/reify ::reset-component (ptk/reify ::reset-component
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(log/info :msg "RESET-COMPONENT of shape" :id (str id)) (dwlh/dbg-warn "RESET-COMPONENT of shape" :id id)
(let [file (wsh/get-local-file state) (let [file (wsh/get-local-file state)
file-full (wsh/get-local-file-full state) file-full (wsh/get-local-file-full state)
libraries (wsh/get-libraries state) libraries (wsh/get-libraries state)
@ -769,9 +769,7 @@
(pcb/with-objects (:objects container)) (pcb/with-objects (:objects container))
(dwlh/generate-sync-shape-direct file-full libraries container id true components-v2))] (dwlh/generate-sync-shape-direct file-full libraries container id true components-v2))]
(log/debug :msg "RESET-COMPONENT finished" :js/rchanges (log-changes (dwlh/dbg-info "RESET-COMPONENT finished" :rchanges (dwlh/dbg-obj (log-changes (:redo-changes changes) file)))
(:redo-changes changes)
file))
(rx/of (rx/of
(dwu/start-undo-transaction undo-id) (dwu/start-undo-transaction undo-id)
(dch/commit-changes changes) (dch/commit-changes changes)
@ -808,7 +806,7 @@
(ptk/reify ::update-component (ptk/reify ::update-component
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(log/info :msg "UPDATE-COMPONENT of shape" :id (str id) :undo-group undo-group) (dwlh/dbg-warn "UPDATE-COMPONENT of shape" :id id :undo-group undo-group)
(let [page-id (get state :current-page-id) (let [page-id (get state :current-page-id)
local-file (wsh/get-local-file state) local-file (wsh/get-local-file state)
full-file (wsh/get-local-file-full state) full-file (wsh/get-local-file-full state)
@ -844,13 +842,9 @@
(update :redo-changes #(into [] xf-remove %)) (update :redo-changes #(into [] xf-remove %))
(update :undo-changes #(into [] xf-remove %)))] (update :undo-changes #(into [] xf-remove %)))]
(log/debug :msg "UPDATE-COMPONENT finished" (dwlh/dbg-info "UPDATE-COMPONENT finished"
:js/local-changes (log-changes :local-changes (dwlh/dbg-obj (log-changes (:redo-changes local-changes) file))
(:redo-changes local-changes) :nonlocal-changes (dwlh/dbg-obj (log-changes (:redo-changes nonlocal-changes) file)))
file)
:js/nonlocal-changes (log-changes
(:redo-changes nonlocal-changes)
file))
(rx/of (rx/of
(when (seq (:redo-changes local-changes)) (when (seq (:redo-changes local-changes))
@ -1038,10 +1032,10 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ state _] (watch [_ state _]
(let [undo-id (js/Symbol)] (let [undo-id (js/Symbol)]
(log/info :msg "COMPONENT-SWAP" (dwlh/dbg-warn "COMPONENT-SWAP"
:file (dwlh/pretty-file file-id state) :file (dwlh/dbg-file file-id state)
:id-new-component id-new-component :id-new-component id-new-component
:undo-id undo-id) :undo-id undo-id)
(rx/concat (rx/concat
(rx/of (dwu/start-undo-transaction undo-id)) (rx/of (dwu/start-undo-transaction undo-id))
(rx/map #(component-swap % file-id id-new-component) (rx/from shapes)) (rx/map #(component-swap % file-id id-new-component) (rx/from shapes))
@ -1091,12 +1085,12 @@
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(when (and (some? file-id) (some? library-id)) ; Prevent race conditions while navigating out of the file (when (and (some? file-id) (some? library-id)) ; Prevent race conditions while navigating out of the file
(log/info :msg "SYNC-FILE" (dwlh/dbg-warn "SYNC-FILE"
:file (dwlh/pretty-file file-id state) :file (dwlh/dbg-file file-id state)
:library (dwlh/pretty-file library-id state) :library (dwlh/dbg-file library-id state)
:asset-type asset-type :asset-type asset-type
:asset-id asset-id :asset-id asset-id
:undo-group undo-group) :undo-group undo-group)
(let [file (wsh/get-file state file-id) (let [file (wsh/get-file state file-id)
sync-components? (or (nil? asset-type) (= asset-type :components)) sync-components? (or (nil? asset-type) (= asset-type :components))
@ -1136,9 +1130,8 @@
(mapcat find-frames) (mapcat find-frames)
distinct)] distinct)]
(log/debug :msg "SYNC-FILE finished" :js/rchanges (log-changes (dwlh/dbg-info "SYNC-FILE finished"
(:redo-changes changes) :rchanges (dwlh/dbg-obj (log-changes (:redo-changes changes) file)))
file))
(rx/concat (rx/concat
(rx/of (set-updating-library false) (rx/of (set-updating-library false)
(msg/hide-tag :sync-dialog)) (msg/hide-tag :sync-dialog))
@ -1306,9 +1299,9 @@
(if (d/not-empty? changed-components) (if (d/not-empty? changed-components)
(if save-undo? (if save-undo?
(do (log/info :msg "DETECTED COMPONENTS CHANGED" (do (dwlh/dbg-warn "DETECTED COMPONENTS CHANGED"
:ids (map str changed-components) :ids (map dwlh/dbg-id changed-components)
:undo-group undo-group) :undo-group undo-group)
(->> (rx/from changed-components) (->> (rx/from changed-components)
(rx/map #(component-changed % (:id old-data) undo-group)))) (rx/map #(component-changed % (:id old-data) undo-group))))
@ -1327,7 +1320,7 @@
notifier-s notifier-s
(->> changes-s (->> changes-s
(rx/debounce 5000) (rx/debounce 5000)
(rx/tap #(log/trc :hint "buffer initialized")))] (rx/tap #(dwlh/dbg-log "buffer initialized")))]
(when components-v2? (when components-v2?
(->> (rx/merge (->> (rx/merge

269
frontend/src/app/main/data/workspace/libraries_helpers.cljs
View file

@ -13,7 +13,7 @@
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.shapes.grid-layout :as gslg] [app.common.geom.shapes.grid-layout :as gslg]
[app.common.logging :as log] ;; [app.common.logging :as log]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.text :as txt] [app.common.text :as txt]
[app.common.types.color :as ctc] [app.common.types.color :as ctc]
@ -27,10 +27,97 @@
[app.common.types.typography :as cty] [app.common.types.typography :as cty]
[app.main.data.workspace.state-helpers :as wsh] [app.main.data.workspace.state-helpers :as wsh]
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[clojure.set :as set])) [clojure.set :as set]
[cuerdas.core :as str]))
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default ;; ---- Logging utilities ----
(log/set-level! :warn)
(def dbg-level-log 1)
(def dbg-level-info 2)
(def dbg-level-warn 3)
;; Change this to one of the levels to display traces of this level or higher
(def dbg-level dbg-level-info)
;; Add some uuids to this to filter log messages affecting only to those shapes
(def dbg-filters #{})
(defn dbg-id
[uuid]
(let [uuid-str (str uuid)]
(str "#" (subs uuid-str (- (count uuid-str) 6)))))
(defn dbg-file
[file-id state]
(if (= file-id (:current-file-id state))
"<local>"
(str "<" (get-in state [:workspace-libraries file-id :name]) "> " (dbg-id file-id))))
(defn dbg-page
[page]
(with-meta page {:dbg-type :page}))
(defn dbg-component
[component]
(with-meta component {:dbg-type :component}))
(defn dbg-container
[container]
(if (cfh/page? container)
(with-meta container {:dbg-type :page})
(with-meta container {:dbg-type :component})))
(defn dbg-shape
[shape]
(with-meta shape {:dbg-type :shape}))
(defn dbg-obj
[obj]
(clj->js obj))
(defn js-value?
[[_key value]]
;; (prn value)
;; (prn (type value))
(or (object? value) (array? value)))
(defn dbg-format-str
[[key value]]
(let [value-str (case (:dbg-type (meta value))
:page (str "[P \"" (subs (:name value) 0 50) "\" " (dbg-id (:id value)) "]")
:component (str "[C \"" (subs (:name value) 0 50) "\" " (dbg-id (:id value)) "]")
:shape (str "\"" (subs (:name value) 0 50) "\" " (dbg-id (:id value)))
(cond
(uuid? value) (dbg-id value)
(js-symbol? value) (.toString value)
:else (d/nilv value "nil")))]
(str (name key) "=" value-str)))
(defn dbg
[level msg & args]
(when (>= level dbg-level)
(let [kvargs (apply sorted-map args)
ids (into #{} (filter uuid? (vals kvargs)))]
(when (or (empty? dbg-filters)
(empty? ids)
(seq (set/intersection dbg-filters ids)))
(let [dbg-fn (condp = level
dbg-level-log js/console.log
dbg-level-info js/console.info
dbg-level-warn js/console.warn)
kv-objects (d/filterm js-value? kvargs)
kv-rest (d/removem js-value? kvargs)]
(dbg-fn (->> (cons msg (map dbg-format-str kv-rest))
(str/join " ")))
(when (seq kv-objects)
(dorun (for [[key value] kv-objects]
(dbg-fn (str key) value)))))))))
(defn dbg-log [& args] (apply dbg (cons dbg-level-log args)))
(defn dbg-info [& args] (apply dbg (cons dbg-level-info args)))
(defn dbg-warn [& args] (apply dbg (cons dbg-level-warn args)))
;; ---- Advanced declaration of helpers ----
(declare generate-sync-container) (declare generate-sync-container)
(declare generate-sync-shape) (declare generate-sync-shape)
@ -58,17 +145,6 @@
(declare reposition-shape) (declare reposition-shape)
(declare make-change) (declare make-change)
(defn pretty-file
[file-id state]
(if (= file-id (:current-file-id state))
"<local>"
(str "<" (get-in state [:workspace-libraries file-id :name]) ">")))
(defn pretty-uuid
[uuid]
(let [uuid-str (str uuid)]
(subs uuid-str (- (count uuid-str) 6))))
;; ---- Components and instances creation ---- ;; ---- Components and instances creation ----
(defn duplicate-component (defn duplicate-component
@ -220,7 +296,7 @@
with a component." with a component."
[changes container libraries shape-id] [changes container libraries shape-id]
(let [shape (ctn/get-shape container shape-id)] (let [shape (ctn/get-shape container shape-id)]
(log/debug :msg "Detach instance" :shape-id shape-id :container (:id container)) (dbg-info "Detach instance" :shape-id shape-id :container (:id container))
(generate-detach-recursive changes container libraries shape-id true (true? (:component-root shape))))) (generate-detach-recursive changes container libraries shape-id true (true? (:component-root shape)))))
(defn- generate-detach-recursive (defn- generate-detach-recursive
@ -310,11 +386,11 @@
(s/assert ::us/uuid file-id) (s/assert ::us/uuid file-id)
(s/assert ::us/uuid library-id) (s/assert ::us/uuid library-id)
(log/info :msg "Sync file with library" (dbg-info "Sync file with library"
:asset-type asset-type :asset-type asset-type
:asset-id asset-id :asset-id asset-id
:file (pretty-file file-id state) :file (dbg-file file-id state)
:library (pretty-file library-id state)) :library (dbg-file library-id state))
(let [file (wsh/get-file state file-id) (let [file (wsh/get-file state file-id)
components-v2 (get-in file [:options :components-v2])] components-v2 (get-in file [:options :components-v2])]
@ -347,11 +423,11 @@
(s/assert ::us/uuid file-id) (s/assert ::us/uuid file-id)
(s/assert ::us/uuid library-id) (s/assert ::us/uuid library-id)
(log/info :msg "Sync local components with library" (dbg-info "Sync local components with library"
:asset-type asset-type :asset-type asset-type
:asset-id asset-id :asset-id asset-id
:file (pretty-file file-id state) :file (dbg-file file-id state)
:library (pretty-file library-id state)) :library (dbg-file library-id state))
(let [file (wsh/get-file state file-id) (let [file (wsh/get-file state file-id)
components-v2 (get-in file [:options :components-v2])] components-v2 (get-in file [:options :components-v2])]
@ -376,8 +452,8 @@
[it asset-type asset-id library-id state container components-v2] [it asset-type asset-id library-id state container components-v2]
(if (cfh/page? container) (if (cfh/page? container)
(log/debug :msg "Sync page in local file" :page-id (:id container)) (dbg-info "Sync page in local file" :page (dbg-page container))
(log/debug :msg "Sync component in local library" :component-id (:id container))) (dbg-info "Sync component in local library" :component (dbg-component container)))
(let [linked-shapes (->> (vals (:objects container)) (let [linked-shapes (->> (vals (:objects container))
(filter #(uses-assets? asset-type asset-id % library-id)))] (filter #(uses-assets? asset-type asset-id % library-id)))]
@ -432,7 +508,7 @@
(defmethod generate-sync-shape :colors (defmethod generate-sync-shape :colors
[_ changes library-id state _ shape _] [_ changes library-id state _ shape _]
(log/debug :msg "Sync colors of shape" :shape (:name shape)) (dbg-info "Sync colors of shape" :shape (dbg-shape shape))
;; Synchronize a shape that uses some colors of the library. The value of the ;; Synchronize a shape that uses some colors of the library. The value of the
;; color in the library is copied to the shape. ;; color in the library is copied to the shape.
@ -443,7 +519,7 @@
(defmethod generate-sync-shape :typographies (defmethod generate-sync-shape :typographies
[_ changes library-id state container shape _] [_ changes library-id state container shape _]
(log/debug :msg "Sync typographies of shape" :shape (:name shape)) (dbg-info "Sync typographies of shape" :shape (dbg-shape shape))
;; Synchronize a shape that uses some typographies of the library. The attributes ;; Synchronize a shape that uses some typographies of the library. The attributes
;; of the typography are copied to the shape." ;; of the typography are copied to the shape."
@ -611,7 +687,7 @@
"Generate changes to synchronize one shape that is the root of a component "Generate changes to synchronize one shape that is the root of a component
instance, and all its children, from the given component." instance, and all its children, from the given component."
[changes file libraries container shape-id reset? components-v2] [changes file libraries container shape-id reset? components-v2]
(log/debug :msg "Sync shape direct" :shape-inst (str shape-id) :reset? reset?) (dbg-info "Sync shape direct" :shape-id shape-id :reset? reset?)
(let [shape-inst (ctn/get-shape container shape-id) (let [shape-inst (ctn/get-shape container shape-id)
library (dm/get-in libraries [(:component-file shape-inst) :data]) library (dm/get-in libraries [(:component-file shape-inst) :data])
component (ctkl/get-component library (:component-id shape-inst) true)] component (ctkl/get-component library (:component-id shape-inst) true)]
@ -648,6 +724,7 @@
reset? reset?
initial-root? initial-root?
redirect-shaperef redirect-shaperef
1
components-v2) components-v2)
;; If the component is not found, because the master component has been ;; If the component is not found, because the master component has been
;; deleted or the library unlinked, do nothing in v2 or detach in v1. ;; deleted or the library unlinked, do nothing in v2 or detach in v1.
@ -674,10 +751,10 @@
nil)))))) nil))))))
(defn- generate-sync-shape-direct-recursive (defn- generate-sync-shape-direct-recursive
[changes container shape-inst component library file libraries shape-main root-inst root-main reset? initial-root? redirect-shaperef components-v2] [changes container shape-inst component library file libraries shape-main root-inst root-main reset? initial-root? redirect-shaperef level components-v2]
(log/debug :msg "Sync shape direct recursive" (dbg-info (str (str/repeat "-" level) "> Sync shape direct recursive")
:shape-inst (str (:name shape-inst) " " (pretty-uuid (:id shape-inst))) :shape-inst (dbg-shape shape-inst)
:component (:name component)) :component (dbg-component component))
(if (nil? shape-main) (if (nil? shape-main)
;; This should not occur, but protect against it in any case ;; This should not occur, but protect against it in any case
@ -733,8 +810,7 @@
(map #(redirect-shaperef %) children-inst) children-inst) (map #(redirect-shaperef %) children-inst) children-inst)
only-inst (fn [changes child-inst] only-inst (fn [changes child-inst]
(log/trace :msg "Only inst" (dbg-log " *Only inst:" :child-inst (dbg-shape child-inst))
:child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))))
(if-not (and omit-touched? (if-not (and omit-touched?
(contains? (:touched shape-inst) (contains? (:touched shape-inst)
:shapes-group)) :shapes-group))
@ -745,8 +821,7 @@
changes)) changes))
only-main (fn [changes child-main] only-main (fn [changes child-main]
(log/trace :msg "Only main" (dbg-log " *Only main:" :child-main (dbg-shape child-main))
:child-main (str (:name child-main) " " (pretty-uuid (:id child-main))))
(if-not (and omit-touched? (if-not (and omit-touched?
(contains? (:touched shape-inst) (contains? (:touched shape-inst)
:shapes-group)) :shapes-group))
@ -764,9 +839,9 @@
changes)) changes))
both (fn [changes child-inst child-main] both (fn [changes child-inst child-main]
(log/trace :msg "Both" (dbg-log " *Both:"
:child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) :child-inst (dbg-shape child-inst)
:child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) :child-main (dbg-shape child-main))
(generate-sync-shape-direct-recursive changes (generate-sync-shape-direct-recursive changes
container container
child-inst child-inst
@ -780,19 +855,20 @@
reset? reset?
initial-root? initial-root?
redirect-shaperef redirect-shaperef
(inc level)
components-v2)) components-v2))
swapped (fn [changes child-inst child-main] swapped (fn [changes child-inst child-main]
(log/trace :msg "Match slot" (dbg-log " *Match slot:"
:child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) :child-inst (dbg-shape child-inst)
:child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) :child-main (dbg-shape child-main))
;; For now we don't make any sync here. ;; For now we don't make any sync here.
changes) changes)
moved (fn [changes child-inst child-main] moved (fn [changes child-inst child-main]
(log/trace :msg "Move" (dbg-log " *Move:"
:child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) :child-inst (dbg-shape child-inst)
:child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) :child-main (dbg-shape child-main))
(move-shape (move-shape
changes changes
child-inst child-inst
@ -840,7 +916,7 @@
"Generate changes to update the component a shape is linked to, from "Generate changes to update the component a shape is linked to, from
the values in the shape and all its children." the values in the shape and all its children."
[changes file libraries container shape-id components-v2] [changes file libraries container shape-id components-v2]
(log/debug :msg "Sync shape inverse" :shape (str shape-id)) (dbg-info "Sync shape inverse" :shape-id shape-id)
(let [redirect-shaperef (partial redirect-shaperef container libraries) (let [redirect-shaperef (partial redirect-shaperef container libraries)
shape-inst (ctn/get-shape container shape-id) shape-inst (ctn/get-shape container shape-id)
library (dm/get-in libraries [(:component-file shape-inst) :data]) library (dm/get-in libraries [(:component-file shape-inst) :data])
@ -877,14 +953,15 @@
root-main root-main
initial-root? initial-root?
redirect-shaperef redirect-shaperef
1
components-v2) components-v2)
changes))) changes)))
(defn- generate-sync-shape-inverse-recursive (defn- generate-sync-shape-inverse-recursive
[changes container shape-inst component library file libraries shape-main root-inst root-main initial-root? redirect-shaperef components-v2] [changes container shape-inst component library file libraries shape-main root-inst root-main initial-root? redirect-shaperef level components-v2]
(log/trace :msg "Sync shape inverse recursive" (dbg-log (str (str/repeat "-" level) "> Sync shape inverse recursive")
:shape (str (:name shape-inst)) :shape-inst (dbg-shape shape-inst)
:component (:name component)) :component (dbg-component component))
(if (nil? shape-main) (if (nil? shape-main)
;; This should not occur, but protect against it in any case ;; This should not occur, but protect against it in any case
@ -942,6 +1019,7 @@
children-inst) children-inst)
only-inst (fn [changes child-inst] only-inst (fn [changes child-inst]
(dbg-log " *Only inst:" :child-inst (dbg-shape child-inst))
(add-shape-to-main changes (add-shape-to-main changes
child-inst child-inst
(d/index-of children-inst (d/index-of children-inst
@ -954,12 +1032,16 @@
components-v2)) components-v2))
only-main (fn [changes child-main] only-main (fn [changes child-main]
(dbg-log " *Only main:" :child-main (dbg-shape child-main))
(remove-shape changes (remove-shape changes
child-main child-main
component-container component-container
false)) false))
both (fn [changes child-inst child-main] both (fn [changes child-inst child-main]
(dbg-log " *Both:"
:child-inst (dbg-shape child-inst)
:child-main (dbg-shape child-main))
(generate-sync-shape-inverse-recursive changes (generate-sync-shape-inverse-recursive changes
container container
child-inst child-inst
@ -972,16 +1054,20 @@
root-main root-main
initial-root? initial-root?
redirect-shaperef redirect-shaperef
(inc level)
components-v2)) components-v2))
swapped (fn [changes child-inst child-main] swapped (fn [changes child-inst child-main]
(log/trace :msg "Match slot" (dbg-log " *Match slot:"
:child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) :child-inst (dbg-shape child-inst)
:child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) :child-main (dbg-shape child-main))
;; For now we don't make any sync here. ;; For now we don't make any sync here.
changes) changes)
moved (fn [changes child-inst child-main] moved (fn [changes child-inst child-main]
(dbg-log " *Move:"
:child-inst (dbg-shape child-inst)
:child-main (dbg-shape child-main))
(move-shape (move-shape
changes changes
child-main child-main
@ -1024,14 +1110,13 @@
(defn- compare-children (defn- compare-children
[changes children-inst children-main container-inst container-main file libraries only-inst-cb only-main-cb both-cb swapped-cb moved-cb inverse? reset? components-v2] [changes children-inst children-main container-inst container-main file libraries only-inst-cb only-main-cb both-cb swapped-cb moved-cb inverse? reset? components-v2]
(log/trace :msg "Compare children") (dbg-log "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 []))
changes changes] changes changes]
(let [child-inst (first children-inst) (let [child-inst (first children-inst)
child-main (first children-main)] child-main (first children-main)]
(log/trace :main (str (:name child-main) " " (pretty-uuid (:id child-main))) (dbg-log " " :main (dbg-shape child-main) :inst (dbg-shape child-inst))
:inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))))
(cond (cond
(and (nil? child-inst) (nil? child-main)) (and (nil? child-inst) (nil? child-main))
changes changes
@ -1093,10 +1178,7 @@
(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? components-v2] [changes component-shape index component-page container root-instance root-main omit-touched? set-remote-synced? components-v2]
(log/info :msg (str "ADD [P " (pretty-uuid (:id container)) "] " (dbg-warn "ADD TO INST" :container (dbg-container container) :component-shape (dbg-shape component-shape))
(:name component-shape)
" "
(pretty-uuid (:id component-shape))))
(let [component-parent-shape (ctn/get-shape component-page (:parent-id component-shape)) (let [component-parent-shape (ctn/get-shape component-page (:parent-id component-shape))
parent-shape (d/seek #(ctk/is-main-of? component-parent-shape % components-v2) parent-shape (d/seek #(ctk/is-main-of? component-parent-shape % components-v2)
(cfh/get-children-with-self (:objects container) (cfh/get-children-with-self (:objects container)
@ -1125,7 +1207,7 @@
update-original-shape (fn [original-shape _new-shape] update-original-shape (fn [original-shape _new-shape]
original-shape) original-shape)
[_ new-shapes _] [new-shape new-shapes _]
(ctst/clone-shape component-shape (ctst/clone-shape component-shape
(:id parent-shape) (:id parent-shape)
(get component-page :objects) (get component-page :objects)
@ -1162,16 +1244,14 @@
:shapes all-parents})) :shapes all-parents}))
changes' (reduce del-obj-change changes' new-shapes)] changes' (reduce del-obj-change changes' new-shapes)]
(dbg-log " " :parent-shape (dbg-shape parent-shape) :new-shape (dbg-shape new-shape))
(if (and (cfh/touched-group? parent-shape :shapes-group) omit-touched?) (if (and (cfh/touched-group? parent-shape :shapes-group) omit-touched?)
changes changes
changes'))) changes')))
(defn- add-shape-to-main (defn- add-shape-to-main
[changes shape index component component-container page root-instance root-main components-v2] [changes shape index component component-container page root-instance root-main components-v2]
(log/info :msg (str "ADD [C " (pretty-uuid (:id component-container)) "] " (dbg-warn "ADD TO MAIN" :component-container (dbg-container component-container) :shape (dbg-shape shape))
(:name shape)
" "
(pretty-uuid (:id shape))))
(let [parent-shape (ctn/get-shape page (:parent-id shape)) (let [parent-shape (ctn/get-shape page (:parent-id shape))
component-parent-shape (d/seek #(ctk/is-main-of? % parent-shape components-v2) component-parent-shape (d/seek #(ctk/is-main-of? % parent-shape components-v2)
(cfh/get-children-with-self (:objects component-container) (cfh/get-children-with-self (:objects component-container)
@ -1189,7 +1269,7 @@
(assoc original-shape (assoc original-shape
:shape-ref (:id new-shape))) :shape-ref (:id new-shape)))
[_new-shape new-shapes updated-shapes] [new-shape new-shapes updated-shapes]
(ctst/clone-shape shape (ctst/clone-shape shape
(:id component-parent-shape) (:id component-parent-shape)
(get page :objects) (get page :objects)
@ -1267,16 +1347,12 @@
changes' (reduce mod-obj-change changes' updated-shapes) changes' (reduce mod-obj-change changes' updated-shapes)
changes' (reduce del-obj-change changes' new-shapes)] changes' (reduce del-obj-change changes' new-shapes)]
(dbg-log " " :component-parent-shape (dbg-shape component-parent-shape) :new-shape (dbg-shape new-shape))
changes')) changes'))
(defn- remove-shape (defn- remove-shape
[changes shape container omit-touched?] [changes shape container omit-touched?]
(log/info :msg (str "REMOVE-SHAPE " (dbg-warn "REMOVE SHAPE" :container (dbg-container container) :shape (dbg-shape shape))
(if (cfh/page? container) "[P " "[C ")
(pretty-uuid (:id container)) "] "
(:name shape)
" "
(pretty-uuid (:id shape))))
(let [objects (get container :objects) (let [objects (get container :objects)
parents (cfh/get-parent-ids objects (:id shape)) parents (cfh/get-parent-ids objects (:id shape))
parent (first parents) parent (first parents)
@ -1323,16 +1399,10 @@
(defn- move-shape (defn- move-shape
[changes shape index-before index-after container omit-touched?] [changes shape index-before index-after container omit-touched?]
(log/info :msg (str "MOVE " (dbg-warn "MOVE"
(if (cfh/page? container) "[P " "[C ") :container (dbg-container container)
(pretty-uuid (:id container)) "] " :shape (dbg-shape shape)
(:name shape) :index (str index-before "->" index-after))
" "
(pretty-uuid (:id shape))
" "
index-before
" -> "
index-after))
(let [parent (ctn/get-shape container (:parent-id shape)) (let [parent (ctn/get-shape container (:parent-id shape))
changes' (-> changes changes' (-> changes
@ -1363,13 +1433,11 @@
(if (nil? (:shape-ref dest-shape)) (if (nil? (:shape-ref dest-shape))
changes changes
(do (do
(log/info :msg (str "CHANGE-TOUCHED " (dbg-warn "CHANGE TOUCHED"
(if (cfh/page? container) "[P " "[C ") :container (dbg-container container)
(pretty-uuid (:id container)) "] " :dest-shape (dbg-shape dest-shape)
(:name dest-shape) :reset-touched? reset-touched?
" " :copy-touched? copy-touched?)
(pretty-uuid (:id dest-shape)))
:options options)
(let [new-touched (cond (let [new-touched (cond
reset-touched? reset-touched?
nil nil
@ -1405,13 +1473,10 @@
(if (nil? (:shape-ref shape)) (if (nil? (:shape-ref shape))
changes changes
(do (do
(log/info :msg (str "CHANGE-REMOTE-SYNCED? " (dbg-warn "CHANGE REMOTE SYNCED"
(if (cfh/page? container) "[P " "[C ") :container (dbg-container container)
(pretty-uuid (:id container)) "] " :shape (dbg-shape shape)
(:name shape) :remote-synced? remote-synced?)
" "
(pretty-uuid (:id shape)))
:remote-synced remote-synced?)
(-> changes (-> changes
(update :redo-changes conj (make-change (update :redo-changes conj (make-change
container container
@ -1436,16 +1501,10 @@
in the destination shape will not be copied." in the destination shape will not be copied."
[changes dest-shape origin-shape dest-root origin-root container omit-touched?] [changes dest-shape origin-shape dest-root origin-root container omit-touched?]
(log/info :msg (str "SYNC " (dbg-warn "SYNC"
(:name origin-shape) :origin-shape (dbg-shape origin-shape)
" " :container (dbg-container container)
(pretty-uuid (:id origin-shape)) :dest-shape (dbg-shape dest-shape))
" -> "
(if (cfh/page? container) "[P " "[C ")
(pretty-uuid (:id container)) "] "
(:name dest-shape)
" "
(pretty-uuid (:id dest-shape))))
(let [;; To synchronize geometry attributes we need to make a prior (let [;; To synchronize geometry attributes we need to make a prior
;; operation, because coordinates are absolute, but we need to ;; operation, because coordinates are absolute, but we need to