diff --git a/backend/src/app/rpc/commands/files.clj b/backend/src/app/rpc/commands/files.clj index 1e67f7d44..a095cbfdf 100644 --- a/backend/src/app/rpc/commands/files.clj +++ b/backend/src/app/rpc/commands/files.clj @@ -253,11 +253,18 @@ (into #{} (comp (filter pmap/pointer-map?) (map pmap/get-id))))) +(declare get-file-libraries) + ;; FIXME: file locking (defn- process-components-v2-feature "A special case handling of the components/v2 feature." - [{:keys [features data] :as file}] - (let [data (ctf/migrate-to-components-v2 data) + [conn {:keys [features data] :as file}] + (let [libraries (-> (->> (get-file-libraries conn (:id file)) ; This may be slow, but it's executed only once, + (map #(db/get conn :file {:id (:id %)})) ; in the migration to components-v2 + (map #(update % :data blob/decode)) + (d/index-by :id)) + (assoc (:id file) file)) + data (ctf/migrate-to-components-v2 data libraries) features (conj features "components/v2")] (-> file (assoc ::pmg/migrated true) @@ -265,7 +272,7 @@ (assoc :data data)))) (defn handle-file-features! - [{:keys [features] :as file} client-features] + [conn {:keys [features] :as file} client-features] ;; Check features compatibility between the currently supported features on ;; the current backend instance and the file retrieved from the database @@ -287,7 +294,7 @@ ;; components and breaking the whole file." (and (contains? client-features "components/v2") (not (contains? features "components/v2"))) - (as-> file (process-components-v2-feature file)) + (as-> file (process-components-v2-feature conn file)) ;; This operation is needed for backward comapatibility with frontends that ;; does not support pointer-map resolution mechanism; this just resolves the @@ -355,7 +362,7 @@ (decode-row) (pmg/migrate-file)) - file (handle-file-features! file client-features)] + file (handle-file-features! conn file client-features)] ;; NOTE: when file is migrated, we break the rule of no perform ;; mutations on get operations and update the file with all diff --git a/backend/src/app/rpc/commands/files_update.clj b/backend/src/app/rpc/commands/files_update.clj index 0884ffcfe..10d52261a 100644 --- a/backend/src/app/rpc/commands/files_update.clj +++ b/backend/src/app/rpc/commands/files_update.clj @@ -230,7 +230,7 @@ ;; to be executed on a separated executor for avoid to do the ;; CPU intensive operation on vthread. file (-> (climit/configure cfg :update-file) - (climit/submit! (partial update-file-data file libraries changes skip-validate)))] + (climit/submit! (partial update-file-data conn file libraries changes skip-validate)))] (db/insert! conn :file-change {:id (uuid/next) @@ -264,11 +264,22 @@ (get-lagged-changes conn params)))) (defn- update-file-data - [file libraries changes skip-validate] + [conn file libraries changes skip-validate] (let [validate (fn [file] (when (and (cf/flags :file-validation) (not skip-validate)) - (val/validate-file file libraries :throw? true)))] + (val/validate-file file libraries :throw? true))) + + do-migrate-v2 (fn [file] + ;; When migrating to components-v2 we need the libraries even + ;; if the validations are disabled. + (let [libraries (or (seq libraries) + (-> (->> (files/get-file-libraries conn (:id file)) + (map #(get-file conn (:id %))) + (map #(update % :data blob/decode)) + (d/index-by :id)) + (assoc (:id file) file)))] + (ctf/migrate-to-components-v2 file libraries)))] (-> file (update :revn inc) (update :data (fn [data] @@ -280,7 +291,7 @@ (and (contains? ffeat/*current* "components/v2") (not (contains? ffeat/*previous* "components/v2"))) - (ctf/migrate-to-components-v2) + (do-migrate-v2) :always (cp/process-changes changes)))) diff --git a/common/src/app/common/files/validate.cljc b/common/src/app/common/files/validate.cljc index f9faea548..b86c8b80c 100644 --- a/common/src/app/common/files/validate.cljc +++ b/common/src/app/common/files/validate.cljc @@ -91,7 +91,7 @@ (defn validate-geometry "Validate that the shape has valid coordinates, selrect and points." [shape file page] - (when (and (not= (:type shape) :path) + (when (and (not (#{:path :bool} (:type shape))) (or (nil? (:x shape)) ; This may occur in root shape (uuid/zero) in old files (nil? (:y shape)) (nil? (:width shape)) diff --git a/common/src/app/common/types/container.cljc b/common/src/app/common/types/container.cljc index 022595b94..8a14defd2 100644 --- a/common/src/app/common/types/container.cljc +++ b/common/src/app/common/types/container.cljc @@ -94,6 +94,18 @@ [container shape] (map #(get-shape container %) (:shapes shape))) +(defn get-children-in-instance + "Get the shape and their children recursively, but stopping when + a component nested instance is found." + [objects id] + (letfn [(get-children-rec [children id] + (let [shape (get objects id)] + (if (and (ctk/instance-head? shape) (seq children)) + children + (into (conj children shape) + (mapcat #(get-children-rec children %) (:shapes shape))))))] + (get-children-rec [] id))) + (defn get-component-shape "Get the parent top shape linked to a component for this shape, if any" ([objects shape] (get-component-shape objects shape nil)) @@ -163,6 +175,8 @@ (cond (or (nil? shape) (cph/root? shape)) false + (nil? (:parent-id shape)) ; This occurs in the root of components v1 + true (ctk/main-instance? shape) true (ctk/instance-head? shape) @@ -254,7 +268,6 @@ (assoc :frame-id uuid/zero)) (get-shape component (:id component))) - orig-pos (gpt/point (:x component-shape) (:y component-shape)) delta (gpt/subtract position orig-pos) diff --git a/common/src/app/common/types/file.cljc b/common/src/app/common/types/file.cljc index bea5cd024..1ac692e4f 100644 --- a/common/src/app/common/types/file.cljc +++ b/common/src/app/common/types/file.cljc @@ -56,8 +56,8 @@ [:typographies {:optional true} [:map-of {:gen/max 2} ::sm/uuid ::cty/typography]] [:media {:optional true} - [:map-of {:gen/max 5} ::sm/uuid ::media-object]] - ]) + [:map-of {:gen/max 5} ::sm/uuid ::media-object]]]) + (def file-data? (sm/pred-fn ::data)) @@ -368,11 +368,13 @@ (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] + [file-data libraries] (let [migrated? (dm/get-in file-data [:options :components-v2])] (if migrated? file-data @@ -384,46 +386,75 @@ [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 [page (ctpl/get-page file-data page-id) + (let [shapes (cph/get-children-with-self (:objects component) + (:id component)) - [new-shape new-shapes] - (ctn/make-component-instance page - component - file-data - position - false - {:main-instance? true - :force-frame-id uuid/zero - :keep-ids? true}) - 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)) + root-shape (first shapes) + orig-pos (gpt/point (:x root-shape) (:y root-shape)) + delta (gpt/subtract position orig-pos) - update-component - (fn [component] - (-> component - (assoc :main-instance-id (:id new-shape) - :main-instance-page page-id) - (dissoc :objects)))] + 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 components] - (let [position-seq (ctst/generate-shape-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)] @@ -436,28 +467,174 @@ file-data (recur (add-main-instance file-data component position) (rest components-seq) - (rest position-seq))))))) - - root-to-board - (fn [shape] - (cond-> shape - (and (ctk/instance-head? shape) - (not (cph/frame-shape? shape))) - (assoc :type :frame - :fills [] - :hide-in-viewer true - :rx 0 - :ry 0))) - - roots-to-board - (fn [page] - (update page :objects update-vals root-to-board))] + (rest position-seq)))))))] (-> file-data - (add-instance-grid (reverse (sort-by :name components))) - (update :pages-index update-vals roots-to-board) + (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 (ctst/get-shape 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)) + (ctn/shapes-seq 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 (ctst/get-shape 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 @@ -831,9 +1008,9 @@ (if (get-in libs-to-show [library-id (:id root)]) libs-to-show (-> libs-to-show - (add-component library-id component-id) + (add-component library-id component-id)))))) ;; (find-used-components-cumulative page root) - ))))) + libs-to-show components)) libs-to-show diff --git a/frontend/src/debug.cljs b/frontend/src/debug.cljs index 34ce6c80b..f2d3afb1a 100644 --- a/frontend/src/debug.cljs +++ b/frontend/src/debug.cljs @@ -23,6 +23,7 @@ [app.main.data.workspace :as dw] [app.main.data.workspace.changes :as dwc] [app.main.data.workspace.path.shortcuts] + [app.main.data.workspace.selection :as dws] [app.main.data.workspace.shortcuts] [app.main.features :as features] [app.main.repo :as rp] @@ -241,6 +242,10 @@ (prn (str (:name frame) " - " (:id frame)))) nil)) +(defn ^:export select-by-id + [shape-id] + (st/emit! (dws/select-shape (uuid/uuid shape-id)))) + (defn dump-tree' ([state] (dump-tree' state false false false)) ([state show-ids] (dump-tree' state show-ids false false))