Merge pull request #1619 from penpot/use-changes-builder

🔧 Refactor to use changes-builder

common/src/app/common/pages/changes_builder.cljc

@@ -31,11 +31,86 @@
 (defn with-objects [changes objects]
   (vary-meta changes assoc ::objects objects))
 
+(defn amend-last-change
+  "Modify the last redo-changes added with an update function."
+  [changes f]
+  (update changes :redo-changes
+          #(conj (pop %) (f (peek %)))))
+
+(defn amend-changes
+  "Modify all redo-changes with an update function."
+  [changes f]
+  (update changes :redo-changes #(mapv f %)))
+
+(defn- assert-page-id
+  [changes]
+  (assert (contains? (meta changes) ::page-id) "Give a page-id or call (with-page) before using this function"))
+
+(defn- assert-page
+  [changes]
+  (assert (contains? (meta changes) ::page) "Call (with-page) before using this function"))
+
+(defn- assert-objects
+  [changes]
+  (assert (contains? (meta changes) ::objects) "Call (with-objects) before using this function"))
+
+;; Page changes
+
+(defn add-empty-page
+  [changes id name]
+  (-> changes
+      (update :redo-changes conj {:type :add-page :id id :name name})
+      (update :undo-changes conj {:type :del-page :id id})))
+
+(defn add-page
+  [changes id page]
+  (-> changes
+      (update :redo-changes conj {:type :add-page :id id :page page})
+      (update :undo-changes conj {:type :del-page :id id})))
+
+(defn mod-page
+  [changes page new-name]
+  (-> changes
+      (update :redo-changes conj {:type :mod-page :id (:id page) :name new-name})
+      (update :undo-changes conj {:type :mod-page :id (:id page) :name (:name page)})))
+
+(defn del-page
+  [changes page]
+  (-> changes
+      (update :redo-changes conj {:type :del-page :id (:id page)})
+      (update :undo-changes conj {:type :add-page :id (:id page) :page page})))
+
+(defn move-page
+  [changes page-id index prev-index]
+  (-> changes
+      (update :redo-changes conj {:type :mov-page :id page-id :index index})
+      (update :undo-changes conj {:type :mov-page :id page-id :index prev-index})))
+
+(defn set-page-option
+  [changes option-key option-val]
+  (assert-page changes)
+  (let [page-id (::page-id (meta changes))
+        page (::page (meta changes))
+        old-val (get-in page [:options option-key])]
+
+    (-> changes
+        (update :redo-changes conj {:type :set-option
+                                    :page-id page-id
+                                    :option option-key
+                                    :value option-val})
+        (update :undo-changes conj {:type :set-option
+                                    :page-id page-id
+                                    :option option-key
+                                    :value old-val}))))
+
+;; Shape tree changes
+
 (defn add-obj
   ([changes obj]
    (add-obj changes obj nil))
 
   ([changes obj {:keys [index ignore-touched] :or {index ::undefined ignore-touched false}}]
+   (assert-page-id changes)
    (let [obj (cond-> obj
                (not= index ::undefined)
                (assoc :index index))
@@ -60,10 +135,12 @@
          (update :undo-changes d/preconj del-change)))))
 
 (defn change-parent
-  ([changes parent-id shapes] (change-parent changes parent-id shapes nil))
+  ([changes parent-id shapes]
-  ([changes parent-id shapes index]
+   (change-parent changes parent-id shapes nil))
-   (assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
 
+  ([changes parent-id shapes index]
+   (assert-page-id changes)
+   (assert-objects changes)
    (let [objects (::objects (meta changes))
          set-parent-change
          (cond-> {:type :mov-objects
@@ -88,18 +165,6 @@
          (update :redo-changes conj set-parent-change)
          (update :undo-changes #(reduce mk-undo-change % shapes))))))
 
-(defn- generate-operation
-  "Given an object old and new versions and an attribute will append into changes
-  the set and undo operations"
-  [changes attr old new ignore-geometry?]
-  (let [old-val (get old attr)
-        new-val (get new attr)]
-    (if (= old-val new-val)
-      changes
-      (-> changes
-          (update :rops conj {:type :set :attr attr :val new-val :ignore-geometry ignore-geometry?})
-          (update :uops conj {:type :set :attr attr :val old-val :ignore-touched true})))))
-
 (defn update-shapes
   "Calculate the changes and undos to be done when a function is applied to a
   single object"
@@ -107,9 +172,20 @@
    (update-shapes changes ids update-fn nil))
 
   ([changes ids update-fn {:keys [attrs ignore-geometry?] :or {attrs nil ignore-geometry? false}}]
-   (assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
+   (assert-page-id changes)
+   (assert-objects changes)
    (let [objects (::objects (meta changes))
 
+         generate-operation
+         (fn [changes attr old new ignore-geometry?]
+           (let [old-val (get old attr)
+                 new-val (get new attr)]
+             (if (= old-val new-val)
+               changes
+               (-> changes
+                   (update :rops conj {:type :set :attr attr :val new-val :ignore-geometry ignore-geometry?})
+                   (update :uops conj {:type :set :attr attr :val old-val :ignore-touched true})))))
+
          update-shape
          (fn [changes id]
            (let [old-obj (get objects id)
@@ -141,7 +217,8 @@
 
 (defn remove-objects
   [changes ids]
-  (assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
+  (assert-page-id changes)
+  (assert-objects changes)
   (let [page-id (::page-id (meta changes))
         objects (::objects (meta changes))
 
@@ -162,6 +239,7 @@
               :parent-id (:frame-id shape)
               :frame-id (:frame-id shape)
               :id id
+              :index (cph/get-position-on-parent objects (:id shape))
               :obj (cond-> shape
                      (contains? shape :shapes)
                      (assoc :shapes []))})))
@@ -184,44 +262,12 @@
                                  (reduce add-undo-change-parent $ ids)
                                  (reduce add-undo-change-shape $ ids))))))
 
-(defn move-page
+(defn resize-parents
-  [chdata index prev-index]
+  [changes ids]
-  (let [page-id (::page-id (meta chdata))]
+  (assert-page-id changes)
-    (-> chdata
+  (let [page-id (::page-id (meta changes))
-        (update :redo-changes conj {:type :mov-page :id page-id :index index})
+        shapes  (vec ids)]
-        (update :undo-changes conj {:type :mov-page :id page-id :index prev-index}))))
+        (-> changes
-
+            (update :redo-changes conj {:type :reg-objects :page-id page-id :shapes shapes})
-(defn set-page-option
+            (update :undo-changes conj {:type :reg-objects :page-id page-id :shapes shapes}))))
-  [chdata option-key option-val]
-  (let [page-id (::page-id (meta chdata))
-        page (::page (meta chdata))
-        old-val (get-in page [:options option-key])]
-
-    (-> chdata
-        (update :redo-changes conj {:type :set-option
-                                    :page-id page-id
-                                    :option option-key
-                                    :value option-val})
-        (update :undo-changes conj {:type :set-option
-                                    :page-id page-id
-                                    :option option-key
-                                    :value old-val}))))
-
-(defn reg-objects
-  [chdata shape-ids]
-  (let [page-id (::page-id (meta chdata))]
-    (-> chdata
-        (update :redo-changes conj {:type :reg-objects :page-id page-id :shapes shape-ids}))))
-        ;; No need to do anything to undo
-
-(defn amend-last-change
-  "Modify the last redo-changes added with an update function."
-  [chdata f]
-  (update chdata :redo-changes
-          #(conj (pop %) (f (peek %)))))
-
-(defn amend-changes
-  "Modify all redo-changes with an update function."
-  [chdata f]
-  (update chdata :redo-changes #(mapv f %)))
 

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

@@ -320,14 +320,10 @@
               unames  (dwc/retrieve-used-names pages)
               name    (dwc/generate-unique-name unames "Page-1")
 
-              rchange {:type :add-page
+              changes (-> (pcb/empty-changes it)
-                       :id id
+                          (pcb/add-empty-page id name))]
-                       :name name}
+
-              uchange {:type :del-page
+          (rx/of (dch/commit-changes changes)))))))
-                       :id id}]
-          (rx/of (dch/commit-changes {:redo-changes [rchange]
-                                      :undo-changes [uchange]
-                                      :origin it})))))))
 
 (defn duplicate-page
   [page-id]
@@ -342,13 +338,10 @@
 
             page (-> page (assoc :name name :id id))
 
-            rchange {:type :add-page
+            changes (-> (pcb/empty-changes it)
-                     :page page}
+                        (pcb/add-page id page))]
-            uchange {:type :del-page
+
-                     :id id}]
+        (rx/of (dch/commit-changes changes))))))
-        (rx/of (dch/commit-changes {:redo-changes [rchange]
-                                    :undo-changes [uchange]
-                                    :origin it}))))))
 
 (s/def ::rename-page
   (s/keys :req-un [::id ::name]))
@@ -360,33 +353,26 @@
   (ptk/reify ::rename-page
     ptk/WatchEvent
     (watch [it state _]
-      (let [page (get-in state [:workspace-data :pages-index id])
+      (let [page    (get-in state [:workspace-data :pages-index id])
-            rchg {:type :mod-page
+            changes (-> (pcb/empty-changes it)
-                  :id id
+                        (pcb/mod-page page name))]
-                  :name name}
+
-            uchg {:type :mod-page
+        (rx/of (dch/commit-changes changes))))))
-                  :id id
-                  :name (:name page)}]
-        (rx/of (dch/commit-changes {:redo-changes [rchg]
-                                    :undo-changes [uchg]
-                                    :origin it}))))))
 
 (declare purge-page)
 (declare go-to-file)
 
-;; TODO: for some reason, the page-id here in some circumstances is `nil`
 (defn delete-page
   [id]
   (ptk/reify ::delete-page
     ptk/WatchEvent
     (watch [it state _]
       (let [page (get-in state [:workspace-data :pages-index id])
-            rchg {:type :del-page :id id}
-            uchg {:type :add-page :page page}]
 
-        (rx/of (dch/commit-changes {:redo-changes [rchg]
+            changes (-> (pcb/empty-changes it)
-                                    :undo-changes [uchg]
+                        (pcb/del-page page))]
-                                    :origin it})
+
+        (rx/of (dch/commit-changes changes)
                (when (= id (:current-page-id state))
                  go-to-file))))))
 
@@ -773,249 +759,93 @@
   (ptk/reify ::vertical-order-selected
     ptk/WatchEvent
     (watch [it state _]
-      (let [page-id  (:current-page-id state)
+      (let [page-id         (:current-page-id state)
-            objects  (wsh/lookup-page-objects state page-id)
+            objects         (wsh/lookup-page-objects state page-id)
-            selected (wsh/lookup-selected state)
+            selected-shapes (->> (wsh/lookup-selected state)
-            rchanges (mapv (fn [id]
+                                 (map (d/getf objects)))
-                             (let [obj (get objects id)
-                                   parent (get objects (:parent-id obj))
-                                   shapes (:shapes parent)
-                                   cindex (d/index-of shapes id)
-                                   nindex (case loc
-                                            :top (count shapes)
-                                            :down (max 0 (- cindex 1))
-                                            :up (min (count shapes) (+ (inc cindex) 1))
-                                            :bottom 0)]
-                               {:type :mov-objects
-                                :parent-id (:parent-id obj)
-                                :frame-id (:frame-id obj)
-                                :page-id page-id
-                                :index nindex
-                                :shapes [id]}))
-                           selected)
 
-            uchanges (mapv (fn [id]
+            move-shape
-                             (let [obj (get objects id)]
+            (fn [changes shape]
-                               {:type :mov-objects
+              (let [parent        (get objects (:parent-id shape))
-                                :parent-id (:parent-id obj)
+                    sibling-ids   (:shapes parent)
-                                :frame-id (:frame-id obj)
+                    current-index (d/index-of sibling-ids (:id shape))
-                                :page-id page-id
+                    new-index     (case loc
-                                :shapes [id]
+                                    :top (count sibling-ids)
-                                :index (cph/get-position-on-parent objects id)}))
+                                    :down (max 0 (- current-index 1))
-                           selected)]
+                                    :up (min (count sibling-ids) (+ (inc current-index) 1))
-        ;; TODO: maybe missing the :reg-objects event?
+                                    :bottom 0)]
-        (rx/of (dch/commit-changes {:redo-changes rchanges
+                (pcb/change-parent changes
-                                    :undo-changes uchanges
+                                   (:id parent)
-                                    :origin it}))))))
+                                   [shape]
+                                   new-index)))
+
+            changes (reduce move-shape
+                            (-> (pcb/empty-changes it page-id)
+                                (pcb/with-objects objects))
+                            selected-shapes)]
+
+        (rx/of (dch/commit-changes changes))))))
 
 
 ;; --- Change Shape Order (D&D Ordering)
 
-(defn relocate-shapes-changes [objects parents parent-id page-id to-index ids
+(defn relocate-shapes-changes [it objects parents parent-id page-id to-index ids
                                groups-to-delete groups-to-unmask shapes-to-detach
                                shapes-to-reroot shapes-to-deroot shapes-to-unconstraint]
-  (let [;; Changes to the shapes that are being move
+  (let [shapes (map (d/getf objects) ids)]
-        r-mov-change
-        [{:type :mov-objects
-          :parent-id parent-id
-          :page-id page-id
-          :index to-index
-          :shapes (vec (reverse ids))}]
 
-        u-mov-change
+    (-> (pcb/empty-changes it page-id)
-        (map (fn [id]
+        (pcb/with-objects objects)
-               (let [obj (get objects id)]
-                 {:type :mov-objects
-                  :parent-id (:parent-id obj)
-                  :page-id page-id
-                  :index (cph/get-position-on-parent objects id)
-                  :shapes [id]}))
-             (reverse ids))
 
-        ;; Changes deleting empty groups
+        ; Move the shapes
-        r-del-change
+        (pcb/change-parent parent-id
-        (map (fn [group-id]
+                           (reverse shapes)
-               {:type :del-obj
+                           to-index)
-                :page-id page-id
-                :id group-id})
-             groups-to-delete)
 
-        u-del-change
+        ; Remove empty groups
-        (concat
+        (pcb/remove-objects groups-to-delete)
-         ;; Create the groups
-         (map (fn [group-id]
-                (let [group (get objects group-id)]
-                  {:type :add-obj
-                   :page-id page-id
-                   :parent-id parent-id
-                   :frame-id (:frame-id group)
-                   :id group-id
-                   :obj (-> group
-                            (assoc :shapes []))}))
-              groups-to-delete)
-         ;; Creates the hierarchy
-         (map (fn [group-id]
-                (let [group (get objects group-id)]
-                  {:type :mov-objects
-                   :page-id page-id
-                   :parent-id (:id group)
-                   :shapes (:shapes group)}))
-              groups-to-delete))
 
-        ;; Changes removing the masks from the groups without mask shape
+        ; Unmask groups whose mask have moved outside
-        r-mask-change
+        (pcb/update-shapes groups-to-unmask
-        (map (fn [group-id]
+                           (fn [shape]
-               {:type :mod-obj
+                             (assoc shape :masked-group? false)))
-                :page-id page-id
-                :id group-id
-                :operations [{:type :set
-                              :attr :masked-group?
-                              :val false}]})
-             groups-to-unmask)
 
-        u-mask-change
+        ; Detach shapes moved out of their component
-        (map (fn [group-id]
+        (pcb/update-shapes shapes-to-detach
-               (let [group (get objects group-id)]
+                           (fn [shape]
-                 {:type :mod-obj
+                             (assoc shape :component-id nil
-                  :page-id page-id
+                                          :component-file nil
-                  :id group-id
+                                          :component-root? nil
-                  :operations [{:type :set
+                                          :remote-synced? nil
-                                :attr :masked-group?
+                                          :shape-ref nil
-                                :val (:masked-group? group)}]}))
+                                          :touched nil)))
-             groups-to-unmask)
 
-        ;; Changes to the components metadata
+        ; Make non root a component moved inside another one
+        (pcb/update-shapes shapes-to-deroot
+                           (fn [shape]
+                             (assoc shape :component-root? nil)))
 
-        detach-keys [:component-id :component-file :component-root? :remote-synced? :shape-ref :touched]
+        ; Make root a subcomponent moved outside its parent component
+        (pcb/update-shapes shapes-to-reroot
+                           (fn [shape]
+                             (assoc shape :component-root? true)))
 
-        r-detach-change
+        ; Reset constraints depending on the new parent
-        (map (fn [id]
+        (pcb/update-shapes shapes-to-unconstraint
-               {:type :mod-obj
+                           (fn [shape]
-                :page-id page-id
+                             (let [parent      (get objects parent-id)
-                :id id
+                                   frame-id    (if (= (:type parent) :frame)
-                :operations (mapv #(hash-map :type :set :attr % :val nil) detach-keys)})
+                                                 (:id parent)
-             shapes-to-detach)
+                                                 (:frame-id parent))
+                                   moved-shape (assoc shape
+                                                      :parent-id parent-id
+                                                      :frame-id frame-id)]
+                               (assoc shape :constraints-h (gsh/default-constraints-h moved-shape)
+                                            :constraints-v (gsh/default-constraints-v moved-shape))))
+                           {:ignore-touched true})
 
-        u-detach-change
+        ; Resize parent containers that need to
-        (map (fn [id]
+        (pcb/resize-parents parents))))
-               (let [obj (get objects id)]
-                 {:type :mod-obj
-                  :page-id page-id
-                  :id id
-                  :operations (mapv #(hash-map :type :set :attr % :val (get obj %)) detach-keys)}))
-             shapes-to-detach)
-
-        r-deroot-change
-        (map (fn [id]
-               {:type :mod-obj
-                :page-id page-id
-                :id id
-                :operations [{:type :set
-                              :attr :component-root?
-                              :val nil}]})
-             shapes-to-deroot)
-
-        u-deroot-change
-        (map (fn [id]
-               {:type :mod-obj
-                :page-id page-id
-                :id id
-                :operations [{:type :set
-                              :attr :component-root?
-                              :val true}]})
-             shapes-to-deroot)
-
-        r-reroot-change
-        (map (fn [id]
-               {:type :mod-obj
-                :page-id page-id
-                :id id
-                :operations [{:type :set
-                              :attr :component-root?
-                              :val true}]})
-             shapes-to-reroot)
-
-        u-reroot-change
-        (map (fn [id]
-               {:type :mod-obj
-                :page-id page-id
-                :id id
-                :operations [{:type :set
-                              :attr :component-root?
-                              :val nil}]})
-             shapes-to-reroot)
-
-
-        ;; Changes resetting constraints
-
-        r-unconstraint-change
-        (map (fn [id]
-               (let [obj      (get objects id)
-                     parent   (get objects parent-id)
-                     frame-id (if (= (:type parent) :frame)
-                                (:id parent)
-                                (:frame-id parent))]
-                 {:type :mod-obj
-                  :page-id page-id
-                  :id id
-                  :operations [{:type :set
-                                :attr :constraints-h
-                                :val (gsh/default-constraints-h
-                                      (assoc obj :parent-id parent-id :frame-id frame-id))
-                                :ignore-touched true}
-                               {:type :set
-                                :attr :constraints-v
-                                :val (gsh/default-constraints-v
-                                      (assoc obj :parent-id parent-id :frame-id frame-id))
-                                :ignore-touched true}]}))
-             shapes-to-unconstraint)
-
-        u-unconstraint-change
-        (map (fn [id]
-               (let [obj (get objects id)]
-                 {:type :mod-obj
-                  :page-id page-id
-                  :id id
-                  :operations [{:type :set
-                                :attr :constraints-h
-                                :val (:constraints-h obj)
-                                :ignore-touched true}
-                               {:type :set
-                                :attr :constraints-v
-                                :val (:constraints-v obj)
-                                :ignore-touched true}]}))
-             shapes-to-unconstraint)
-
-        r-reg-change
-        [{:type :reg-objects
-          :page-id page-id
-          :shapes (vec parents)}]
-
-        u-reg-change
-        [{:type :reg-objects
-          :page-id page-id
-          :shapes (vec parents)}]
-
-        rchanges (d/concat-vec
-                  r-mov-change
-                  r-del-change
-                  r-mask-change
-                  r-detach-change
-                  r-deroot-change
-                  r-reroot-change
-                  r-unconstraint-change
-                  r-reg-change)
-
-        uchanges (d/concat-vec
-                  u-del-change
-                  u-reroot-change
-                  u-deroot-change
-                  u-detach-change
-                  u-mask-change
-                  u-mov-change
-                  u-unconstraint-change
-                  u-reg-change)]
-    [rchanges uchanges]))
 
 (defn relocate-shapes
   [ids parent-id to-index]
@@ -1114,23 +944,21 @@
                     [[] [] []]
                     ids)
 
-            [rchanges uchanges]
+            changes (relocate-shapes-changes it
-            (relocate-shapes-changes objects
+                                             objects
-                                     parents
+                                             parents
-                                     parent-id
+                                             parent-id
-                                     page-id
+                                             page-id
-                                     to-index
+                                             to-index
-                                     ids
+                                             ids
-                                     groups-to-delete
+                                             groups-to-delete
-                                     groups-to-unmask
+                                             groups-to-unmask
-                                     shapes-to-detach
+                                             shapes-to-detach
-                                     shapes-to-reroot
+                                             shapes-to-reroot
-                                     shapes-to-deroot
+                                             shapes-to-deroot
-                                     ids)]
+                                             ids)]
 
-        (rx/of (dch/commit-changes {:redo-changes rchanges
+        (rx/of (dch/commit-changes changes)
-                                    :undo-changes uchanges
-                                    :origin it})
                (dwc/expand-collapse parent-id))))))
 
 (defn relocate-selected-shapes
@@ -1177,8 +1005,8 @@
     (watch [it state _]
       (let [prev-index (-> (get-in state [:workspace-data :pages])
                            (d/index-of id))
-            changes    (-> (pcb/empty-changes it id)
+            changes    (-> (pcb/empty-changes it)
-                           (pcb/move-page index prev-index))]
+                           (pcb/move-page id index prev-index))]
         (rx/of (dch/commit-changes changes))))))
 
 ;; --- Shape / Selection Alignment and Distribution
@@ -1851,7 +1679,7 @@
                   ;; Adds a reg-objects operation so the groups are updated. We add all the new objects
                   new-objects-ids (->> changes :redo-changes (filter #(= (:type %) :add-obj)) (mapv :id))
 
-                  changes (pcb/reg-objects changes new-objects-ids)
+                  changes (pcb/resize-parents changes new-objects-ids)
 
                   selected  (->> changes
                                  :redo-changes
@@ -1962,19 +1790,12 @@
   (ptk/reify ::change-canvas-color
     ptk/WatchEvent
     (watch [it state _]
-      (let [page-id (get state :current-page-id)
+      (let [page    (wsh/lookup-page state)
-            options (wsh/lookup-page-options state page-id)
+            changes (-> (pcb/empty-changes it)
-            previous-color  (:background options)]
+                        (pcb/with-page page)
-        (rx/of (dch/commit-changes
+                        (pcb/set-page-option :background (:color color)))]
-                {:redo-changes [{:type :set-option
+
-                                 :page-id page-id
+        (rx/of (dch/commit-changes changes))))))
-                                 :option :background
-                                 :value (:color color)}]
-                 :undo-changes [{:type :set-option
-                                 :page-id page-id
-                                 :option :background
-                                 :value previous-color}]
-                 :origin it}))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Artboard