🎉 Allow nested components

backend/src/app/services/mutations/files.clj

@@ -241,10 +241,13 @@
 
 ;; File changes that affect to the library, and must be notified
 ;; to all clients using it.
-(def library-changes
+(defn library-change?
-  #{:add-color :mod-color :del-color
+  [change]
-    :add-media :mod-media :del-media
+  (or (#{:add-color :mod-color :del-color
-    :add-component :mod-component :del-component})
+         :add-media :mod-media :del-media
+         :add-component :mod-component :del-component} (:type change))
+      (and (= (:type change) :mod-obj)
+           (some? (:component-id change)))))
 
 (declare update-file)
 (declare retrieve-lagged-changes)
@@ -285,12 +288,12 @@
                   :revn (:revn file)
                   :changes changes}
 
-        library-changes (filter #(library-changes (:type %)) changes)]
+        library-changes (filter library-change? changes)]
 
     @(redis/run! :publish {:channel (str (:id file))
                            :message (t/encode-str msg)})
 
-    (if (and (:is-shared file) (seq library-changes))
+    (when (and (:is-shared file) (seq library-changes))
       (let [{:keys [team-id] :as project}
             (db/get-by-id conn :project (:project-id file))
 
@@ -299,7 +302,7 @@
                  :file-id (:id file)
                  :session-id sid
                  :revn (:revn file)
-                 :modified-at (:modified-at file)
+                 :modified-at (dt/now)
                  :changes library-changes}]
 
         @(redis/run! :publish {:channel (str team-id)

common/app/common/data.cljc

@@ -13,6 +13,8 @@
                :clj [clojure.edn :as r])
             #?(:cljs [cljs.core :as core]
                :clj [clojure.core :as core]))
+  #?(:cljs
+     (:require-macros [app.common.data]))
   #?(:clj
      (:import linked.set.LinkedSet)))
 
@@ -109,40 +111,12 @@
   ([coll value]
    (sequence (replace-by-id value) coll)))
 
-(defn remove-nil-vals
+(defn without-nils
   "Given a map, return a map removing key-value
   pairs when value is `nil`."
   [data]
   (into {} (remove (comp nil? second) data)))
 
-
-(defmacro without-nils
-  "A generic helper macro that removes nils from hash-map from
-  collection at compile time. If it is not possible (a symbol is
-  received), fallback to runtume nil removing procediment thanks to
-  `remove-nil-vals` function."
-  [param]
-  (cond
-    (symbol? param)
-    `(remove-nil-vals ~param)
-
-    (map? param)
-    `~(remove-nil-vals param)
-
-    :else
-    (throw (ex-info "Invalid arguments"
-                    {:type :internal
-                     :code :invalid-arguments}))))
-
-(defmacro hash-map
-  "A closure friendly macro for build nil-free hash-maps at compile
-  time."
-  [& kvpairs]
-  (let [data (->> (partition 2 kvpairs)
-                  (remove (comp nil? second))
-                  (mapcat identity))]
-    `(hash-map ~@data)))
-
 (defn without-keys
   "Return a map without the keys provided
   in the `keys` parameter."

common/app/common/pages.cljc

@@ -122,6 +122,7 @@
 (s/def :internal.shape/line-height ::safe-number)
 (s/def :internal.shape/locked boolean?)
 (s/def :internal.shape/page-id uuid?)
+(s/def :internal.shape/component-id uuid?)
 (s/def :internal.shape/proportion ::safe-number)
 (s/def :internal.shape/proportion-lock boolean?)
 (s/def :internal.shape/rx ::safe-number)
@@ -235,6 +236,8 @@
                            :width                 :size-group
                            :height                :size-group
                            :proportion            :size-group
+                           :x                     :position-group
+                           :y                     :position-group
                            :rx                    :radius-group
                            :ry                    :radius-group
                            :points                :points-group
@@ -346,7 +349,7 @@
 (s/def ::operations (s/coll-of ::operation))
 
 (defmethod change-spec :mod-obj [_]
-  (s/keys :req-un [::id ::page-id ::operations]))
+  (s/keys :req-un [::id (or ::page-id ::component-id) ::operations]))
 
 (defmethod change-spec :del-obj [_]
   (s/keys :req-un [::id ::page-id]))
@@ -594,12 +597,14 @@
                                                  :else (cph/insert-at-index shapes index [id]))))))))))))
 
 (defmethod process-change :mod-obj
-  [data {:keys [id page-id operations] :as change}]
+  [data {:keys [id page-id component-id operations] :as change}]
-  (d/update-in-when data [:pages-index page-id :objects]
+  (let [update-fn (fn [objects]
-                    (fn [objects]
+                    (if-let [obj (get objects id)]
-                      (if-let [obj (get objects id)]
+                      (assoc objects id (reduce process-operation obj operations))
-                        (assoc objects id (reduce process-operation obj operations))
+                      objects))]
-                        objects))))
+    (if page-id
+      (d/update-in-when data [:pages-index page-id :objects] update-fn)
+      (d/update-in-when data [:components component-id :objects] update-fn))))
 
 (defmethod process-change :del-obj
   [data {:keys [page-id id] :as change}]

common/app/common/pages_helpers.cljc

@@ -37,7 +37,7 @@
     (if-let [component-id (:component-id obj)]
       id
       (if-let [parent-id (:parent-id obj)]
-        (get-root-component parent-id obj)
+        (get-root-component parent-id objects)
         nil))))
 
 (defn get-children

frontend/src/app/main/data/workspace/libraries.cljs

@@ -18,6 +18,7 @@
    [app.main.data.messages :as dm]
    [app.main.data.workspace.common :as dwc]
    [app.main.data.workspace.selection :as dws]
+   [app.main.data.workspace.libraries-helpers :as dwlh]
    [app.common.pages :as cp]
    [app.main.repo :as rp]
    [app.main.store :as st]
@@ -117,8 +118,6 @@
                   :object prev}]
         (rx/of (dwc/commit-changes [rchg] [uchg] {:commit-local? true}))))))
 
-(declare make-component-shape)
-
 (def add-component
   (ptk/reify ::add-component
     ptk/WatchEvent
@@ -137,7 +136,7 @@
                   (dws/prepare-create-group page-id shapes "Component-" true))
 
                 [new-shape new-shapes updated-shapes]
-                (make-component-shape group nil objects)
+                (dwlh/make-component-shape group objects)
 
                 rchanges (conj rchanges
                                {:type :add-component
@@ -167,41 +166,24 @@
 
                 uchanges (into uchanges
                                (map (fn [updated-shape]
-                                      {:type :mod-obj
+                                      (let [original-shape (get objects (:id updated-shape))]
-                                       :page-id page-id
+                                        {:type :mod-obj
-                                       :id (:id updated-shape)
+                                         :page-id page-id
-                                       :operations [{:type :set
+                                         :id (:id updated-shape)
-                                                     :attr :component-id
+                                         :operations [{:type :set
-                                                     :val nil}
+                                                       :attr :component-id
-                                                    {:type :set
+                                                       :val (:component-id original-shape)}
-                                                     :attr :component-file
+                                                      {:type :set
-                                                     :val nil}
+                                                       :attr :component-file
-                                                    {:type :set
+                                                       :val (:component-file original-shape)}
-                                                     :attr :shape-ref
+                                                      {:type :set
-                                                     :val nil}]})
+                                                       :attr :shape-ref
+                                                       :val (:shape-ref original-shape)}]}))
                                     updated-shapes))]
 
             (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
                    (dws/select-shapes (d/ordered-set (:id group))))))))))
 
-(defn- make-component-shape
-  "Clone the shape and all children. Generate new ids and detach
-  from parent and frame. Update the original shapes to have links
-  to the new ones."
-  [shape parent-id objects]
-  (let [update-new-shape (fn [new-shape original-shape]
-                           (assoc new-shape :frame-id nil))
-
-        update-original-shape (fn [original-shape new-shape]
-                                (cond-> original-shape
-                                  true
-                                  (assoc :shape-ref (:id new-shape))
-
-                                  (nil? (:parent-id new-shape))
-                                  (assoc :component-id (:id new-shape))))]
-
-    (cph/clone-object shape parent-id objects update-new-shape update-original-shape)))
-
 (defn delete-component
   [{:keys [id] :as params}]
   (us/assert ::us/uuid id)
@@ -268,7 +250,13 @@
                   (assoc :component-id (:id original-shape))
 
                   (and (nil? (:parent-id original-shape)) (some? file-id))
-                  (assoc :component-file file-id))))
+                  (assoc :component-file file-id)
+
+                  (and (nil? (:parent-id original-shape)) (nil? file-id))
+                  (dissoc :component-file)
+
+                  (some? (:parent-id original-shape))
+                  (dissoc :component-id :component-file))))
 
             [new-shape new-shapes _]
             (cph/clone-object component-shape
@@ -362,18 +350,6 @@
           (d/update-in-when [:workspace-libraries file-id :data]
                             cp/process-changes changes)))))
 
-(declare generate-sync-components-file)
-(declare generate-sync-components-page)
-(declare generate-sync-components-shape-and-children)
-(declare generate-sync-components-shape)
-(declare generate-sync-colors-file)
-(declare generate-sync-colors-page)
-(declare generate-sync-colors-shape)
-(declare remove-component-and-ref)
-(declare remove-ref)
-(declare update-attrs)
-(declare calc-new-pos)
-
 (defn reset-component
   [id]
   (us/assert ::us/uuid id)
@@ -393,7 +369,12 @@
               (get-in state [:workspace-libraries file-id :data :components]))
 
             [rchanges uchanges]
-            (generate-sync-components-shape-and-children root-shape page components true)]
+            (dwlh/generate-sync-shape-and-children-components root-shape
+                                                              objects
+                                                              components
+                                                              (:id page)
+                                                              nil
+                                                              true)]
 
         (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}))))))
 
@@ -420,6 +401,9 @@
                                  true
                                  (assoc :frame-id nil)
 
+                                 (= (:component-id original-shape) component-id)
+                                 (dissoc :component-id)
+
                                  (some? (:shape-ref original-shape))
                                  (assoc :id (:shape-ref original-shape))))
 
@@ -457,6 +441,8 @@
 
         (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}))))))
 
+(declare sync-file-2nd-stage)
+
 (defn sync-file
   [file-id]
   (us/assert (s/nilable ::us/uuid) file-id)
@@ -469,17 +455,38 @@
 
     ptk/WatchEvent
     (watch [_ state stream]
-      (let [[rchanges1 uchanges1] (generate-sync-components-file state file-id)
+      (let [[rchanges1 uchanges1] (dwlh/generate-sync-file-components state file-id)
-            [rchanges2 uchanges2] (generate-sync-colors-file state file-id)
+            [rchanges2 uchanges2] (dwlh/generate-sync-library-components state file-id)
-            rchanges (concat rchanges1 rchanges2)
+            [rchanges3 uchanges3] (dwlh/generate-sync-file-colors state file-id)
-            uchanges (concat uchanges1 uchanges2)]
+            rchanges (concat rchanges1 rchanges2 rchanges3)
+            uchanges (concat uchanges1 uchanges2 uchanges3)]
         (rx/concat
           (when rchanges
             (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})))
           (when file-id
             (rp/mutation :update-sync
                          {:file-id (get-in state [:workspace-file :id])
-                          :library-id file-id})))))))
+                          :library-id file-id}))
+          (when (seq rchanges2)
+            (rx/of (sync-file-2nd-stage file-id))))))))
+
+(defn sync-file-2nd-stage
+  "If some components have been modified, we need to launch another synchronization
+  to update the instances of the changed components."
+  ;; TODO: this does not work if there are multiple nested components. Only the
+  ;;       first level will be updated.
+  ;;       To solve this properly, it would be better to launch another sync-file
+  ;;       recursively. But for this not to cause an infinite loop, we need to
+  ;;       implement updated-at at component level, to detect what components have
+  ;;       not changed, and then not to apply sync and terminate the loop.
+  [file-id]
+  (us/assert (s/nilable ::us/uuid) file-id)
+  (ptk/reify ::sync-file-2nd-stage
+    ptk/WatchEvent
+    (watch [_ state stream]
+      (let [[rchanges uchanges] (dwlh/generate-sync-file-components state nil)]
+        (when rchanges
+          (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})))))))
 
 (def ignore-sync
   (ptk/reify ::sync-file
@@ -515,274 +522,3 @@
                   {:label (tr "workspace.updates.dismiss")
                    :callback do-dismiss}]))))))
 
-(defn- generate-sync-components-file
-  [state file-id]
-  (let [components
-        (if (nil? file-id)
-          (get-in state [:workspace-data :components])
-          (get-in state [:workspace-libraries file-id :data :components]))]
-    (when (some? components)
-      (loop [pages (seq (vals (get-in state [:workspace-data :pages-index])))
-             rchanges []
-             uchanges []]
-        (let [page (first pages)]
-          (if (nil? page)
-            [rchanges uchanges]
-            (let [[page-rchanges page-uchanges]
-                  (generate-sync-components-page file-id page components)]
-              (recur (next pages)
-                     (concat rchanges page-rchanges)
-                     (concat uchanges page-uchanges)))))))))
-
-(defn- generate-sync-components-page
-  [file-id page components]
-  (let [linked-shapes
-        (cph/select-objects #(and (some? (:component-id %))
-                                  (= (:component-file %) file-id))
-                            page)]
-    (loop [shapes (seq linked-shapes)
-           rchanges []
-           uchanges []]
-      (let [shape (first shapes)]
-        (if (nil? shape)
-          [rchanges uchanges]
-          (let [[shape-rchanges shape-uchanges]
-                (generate-sync-components-shape-and-children shape page components false)]
-            (recur (next shapes)
-                   (concat rchanges shape-rchanges)
-                   (concat uchanges shape-uchanges))))))))
-
-(defn- generate-sync-components-shape-and-children
-  [root-shape page components reset-touched?]
-  (let [objects (get page :objects)
-        all-shapes (cph/get-object-with-children (:id root-shape) objects)
-        component (get components (:component-id root-shape))
-        root-component (get-in component [:objects (:shape-ref root-shape)])]
-    (loop [shapes (seq all-shapes)
-           rchanges []
-           uchanges []]
-      (let [shape (first shapes)]
-        (if (nil? shape)
-          [rchanges uchanges]
-          (let [[shape-rchanges shape-uchanges]
-                (generate-sync-components-shape shape root-shape root-component page component reset-touched?)]
-            (recur (next shapes)
-                   (concat rchanges shape-rchanges)
-                   (concat uchanges shape-uchanges))))))))
-
-(defn- generate-sync-components-shape
-  [shape root-shape root-component page component reset-touched?]
-  (if (nil? component)
-    (remove-component-and-ref shape page)
-    (let [component-shape (get (:objects component) (:shape-ref shape))]
-      (if (nil? component-shape)
-        (remove-ref shape page)
-        (update-attrs shape
-                      component-shape
-                      root-shape
-                      root-component
-                      page
-                      reset-touched?)))))
-
-(defn- remove-component-and-ref
-  [shape page]
-  [[{:type :mod-obj
-     :page-id (:id page)
-     :id (:id shape)
-     :operations [{:type :set
-                   :attr :component-id
-                   :val nil}
-                  {:type :set
-                   :attr :component-file
-                   :val nil}
-                  {:type :set
-                   :attr :shape-ref
-                   :val nil}
-                  {:type :set-touched
-                   :touched nil}]}]
-   [{:type :mod-obj
-     :page-id (:id page)
-     :id (:id shape)
-     :operations [{:type :set
-                   :attr :component-id
-                   :val (:component-id shape)}
-                  {:type :set
-                   :attr :component-file
-                   :val (:component-file shape)}
-                  {:type :set
-                   :attr :shape-ref
-                   :val (:shape-ref shape)}
-                  {:type :set-touched
-                   :touched (:touched shape)}]}]])
-
-(defn- remove-ref
-  [shape page]
-  [[{:type :mod-obj
-     :page-id (:id page)
-     :id (:id shape)
-     :operations [{:type :set
-                   :attr :shape-ref
-                   :val nil}
-                  {:type :set-touched
-                   :touched nil}]}]
-   [{:type :mod-obj
-     :page-id (:id page)
-     :id (:id shape)
-     :operations [{:type :set
-                   :attr :shape-ref
-                   :val (:shape-ref shape)}
-                  {:type :set-touched
-                   :touched (:touched shape)}]}]])
-
-(defn- update-attrs
-  [shape component-shape root-shape root-component page reset-touched?]
-  (let [new-pos (calc-new-pos shape component-shape root-shape root-component)]
-    (loop [attrs (seq (keys cp/component-sync-attrs))
-           roperations [{:type :set
-                         :attr :x
-                         :val (:x new-pos)}
-                        {:type :set
-                         :attr :y
-                         :val (:y new-pos)}]
-           uoperations [{:type :set
-                         :attr :x
-                         :val (:x shape)}
-                        {:type :set
-                         :attr :y
-                         :val (:y shape)}]]
-
-      (let [attr (first attrs)]
-        (if (nil? attr)
-          (let [roperations (if reset-touched?
-                              (conj roperations
-                                    {:type :set-touched
-                                     :touched nil})
-                              roperations)
-
-                uoperations (if reset-touched?
-                              (conj uoperations
-                                    {:type :set-touched
-                                     :touched (:touched shape)})
-                              uoperations)
-
-                rchanges [{:type :mod-obj
-                           :page-id (:id page)
-                           :id (:id shape)
-                           :operations roperations}]
-                uchanges [{:type :mod-obj
-                           :page-id (:id page)
-                           :id (:id shape)
-                           :operations uoperations}]]
-            [rchanges uchanges])
-          (if-not (contains? shape attr)
-            (recur (next attrs)
-                   roperations
-                   uoperations)
-            (let [roperation {:type :set
-                              :attr attr
-                              :val (get component-shape attr)
-                              :ignore-touched true}
-                  uoperation {:type :set
-                              :attr attr
-                              :val (get shape attr)
-                              :ignore-touched true}
-
-                  attr-group (get cp/component-sync-attrs attr)
-                  touched    (get shape :touched #{})]
-              (if (or (not (touched attr-group)) reset-touched?)
-                (recur (next attrs)
-                       (conj roperations roperation)
-                       (conj uoperations uoperation))
-                (recur (next attrs)
-                       roperations
-                       uoperations)))))))))
-
-(defn- calc-new-pos
-  [shape component-shape root-shape root-component]
-  (let [root-pos           (gpt/point (:x root-shape) (:y root-shape))
-        root-component-pos (gpt/point (:x root-component) (:y root-component))
-        component-pos      (gpt/point (:x component-shape) (:y component-shape))
-        delta              (gpt/subtract component-pos root-component-pos)
-        shape-pos          (gpt/point (:x shape) (:y shape))
-        new-pos            (gpt/add root-pos delta)]
-    new-pos))
-
-(defn- generate-sync-colors-file
-  [state file-id]
-  (let [colors
-        (if (nil? file-id)
-          (get-in state [:workspace-data :colors])
-          (get-in state [:workspace-libraries file-id :data :colors]))]
-    (when (some? colors)
-      (loop [pages (seq (vals (get-in state [:workspace-data :pages-index])))
-             rchanges []
-             uchanges []]
-        (let [page (first pages)]
-          (if (nil? page)
-            [rchanges uchanges]
-            (let [[page-rchanges page-uchanges]
-                  (generate-sync-colors-page file-id page colors)]
-              (recur (next pages)
-                     (concat rchanges page-rchanges)
-                     (concat uchanges page-uchanges)))))))))
-
-(defn- generate-sync-colors-page
-  [file-id page colors]
-  (let [linked-color? (fn [shape]
-                        (some
-                          #(let [attr (name %)
-                                 attr-ref-id (keyword (str attr "-ref-id"))
-                                 attr-ref-file (keyword (str attr "-ref-file"))]
-                             (and (get shape attr-ref-id)
-                                  (= file-id (get shape attr-ref-file))))
-                          cp/color-sync-attrs))
-
-        linked-shapes (cph/select-objects linked-color? page)]
-    (loop [shapes (seq linked-shapes)
-           rchanges []
-           uchanges []]
-      (let [shape (first shapes)]
-        (if (nil? shape)
-          [rchanges uchanges]
-          (let [[shape-rchanges shape-uchanges]
-                (generate-sync-colors-shape shape page colors)]
-            (recur (next shapes)
-                   (concat rchanges shape-rchanges)
-                   (concat uchanges shape-uchanges))))))))
-
-(defn- generate-sync-colors-shape
-  [shape page colors]
-  (loop [attrs (seq cp/color-sync-attrs)
-         roperations []
-         uoperations []]
-    (let [attr (first attrs)]
-      (if (nil? attr)
-        (if (empty? roperations)
-          [[] []]
-          (let [rchanges [{:type :mod-obj
-                           :page-id (:id page)
-                           :id (:id shape)
-                           :operations roperations}]
-                uchanges [{:type :mod-obj
-                           :page-id (:id page)
-                           :id (:id shape)
-                           :operations uoperations}]]
-            [rchanges uchanges]))
-        (let [attr-ref-id (keyword (str (name attr) "-ref-id"))]
-          (if-not (contains? shape attr-ref-id)
-            (recur (next attrs)
-                   roperations
-                   uoperations)
-            (let [color (get colors (get shape attr-ref-id))
-                  roperation {:type :set
-                              :attr attr
-                              :val (:value color)
-                              :ignore-touched true}
-                  uoperation {:type :set
-                              :attr attr
-                              :val (get shape attr)
-                              :ignore-touched true}]
-              (recur (next attrs)
-                     (conj roperations roperation)
-                     (conj uoperations uoperation)))))))))
-

frontend/src/app/main/data/workspace/libraries_helpers.cljs

@@ -0,0 +1,435 @@
+;; 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/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns app.main.data.workspace.libraries-helpers
+  (:require
+   [app.common.data :as d]
+   [app.common.pages-helpers :as cph]
+   [app.common.geom.point :as gpt]
+   [app.common.pages :as cp]))
+
+(declare generate-sync-file-components)
+(declare generate-sync-page-components)
+(declare generate-sync-library-components)
+(declare generate-sync-component-components)
+(declare generate-sync-shape-and-children-components)
+(declare generate-sync-shape-components)
+(declare generate-sync-file-colors)
+(declare generate-sync-page-colors)
+(declare generate-sync-shape-colors)
+(declare remove-component-and-ref)
+(declare remove-ref)
+(declare update-attrs)
+(declare calc-new-pos)
+
+;; ---- Create a new component ----
+
+(defn make-component-shape
+  "Clone the shape and all children. Generate new ids and detach
+  from parent and frame. Update the original shapes to have links
+  to the new ones."
+  [shape objects]
+  (let [update-new-shape (fn [new-shape original-shape]
+                           (assoc new-shape :frame-id nil))
+
+        ;; If one of the original shape children already was a component
+        ;; instance, the 'instanceness' is copied into the new component,
+        ;; and the original shape now points to the new component.
+        update-original-shape (fn [original-shape new-shape]
+                                (cond-> original-shape
+                                  true
+                                  (assoc :shape-ref (:id new-shape))
+
+                                  (nil? (:parent-id new-shape))
+                                  (assoc :component-id (:id new-shape)
+                                         :component-file nil)
+
+                                  (some? (:parent-id new-shape))
+                                  (assoc :component-id nil
+                                         :component-file nil)))]
+
+    (cph/clone-object shape nil objects update-new-shape update-original-shape)))
+
+
+;; ---- Synchronize shapes with components
+
+(defn generate-sync-file-components
+  "Generate changes to synchronize all shapes in current file that are linked
+  to some component in the given library. All attributes of the components
+  that have changed, and whose group have not been touched in the linked shape,
+  will be copied to the shape. Any shape that is linked to a no-longer
+  existent component will be detached."
+  [state library-id]
+  (let [components
+        (if (nil? library-id)
+          (get-in state [:workspace-data :components])
+          (get-in state [:workspace-libraries library-id :data :components]))]
+    (if (nil? components)
+      [[] []]
+      (loop [pages (seq (vals (get-in state [:workspace-data :pages-index])))
+             rchanges []
+             uchanges []]
+        (let [page (first pages)]
+          (if (nil? page)
+            [rchanges uchanges]
+            (let [[page-rchanges page-uchanges]
+                  (generate-sync-page-components page library-id components)]
+              (recur (next pages)
+                     (concat rchanges page-rchanges)
+                     (concat uchanges page-uchanges)))))))))
+
+
+(defn generate-sync-page-components
+  "Generate changes to synchronize all shapes in a particular page.
+  Same considerations as above."
+  [page library-id components]
+  (let [objects       (get page :objects)
+        linked-shapes (cph/select-objects #(and (some? (:component-id %))
+                                                (= (:component-file %) library-id))
+                                          page)]
+    (loop [shapes (seq linked-shapes)
+           rchanges []
+           uchanges []]
+      (let [shape (first shapes)]
+        (if (nil? shape)
+          [rchanges uchanges]
+          (let [[shape-rchanges shape-uchanges]
+                (generate-sync-shape-and-children-components shape
+                                                             objects
+                                                             components
+                                                             (:id page)
+                                                             nil
+                                                             false)]
+            (recur (next shapes)
+                   (concat rchanges shape-rchanges)
+                   (concat uchanges shape-uchanges))))))))
+
+
+(defn generate-sync-library-components
+  "Generate changes to synchronize all shapes inside components of the current
+  file library, that are linked to other component in the given library.
+  Same considerations as above."
+  [state library-id]
+  (let [components
+        (if (nil? library-id)
+          (get-in state [:workspace-data :components])
+          (get-in state [:workspace-libraries library-id :data :components]))]
+    (if (nil? components)
+      [[] []]
+      (loop [local-components (seq (vals (get-in state [:workspace-data :components])))
+             rchanges []
+             uchanges []]
+        (let [local-component (first local-components)]
+          (if (nil? local-component)
+            [rchanges uchanges]
+            (let [[comp-rchanges comp-uchanges]
+                  (generate-sync-component-components
+                    local-component library-id components)]
+              (recur (next local-components)
+                     (concat rchanges comp-rchanges)
+                     (concat uchanges comp-uchanges)))))))))
+
+
+(defn generate-sync-component-components
+  "Generate changes to synchronize all shapes in a particular component.
+  Same considerations as above."
+  [local-component library-id components]
+  (let [objects       (get local-component :objects)
+        linked-shapes (filter #(and (some? (:component-id %))
+                                    (= (:component-file %) library-id))
+                              (vals objects))]
+    (loop [shapes (seq linked-shapes)
+           rchanges []
+           uchanges []]
+      (let [shape (first shapes)]
+        (if (nil? shape)
+          [rchanges uchanges]
+          (let [[shape-rchanges shape-uchanges]
+                (generate-sync-shape-and-children-components shape
+                                                             objects
+                                                             components
+                                                             nil
+                                                             (:id local-component)
+                                                             false)]
+            (recur (next shapes)
+                   (concat rchanges shape-rchanges)
+                   (concat uchanges shape-uchanges))))))))
+
+
+(defn generate-sync-shape-and-children-components
+  "Generate changes to synchronize one shape that is linked to a component,
+  and all its children. If reset-touched? is false, same considerations as
+  above. If it's true, all attributes of the component that have changed
+  will be copied, and the 'touched' flags in the shapes will be cleared."
+  [root-shape objects components page-id component-id reset-touched?]
+  (let [all-shapes (cph/get-object-with-children (:id root-shape) objects)
+        component (get components (:component-id root-shape))
+        root-component (get-in component [:objects (:shape-ref root-shape)])]
+    (loop [shapes (seq all-shapes)
+           rchanges []
+           uchanges []]
+      (let [shape (first shapes)]
+        (if (nil? shape)
+          [rchanges uchanges]
+          (let [[shape-rchanges shape-uchanges]
+                (generate-sync-shape-components
+                  shape
+                  root-shape
+                  root-component
+                  component
+                  page-id
+                  component-id
+                  reset-touched?)]
+            (recur (next shapes)
+                   (concat rchanges shape-rchanges)
+                   (concat uchanges shape-uchanges))))))))
+
+(defn generate-sync-shape-components
+  "Generate changes to synchronize one shape that is linked to other shape
+  inside a component. Same considerations as above about reset-touched?"
+  [shape root-shape root-component component page-id component-id reset-touched?]
+  (if (nil? component)
+    (remove-component-and-ref shape page-id component-id)
+    (let [component-shape (get (:objects component) (:shape-ref shape))]
+      (if (nil? component-shape)
+        (remove-ref shape page-id component-id)
+        (update-attrs shape
+                      component-shape
+                      root-shape
+                      root-component
+                      page-id
+                      component-id
+                      reset-touched?)))))
+
+(defn remove-component-and-ref
+  [shape page-id component-id]
+  [[(d/without-nils {:type :mod-obj
+                     :id (:id shape)
+                     :page-id page-id
+                     :component-id component-id
+                     :operations [{:type :set
+                                   :attr :component-id
+                                   :val nil}
+                                  {:type :set
+                                   :attr :component-file
+                                   :val nil}
+                                  {:type :set
+                                   :attr :shape-ref
+                                   :val nil}
+                                  {:type :set-touched
+                                   :touched nil}]})]
+   [(d/without-nils {:type :mod-obj
+                     :id (:id shape)
+                     :page-id page-id
+                     :component-id component-id
+                     :operations [{:type :set
+                                   :attr :component-id
+                                   :val (:component-id shape)}
+                                  {:type :set
+                                   :attr :component-file
+                                   :val (:component-file shape)}
+                                  {:type :set
+                                   :attr :shape-ref
+                                   :val (:shape-ref shape)}
+                                  {:type :set-touched
+                                   :touched (:touched shape)}]})]])
+
+(defn remove-ref
+  [shape page-id component-id]
+  [[(d/without-nils {:type :mod-obj
+                     :id (:id shape)
+                     :page-id page-id
+                     :component-id component-id
+                     :operations [{:type :set
+                                   :attr :shape-ref
+                                   :val nil}
+                                  {:type :set-touched
+                                   :touched nil}]})]
+   [(d/without-nils {:type :mod-obj
+                     :id (:id shape)
+                     :page-id page-id
+                     :component-id component-id
+                     :operations [{:type :set
+                                   :attr :shape-ref
+                                   :val (:shape-ref shape)}
+                                  {:type :set-touched
+                                   :touched (:touched shape)}]})]])
+
+(defn update-attrs
+  "The main function that implements the sync algorithm."
+  [shape component-shape root-shape root-component page-id component-id reset-touched?]
+
+  ;; === Uncomment this to debug synchronization ===
+  ;; (println "SYNC"
+  ;;          "[C]" (:name component-shape)
+  ;;          "->"
+  ;;          (if page-id "[W]" ["C"])
+  ;;          (:name shape))
+
+  (let [; The position attributes need a special sync algorith, because we do
+        ; not synchronize the absolute position, but the position relative of
+        ; the container shape of the component.
+        new-pos   (calc-new-pos shape component-shape root-shape root-component)
+        pos-group (get cp/component-sync-attrs :x)
+        touched   (get shape :touched #{})]
+
+    (loop [attrs (seq (keys (dissoc cp/component-sync-attrs :x :y)))
+           roperations (if (or (not (touched pos-group)) reset-touched? true)
+                         [{:type :set :attr :x :val (:x new-pos)}        ; ^ TODO: the position-group is being set
+                          {:type :set :attr :y :val (:y new-pos)}]       ; | as touched somewhere. Investigate why.
+                         [])
+           uoperations (if (or (not (touched pos-group)) reset-touched? true)
+                         [{:type :set :attr :x :val (:x shape)}
+                          {:type :set :attr :y :val (:y shape)}]
+                         [])]
+
+      (let [attr (first attrs)]
+        (if (nil? attr)
+          (let [roperations (if reset-touched?
+                              (conj roperations
+                                    {:type :set-touched
+                                     :touched nil})
+                              roperations)
+
+                uoperations (if reset-touched?
+                              (conj uoperations
+                                    {:type :set-touched
+                                     :touched (:touched shape)})
+                              uoperations)
+
+                rchanges [(d/without-nils {:type :mod-obj
+                                           :id (:id shape)
+                                           :page-id page-id
+                                           :component-id component-id
+                                           :operations roperations})]
+                uchanges [(d/without-nils {:type :mod-obj
+                                           :id (:id shape)
+                                           :page-id page-id
+                                           :component-id component-id
+                                           :operations uoperations})]]
+            [rchanges uchanges])
+
+          (if-not (contains? shape attr)
+            (recur (next attrs)
+                   roperations
+                   uoperations)
+            (let [roperation {:type :set
+                              :attr attr
+                              :val (get component-shape attr)
+                              :ignore-touched true}
+                  uoperation {:type :set
+                              :attr attr
+                              :val (get shape attr)
+                              :ignore-touched true}
+
+                  attr-group (get cp/component-sync-attrs attr)]
+              (if (or (not (touched attr-group)) reset-touched?)
+                (recur (next attrs)
+                       (conj roperations roperation)
+                       (conj uoperations uoperation))
+                (recur (next attrs)
+                       roperations
+                       uoperations)))))))))
+
+(defn calc-new-pos
+  [shape component-shape root-shape root-component]
+  (let [root-pos           (gpt/point (:x root-shape) (:y root-shape))
+        root-component-pos (gpt/point (:x root-component) (:y root-component))
+        component-pos      (gpt/point (:x component-shape) (:y component-shape))
+        delta              (gpt/subtract component-pos root-component-pos)
+        shape-pos          (gpt/point (:x shape) (:y shape))
+        new-pos            (gpt/add root-pos delta)]
+    new-pos))
+
+
+;; ---- Synchronize shapes with colors
+
+(defn generate-sync-file-colors
+  "Generate changes to synchronize all shapes in current file that have
+  any color linked to some color in the given library."
+  [state library-id]
+  (let [colors
+        (if (nil? library-id)
+          (get-in state [:workspace-data :colors])
+          (get-in state [:workspace-libraries library-id :data :colors]))]
+    (when (some? colors)
+      (loop [pages (seq (vals (get-in state [:workspace-data :pages-index])))
+             rchanges []
+             uchanges []]
+        (let [page (first pages)]
+          (if (nil? page)
+            [rchanges uchanges]
+            (let [[page-rchanges page-uchanges]
+                  (generate-sync-page-colors library-id page colors)]
+              (recur (next pages)
+                     (concat rchanges page-rchanges)
+                     (concat uchanges page-uchanges)))))))))
+
+(defn generate-sync-page-colors
+  "Generate changes to synchronize all shapes in a particular page."
+  [library-id page colors]
+  (let [linked-color? (fn [shape]
+                        (some
+                          #(let [attr (name %)
+                                 attr-ref-id (keyword (str attr "-ref-id"))
+                                 attr-ref-file (keyword (str attr "-ref-file"))]
+                             (and (get shape attr-ref-id)
+                                  (= library-id (get shape attr-ref-file))))
+                          cp/color-sync-attrs))
+
+        linked-shapes (cph/select-objects linked-color? page)]
+    (loop [shapes (seq linked-shapes)
+           rchanges []
+           uchanges []]
+      (let [shape (first shapes)]
+        (if (nil? shape)
+          [rchanges uchanges]
+          (let [[shape-rchanges shape-uchanges]
+                (generate-sync-shape-colors shape page colors)]
+            (recur (next shapes)
+                   (concat rchanges shape-rchanges)
+                   (concat uchanges shape-uchanges))))))))
+
+(defn generate-sync-shape-colors
+  "Generate changes to synchronize colors of one shape."
+  [shape page colors]
+  (loop [attrs (seq cp/color-sync-attrs)
+         roperations []
+         uoperations []]
+    (let [attr (first attrs)]
+      (if (nil? attr)
+        (if (empty? roperations)
+          [[] []]
+          (let [rchanges [{:type :mod-obj
+                           :page-id (:id page)
+                           :id (:id shape)
+                           :operations roperations}]
+                uchanges [{:type :mod-obj
+                           :page-id (:id page)
+                           :id (:id shape)
+                           :operations uoperations}]]
+            [rchanges uchanges]))
+        (let [attr-ref-id (keyword (str (name attr) "-ref-id"))]
+          (if-not (contains? shape attr-ref-id)
+            (recur (next attrs)
+                   roperations
+                   uoperations)
+            (let [color (get colors (get shape attr-ref-id))
+                  roperation {:type :set
+                              :attr attr
+                              :val (:value color)
+                              :ignore-touched true}
+                  uoperation {:type :set
+                              :attr attr
+                              :val (get shape attr)
+                              :ignore-touched true}]
+              (recur (next attrs)
+                     (conj roperations roperation)
+                     (conj uoperations uoperation)))))))))
+

frontend/src/app/main/store.cljs

@@ -9,6 +9,9 @@
    [beicon.core :as rx]
    [okulary.core :as l]
    [potok.core :as ptk]
+   [cuerdas.core :as str]
+   [app.common.data :as d]
+   [app.common.pages-helpers :as cph]
    [app.common.uuid :as uuid]
    [app.util.storage :refer [storage]]
    [app.util.debug :refer [debug? logjs]]))
@@ -72,3 +75,51 @@
 (defn ^:export dump-objects []
   (let [page-id (get @state :current-page-id)]
     (logjs "state" (get-in @state [:workspace-data :pages-index page-id :objects]))))
+
+(defn ^:export dump-tree []
+  (let [page-id    (get @state :current-page-id)
+        objects    (get-in @state [:workspace-data :pages-index page-id :objects])
+        components (get-in @state [:workspace-data :components])
+        libraries  (get-in @state [:workspace-libraries])
+        root (d/seek #(nil? (:parent-id %)) (vals objects))]
+
+    (letfn [(show-shape [shape-id level objects]
+              (let [shape (get objects shape-id)]
+                (println (str/pad (str (str/repeat "  " level)
+                                       (:name shape))
+                                  {:length 20
+                                   :type :right})
+                         (show-component shape objects))
+                (when (:shapes shape)
+                  (dorun (for [shape-id (:shapes shape)]
+                           (show-shape shape-id (inc level) objects))))))
+
+            (show-component [shape objects]
+              (let [root-id           (cph/get-root-component (:id shape) objects)
+                    root-shape        (when root-id (get objects root-id))
+                    component-id      (when root-shape (:component-id root-shape))
+                    component-file-id (when root-shape (:component-file root-shape))
+                    component-file    (when component-file-id (get libraries component-file-id))
+                    shape-ref         (:shape-ref shape)
+                    component         (when component-id
+                                        (if component-file
+                                          (get-in component-file [:data :components component-id])
+                                          (get components component-id)))
+                    component-shape (when (and component shape-ref)
+                                      (get-in component [:objects shape-ref]))]
+                (if component-shape
+                  (str/format " %s--> %s%s"
+                       (if (:component-id shape) "#" "-")
+                       (when component-file (str/format "<%s> " (:name component-file)))
+                       (:name component-shape))
+                  "")))]
+
+      (println "[Workspace]")
+      (show-shape (:id root) 0 objects)
+
+      (dorun (for [component (vals components)]
+               (do
+                 (println)
+                 (println (str/format "[%s]" (:name component)))
+                 (show-shape (:id component) 0 (:objects component))))))))
+

frontend/src/app/util/data.cljs

@@ -25,7 +25,7 @@
 
 (def index-by-id #(index-by :id %))
 
-(defn remove-nil-vals
+(defn without-nils
   "Given a map, return a map removing key-value
   pairs when value is `nil`."
   [data]

frontend/src/app/util/router.cljs

@@ -52,7 +52,7 @@
        (r/match->path match)
        (let [uri (.parse goog.Uri (r/match->path match))
              qdt (.createFromMap QueryData (-> qparams
-                                               (d/remove-nil-vals)
+                                               (d/without-nils)
                                                (clj->js)))]
          (.setQueryData ^js uri qdt)
          (.toString ^js uri))))))