Improve the shape changes protocol.

Enabling skiping local reaply of changes after
save round-trip.
This commit is contained in:
Andrey Antukh 2020-01-11 18:40:36 +01:00
parent f2a926d22d
commit f7838601e6
5 changed files with 139 additions and 84 deletions

View file

@ -130,7 +130,7 @@
;; A generic, Changes based (granular) page update method. ;; A generic, Changes based (granular) page update method.
(s/def ::changes (s/def ::changes
(s/coll-of vector? :kind vector?)) (s/coll-of map? :kind vector?))
(s/def ::update-project-page (s/def ::update-project-page
(s/keys :opt-un [::id ::user ::version ::changes])) (s/keys :opt-un [::id ::user ::version ::changes]))

View file

@ -7,6 +7,8 @@
;; --- Specs ;; --- Specs
(s/def ::id uuid?) (s/def ::id uuid?)
(s/def ::shape-id uuid?)
(s/def ::session-id uuid?)
(s/def ::name string?) (s/def ::name string?)
(s/def ::type keyword?) (s/def ::type keyword?)
@ -100,37 +102,44 @@
::shapes-by-id])) ::shapes-by-id]))
;; Changes related ;; Changes related
(s/def ::attr-change (s/def ::operation (s/tuple #{:set} keyword? any?))
(s/tuple #{:set} keyword? any?)) (s/def ::move-after-id (s/nilable uuid?))
(s/def ::change (s/def ::operations
(s/or :mod-shape (s/cat :name #(= % :mod-shape) (s/coll-of ::operation :kind vector?))
:id uuid?
:changes (s/* ::attr-change))
:add-shape (s/cat :name #(= % :add-shape)
:id uuid?
:data any?)
:mod-opts (s/cat :name #(= % :mod-opts) (defmulti change-spec-impl :type)
:changes (s/* ::attr-change))
:del-shape (s/cat :name #(= % :del-shape) (defmethod change-spec-impl :add-shape [_]
:id uuid?) (s/keys :req-un [::shape ::id ::session-id]))
:mov-shape (s/cat :name #(= % :mov-shape)
:id1 uuid?
:pos #(= :after %)
:id2 (s/nilable uuid?))
:add-canvas (s/cat :name #(= % :add-canvas)
:id uuid?
:data any?)
:del-canvas (s/cat :name #(= % :del-canvas)
:id uuid?)))
(s/def ::changes (defmethod change-spec-impl :add-canvas [_]
(s/coll-of ::change :kind vector?)) (s/keys :req-un [::shape ::id ::session-id]))
(defmethod change-spec-impl :mod-shape [_]
(s/keys :req-un [::id ::operations ::session-id]))
(defmethod change-spec-impl :mov-shape [_]
(s/keys :req-un [::id ::move-after-id ::session-id]))
(defmethod change-spec-impl :mod-opts [_]
(s/keys :req-un [::operations ::session-id]))
(defmethod change-spec-impl :del-shape [_]
(s/keys :req-un [::id ::session-id]))
(defmethod change-spec-impl :del-canvas [_]
(s/keys :req-un [::id ::session-id]))
(s/def ::change (s/multi-spec change-spec-impl :type))
(s/def ::changes (s/coll-of ::change))
;; --- Changes Processing Impl ;; --- Changes Processing Impl
(defn change
[data]
(s/assert ::change data))
(declare process-change) (declare process-change)
(declare process-mod-shape) (declare process-mod-shape)
(declare process-mod-opts) (declare process-mod-opts)
@ -146,52 +155,61 @@
(reduce process-change data))) (reduce process-change data)))
(defn- process-change (defn- process-change
[data [op & rest]] [data {:keys [type] :as change}]
(case op (case type
:mod-shape (process-mod-shape data rest) :add-shape (process-add-shape data change)
:mov-shape (process-mov-shape data rest) :add-canvas (process-add-canvas data change)
:add-shape (process-add-shape data rest) :mod-shape (process-mod-shape data change)
:add-canvas (process-add-canvas data rest) :mov-shape (process-mov-shape data change)
:del-shape (process-del-shape data rest) :del-shape (process-del-shape data change)
:del-canvas (process-del-canvas data rest) :del-canvas (process-del-canvas data change)
:mod-opts (process-mod-opts data rest))) :mod-opts (process-mod-opts data change)))
(defn- process-add-shape
[data {:keys [id shape] :as change}]
(-> data
(update :shapes (fn [shapes]
(if (some #{id} shapes)
shapes
(conj shapes id))))
(update :shapes-by-id assoc id shape)))
(defn- process-add-canvas
[data {:keys [id shape] :as change}]
(-> data
(update :canvas (fn [shapes]
(if (some #{id} shapes)
shapes
(conj shapes id))))
(update :shapes-by-id assoc id shape)))
(defn- process-mod-shape (defn- process-mod-shape
[data [id & changes]] [data {:keys [id operations] :as change}]
(if (get-in data [:shapes-by-id id]) (if (get-in data [:shapes-by-id id])
(update-in data [:shapes-by-id id] (update-in data [:shapes-by-id id]
#(reduce (fn [shape [_ att val]] #(reduce (fn [shape [_ att val]]
(if (nil? val) (if (nil? val)
(dissoc shape att) (dissoc shape att)
(assoc shape att val))) (assoc shape att val)))
% changes)) % operations))
data)) data))
(defn- process-mod-opts (defn- process-mod-opts
[data changes] [data {:keys [operations]}]
(update data :options (update data :options
#(reduce (fn [options [_ att val]] #(reduce (fn [options [_ att val]]
(if (nil? val) (if (nil? val)
(dissoc options att) (dissoc options att)
(assoc options att val))) (assoc options att val)))
% changes))) % operations)))
(defn- process-add-shape
[data [id sdata]]
(-> data
(update :shapes (fn [shapes]
(if (some #{id} shapes)
shapes
(conj shapes id))))
(update :shapes-by-id assoc id sdata)))
(defn- process-mov-shape (defn- process-mov-shape
[data [id _ id2]] [data {:keys [id move-after-id]}]
(let [shapes (:shapes data) (let [shapes (:shapes data)
shapes' (into [] (remove #(= % id) shapes)) shapes' (into [] (remove #(= % id) shapes))
index (d/index-of shapes' id2)] index (d/index-of shapes' move-after-id)]
(cond (cond
(= id id2) (= id move-after-id)
(assoc data :shapes shapes) (assoc data :shapes shapes)
(nil? index) (nil? index)
@ -202,22 +220,13 @@
(assoc data :shapes (d/concat [] before [id] after)))))) (assoc data :shapes (d/concat [] before [id] after))))))
(defn- process-del-shape (defn- process-del-shape
[data [id]] [data {:keys [id] :as change}]
(-> data (-> data
(update :shapes (fn [s] (filterv #(not= % id) s))) (update :shapes (fn [s] (filterv #(not= % id) s)))
(update :shapes-by-id dissoc id))) (update :shapes-by-id dissoc id)))
(defn- process-add-canvas
[data [id sdata]]
(-> data
(update :canvas (fn [shapes]
(if (some #{id} shapes)
shapes
(conj shapes id))))
(update :shapes-by-id assoc id sdata)))
(defn- process-del-canvas (defn- process-del-canvas
[data [id]] [data {:keys [id] :as change}]
(-> data (-> data
(update :canvas (fn [s] (filterv #(not= % id) s))) (update :canvas (fn [s] (filterv #(not= % id) s)))
(update :shapes-by-id dissoc id))) (update :shapes-by-id dissoc id)))

View file

@ -7,6 +7,7 @@
(ns ^:figwheel-hooks uxbox.main (ns ^:figwheel-hooks uxbox.main
(:require (:require
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[beicon.core :as rx]
[rumext.alpha :as mf] [rumext.alpha :as mf]
[uxbox.main.data.auth :refer [logout]] [uxbox.main.data.auth :refer [logout]]
[uxbox.main.data.users :as udu] [uxbox.main.data.users :as udu]

View file

@ -554,8 +554,12 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [shape (get-in state [:workspace-data :shapes-by-id id])] (let [shape (get-in state [:workspace-data :shapes-by-id id])
(rx/of (commit-changes [[:add-shape id shape]]) sid (:session-id state)]
(rx/of (commit-changes [{:type :add-shape
:session-id sid
:shape shape
:id id}])
(select-shape id))))))) (select-shape id)))))))
(def canvas-default-attrs (def canvas-default-attrs
@ -579,8 +583,12 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [shape (get-in state [:workspace-data :shapes-by-id id])] (let [shape (get-in state [:workspace-data :shapes-by-id id])
(rx/of (commit-changes [[:add-canvas id shape]]) sid (:session-id state)]
(rx/of (commit-changes [{:type :add-canvas
:session-id sid
:id id
:shape shape}])
(select-shape id))))))) (select-shape id)))))))
@ -597,10 +605,17 @@
(watch [_ state stream] (watch [_ state stream]
(let [selected (get-in state [:workspace-local :selected]) (let [selected (get-in state [:workspace-local :selected])
duplicate (partial impl-duplicate-shape state) duplicate (partial impl-duplicate-shape state)
shapes (map duplicate selected)] shapes (map duplicate selected)
sid (:session-id state)
changes (mapv (fn [shape]
{:type :add-shape
:id (:id shape)
:shape shape
:session-id sid})
shapes)]
(rx/merge (rx/merge
(rx/from (map (fn [s] #(impl-assoc-shape % s)) shapes)) (rx/from (map (fn [s] #(impl-assoc-shape % s)) shapes))
(rx/of (commit-changes (mapv #(vector :add-shape (:id %) %) shapes)))))))) (rx/of (commit-changes changes)))))))
;; --- Toggle shape's selection status (selected or deselected) ;; --- Toggle shape's selection status (selected or deselected)
@ -676,10 +691,14 @@
(update [_ state] (update [_ state]
(let [shape-old (get-in state [:workspace-data :shapes-by-id id]) (let [shape-old (get-in state [:workspace-data :shapes-by-id id])
shape-new (merge shape-old attrs) shape-new (merge shape-old attrs)
diff (d/diff-maps shape-old shape-new)] operations (d/diff-maps shape-old shape-new)
change {:type :mod-shape
:session-id (:session-id state)
:operations operations
:id id}]
(-> state (-> state
(assoc-in [:workspace-data :shapes-by-id id] shape-new) (assoc-in [:workspace-data :shapes-by-id id] shape-new)
(update ::batched-changes (fnil conj []) (into [:mod-shape id] diff))))))) (update ::batched-changes (fnil conj []) change))))))
;; --- Update Page Options ;; --- Update Page Options
@ -692,10 +711,13 @@
(update [_ state] (update [_ state]
(let [opts-old (get-in state [:workspace-data :options]) (let [opts-old (get-in state [:workspace-data :options])
opts-new (merge opts-old opts) opts-new (merge opts-old opts)
diff (d/diff-maps opts-old opts-new)] operations (d/diff-maps opts-old opts-new)
change {:type :mod-opts
:session-id (:session-id state)
:operations operations}]
(-> state (-> state
(assoc-in [:workspace-data :options] opts-new) (assoc-in [:workspace-data :options] opts-new)
(update ::batched-changes (fnil conj []) (into [:mod-opts] diff))))))) (update ::batched-changes (fnil conj []) change))))))
;; --- Update Selected Shapes attrs ;; --- Update Selected Shapes attrs
@ -781,14 +803,21 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [selected (get-in state [:workspace-local :selected])] (let [selected (get-in state [:workspace-local :selected])
(rx/of (commit-changes (mapv #(vector :del-shape %) selected))))))) session-id (:session-id state)
changes (mapv (fn [id]
{:type :del-shape
:session-id session-id
:id id})
selected)]
(rx/of (commit-changes changes))))))
;; --- Rename Shape ;; --- Rename Shape
(defn rename-shape (defn rename-shape
[id name] [id name]
{:pre [(uuid? id) (string? name)]} (s/assert ::us/uuid id)
(s/assert string? name)
(ptk/reify ::rename-shape (ptk/reify ::rename-shape
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
@ -796,7 +825,12 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(rx/of (commit-changes [[:mod-shape id [:mod :name name]]]))))) (let [session-id (:session-id state)
change {:type :mod-shape
:id id
:session-id session-id
:operations [[:set :name name]]}]
(rx/of (commit-changes [change]))))))
;; --- Shape Vertical Ordering ;; --- Shape Vertical Ordering
@ -842,7 +876,10 @@
shapes (into [] (remove #(= % id)) shapes) shapes (into [] (remove #(= % id)) shapes)
[before after] (split-at index shapes) [before after] (split-at index shapes)
shapes (d/concat [] before [id] after) shapes (d/concat [] before [id] after)
change [:mov-shape id :after (last before)]] change {:type :mov-shape
:session-id (:session-id state)
:move-after-id (last before)
:id id}]
(-> state (-> state
(assoc-in [:workspace-data :shapes] shapes) (assoc-in [:workspace-data :shapes] shapes)
(assoc ::tmp-shape-order-change change)))))) (assoc ::tmp-shape-order-change change))))))
@ -852,7 +889,7 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [change (::tmp-shape-order-change state)] (let [change (::tmp-shape-order-change state)]
(rx/of #(dissoc state ::tmp-changes) (rx/of #(dissoc state ::tmp-shape-order-change)
(commit-changes [change])))))) (commit-changes [change]))))))
;; --- Change Canvas Order (D&D Ordering) ;; --- Change Canvas Order (D&D Ordering)
@ -935,10 +972,14 @@
shape-old (dissoc shape :modifier-mtx) shape-old (dissoc shape :modifier-mtx)
shape-new (geom/transform shape-old xfmt) shape-new (geom/transform shape-old xfmt)
shape-new (recalculate-shape-canvas-relation state shape-new) shape-new (recalculate-shape-canvas-relation state shape-new)
diff (d/diff-maps shape-old shape-new)] operations (d/diff-maps shape-old shape-new)
change {:type :mod-shape
:session-id (:session-id state)
:operations operations
:id id}]
(-> state (-> state
(assoc-in [:workspace-data :shapes-by-id id] shape-new) (assoc-in [:workspace-data :shapes-by-id id] shape-new)
(update ::batched-changes (fnil conj []) (into [:mod-shape id] diff)))))] (update ::batched-changes (fnil conj []) change))))]
(ptk/reify ::materialize-temporal-modifier-in-bulk (ptk/reify ::materialize-temporal-modifier-in-bulk
IBatchedChange IBatchedChange
@ -982,11 +1023,13 @@
(ptk/reify ::shapes-changes-commited (ptk/reify ::shapes-changes-commited
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [sid (:session-id state)
changes (remove #(= sid (:session-id %)) changes)]
(-> state (-> state
(assoc-in [:workspace-page :version] version) (assoc-in [:workspace-page :version] version)
(assoc-in [:pages page-id :version] version) (assoc-in [:pages page-id :version] version)
(update-in [:pages-data page-id] cp/process-changes changes) (update-in [:pages-data page-id] cp/process-changes changes)
(update :workspace-data cp/process-changes changes))))) (update :workspace-data cp/process-changes changes))))))
;; --- Start shape "edition mode" ;; --- Start shape "edition mode"

View file

@ -8,6 +8,7 @@
(:require [beicon.core :as rx] (:require [beicon.core :as rx]
[lentes.core :as l] [lentes.core :as l]
[potok.core :as ptk] [potok.core :as ptk]
[uxbox.util.uuid :as uuid]
[uxbox.builtins.colors :as colors] [uxbox.builtins.colors :as colors]
[uxbox.util.storage :refer [storage]])) [uxbox.util.storage :refer [storage]]))
@ -55,6 +56,7 @@
(def initial-state (def initial-state
{:route nil {:route nil
:router nil :router nil
:session-id (uuid/random)
:auth (:auth storage) :auth (:auth storage)
:profile (:profile storage) :profile (:profile storage)
:clipboard #queue [] :clipboard #queue []