✨ Add some migrations and fixes to component-v2 migration

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}]
+  [conn {:keys [features data] :as file}]
-  (let [data     (ctf/migrate-to-components-v2 data)
+  (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

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))))

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))

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)
 

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]
+                       root-shape (first shapes)
-                        (ctn/make-component-instance page
+                       orig-pos   (gpt/point (:x root-shape) (:y root-shape))
-                                                     component
+                       delta      (gpt/subtract position orig-pos)
-                                                     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))
 
-                        update-component
+                       xf-shape (map #(migrate-component-shape %
-                        (fn [component]
+                                                               delta
-                          (-> component
+                                                               (:id file-data)
-                              (assoc :main-instance-id (:id new-shape)
+                                                               (:id component)))
-                                     :main-instance-page page-id)
+                       new-shapes
-                              (dissoc :objects)))]
+                       (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]
+                (fn [file-data]
-                  (let [position-seq (ctst/generate-shape-grid
+                  (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)))))))
+                                 (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))]
 
             (-> file-data
-                (add-instance-grid (reverse (sort-by :name components)))
+                (preprocess-file libraries)
-                (update :pages-index update-vals roots-to-board)
+                (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

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))