mirror of
https://github.com/penpot/penpot.git
synced 2025-01-23 23:18:48 -05:00
🎉 Add migration scripts
This commit is contained in:
Andrey Antukh
Andrés Moya
parent
6f93b41920
commit
bb6fd4107b
3 changed files with 298 additions and 273 deletions
|
|
@ -619,6 +619,7 @@
|
|||
(assoc :elapsed/total-by-file total)
|
||||
(assoc :processed/files completed)))))))))))
|
||||
|
||||
|
||||
(defn migrate-team!
|
||||
[system team-id]
|
||||
(let [tpoint (dt/tpoint)
|
||||
|
|
@ -627,14 +628,22 @@
|
|||
team-id)]
|
||||
(l/dbg :hint "migrate:team:start" :team-id (dm/str team-id))
|
||||
(try
|
||||
;; We execute this out of transaction because we want this
|
||||
;; change to be visible to all other sessions before starting
|
||||
;; the migration
|
||||
(let [sql (str "UPDATE team SET features = "
|
||||
" array_append(features, 'ephimeral/v2-migration') "
|
||||
" WHERE id = ?")]
|
||||
(db/exec-one! system [sql team-id]))
|
||||
|
||||
(db/tx-run! system
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
;; Lock the team
|
||||
(db/exec-one! conn ["SET idle_in_transaction_session_timeout = 0"])
|
||||
(db/exec-one! conn ["UPDATE team SET features = array_append(features, 'ephimeral/v2-migration') WHERE id = ?" team-id])
|
||||
|
||||
(let [{:keys [features] :as team} (-> (db/get conn :team {:id team-id})
|
||||
(update :features db/decode-pgarray #{}))]
|
||||
|
||||
(if (contains? features "components/v2")
|
||||
(l/dbg :hint "team already migrated")
|
||||
(let [sql (str/concat
|
||||
|
|
@ -650,6 +659,7 @@
|
|||
(some-> *stats* (swap! assoc :current/files (count rows)))
|
||||
|
||||
(let [features (-> features
|
||||
(disj "ephimeral/v2-migration")
|
||||
(conj "components/v2")
|
||||
(conj "layout/grid")
|
||||
(conj "styles/v2"))]
|
||||
|
|
@ -660,10 +670,6 @@
|
|||
(some-> *semaphore* ps/release!)
|
||||
(let [elapsed (tpoint)
|
||||
stats (some-> *stats* deref)]
|
||||
(l/dbg :hint "migrate:team:end"
|
||||
:team-id (dm/str team-id)
|
||||
:files (:current/files stats 0)
|
||||
:elapsed (dt/format-duration elapsed))
|
||||
(when (some? *stats*)
|
||||
(swap! *stats* (fn [stats]
|
||||
(let [elapsed (inst-ms elapsed)
|
||||
|
|
@ -674,4 +680,19 @@
|
|||
(update :elapsed/max-by-team (fnil max 0) elapsed)
|
||||
(assoc :elapsed/avg-by-team avg)
|
||||
(assoc :elapsed/total-by-team total)
|
||||
(assoc :processed/teams completed)))))))))))
|
||||
(assoc :processed/teams completed))))))
|
||||
|
||||
;; We execute this out of transaction because we want this
|
||||
;; change to be visible to all other sessions before starting
|
||||
;; the migration
|
||||
(let [sql (str "UPDATE team SET features = "
|
||||
" array_remove(features, 'ephimeral/v2-migration') "
|
||||
" WHERE id = ?")]
|
||||
(db/exec-one! system [sql team-id]))
|
||||
|
||||
(l/dbg :hint "migrate:team:end"
|
||||
:team-id (dm/str team-id)
|
||||
:files (:current/files stats 0)
|
||||
:elapsed (dt/format-duration elapsed)))))))
|
||||
|
||||
|
||||
|
|
|
|||
271
backend/src/app/srepl/components_v2.clj
Normal file
271
backend/src/app/srepl/components_v2.clj
Normal file
|
|
@ -0,0 +1,271 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.srepl.components-v2
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.logging :as l]
|
||||
[app.common.pprint :as pp]
|
||||
[app.db :as db]
|
||||
[app.features.components-v2 :as feat]
|
||||
[app.util.time :as dt]
|
||||
[cuerdas.core :as str]
|
||||
[promesa.core :as p]
|
||||
[promesa.exec :as px]
|
||||
[promesa.exec.semaphore :as ps]
|
||||
[promesa.util :as pu]))
|
||||
|
||||
(defn- print-stats!
|
||||
[stats]
|
||||
(let [stats (-> stats
|
||||
(d/update-when :elapsed/max-by-team (comp dt/format-duration dt/duration int))
|
||||
(d/update-when :elapsed/avg-by-team (comp dt/format-duration dt/duration int))
|
||||
(d/update-when :elapsed/total-by-team (comp dt/format-duration dt/duration int))
|
||||
(d/update-when :elapsed/max-by-file (comp dt/format-duration dt/duration int))
|
||||
(d/update-when :elapsed/avg-by-file (comp dt/format-duration dt/duration int))
|
||||
(d/update-when :elapsed/total-by-file (comp dt/format-duration dt/duration int))
|
||||
)]
|
||||
(->> stats
|
||||
(into (sorted-map))
|
||||
(pp/pprint))))
|
||||
|
||||
(defn- report-progress-files
|
||||
[tpoint]
|
||||
(fn [_ _ oldv newv]
|
||||
(when (not= (:processed/files oldv)
|
||||
(:processed/files newv))
|
||||
(let [total (:total/files newv)
|
||||
completed (:processed/files newv)
|
||||
progress (/ (* completed 100.0) total)
|
||||
elapsed (tpoint)]
|
||||
(l/trc :hint "progress"
|
||||
:completed (:processed/files newv)
|
||||
:total (:total/files newv)
|
||||
:progress (str (int progress) "%")
|
||||
:elapsed (dt/format-duration elapsed))))))
|
||||
|
||||
(defn- report-progress-teams
|
||||
[tpoint]
|
||||
(fn [_ _ oldv newv]
|
||||
(when (not= (:processed/teams oldv)
|
||||
(:processed/teams newv))
|
||||
(let [total (:total/teams newv)
|
||||
completed (:processed/teams newv)
|
||||
progress (/ (* completed 100.0) total)
|
||||
elapsed (tpoint)]
|
||||
(l/trc :hint "progress"
|
||||
:completed (:processed/teams newv)
|
||||
:progress (str (int progress) "%")
|
||||
:elapsed (dt/format-duration elapsed))))))
|
||||
|
||||
(defn- get-total-files
|
||||
[pool & {:keys [team-id]}]
|
||||
(if (some? team-id)
|
||||
(let [sql (str/concat
|
||||
"SELECT count(f.id) AS count FROM file AS f "
|
||||
" JOIN project AS p ON (p.id = f.project_id) "
|
||||
" WHERE p.team_id = ? AND f.deleted_at IS NULL "
|
||||
" AND p.deleted_at IS NULL")
|
||||
res (db/exec-one! pool [sql team-id])]
|
||||
(:count res))
|
||||
|
||||
(let [sql (str/concat
|
||||
"SELECT count(id) AS count FROM file "
|
||||
" WHERE deleted_at IS NULL")
|
||||
res (db/exec-one! pool [sql])]
|
||||
(:count res))))
|
||||
|
||||
(defn- get-total-teams
|
||||
[pool]
|
||||
(let [sql (str/concat
|
||||
"SELECT count(id) AS count FROM team "
|
||||
" WHERE deleted_at IS NULL")
|
||||
res (db/exec-one! pool [sql])]
|
||||
(:count res)))
|
||||
|
||||
(defn migrate-file!
|
||||
[system file-id & {:keys [rollback] :or {rollback true}}]
|
||||
|
||||
(l/dbg :hint "migrate:start")
|
||||
(let [tpoint (dt/tpoint)]
|
||||
(try
|
||||
(binding [feat/*stats* (atom {})]
|
||||
(-> (assoc system ::db/rollback rollback)
|
||||
(feat/migrate-file! file-id))
|
||||
(-> (deref feat/*stats*)
|
||||
(assoc :elapsed (dt/format-duration (tpoint)))
|
||||
(dissoc :current/graphics)
|
||||
(dissoc :current/components)
|
||||
(dissoc :current/files)))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/dbg :hint "migrate:error" :cause cause))
|
||||
|
||||
(finally
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end" :elapsed elapsed))))))
|
||||
|
||||
(defn migrate-files!
|
||||
[{:keys [::db/pool] :as system} & {:keys [chunk-size max-jobs max-items start-at preset rollback skip-on-error]
|
||||
:or {chunk-size 10
|
||||
skip-on-error true
|
||||
max-jobs 10
|
||||
max-items Long/MAX_VALUE
|
||||
preset :shutdown-on-failure
|
||||
rollback true}}]
|
||||
(letfn [(get-chunk [cursor]
|
||||
(let [sql (str/concat
|
||||
"SELECT id, created_at FROM file "
|
||||
" WHERE created_at < ? AND deleted_at IS NULL "
|
||||
" ORDER BY created_at desc LIMIT ?")
|
||||
rows (db/exec! pool [sql cursor chunk-size])]
|
||||
[(some->> rows peek :created-at) (seq rows)]))
|
||||
|
||||
(get-candidates []
|
||||
(->> (d/iteration get-chunk
|
||||
:vf second
|
||||
:kf first
|
||||
:initk (or start-at (dt/now)))
|
||||
(take max-items)
|
||||
(map :id)))]
|
||||
|
||||
(l/dbg :hint "migrate:start")
|
||||
(let [fsem (ps/create :permits max-jobs)
|
||||
total (get-total-files pool)
|
||||
stats (atom {:files/total total})
|
||||
tpoint (dt/tpoint)]
|
||||
|
||||
(add-watch stats :progress-report (report-progress-files tpoint))
|
||||
|
||||
(binding [feat/*stats* stats
|
||||
feat/*semaphore* fsem
|
||||
feat/*skip-on-error* skip-on-error]
|
||||
(try
|
||||
(pu/with-open [scope (px/structured-task-scope :preset preset :factory :virtual)]
|
||||
|
||||
(run! (fn [file-id]
|
||||
(ps/acquire! feat/*semaphore*)
|
||||
(px/submit! scope (fn []
|
||||
(-> (assoc system ::db/rollback rollback)
|
||||
(feat/migrate-file! file-id)))))
|
||||
(get-candidates))
|
||||
|
||||
(p/await! scope))
|
||||
|
||||
(-> (deref feat/*stats*)
|
||||
(assoc :elapsed (dt/format-duration (tpoint)))
|
||||
(dissoc :current/graphics)
|
||||
(dissoc :current/components)
|
||||
(dissoc :current/files))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/dbg :hint "migrate:error" :cause cause))
|
||||
|
||||
(finally
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end" :elapsed elapsed))))))))
|
||||
|
||||
(defn migrate-team!
|
||||
[{:keys [::db/pool] :as system} team-id
|
||||
& {:keys [rollback skip-on-error]
|
||||
:or {rollback true skip-on-error true}}]
|
||||
(l/dbg :hint "migrate:start")
|
||||
|
||||
(let [total (get-total-files pool :team-id team-id)
|
||||
stats (atom {:total/files total})
|
||||
tpoint (dt/tpoint)]
|
||||
|
||||
(add-watch stats :progress-report (report-progress-files tpoint))
|
||||
|
||||
(try
|
||||
(binding [feat/*stats* stats
|
||||
feat/*skip-on-error* skip-on-error]
|
||||
(-> (assoc system ::db/rollback rollback)
|
||||
(feat/migrate-team! team-id))
|
||||
|
||||
(print-stats!
|
||||
(-> (deref feat/*stats*)
|
||||
(dissoc :total/files)
|
||||
(dissoc :current/graphics)
|
||||
(dissoc :current/components)
|
||||
(dissoc :current/files))))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/dbg :hint "migrate:error" :cause cause))
|
||||
|
||||
(finally
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end" :elapsed elapsed))))))
|
||||
|
||||
(defn migrate-teams!
|
||||
[{:keys [::db/pool] :as system}
|
||||
& {:keys [chunk-size max-jobs max-items start-at rollback preset skip-on-error]
|
||||
:or {chunk-size 10000
|
||||
rollback true
|
||||
skip-on-error true
|
||||
preset :shutdown-on-failure
|
||||
max-jobs Integer/MAX_VALUE
|
||||
max-items Long/MAX_VALUE}}]
|
||||
(letfn [(get-chunk [cursor]
|
||||
(let [sql (str/concat
|
||||
"SELECT id, created_at, features FROM team "
|
||||
" WHERE created_at < ? AND deleted_at IS NULL "
|
||||
" ORDER BY created_at desc LIMIT ?")
|
||||
rows (db/exec! pool [sql cursor chunk-size])]
|
||||
[(some->> rows peek :created-at) (seq rows)]))
|
||||
|
||||
(get-candidates []
|
||||
(->> (d/iteration get-chunk
|
||||
:vf second
|
||||
:kf first
|
||||
:initk (or start-at (dt/now)))
|
||||
(map #(update % :features db/decode-pgarray #{}))
|
||||
(remove #(contains? (:features %) "ephimeral/v2-migration"))
|
||||
(take max-items)
|
||||
(map :id)))]
|
||||
|
||||
(l/dbg :hint "migrate:start")
|
||||
|
||||
(let [sem (ps/create :permits max-jobs)
|
||||
total (get-total-teams pool)
|
||||
stats (atom {:total/teams (min total max-items)})
|
||||
tpoint (dt/tpoint)]
|
||||
|
||||
(add-watch stats :progress-report (report-progress-teams tpoint))
|
||||
|
||||
(binding [feat/*stats* stats
|
||||
feat/*semaphore* sem
|
||||
feat/*skip-on-error* skip-on-error]
|
||||
(try
|
||||
(pu/with-open [scope (px/structured-task-scope :preset preset
|
||||
:factory :virtual)]
|
||||
(run! (fn [team-id]
|
||||
(l/trc :hint "scheduling task" :team-id (dm/str team-id))
|
||||
(ps/acquire! sem)
|
||||
(px/submit! scope (fn []
|
||||
(try
|
||||
(-> (assoc system ::db/rollback rollback)
|
||||
(feat/migrate-team! team-id))
|
||||
(catch Throwable cause
|
||||
(l/err :hint "unexpected error on processing team" :team-id (dm/str team-id) :cause cause))))))
|
||||
|
||||
(get-candidates))
|
||||
(p/await! scope))
|
||||
|
||||
(print-stats!
|
||||
(-> (deref feat/*stats*)
|
||||
(dissoc :total/teams)
|
||||
(dissoc :current/graphics)
|
||||
(dissoc :current/components)
|
||||
(dissoc :current/files)))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/dbg :hint "migrate:error" :cause cause))
|
||||
|
||||
(finally
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end" :elapsed elapsed))))))))
|
||||
|
|
@ -369,273 +369,6 @@
|
|||
(let [library-page (ctp/make-empty-page (uuid/next) "Library backup")]
|
||||
[(ctpl/add-page file-data library-page) (:id library-page) (gpt/point 0 0)]))))
|
||||
|
||||
(declare preprocess-file)
|
||||
|
||||
(defn migrate-to-components-v2
|
||||
"If there is any component in the file library, add a new 'Library backup', generate
|
||||
main instances for all components there and remove shapes from library components.
|
||||
Mark the file with the :components-v2 option."
|
||||
[file-data libraries]
|
||||
(let [migrated? (dm/get-in file-data [:options :components-v2])]
|
||||
(if migrated?
|
||||
file-data
|
||||
(let [components (ctkl/components-seq file-data)]
|
||||
(if (empty? components)
|
||||
(assoc-in file-data [:options :components-v2] true)
|
||||
(let [grid-gap 50
|
||||
|
||||
[file-data page-id start-pos]
|
||||
(get-or-add-library-page file-data grid-gap)
|
||||
|
||||
migrate-component-shape
|
||||
(fn [shape delta component-file component-id]
|
||||
(cond-> shape
|
||||
(nil? (:parent-id shape))
|
||||
(assoc :parent-id uuid/zero
|
||||
:main-instance true
|
||||
:component-root true
|
||||
:component-file component-file
|
||||
:component-id component-id
|
||||
:type :frame ; Old groups must be converted
|
||||
:fills [] ; to frames and conform to spec
|
||||
:hide-in-viewer true
|
||||
:rx 0
|
||||
:ry 0)
|
||||
|
||||
|
||||
(nil? (:frame-id shape))
|
||||
(assoc :frame-id uuid/zero)
|
||||
|
||||
:always
|
||||
(gsh/move delta)))
|
||||
|
||||
add-main-instance
|
||||
(fn [file-data component position]
|
||||
(let [shapes (cph/get-children-with-self (:objects component)
|
||||
(:id component))
|
||||
|
||||
root-shape (first shapes)
|
||||
orig-pos (gpt/point (:x root-shape) (:y root-shape))
|
||||
delta (gpt/subtract position orig-pos)
|
||||
|
||||
xf-shape (map #(migrate-component-shape %
|
||||
delta
|
||||
(:id file-data)
|
||||
(:id component)))
|
||||
new-shapes
|
||||
(into [] xf-shape shapes)
|
||||
|
||||
add-shapes
|
||||
(fn [page]
|
||||
(reduce (fn [page shape]
|
||||
(ctst/add-shape (:id shape)
|
||||
shape
|
||||
page
|
||||
(:frame-id shape)
|
||||
(:parent-id shape)
|
||||
nil ; <- As shapes are ordered, we can safely add each
|
||||
true)) ; one at the end of the parent's children list.
|
||||
page
|
||||
new-shapes))
|
||||
|
||||
update-component
|
||||
(fn [component]
|
||||
(-> component
|
||||
(assoc :main-instance-id (:id root-shape)
|
||||
:main-instance-page page-id)
|
||||
(dissoc :objects)))]
|
||||
|
||||
(-> file-data
|
||||
(ctpl/update-page page-id add-shapes)
|
||||
(ctkl/update-component (:id component) update-component))))
|
||||
|
||||
add-instance-grid
|
||||
(fn [file-data]
|
||||
(let [components (->> file-data
|
||||
(ctkl/components-seq)
|
||||
(sort-by :name)
|
||||
(reverse))
|
||||
position-seq (ctst/generate-shape-grid
|
||||
(map (partial get-component-root file-data) components)
|
||||
start-pos
|
||||
grid-gap)]
|
||||
(loop [file-data file-data
|
||||
components-seq (seq components)
|
||||
position-seq position-seq]
|
||||
(let [component (first components-seq)
|
||||
position (first position-seq)]
|
||||
(if (nil? component)
|
||||
file-data
|
||||
(recur (add-main-instance file-data component position)
|
||||
(rest components-seq)
|
||||
(rest position-seq)))))))]
|
||||
|
||||
(-> file-data
|
||||
(preprocess-file libraries)
|
||||
(add-instance-grid)
|
||||
(assoc-in [:options :components-v2] true))))))))
|
||||
|
||||
(defn- preprocess-file
|
||||
"Apply some specific migrations or fixes to things that are allowed in v1 but not in v2,
|
||||
or that are the result of old bugs."
|
||||
[file-data libraries]
|
||||
(let [detached-ids (volatile! #{})
|
||||
|
||||
detach-shape
|
||||
(fn [container shape]
|
||||
; Detach a shape. If it's inside a component, add it to detached-ids, for further use.
|
||||
(let [is-component? (let [root-shape (ctst/get-shape container (:id container))]
|
||||
(and (some? root-shape) (nil? (:parent-id root-shape))))]
|
||||
(when is-component?
|
||||
(vswap! detached-ids conj (:id shape)))
|
||||
(ctk/detach-shape shape)))
|
||||
|
||||
fix-orphan-shapes
|
||||
(fn [file-data]
|
||||
; Find shapes that are not listed in their parent's children list.
|
||||
; Remove them, and also their children
|
||||
(letfn [(fix-container [container]
|
||||
(reduce fix-shape container (ctn/shapes-seq container)))
|
||||
|
||||
(fix-shape
|
||||
[container shape]
|
||||
(if-not (or (= (:id shape) uuid/zero)
|
||||
(nil? (:parent-id shape)))
|
||||
(let [parent (ctst/get-shape container (:parent-id shape))
|
||||
exists? (d/index-of (:shapes parent) (:id shape))]
|
||||
(if (nil? exists?)
|
||||
(let [ids (cph/get-children-ids-with-self (:objects container) (:id shape))]
|
||||
(update container :objects #(reduce dissoc % ids)))
|
||||
container))
|
||||
container))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(update :components update-vals fix-container))))
|
||||
|
||||
remove-nested-roots
|
||||
(fn [file-data]
|
||||
; Remove :component-root in head shapes that are nested.
|
||||
(letfn [(fix-container [container]
|
||||
(update container :objects update-vals (partial fix-shape container)))
|
||||
|
||||
(fix-shape [container shape]
|
||||
(let [parent (ctst/get-shape container (:parent-id shape))]
|
||||
(if (and (ctk/instance-root? shape)
|
||||
(ctn/in-any-component? (:objects container) parent))
|
||||
(dissoc shape :component-root)
|
||||
shape)))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(update :components update-vals fix-container))))
|
||||
|
||||
add-not-nested-roots
|
||||
(fn [file-data]
|
||||
; Add :component-root in head shapes that are not nested.
|
||||
(letfn [(fix-container [container]
|
||||
(update container :objects update-vals (partial fix-shape container)))
|
||||
|
||||
(fix-shape [container shape]
|
||||
(let [parent (ctst/get-shape container (:parent-id shape))]
|
||||
(if (and (ctk/subinstance-head? shape)
|
||||
(not (ctn/in-any-component? (:objects container) parent)))
|
||||
(assoc shape :component-root true)
|
||||
shape)))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(update :components update-vals fix-container))))
|
||||
|
||||
fix-orphan-copies
|
||||
(fn [file-data]
|
||||
; Detach shapes that were inside a copy (have :shape-ref) but now they aren't.
|
||||
(letfn [(fix-container [container]
|
||||
(update container :objects update-vals (partial fix-shape container)))
|
||||
|
||||
(fix-shape [container shape]
|
||||
(let [parent (ctst/get-shape container (:parent-id shape))]
|
||||
(if (and (ctk/in-component-copy? shape)
|
||||
(not (ctk/instance-head? shape))
|
||||
(not (ctk/in-component-copy? parent)))
|
||||
(detach-shape container shape)
|
||||
shape)))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(update :components update-vals fix-container))))
|
||||
|
||||
remap-refs
|
||||
(fn [file-data]
|
||||
; Remap shape-refs so that they point to the near main.
|
||||
; At the same time, if there are any dangling ref, detach the shape and its children.
|
||||
(letfn [(fix-container [container]
|
||||
(reduce fix-shape container (ctn/shapes-seq container)))
|
||||
|
||||
(fix-shape
|
||||
[container shape]
|
||||
(if (ctk/in-component-copy? shape)
|
||||
; First look for the direct shape.
|
||||
(let [root (ctn/get-component-shape (:objects container) shape)
|
||||
libraries (assoc-in libraries [(:id file-data) :data] file-data)
|
||||
library (get libraries (:component-file root))
|
||||
component (ctkl/get-component (:data library) (:component-id root) true)
|
||||
direct-shape (get-component-shape (:data library) component (:shape-ref shape))]
|
||||
(if (some? direct-shape)
|
||||
; If it exists, there is nothing else to do.
|
||||
container
|
||||
; If not found, find the near shape.
|
||||
(let [near-shape (d/seek #(= (:shape-ref %) (:shape-ref shape))
|
||||
(get-component-shapes (:data library) component))]
|
||||
(if (some? near-shape)
|
||||
; If found, update the ref to point to the near shape.
|
||||
(ctn/update-shape container (:id shape) #(assoc % :shape-ref (:id near-shape)))
|
||||
; If not found, it may be a fostered component. Try to locate a direct shape
|
||||
; in the head component.
|
||||
(let [head (ctn/get-head-shape (:objects container) shape)
|
||||
library-2 (get libraries (:component-file head))
|
||||
component-2 (ctkl/get-component (:data library-2) (:component-id head) true)
|
||||
direct-shape-2 (get-component-shape (:data library-2) component-2 (:shape-ref shape))]
|
||||
(if (some? direct-shape-2)
|
||||
; If it exists, there is nothing else to do.
|
||||
container
|
||||
; If not found, detach shape and all children (stopping if a nested instance is reached)
|
||||
(let [children (ctn/get-children-in-instance (:objects container) (:id shape))]
|
||||
(reduce #(ctn/update-shape %1 (:id %2) (partial detach-shape %1))
|
||||
container
|
||||
children))))))))
|
||||
container))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(update :components update-vals fix-container))))
|
||||
|
||||
fix-copies-of-detached
|
||||
(fn [file-data]
|
||||
; Find any copy that is referencing a detached shape inside a component, and
|
||||
; undo the nested copy, converting it into a direct copy.
|
||||
(letfn [(fix-container [container]
|
||||
(update container :objects update-vals fix-shape))
|
||||
|
||||
(fix-shape [shape]
|
||||
(cond-> shape
|
||||
(@detached-ids (:shape-ref shape))
|
||||
(dissoc shape
|
||||
:component-id
|
||||
:component-file
|
||||
:component-root)))]
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(update :components update-vals fix-container))))]
|
||||
|
||||
(-> file-data
|
||||
(fix-orphan-shapes)
|
||||
(remove-nested-roots)
|
||||
(add-not-nested-roots)
|
||||
(fix-orphan-copies)
|
||||
(remap-refs)
|
||||
(fix-copies-of-detached))))
|
||||
|
||||
(defn- absorb-components
|
||||
[file-data used-components library-data]
|
||||
(let [grid-gap 50
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue