From 2247f0ecac93f7afd61ae8c5a1db4c1b58a7f056 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Moya?= Date: Fri, 8 Mar 2024 16:47:30 +0100 Subject: [PATCH] :recycle: Add a tool to generate swap-slots --- backend/src/app/srepl/fixes.clj | 105 ++++++++++++++++++++- common/src/app/common/types/container.cljc | 6 +- common/src/app/common/types/file.cljc | 13 +-- 3 files changed, 116 insertions(+), 8 deletions(-) diff --git a/backend/src/app/srepl/fixes.clj b/backend/src/app/srepl/fixes.clj index 955f08366..2d50bd8a8 100644 --- a/backend/src/app/srepl/fixes.clj +++ b/backend/src/app/srepl/fixes.clj @@ -10,10 +10,15 @@ (:require [app.binfile.common :as bfc] [app.common.data :as d] + [app.common.data.macros :as dm] [app.common.files.changes :as cpc] + [app.common.files.helpers :as cfh] [app.common.files.repair :as cfr] [app.common.files.validate :as cfv] [app.common.logging :as l] + [app.common.types.component :as ctk] + [app.common.types.container :as ctn] + [app.common.types.file :as ctf] [app.common.uuid :as uuid] [app.db :as db] [app.features.fdata :as feat.fdata] @@ -133,4 +138,102 @@ (fn [touched] (disj touched :shapes-group))))] file (-> file - (update :data fix-fdata)))) \ No newline at end of file + (update :data fix-fdata)))) + +(defn add-swap-slots + [file libs _opts] + ;; Detect swapped copies and try to generate a valid swap-slot. + (letfn [(process-fdata [data] + ;; Walk through all containers in the file, both pages and deleted components. + (reduce process-container data (ctf/object-containers-seq data))) + + (process-container [data container] + ;; Walk through all shapes in depth-first tree order. + (l/dbg :hint "Processing container" :type (:type container) :name (:name container)) + (let [root-shape (ctn/get-container-root container)] + (ctf/update-container data + container + #(reduce process-shape % (ctn/get-direct-children container root-shape))))) + + (process-shape [container shape] + ;; Look for head copies in the first level (either component roots or inside main components). + ;; Even if they have been swapped, we don't add slot to them because there is no way to know + ;; the original shape. Only children. + (if (and (ctk/instance-head? shape) + (ctk/in-component-copy? shape) + (nil? (ctk/get-swap-slot shape))) + (process-copy-head container shape) + (reduce process-shape container (ctn/get-direct-children container shape)))) + + (process-copy-head [container head-shape] + ;; Process recursively all children, comparing each one with the corresponding child in the main + ;; component, looking by position. If the shape-ref does not point to the found child, then it has + ;; been swapped and need to set up a slot. + (l/trc :hint "Processing copy-head" :id (:id head-shape) :name (:name head-shape)) + (let [component-shape (ctf/find-ref-shape file container libs head-shape :include-deleted? true :with-context? true) + component-container (:container (meta component-shape))] + (loop [container container + children (map #(ctn/get-shape container %) (:shapes head-shape)) + component-children (map #(ctn/get-shape component-container %) (:shapes component-shape))] + (let [child (first children) + component-child (first component-children)] + (if (or (nil? child) (nil? component-child)) + container + (let [container (if (and (not (ctk/is-main-of? component-child child)) + (nil? (ctk/get-swap-slot child)) + (ctk/instance-head? child)) + (let [slot (guess-swap-slot component-child component-container)] + (l/dbg :hint "child" :id (:id child) :name (:name child) :slot slot) + (ctn/update-shape container (:id child) + #(update % :touched + cfh/set-touched-group + (ctk/build-swap-slot-group slot)))) + container)] + (recur (process-copy-head container child) + (rest children) + (rest component-children)))))))) + + (guess-swap-slot [shape container] + ;; To guess the slot, we must follow the chain until we find the definitive main. But + ;; we cannot navigate by shape-ref, because main shapes may also have been swapped. So + ;; chain by position, too. + (if-let [slot (ctk/get-swap-slot shape)] + slot + (if-not (ctk/in-component-copy? shape) + (:id shape) + (let [head-copy (ctn/get-component-shape (:objects container) shape)] + (if (= (:id head-copy) (:id shape)) + (:id shape) + (let [head-main (ctf/find-ref-shape file + container + libs + head-copy + :include-deleted? true + :with-context? true) + container-main (:container (meta head-main)) + shape-main (find-match-by-position shape + head-copy + container + head-main + container-main)] + (guess-swap-slot shape-main container-main))))))) + + (find-match-by-position [shape-copy head-copy container-copy head-main container-main] + ;; Find the shape in the main that has the same position under its parent than + ;; the copy under its one. To get the parent we must process recursively until + ;; the component head, because mains may also have been swapped. + (let [parent-copy (ctn/get-shape container-copy (:parent-id shape-copy)) + parent-main (if (= (:id parent-copy) (:id head-copy)) + head-main + (find-match-by-position parent-copy + head-copy + container-copy + head-main + container-main)) + index (cfh/get-position-on-parent (:objects container-copy) + (:id shape-copy)) + shape-main-id (dm/get-in parent-main [:shapes index])] + (ctn/get-shape container-main shape-main-id)))] + + file (-> file + (update :data process-fdata)))) diff --git a/common/src/app/common/types/container.cljc b/common/src/app/common/types/container.cljc index ddeeea734..ee2be1ae6 100644 --- a/common/src/app/common/types/container.cljc +++ b/common/src/app/common/types/container.cljc @@ -90,6 +90,10 @@ [container shape-id f] (update-in container [:objects shape-id] f)) +(defn get-container-root + [container] + (d/seek #(or (nil? (:parent-id %)) (= (:parent-id %) uuid/zero)) (shapes-seq container))) + (defn get-direct-children [container shape] (map #(get-shape container %) (:shapes shape))) @@ -107,7 +111,7 @@ (get-children-rec [] id))) (defn get-component-shape - "Get the parent top shape linked to a component for this shape, if any" + "Get the parent top shape linked to a component main for this shape, if any" ([objects shape] (get-component-shape objects shape nil)) ([objects shape {:keys [allow-main?] :or {allow-main? false} :as options}] (let [parent (get objects (:parent-id shape))] diff --git a/common/src/app/common/types/file.cljc b/common/src/app/common/types/file.cljc index a060fe634..3afb89c24 100644 --- a/common/src/app/common/types/file.cljc +++ b/common/src/app/common/types/file.cljc @@ -147,7 +147,7 @@ (defn get-component-container "Retrieve the container that holds the component shapes (the page in components-v2 - or the component itself in v1)" + or the component itself in v1 or deleted component)." [file-data component] (let [components-v2 (dm/get-in file-data [:options :components-v2])] (if (and components-v2 (not (:deleted component))) @@ -182,11 +182,12 @@ :data file-data} :container (ctn/make-container component-page :page)}))))) - (cond-> (dm/get-in component [:objects shape-id]) - with-context? - (with-meta {:file {:id (:id file-data) - :data file-data} - :container (ctn/make-container component :component)}))))) + (let [shape (dm/get-in component [:objects shape-id])] + (cond-> shape + (and shape with-context?) + (with-meta {:file {:id (:id file-data) + :data file-data} + :container (ctn/make-container component :component)})))))) (defn get-ref-shape "Retrieve the shape in the component that is referenced by the instance shape."