Merge branch 'staging' into develop

common/src/app/common/files/defaults.cljc

@@ -6,4 +6,4 @@
 
 (ns app.common.files.defaults)
 
-(def version 46)
+(def version 47)

common/src/app/common/files/migrations.cljc

@@ -22,6 +22,8 @@
    [app.common.schema :as sm]
    [app.common.svg :as csvg]
    [app.common.text :as txt]
+   [app.common.types.component :as ctk]
+   [app.common.types.file :as ctf]
    [app.common.types.shape :as cts]
    [app.common.types.shape.shadow :as ctss]
    [app.common.uuid :as uuid]
@@ -898,6 +900,29 @@
         (update :pages-index update-vals update-container)
         (update :components update-vals update-container))))
 
+(defn migrate-up-47
+  [data]
+  (letfn [(fix-shape [page shape]
+            (let [file {:id (:id data) :data data}
+                  component-file (:component-file shape)
+                  ;; On cloning a file, the component-file of the shapes point to the old file id
+                  ;; this is a workaround to be able to found the components in that case
+                  libraries {component-file {:id component-file :data data}}
+                  ref-shape  (ctf/find-ref-shape file page libraries shape {:include-deleted? true :with-context? true})
+                  ref-parent (get (:objects (:container (meta ref-shape))) (:parent-id ref-shape))
+                  shape-swap-slot (ctk/get-swap-slot shape)
+                  ref-swap-slot   (ctk/get-swap-slot ref-shape)]
+              (if (and (some? shape-swap-slot)
+                       (= shape-swap-slot ref-swap-slot)
+                       (ctk/main-instance? ref-parent))
+                (ctk/remove-swap-slot shape)
+                shape)))
+
+          (update-page [page]
+            (d/update-when page :objects update-vals (partial fix-shape page)))]
+    (-> data
+        (update :pages-index update-vals update-page))))
+
 (def migrations
   "A vector of all applicable migrations"
   [{:id 2 :migrate-up migrate-up-2}
@@ -935,4 +960,5 @@
    {:id 43 :migrate-up migrate-up-43}
    {:id 44 :migrate-up migrate-up-44}
    {:id 45 :migrate-up migrate-up-45}
-   {:id 46 :migrate-up migrate-up-46}])
+   {:id 46 :migrate-up migrate-up-46}
+   {:id 47 :migrate-up migrate-up-47}])

common/src/app/common/files/repair.cljc

@@ -460,6 +460,21 @@
         (pcb/with-library-data file-data)
         (pcb/update-component (:id shape) repair-component))))
 
+(defmethod repair-error :missing-slot
+  [_ {:keys [shape page-id args] :as error} file-data _]
+  (let [repair-shape
+        (fn [shape]
+          ;; Set the desired swap slot
+          (let [slot (:swap-slot args)]
+            (when (some? slot)
+              (log/debug :hint (str "  -> set swap-slot to " slot))
+              (update shape :touched cfh/set-touched-group (ctk/build-swap-slot-group slot)))))]
+
+    (log/dbg :hint "repairing shape :missing-slot" :id (:id shape) :name (:name shape) :page-id page-id)
+    (-> (pcb/empty-changes nil page-id)
+        (pcb/with-file-data file-data)
+        (pcb/update-shapes [(:id shape)] repair-shape))))
+
 (defmethod repair-error :default
   [_ error file _]
   (log/error :hint "Unknown error code, don't know how to repair" :code (:code error))

common/src/app/common/files/validate.cljc

@@ -6,6 +6,7 @@
 
 (ns app.common.files.validate
   (:require
+   [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.files.helpers :as cfh]
@@ -50,7 +51,8 @@
     :not-head-copy-not-allowed
     :not-component-not-allowed
     :component-nil-objects-not-allowed
-    :instance-head-not-frame})
+    :instance-head-not-frame
+    :missing-slot})
 
 (def ^:private
   schema:error
@@ -454,6 +456,8 @@
 ;; PUBLIC API: VALIDATION FUNCTIONS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(declare check-swap-slots)
+
 (defn validate-file
   "Validate full referential integrity and semantic coherence on file data.
 
@@ -464,6 +468,8 @@
 
       (doseq [page (filter :id (ctpl/pages-seq data))]
         (check-shape uuid/zero file page libraries)
+        (when (str/includes? (:name file) "check-swap-slot")
+          (check-swap-slots uuid/zero file page libraries))
         (->> (get-orphan-shapes page)
              (run! #(check-shape % file page libraries))))
 
@@ -517,3 +523,41 @@
               :hint "error on validating file referential integrity"
               :file-id (:id file)
               :details errors)))
+
+
+(declare compare-slots)
+
+;; Optional check to look for missing swap slots.
+;; Search for copies that do not point the shape-ref to the near component but don't have swap slot
+;; (looking for position relative to the parent, in the copy and the main).
+;;
+;; This check cannot be generally enabled, because files that have been migrated from components v1
+;; may have copies with shapes that do not match by position, but have not been swapped. So we enable
+;; it for specific files only. To activate the check, you need to add the string "check-swap-slot" to
+;; the name of the file.
+(defn- check-swap-slots
+  [shape-id file page libraries]
+  (let [shape (ctst/get-shape page shape-id)]
+    (if (and (ctk/instance-root? shape) (ctk/in-component-copy? shape))
+      (let [ref-shape (ctf/find-ref-shape file page libraries shape :include-deleted? true :with-context? true)
+            container (:container (meta ref-shape))]
+        (when (some? ref-shape)
+          (compare-slots shape ref-shape file page container)))
+      (doall (for [child-id (:shapes shape)]
+               (check-swap-slots child-id file page libraries))))))
+
+(defn- compare-slots
+  [shape-copy shape-main file container-copy container-main]
+  (if (and (not= (:shape-ref shape-copy) (:id shape-main))
+           (nil? (ctk/get-swap-slot shape-copy)))
+    (report-error :missing-slot
+                  "Shape has been swapped, should have swap slot"
+                  shape-copy file container-copy
+                  :swap-slot (or (ctk/get-swap-slot shape-main) (:id shape-main)))
+    (when (nil? (ctk/get-swap-slot shape-copy))
+      (let [children-id-pairs (d/zip-all (:shapes shape-copy) (:shapes shape-main))]
+        (doall (for [[child-copy-id child-main-id] children-id-pairs]
+                 (let [child-copy (ctst/get-shape container-copy child-copy-id)
+                       child-main (ctst/get-shape container-main child-main-id)]
+                   (when (and (some? child-copy) (some? child-main))
+                     (compare-slots child-copy child-main file container-copy container-main)))))))))

common/src/app/common/types/container.cljc

@@ -386,8 +386,7 @@
          (fn [new-shape original-shape]
            (let [new-name (:name new-shape)
                  root?    (or (ctk/instance-root? original-shape)   ; If shape is inside a component (not components-v2)
-                              (nil? (:parent-id original-shape)))  ; we detect it by having no parent)
-                 swap-slot (ctk/get-swap-slot original-shape)]
+                              (nil? (:parent-id original-shape)))]  ; we detect it by having no parent)
 
              (when root?
                (vswap! unames conj new-name))
@@ -399,9 +398,6 @@
                (-> (gsh/move delta)
                    (dissoc :touched))
 
-               (some? swap-slot)
-               (assoc :touched #{(ctk/build-swap-slot-group swap-slot)})
-
                (and main-instance? root?)
                (assoc :main-instance true)
 

frontend/src/app/config.cljs

@@ -130,6 +130,10 @@
 (def worker-uri
   (obj/get global "penpotWorkerURI" "/js/worker.js"))
 
+(defn external-feature-flag [flag value]
+  (when-let [fn (obj/get global "externalFeatureFlag")]
+    (fn flag value)))
+
 ;; --- Helper Functions
 
 (defn ^boolean check-browser? [candidate]