Enhance synchronization of nested shapes

This commit is contained in:
Andrés Moya 2023-07-25 11:32:49 +02:00 committed by Andrey Antukh
parent 2e33575f01
commit 8b801b65f6
7 changed files with 208 additions and 112 deletions

View file

@ -8,14 +8,16 @@
"A collection of adhoc fixes scripts." "A collection of adhoc fixes scripts."
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.types.component :as ctk] [app.common.types.component :as ctk]
[app.common.types.container :as ctn]
[app.common.types.file :as ctf] [app.common.types.file :as ctf]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db]
[app.rpc.commands.files :as files] [app.rpc.commands.files :as files]
[app.srepl.helpers :as h])) [app.srepl.helpers :as h]
[app.util.blob :as blob]))
(defn repair-orphaned-shapes (defn repair-orphaned-shapes
"There are some shapes whose parent has been deleted. This function "There are some shapes whose parent has been deleted. This function
@ -81,62 +83,183 @@
(update state :total (fnil inc 0)))) (update state :total (fnil inc 0))))
(defn fix-components-shaperefs (defn fix-components-shaperefs
[file] ([file]
(if-not (contains? (:features file) "components/v2") (if-not (contains? (:features file) "components/v2")
(ex/raise :type :invalid-file (prn " This file is not v2")
:code :invalid-file (let [libs (->> (files/get-file-libraries app.srepl.helpers/*conn* (:id file))
:hint "this file is not v2") (cons file)
(let [libs (->> (files/get-file-libraries app.srepl.helpers/*conn* (:id file)) (map #(files/get-file app.srepl.helpers/*conn* (:id %) (:features file)))
(cons file) (d/index-by :id))
(map #(files/get-file app.srepl.helpers/*conn* (:id %) (:features file)))
(d/index-by :id))
fix-copy-item fix-copy-item
(fn fix-copy-item [allow-head shapes-copy shapes-base copy-id base-id] (fn fix-copy-item [allow-head shapes-copy shapes-base copy-id base-id]
(let [copy (first (filter #(= (:id %) copy-id) shapes-copy)) (let [copy (first (filter #(= (:id %) copy-id) shapes-copy))
;; do nothing if it is a copy inside of a copy. It will be treated later ;; do nothing if it is a copy inside of a copy. It will be treated later
stop? (and (not allow-head) (ctk/instance-head? copy)) stop? (and (not allow-head) (ctk/instance-head? copy))
base (first (filter #(= (:id %) base-id) shapes-base)) base (first (filter #(= (:id %) base-id) shapes-base))
fci (partial fix-copy-item false shapes-copy shapes-base) fci (partial fix-copy-item false shapes-copy shapes-base)
updates (if (and updates (if (and
(not stop?) (not stop?)
(not= (:shape-ref copy) base-id)) (not= (:shape-ref copy) base-id))
[[(:id copy) base-id]] [[(:id copy) base-id]]
[]) [])
child-updates (if (and child-updates (if (and
(not stop?) (not stop?)
;; If the base has the same number of childrens than the copy, we asume ;; If the base has the same number of childrens than the copy, we asume
;; that the shaperefs can be fixed ad pointed in the same order ;; that the shaperefs can be fixed ad pointed in the same order
(= (count (:shapes copy)) (count (:shapes base)))) (= (count (:shapes copy)) (count (:shapes base))))
(apply concat (mapv fci (:shapes copy) (:shapes base))) (apply concat (map fci (:shapes copy) (:shapes base)))
[])] [])]
(concat updates child-updates))) (concat updates child-updates)))
fix-copy fix-copy
(fn [objects updates copy] (fn [objects updates copy]
(let [component (ctf/find-component libs (:component-id copy) {:included-delete? true}) (let [component (ctf/find-component libs (:component-id copy) {:include-deleted? true})
component-file (get libs (:component-file copy)) component-file (get libs (:component-file copy))
component-shapes (ctf/get-component-shapes (:data component-file) component) component-shapes (ctf/get-component-shapes (:data component-file) component)
copy-shapes (cph/get-children-with-self objects (:id copy)) copy-shapes (cph/get-children-with-self objects (:id copy))
copy-updates (fix-copy-item true copy-shapes component-shapes (:id copy) (:main-instance-id component))] copy-updates (fix-copy-item true copy-shapes component-shapes (:id copy) (:main-instance-id component))]
(concat updates copy-updates))) (concat updates copy-updates)))
update-page (fn [page] update-page
(let [objects (:objects page) (fn [page]
fc (partial fix-copy objects) (let [objects (:objects page)
copies (->> objects fc (partial fix-copy objects)
vals copies (->> objects
(filter #(and (ctk/instance-head? %) (not (ctk/main-instance? %))))) vals
updates (reduce fc [] copies) (filter #(and (ctk/instance-head? %) (not (ctk/main-instance? %)))))
updated-page (reduce (fn [p [id shape-ref]] updates (reduce fc [] copies)
(assoc-in p [:objects id :shape-ref] shape-ref)) updated-page (reduce (fn [p [id shape-ref]]
page (assoc-in p [:objects id :shape-ref] shape-ref))
updates)] page
(prn (str "Page " (:name page) " - Fixing " (count updates))) updates)]
updated-page))] (prn (str "Page " (:name page) " - Fixing " (count updates)))
updated-page))]
(prn (str "Updating " (:name file) " " (:id file))) (prn (str "Updating " (:name file) " " (:id file)))
(update file :data h/update-pages update-page)))) (update file :data h/update-pages update-page))))
([file save?]
(let [file (-> file
(update :data blob/decode)
(fix-components-shaperefs))]
(when save?
(let [features (db/create-array h/*conn* "text" (:features file))
data (blob/encode (:data file))]
(db/update! h/*conn* :file
{:data data
;; :revn (:revn file)
:features features}
{:id (:id file)})
(when (contains? (:features file) "storage/pointer-map")
(files/persist-pointers! h/*conn* (:id file))))))))
(defn fix-component-root
([file]
(let [update-shape (fn [page shape]
(let [parent (get (:objects page) (:parent-id shape))]
(if (and parent
(:component-root shape)
(:shape-ref parent))
(do
(prn (str " Shape " (:name shape) " " (:id shape)))
(dissoc shape :component-root))
shape)))
update-page (fn [page]
(prn (str "Page " (:name page)))
(h/update-shapes page (partial update-shape page)))]
(prn (str "Updating " (:name file) " " (:id file)))
(update file :data h/update-pages update-page)))
([file save?]
(let [file (-> file
(update :data blob/decode)
(fix-component-root))]
(when save?
(let [features (db/create-array h/*conn* "text" (:features file))
data (blob/encode (:data file))]
(db/update! h/*conn* :file
{:data data
;; :revn (:revn file)
:features features}
{:id (:id file)})
(when (contains? (:features file) "storage/pointer-map")
(files/persist-pointers! h/*conn* (:id file))))))))
(defn update-near-components
([file]
(prn (str "Updating " (:name file) " " (:id file)))
(if-not (contains? (:features file) "components/v2")
(prn " This file is not v2")
(let [libs (->> (files/get-file-libraries h/*conn* (:id file))
(cons file)
(map #(files/get-file h/*conn* (:id %) (:features file)))
(d/index-by :id))
update-shape
(fn [page shape]
(if-not (:shape-ref shape)
shape
(do
;; Uncomment prn's to debug
;; (prn (str " -> Shape " (:name shape) " " (:id shape) " shape-ref " (:shape-ref shape)))
(let [root-shape (ctn/get-copy-root (:objects page) shape)]
(if root-shape
(let [component (ctf/get-component libs (:component-file root-shape) (:component-id root-shape) {:include-deleted? true})
component-file (get libs (:component-file root-shape))
component-shapes (ctf/get-component-shapes (:data component-file) component)
ref-shape (d/seek #(= (:id %) (:shape-ref shape)) component-shapes)]
(if-not (and component component-file component-shapes)
(do
;; (prn (str " -> Shape " (:name shape) " " (:id shape) " shape-ref " (:shape-ref shape)))
;; (when-not component (prn " (component not found)"))
;; (when-not component-file (prn " (component-file not found)"))
;; (when-not component-shapes (prn " (component-shapes not found)"))
shape)
(if ref-shape
shape ; This means that the copy is not nested, or this script already was run
(let [near-shape (d/seek #(= (:shape-ref %) (:shape-ref shape)) component-shapes)]
(if near-shape
(do
(prn (str " -> Shape " (:name shape) " " (:id shape) " shape-ref " (:shape-ref shape)))
(prn (str " new ref-shape " (:id near-shape)))
(assoc shape :shape-ref (:id near-shape)))
(do
;; We assume in this case that this is a fostered sub instance, so we do nothing
;; (prn (str " -> Shape " (:name shape) " " (:id shape) " shape-ref " (:shape-ref shape)))
;; (prn " (near-shape not found)")
shape))))))
(do
;; (prn (str " -> Shape " (:name shape) " " (:id shape) " shape-ref " (:shape-ref shape)))
;; (prn " (root shape not found)")
shape))))))
update-page
(fn [page]
(prn (str "Page " (:name page)))
(h/update-shapes page (partial update-shape page)))]
(update file :data h/update-pages update-page))))
([file save?]
(let [file (-> file
(update :data blob/decode)
(update-near-components))]
(when save?
(let [features (db/create-array h/*conn* "text" (:features file))
data (blob/encode (:data file))]
(db/update! h/*conn* :file
{:data data
;; :revn (:revn file)
:features features}
{:id (:id file)})
(when (contains? (:features file) "storage/pointer-map")
(files/persist-pointers! h/*conn* (:id file))))))))

View file

@ -125,7 +125,7 @@
(dissoc file :data)))))) (dissoc file :data))))))
(def ^:private sql:retrieve-files-chunk (def ^:private sql:retrieve-files-chunk
"SELECT id, name, created_at, revn, data FROM file "SELECT id, name, features, created_at, revn, data FROM file
WHERE created_at < ? AND deleted_at is NULL WHERE created_at < ? AND deleted_at is NULL
ORDER BY created_at desc LIMIT ?") ORDER BY created_at desc LIMIT ?")
@ -147,7 +147,9 @@
:kf first :kf first
:initk (or start-at (dt/now))) :initk (or start-at (dt/now)))
(take max-items) (take max-items)
(map #(update % :data blob/decode)))) (map #(-> %
(update :data blob/decode)
(update :features db/decode-pgarray #{})))))
(on-error* [cause file] (on-error* [cause file]
(println "unexpected exception happened on processing file: " (:id file)) (println "unexpected exception happened on processing file: " (:id file))
@ -184,11 +186,13 @@
on-end on-end
on-init] on-init]
:or {chunk-size 10 :or {chunk-size 10
max-items Long/MAX_VALUE
workers 1}}] workers 1}}]
(letfn [(get-chunk [conn cursor] (letfn [(get-chunk [conn cursor]
(let [rows (db/exec! conn [sql:retrieve-files-chunk cursor chunk-size])] (let [rows (db/exec! conn [sql:retrieve-files-chunk cursor chunk-size])]
[(some->> rows peek :created-at) (seq rows)])) [(some->> rows peek :created-at)
(map #(update % :features db/decode-pgarray #{}) rows)]))
(get-candidates [conn] (get-candidates [conn]
(->> (d/iteration (partial get-chunk conn) (->> (d/iteration (partial get-chunk conn)
@ -197,7 +201,6 @@
:initk (or start-at (dt/now))) :initk (or start-at (dt/now)))
(take max-items))) (take max-items)))
(on-error* [cause file] (on-error* [cause file]
(println! "unexpected exception happened on processing file: " (:id file)) (println! "unexpected exception happened on processing file: " (:id file))
(strace/print-stack-trace cause)) (strace/print-stack-trace cause))

View file

@ -131,7 +131,7 @@
(mapv (d/getf objects) (get-children-ids-with-self objects id))) (mapv (d/getf objects) (get-children-ids-with-self objects id)))
(defn get-parent (defn get-parent
"Retrieve the id of the parent for the shape-id (if exists)" "Retrieve the parent for the shape-id (if exists)"
[objects id] [objects id]
(when-let [shape (get objects id)] (when-let [shape (get objects id)]
(get objects (dm/get-prop shape :parent-id)))) (get objects (dm/get-prop shape :parent-id))))

View file

@ -113,7 +113,12 @@
:else :else
(get-component-shape objects (get objects (:parent-id shape)) options)))) (get-component-shape objects (get objects (:parent-id shape)) options))))
(defn get-copy-root
"Get the top shape of the copy."
[objects shape]
(when (:shape-ref shape)
(let [parent (cph/get-parent objects (:id shape))]
(or (get-copy-root objects parent) shape))))
(defn component-main? (defn component-main?
"Check if the shape is a component main instance or is inside one." "Check if the shape is a component main instance or is inside one."
@ -244,7 +249,9 @@
(not main-instance?) (not main-instance?)
(dissoc :main-instance) (dissoc :main-instance)
(and (not main-instance?) (nil? (:shape-ref original-shape))) (and (not main-instance?)
(or components-v2 ; In v1, shape-ref points to the remote instance
(nil? (:shape-ref original-shape)))) ; in v2, shape-ref points to the near instance
(assoc :shape-ref (:id original-shape)) (assoc :shape-ref (:id original-shape))
(nil? (:parent-id original-shape)) (nil? (:parent-id original-shape))

View file

@ -120,7 +120,7 @@
(defn get-component (defn get-component
"Retrieve a component from a library." "Retrieve a component from a library."
[libraries library-id component-id & {:keys [included-delete?] :or {included-delete? false}}] [libraries library-id component-id & {:keys [included-delete?] :or {included-delete? false}}]
(ctkl/get-component (dm/get-in libraries [library-id :data]) component-id included-delete?)) (ctkl/get-component (dm/get-in libraries [library-id :data]) component-id included-delete?))
(defn get-component-library (defn get-component-library
"Retrieve the library the component belongs to." "Retrieve the library the component belongs to."
@ -587,7 +587,7 @@
(let [page (ctpl/get-page file-data page-id) (let [page (ctpl/get-page file-data page-id)
objects (:objects page) objects (:objects page)
components (ctkl/components file-data) components (ctkl/components file-data)
root (d/seek #(nil? (:parent-id %)) (vals objects))] root (get objects uuid/zero)]
(letfn [(show-shape [shape-id level objects] (letfn [(show-shape [shape-id level objects]
(let [shape (get objects shape-id)] (let [shape (get objects shape-id)]
@ -628,7 +628,7 @@
(get-ref-shape (:data component-file) component shape) (get-ref-shape (:data component-file) component shape)
(get-ref-shape file-data component shape)))] (get-ref-shape file-data component shape)))]
(str/format " %s--> %s%s%s" (str/format " %s--> %s%s%s%s"
(cond (:component-root shape) "#" (cond (:component-root shape) "#"
(:component-id shape) "@" (:component-id shape) "@"
:else "-") :else "-")
@ -636,6 +636,9 @@
(when component-file (str/format "<%s> " (:name component-file))) (when component-file (str/format "<%s> " (:name component-file)))
(or (:name component-shape) "?") (or (:name component-shape) "?")
(when (and show-ids component-shape)
(str/format " <%s>" (:id component-shape)))
(if (or (:component-root shape) (if (or (:component-root shape)
(nil? (:component-id shape)) (nil? (:component-id shape))

View file

@ -714,8 +714,6 @@
(rx/map #(update-component-sync (:id %) file-id (uuid/next)) (rx/from shapes)) (rx/map #(update-component-sync (:id %) file-id (uuid/next)) (rx/from shapes))
(rx/of (dwu/commit-undo-transaction undo-id))))))) (rx/of (dwu/commit-undo-transaction undo-id)))))))
(declare sync-file-2nd-stage)
(def valid-asset-types (def valid-asset-types
#{:colors :components :typographies}) #{:colors :components :typographies})
@ -803,44 +801,7 @@
(rx/concat (rx/timer 3000) (rx/concat (rx/timer 3000)
(rp/cmd! :update-file-library-sync-status (rp/cmd! :update-file-library-sync-status
{:file-id file-id {:file-id file-id
:library-id library-id}))) :library-id library-id}))))))))))
(when (and (seq (:redo-changes library-changes))
sync-components?)
(rx/of (sync-file-2nd-stage file-id library-id asset-id undo-group))))))))))
(defn- sync-file-2nd-stage
"If some components have been modified, we need to launch another synchronization
to update the instances of the changed components."
;; TODO: this does not work if there are multiple nested components. Only the
;; first level will be updated.
;; To solve this properly, it would be better to launch another sync-file
;; recursively. But for this not to cause an infinite loop, we need to
;; implement updated-at at component level, to detect what components have
;; not changed, and then not to apply sync and terminate the loop.
[file-id library-id asset-id undo-group]
(dm/assert! (uuid? file-id))
(dm/assert! (uuid? library-id))
(dm/assert! (or (nil? asset-id)
(uuid? asset-id)))
(ptk/reify ::sync-file-2nd-stage
ptk/WatchEvent
(watch [it state _]
(log/info :msg "SYNC-FILE (2nd stage)"
:file (dwlh/pretty-file file-id state)
:library (dwlh/pretty-file library-id state))
(let [file (wsh/get-file state file-id)
changes (reduce
pcb/concat-changes
(-> (pcb/empty-changes it)
(pcb/set-undo-group undo-group))
[(dwlh/generate-sync-file it file-id :components asset-id library-id state)
(dwlh/generate-sync-library it file-id :components asset-id library-id state)])]
(log/debug :msg "SYNC-FILE (2nd stage) finished" :js/rchanges (log-changes
(:redo-changes changes)
file))
(when (seq (:redo-changes changes))
(rx/of (dch/commit-changes (assoc changes :file-id file-id))))))))
(def ignore-sync (def ignore-sync
"Mark the file as ignore syncs. All library changes before this moment will not "Mark the file as ignore syncs. All library changes before this moment will not

View file

@ -543,8 +543,7 @@
initial-root? (:component-root shape-inst) initial-root? (:component-root shape-inst)
root-inst shape-inst root-inst shape-inst
root-main (when component root-main shape-main]
(ctf/get-component-root library component))]
(if component (if component
(generate-sync-shape-direct-recursive changes (generate-sync-shape-direct-recursive changes
@ -608,13 +607,13 @@
only-inst (fn [changes child-inst] only-inst (fn [changes child-inst]
(if-not (and omit-touched? (if-not (and omit-touched?
(contains? (:touched shape-inst) (contains? (:touched shape-inst)
:shapes-group)) :shapes-group))
(remove-shape changes (remove-shape changes
child-inst child-inst
container container
omit-touched?) omit-touched?)
changes)) changes))
only-main (fn [changes child-main] only-main (fn [changes child-main]
(if-not (and omit-touched? (if-not (and omit-touched?