3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-06-09 16:11:38 +02:00
Code Issues Projects Releases Packages Wiki Activity

Merge remote-tracking branch 'origin/library-changes-builder' into staging

Browse source
This commit is contained in:
Andrey Antukh 2022-03-22 13:14:53 +01:00
commit ad262f6fb3
21 changed files with 2384 additions and 1182 deletions
Download patch file Download diff file Expand all files Collapse all files

251
common/src/app/common/pages/changes_builder.cljc
View file

@ -7,6 +7,7 @@
(ns app.common.pages.changes-builder (ns app.common.pages.changes-builder
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.shapes.bool :as gshb] [app.common.geom.shapes.bool :as gshb]
[app.common.pages :as cp] [app.common.pages :as cp]
@ -30,18 +31,30 @@
[changes save-undo?] [changes save-undo?]
(assoc changes :save-undo? save-undo?)) (assoc changes :save-undo? save-undo?))
(defn with-page [changes page] (defn with-page
[changes page]
(vary-meta changes assoc (vary-meta changes assoc
::page page ::page page
::page-id (:id page) ::page-id (:id page)))
::objects (:objects page)))
(defn with-objects [changes objects] (defn with-container
[changes container]
(if (cph/page? container)
(vary-meta changes assoc ::page-id (:id container))
(vary-meta changes assoc ::component-id (:id container))))
(defn with-objects
[changes objects]
(let [file-data (-> (cp/make-file-data (uuid/next) uuid/zero) (let [file-data (-> (cp/make-file-data (uuid/next) uuid/zero)
(assoc-in [:pages-index uuid/zero :objects] objects))] (assoc-in [:pages-index uuid/zero :objects] objects))]
(vary-meta changes assoc ::file-data file-data (vary-meta changes assoc ::file-data file-data
::applied-changes-count 0))) ::applied-changes-count 0)))
(defn with-library-data
[changes data]
(vary-meta changes assoc
::library-data data))
(defn amend-last-change (defn amend-last-change
"Modify the last redo-changes added with an update function." "Modify the last redo-changes added with an update function."
[changes f] [changes f]
@ -53,10 +66,23 @@
[changes f] [changes f]
(update changes :redo-changes #(mapv f %))) (update changes :redo-changes #(mapv f %)))
(defn concat-changes
[changes1 changes2]
{:redo-changes (d/concat-vec (:redo-changes changes1) (:redo-changes changes2))
:undo-changes (d/concat-vec (:undo-changes changes1) (:undo-changes changes2))
:origin (:origin changes1)})
; TODO: remove this when not needed
(defn- assert-page-id (defn- assert-page-id
[changes] [changes]
(assert (contains? (meta changes) ::page-id) "Give a page-id or call (with-page) before using this function")) (assert (contains? (meta changes) ::page-id) "Give a page-id or call (with-page) before using this function"))
(defn- assert-container-id
[changes]
(assert (or (contains? (meta changes) ::page-id)
(contains? (meta changes) ::component-id))
"Give a page-id or call (with-container) before using this function"))
(defn- assert-page (defn- assert-page
[changes] [changes]
(assert (contains? (meta changes) ::page) "Call (with-page) before using this function")) (assert (contains? (meta changes) ::page) "Call (with-page) before using this function"))
@ -65,6 +91,15 @@
[changes] [changes]
(assert (contains? (meta changes) ::file-data) "Call (with-objects) before using this function")) (assert (contains? (meta changes) ::file-data) "Call (with-objects) before using this function"))
(defn- assert-library
[changes]
(assert (contains? (meta changes) ::library-data) "Call (with-library-data) before using this function"))
(defn- lookup-objects
[changes]
(let [data (::file-data (meta changes))]
(dm/get-in data [:pages-index uuid/zero :objects])))
(defn- apply-changes-local (defn- apply-changes-local
[changes] [changes]
(if-let [file-data (::file-data (meta changes))] (if-let [file-data (::file-data (meta changes))]
@ -155,9 +190,9 @@
;; Shape tree changes ;; Shape tree changes
(defn add-obj (defn add-object
([changes obj] ([changes obj]
(add-obj changes obj nil)) (add-object changes obj nil))
([changes obj {:keys [index ignore-touched] :or {index ::undefined ignore-touched false}}] ([changes obj {:keys [index ignore-touched] :or {index ::undefined ignore-touched false}}]
(assert-page-id changes) (assert-page-id changes)
@ -192,7 +227,7 @@
([changes parent-id shapes index] ([changes parent-id shapes index]
(assert-page-id changes) (assert-page-id changes)
(assert-objects changes) (assert-objects changes)
(let [objects (get-in (meta changes) [::file-data :pages-index uuid/zero :objects]) (let [objects (lookup-objects changes)
set-parent-change set-parent-change
(cond-> {:type :mov-objects (cond-> {:type :mov-objects
@ -224,10 +259,13 @@
([changes ids update-fn] ([changes ids update-fn]
(update-shapes changes ids update-fn nil)) (update-shapes changes ids update-fn nil))
([changes ids update-fn {:keys [attrs ignore-geometry?] :or {attrs nil ignore-geometry? false}}] ([changes ids update-fn {:keys [attrs ignore-geometry? ignore-touched]
(assert-page-id changes) :or {ignore-geometry? false ignore-touched false}}]
(assert-container-id changes)
(assert-objects changes) (assert-objects changes)
(let [objects (get-in (meta changes) [::file-data :pages-index uuid/zero :objects]) (let [page-id (::page-id (meta changes))
component-id (::component-id (meta changes))
objects (lookup-objects changes)
generate-operation generate-operation
(fn [operations attr old new ignore-geometry?] (fn [operations attr old new ignore-geometry?]
@ -236,8 +274,11 @@
(if (= old-val new-val) (if (= old-val new-val)
operations operations
(-> operations (-> operations
(update :rops conj {:type :set :attr attr :val new-val :ignore-geometry ignore-geometry?}) (update :rops conj {:type :set :attr attr :val new-val
(update :uops conj {:type :set :attr attr :val old-val :ignore-touched true}))))) :ignore-geometry ignore-geometry?
:ignore-touched ignore-touched})
(update :uops conj {:type :set :attr attr :val old-val
:ignore-touched true})))))
update-shape update-shape
(fn [changes id] (fn [changes id]
@ -255,9 +296,14 @@
(seq uops) (seq uops)
(conj {:type :set-touched :touched (:touched old-obj)})) (conj {:type :set-touched :touched (:touched old-obj)}))
change {:type :mod-obj change (cond-> {:type :mod-obj
:page-id (::page-id (meta changes)) :id id}
:id id}]
(some? page-id)
(assoc :page-id page-id)
(some? component-id)
(assoc :component-id component-id))]
(cond-> changes (cond-> changes
(seq rops) (seq rops)
@ -274,7 +320,7 @@
(assert-page-id changes) (assert-page-id changes)
(assert-objects changes) (assert-objects changes)
(let [page-id (::page-id (meta changes)) (let [page-id (::page-id (meta changes))
objects (get-in (meta changes) [::file-data :pages-index uuid/zero :objects]) objects (lookup-objects changes)
add-redo-change add-redo-change
(fn [change-set id] (fn [change-set id]
@ -322,7 +368,7 @@
(assert-page-id changes) (assert-page-id changes)
(assert-objects changes) (assert-objects changes)
(let [page-id (::page-id (meta changes)) (let [page-id (::page-id (meta changes))
objects (get-in (meta changes) [::file-data :pages-index uuid/zero :objects]) objects (lookup-objects changes)
xform (comp xform (comp
(mapcat #(cons % (cph/get-parent-ids objects %))) (mapcat #(cons % (cph/get-parent-ids objects %)))
@ -374,3 +420,174 @@
(-> (reduce resize-parent changes all-parents) (-> (reduce resize-parent changes all-parents)
(apply-changes-local)))) (apply-changes-local))))
;; Library changes
(defn add-recent-color
[changes color]
(-> changes
(update :redo-changes conj {:type :add-recent-color :color color})
(apply-changes-local)))
(defn add-color
[changes color]
(-> changes
(update :redo-changes conj {:type :add-color :color color})
(update :undo-changes conj {:type :del-color :id (:id color)})
(apply-changes-local)))
(defn update-color
[changes color]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-color (get-in library-data [:colors (:id color)])]
(-> changes
(update :redo-changes conj {:type :mod-color :color color})
(update :undo-changes conj {:type :mod-color :color prev-color})
(apply-changes-local))))
(defn delete-color
[changes color-id]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-color (get-in library-data [:colors color-id])]
(-> changes
(update :redo-changes conj {:type :del-color :id color-id})
(update :undo-changes conj {:type :add-color :color prev-color})
(apply-changes-local))))
(defn add-media
[changes object]
(-> changes
(update :redo-changes conj {:type :add-media :object object})
(update :undo-changes conj {:type :del-media :id (:id object)})
(apply-changes-local)))
(defn update-media
[changes object]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-object (get-in library-data [:media (:id object)])]
(-> changes
(update :redo-changes conj {:type :mod-media :object object})
(update :undo-changes conj {:type :mod-media :object prev-object})
(apply-changes-local))))
(defn delete-media
[changes id]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-object (get-in library-data [:media id])]
(-> changes
(update :redo-changes conj {:type :del-media :id id})
(update :undo-changes conj {:type :add-media :object prev-object})
(apply-changes-local))))
(defn add-typography
[changes typography]
(-> changes
(update :redo-changes conj {:type :add-typography :typography typography})
(update :undo-changes conj {:type :del-typography :id (:id typography)})
(apply-changes-local)))
(defn update-typography
[changes typography]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-typography (get-in library-data [:typographies (:id typography)])]
(-> changes
(update :redo-changes conj {:type :mod-typography :typography typography})
(update :undo-changes conj {:type :mod-typography :typography prev-typography})
(apply-changes-local))))
(defn delete-typography
[changes typography-id]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-typography (get-in library-data [:typographies typography-id])]
(-> changes
(update :redo-changes conj {:type :del-typography :id typography-id})
(update :undo-changes conj {:type :add-typography :typography prev-typography})
(apply-changes-local))))
(defn add-component
[changes id path name new-shapes updated-shapes]
(assert-page-id changes)
(assert-objects changes)
(let [page-id (::page-id (meta changes))
objects (lookup-objects changes)
lookupf (d/getf objects)
mk-change (fn [shape]
{:type :mod-obj
:page-id page-id
: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 :component-root?
:val (:component-root? shape)}
{:type :set
:attr :shape-ref
:val (:shape-ref shape)}
{:type :set
:attr :touched
:val (:touched shape)}]}) ]
(-> changes
(update :redo-changes
(fn [redo-changes]
(-> redo-changes
(conj {:type :add-component
:id id
:path path
:name name
:shapes new-shapes})
(into (map mk-change) updated-shapes))))
(update :undo-changes
(fn [undo-changes]
(-> undo-changes
(conj {:type :del-component
:id id})
(into (comp (map :id)
(map lookupf)
(map mk-change))
updated-shapes))))
(apply-changes-local))))
(defn update-component
[changes id update-fn]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-component (get-in library-data [:components id])
new-component (update-fn prev-component)]
(if new-component
(-> changes
(update :redo-changes conj {:type :mod-component
:id id
:name (:name new-component)
:path (:path new-component)
:objects (:objects new-component)})
(update :undo-changes conj {:type :mod-component
:id id
:name (:name prev-component)
:path (:path prev-component)
:objects (:objects prev-component)}))
changes)))
(defn delete-component
[changes id]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-component (get-in library-data [:components id])]
(-> changes
(update :redo-changes conj {:type :del-component
:id id})
(update :undo-changes conj {:type :add-component
:id id
:name (:name prev-component)
:path (:path prev-component)
:shapes (vals (:objects prev-component))}))))

1
common/src/app/common/pages/helpers.cljc
View file

@ -307,7 +307,6 @@
(defn clean-loops (defn clean-loops
"Clean a list of ids from circular references." "Clean a list of ids from circular references."
[objects ids] [objects ids]
(let [parent-selected? (let [parent-selected?
(fn [id] (fn [id]
(let [parents (get-parent-ids objects id)] (let [parents (get-parent-ids objects id)]

1
frontend/package.json
View file

@ -13,6 +13,7 @@
], ],
"scripts": { "scripts": {
"compile-test": "clojure -M:dev:shadow-cljs compile test --config-merge '{:autorun false}'", "compile-test": "clojure -M:dev:shadow-cljs compile test --config-merge '{:autorun false}'",
"lint": "clj-kondo --parallel --lint src/",
"lint-scss": "yarn run prettier -c resources/styles", "lint-scss": "yarn run prettier -c resources/styles",
"run-test": "node target/tests.js", "run-test": "node target/tests.js",
"test": "yarn run compile-test && yarn run run-test", "test": "yarn run compile-test && yarn run run-test",

3
frontend/src/app/main/data/workspace.cljs
View file

@ -660,7 +660,8 @@
moved-shape (assoc shape moved-shape (assoc shape
:parent-id parent-id :parent-id parent-id
:frame-id frame-id)] :frame-id frame-id)]
(assoc shape :constraints-h (gsh/default-constraints-h moved-shape) (assoc shape
:constraints-h (gsh/default-constraints-h moved-shape)
:constraints-v (gsh/default-constraints-v moved-shape)))) :constraints-v (gsh/default-constraints-v moved-shape))))
{:ignore-touched true}) {:ignore-touched true})

2
frontend/src/app/main/data/workspace/bool.cljs
View file

@ -98,7 +98,7 @@
shape-id (:id boolean-data) shape-id (:id boolean-data)
changes (-> (pcb/empty-changes it page-id) changes (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects) (pcb/with-objects objects)
(pcb/add-obj boolean-data {:index index}) (pcb/add-object boolean-data {:index index})
(pcb/change-parent shape-id shapes))] (pcb/change-parent shape-id shapes))]
(rx/of (dch/commit-changes changes) (rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set shape-id))))))))) (dwc/select-shapes (d/ordered-set shape-id)))))))))

4
frontend/src/app/main/data/workspace/changes.cljs
View file

@ -102,10 +102,6 @@
(us/assert ::spec.change/changes redo-changes) (us/assert ::spec.change/changes redo-changes)
(us/assert ::spec.change/changes undo-changes) (us/assert ::spec.change/changes undo-changes)
;; (prn "====== commit-changes ======" path)
;; (cljs.pprint/pprint redo-changes)
;; (cljs.pprint/pprint undo-changes)
(update-in state path cp/process-changes redo-changes false) (update-in state path cp/process-changes redo-changes false)
(catch :default e (catch :default e

2
frontend/src/app/main/data/workspace/common.cljs
View file

@ -325,7 +325,7 @@
selected) selected)
changes (-> (pcb/empty-changes it page-id) changes (-> (pcb/empty-changes it page-id)
(pcb/add-obj shape))] (pcb/add-object shape))]
(rx/concat (rx/concat
(rx/of (dch/commit-changes changes) (rx/of (dch/commit-changes changes)

2
frontend/src/app/main/data/workspace/groups.cljs
View file

@ -88,7 +88,7 @@
changes (-> (pcb/empty-changes it page-id) changes (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects) (pcb/with-objects objects)
(pcb/add-obj group) (pcb/add-object group)
(pcb/change-parent (:id group) shapes) (pcb/change-parent (:id group) shapes)
(pcb/remove-objects ids-to-delete))] (pcb/remove-objects ids-to-delete))]

454
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -8,9 +8,9 @@
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.shapes :as geom]
[app.common.logging :as log] [app.common.logging :as log]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.spec.change :as spec.change] [app.common.spec.change :as spec.change]
@ -57,7 +57,7 @@
prefix (if (:component-id change) "[C] " "[P] ") prefix (if (:component-id change) "[C] " "[P] ")
extract (cond-> {:type (:type change) extract (cond-> {:type (:type change)
:change change} :raw-change change}
shape shape
(assoc :shape (str prefix (:name shape))) (assoc :shape (str prefix (:name shape)))
(:operations change) (:operations change)
@ -100,25 +100,20 @@
ptk/WatchEvent ptk/WatchEvent
(watch [it _ _] (watch [it _ _]
(let [rchg {:type :add-color (let [changes (-> (pcb/empty-changes it)
:color color} (pcb/add-color color))]
uchg {:type :del-color
:id id}]
(rx/of #(assoc-in % [:workspace-local :color-for-rename] id) (rx/of #(assoc-in % [:workspace-local :color-for-rename] id)
(dch/commit-changes {:redo-changes [rchg] (dch/commit-changes changes)))))))
:undo-changes [uchg]
:origin it})))))))
(defn add-recent-color (defn add-recent-color
[color] [color]
(us/assert ::spec.color/recent-color color) (us/assert ::spec.color/recent-color color)
(ptk/reify ::add-recent-color (ptk/reify ::add-recent-color
ptk/WatchEvent ptk/WatchEvent
(watch [it _ _] (watch [it _ _]
(let [rchg {:type :add-recent-color (let [changes (-> (pcb/empty-changes it)
:color color}] (pcb/add-recent-color color))]
(rx/of (dch/commit-changes {:redo-changes [rchg] (rx/of (dch/commit-changes changes))))))
:undo-changes []
:origin it}))))))
(def clear-color-for-rename (def clear-color-for-rename
(ptk/reify ::clear-color-for-rename (ptk/reify ::clear-color-for-rename
@ -127,23 +122,20 @@
(assoc-in state [:workspace-local :color-for-rename] nil)))) (assoc-in state [:workspace-local :color-for-rename] nil))))
(defn update-color (defn update-color
[{:keys [id] :as color} file-id] [color file-id]
(us/assert ::spec.color/color color) (us/assert ::spec.color/color color)
(us/assert ::us/uuid file-id) (us/assert ::us/uuid file-id)
(ptk/reify ::update-color (ptk/reify ::update-color
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [[path name] (cph/parse-path-name (:name color)) (let [data (get state :workspace-data)
[path name] (cph/parse-path-name (:name color))
color (assoc color :path path :name name) color (assoc color :path path :name name)
prev (get-in state [:workspace-data :colors id]) changes (-> (pcb/empty-changes it)
rchg {:type :mod-color (pcb/with-library-data data)
:color color} (pcb/update-color color))]
uchg {:type :mod-color
:color prev}]
(rx/of (dwu/start-undo-transaction) (rx/of (dwu/start-undo-transaction)
(dch/commit-changes {:redo-changes [rchg] (dch/commit-changes changes)
:undo-changes [uchg]
:origin it})
(sync-file (:current-file-id state) file-id) (sync-file (:current-file-id state) file-id)
(dwu/commit-undo-transaction)))))) (dwu/commit-undo-transaction))))))
@ -153,29 +145,22 @@
(ptk/reify ::delete-color (ptk/reify ::delete-color
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [prev (get-in state [:workspace-data :colors id]) (let [data (get state :workspace-data)
rchg {:type :del-color changes (-> (pcb/empty-changes it)
:id id} (pcb/with-library-data data)
uchg {:type :add-color (pcb/delete-color id))]
:color prev}] (rx/of (dch/commit-changes changes))))))
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it}))))))
(defn add-media (defn add-media
[{:keys [id] :as media}] [media]
(us/assert ::spec.file/media-object media) (us/assert ::spec.file/media-object media)
(ptk/reify ::add-media (ptk/reify ::add-media
ptk/WatchEvent ptk/WatchEvent
(watch [it _ _] (watch [it _ _]
(let [obj (select-keys media [:id :name :width :height :mtype]) (let [obj (select-keys media [:id :name :width :height :mtype])
rchg {:type :add-media changes (-> (pcb/empty-changes it)
:object obj} (pcb/add-media obj))]
uchg {:type :del-media (rx/of (dch/commit-changes changes))))))
:id id}]
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it}))))))
(defn rename-media (defn rename-media
[id new-name] [id new-name]
@ -184,22 +169,14 @@
(ptk/reify ::rename-media (ptk/reify ::rename-media
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [object (get-in state [:workspace-data :media id]) (let [data (get state :workspace-data)
[path name] (cph/parse-path-name new-name) [path name] (cph/parse-path-name new-name)
object (get-in data [:media id])
rchanges [{:type :mod-media new-object (assoc object :path path :name name)
:object {:id id changes (-> (pcb/empty-changes it)
:name name (pcb/with-library-data data)
:path path}}] (pcb/update-media new-object))]
(rx/of (dch/commit-changes changes))))))
uchanges [{:type :mod-media
:object {:id id
:name (:name object)
:path (:path object)}}]]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it}))))))
(defn delete-media (defn delete-media
[{:keys [id] :as params}] [{:keys [id] :as params}]
@ -207,14 +184,11 @@
(ptk/reify ::delete-media (ptk/reify ::delete-media
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [prev (get-in state [:workspace-data :media id]) (let [data (get state :workspace-data)
rchg {:type :del-media changes (-> (pcb/empty-changes it)
:id id} (pcb/with-library-data data)
uchg {:type :add-media (pcb/delete-media id))]
:object prev}] (rx/of (dch/commit-changes changes))))))
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it}))))))
(defn add-typography (defn add-typography
([typography] (add-typography typography true)) ([typography] (add-typography typography true))
@ -227,13 +201,9 @@
ptk/WatchEvent ptk/WatchEvent
(watch [it _ _] (watch [it _ _]
(let [rchg {:type :add-typography (let [changes (-> (pcb/empty-changes it)
:typography typography} (pcb/add-typography typography))]
uchg {:type :del-typography (rx/of (dch/commit-changes changes)
:id (:id typography)}]
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it})
#(cond-> % #(cond-> %
edit? edit?
(assoc-in [:workspace-global :rename-typography] (:id typography)))))))))) (assoc-in [:workspace-global :rename-typography] (:id typography))))))))))
@ -245,15 +215,12 @@
(ptk/reify ::update-typography (ptk/reify ::update-typography
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [prev (get-in state [:workspace-data :typographies (:id typography)]) (let [data (get state :workspace-data)
rchg {:type :mod-typography changes (-> (pcb/empty-changes it)
:typography typography} (pcb/with-library-data data)
uchg {:type :mod-typography (pcb/update-typography typography))]
:typography prev}]
(rx/of (dwu/start-undo-transaction) (rx/of (dwu/start-undo-transaction)
(dch/commit-changes {:redo-changes [rchg] (dch/commit-changes changes)
:undo-changes [uchg]
:origin it})
(sync-file (:current-file-id state) file-id) (sync-file (:current-file-id state) file-id)
(dwu/commit-undo-transaction)))))) (dwu/commit-undo-transaction))))))
@ -263,15 +230,11 @@
(ptk/reify ::delete-typography (ptk/reify ::delete-typography
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [prev (get-in state [:workspace-data :typographies id]) (let [data (get state :workspace-data)
rchg {:type :del-typography changes (-> (pcb/empty-changes it)
:id id} (pcb/with-library-data data)
uchg {:type :add-typography (pcb/delete-typography id))]
:typography prev}] (rx/of (dch/commit-changes changes))))))
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it}))))))
(defn- add-component2 (defn- add-component2
"This is the second step of the component creation." "This is the second step of the component creation."
@ -287,12 +250,10 @@
objects (wsh/lookup-page-objects state page-id) objects (wsh/lookup-page-objects state page-id)
shapes (dwg/shapes-for-grouping objects selected)] shapes (dwg/shapes-for-grouping objects selected)]
(when-not (empty? shapes) (when-not (empty? shapes)
(let [[group rchanges uchanges] (let [[group _ changes]
(dwlh/generate-add-component it shapes objects page-id file-id)] (dwlh/generate-add-component it shapes objects page-id file-id)]
(when-not (empty? rchanges) (when-not (empty? (:redo-changes changes))
(rx/of (dch/commit-changes {:redo-changes rchanges (rx/of (dch/commit-changes changes)
:undo-changes uchanges
:origin it})
(dwc/select-shapes (d/ordered-set (:id group))))))))))) (dwc/select-shapes (d/ordered-set (:id group)))))))))))
(defn add-component (defn add-component
@ -317,31 +278,27 @@
(ptk/reify ::rename-component (ptk/reify ::rename-component
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
;; NOTE: we need to ensure the component exists, because there (let [data (get state :workspace-data)
;; are small posibilities of race conditions with component [path name] (cph/parse-path-name new-name)
;; deletion.
(when-let [component (get-in state [:workspace-data :components id])] update-fn
(let [[path name] (cph/parse-path-name new-name) (fn [component]
objects (get component :objects) ;; NOTE: we need to ensure the component exists,
;; because there are small posibilities of race
;; conditions with component deletion.
(when component
(-> component
(assoc :path path)
(assoc :name name)
(update :objects
;; Give the same name to the root shape ;; Give the same name to the root shape
new-objects (assoc-in objects #(assoc-in % [id :name] name)))))
[(:id component) :name]
name)
rchanges [{:type :mod-component changes (-> (pcb/empty-changes it)
:id id (pcb/with-library-data data)
:name name (pcb/update-component id update-fn))]
:path path
:objects new-objects}]
uchanges [{:type :mod-component (rx/of (dch/commit-changes changes))))))
:id id
:name (:name component)
:path (:path component)
:objects objects}]]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it})))))))
(defn duplicate-component (defn duplicate-component
"Create a new component copied from the one with the given id." "Create a new component copied from the one with the given id."
@ -349,7 +306,7 @@
(ptk/reify ::duplicate-component (ptk/reify ::duplicate-component
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [libraries (dwlh/get-libraries state) (let [libraries (wsh/get-libraries state)
component (cph/get-component libraries id) component (cph/get-component libraries id)
all-components (-> state :workspace-data :components vals) all-components (-> state :workspace-data :components vals)
unames (into #{} (map :name) all-components) unames (into #{} (map :name) all-components)
@ -358,18 +315,15 @@
[new-shape new-shapes _updated-shapes] [new-shape new-shapes _updated-shapes]
(dwlh/duplicate-component component) (dwlh/duplicate-component component)
rchanges [{:type :add-component changes (-> (pcb/empty-changes it nil) ;; no objects are changed
:id (:id new-shape) (pcb/with-objects nil) ;; in the current page
:name new-name (pcb/add-component (:id new-shape)
:path (:path component) (:path component)
:shapes new-shapes}] new-name
new-shapes
[]))]
uchanges [{:type :del-component (rx/of (dch/commit-changes changes))))))
:id (:id new-shape)}]]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it}))))))
(defn delete-component (defn delete-component
"Delete the component with the given id, from the current file library." "Delete the component with the given id, from the current file library."
@ -378,20 +332,12 @@
(ptk/reify ::delete-component (ptk/reify ::delete-component
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [component (get-in state [:workspace-data :components id]) (let [data (get state :workspace-data)
changes (-> (pcb/empty-changes it)
(pcb/with-library-data data)
(pcb/delete-component id))]
rchanges [{:type :del-component (rx/of (dch/commit-changes changes))))))
:id id}]
uchanges [{:type :add-component
:id id
:name (:name component)
:path (:path component)
:shapes (vals (:objects component))}]]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it}))))))
(defn instantiate-component (defn instantiate-component
"Create a new shape in the current page, from the component with the given id "Create a new shape in the current page, from the component with the given id
@ -403,73 +349,17 @@
(ptk/reify ::instantiate-component (ptk/reify ::instantiate-component
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [libraries (dwlh/get-libraries state) (let [page (wsh/lookup-page state)
component (cph/get-component libraries file-id component-id) libraries (wsh/get-libraries state)
component-shape (cph/get-shape component component-id)
orig-pos (gpt/point (:x component-shape) (:y component-shape)) [new-shape changes]
delta (gpt/subtract position orig-pos) (dwlh/generate-instantiate-component it
file-id
page-id (:current-page-id state) component-id
objects (wsh/lookup-page-objects state page-id) position
unames (volatile! (dwc/retrieve-used-names objects)) page
libraries)]
frame-id (cph/frame-id-by-position objects (gpt/add orig-pos delta)) (rx/of (dch/commit-changes changes)
update-new-shape
(fn [new-shape original-shape]
(let [new-name (dwc/generate-unique-name @unames (:name new-shape))]
(when (nil? (:parent-id original-shape))
(vswap! unames conj new-name))
(cond-> new-shape
true
(as-> $
(geom/move $ delta)
(assoc $ :frame-id frame-id)
(assoc $ :parent-id
(or (:parent-id $) (:frame-id $)))
(dissoc $ :touched))
(nil? (:shape-ref original-shape))
(assoc :shape-ref (:id original-shape))
(nil? (:parent-id original-shape))
(assoc :component-id (:id original-shape)
:component-file file-id
:component-root? true
:name new-name)
(some? (:parent-id original-shape))
(dissoc :component-root?))))
[new-shape new-shapes _]
(cph/clone-object component-shape
nil
(get component :objects)
update-new-shape)
rchanges (mapv (fn [obj]
{:type :add-obj
:id (:id obj)
:page-id page-id
:frame-id (:frame-id obj)
:parent-id (:parent-id obj)
:ignore-touched true
:obj obj})
new-shapes)
uchanges (mapv (fn [obj]
{:type :del-obj
:id (:id obj)
:page-id page-id
:ignore-touched true})
new-shapes)]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it})
(dwc/select-shapes (d/ordered-set (:id new-shape)))))))) (dwc/select-shapes (d/ordered-set (:id new-shape))))))))
(defn detach-component (defn detach-component
@ -480,16 +370,16 @@
(ptk/reify ::detach-component (ptk/reify ::detach-component
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [file (dwlh/get-local-file state) (let [file (wsh/get-local-file state)
page-id (get state :current-page-id) page-id (get state :current-page-id)
container (cph/get-container file :page page-id) container (cph/get-container file :page page-id)
[rchanges uchanges] changes (-> (pcb/empty-changes it)
(dwlh/generate-detach-instance container id)] (pcb/with-container container)
(pcb/with-objects (:objects container))
(dwlh/generate-detach-instance container id))]
(rx/of (dch/commit-changes {:redo-changes rchanges (rx/of (dch/commit-changes changes))))))
:undo-changes uchanges
:origin it}))))))
(def detach-selected-components (def detach-selected-components
(ptk/reify ::detach-selected-components (ptk/reify ::detach-selected-components
@ -497,23 +387,21 @@
(watch [it state _] (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)
file (dwlh/get-local-file state) file (wsh/get-local-file state)
container (cph/get-container file :page page-id) container (cph/get-container file :page page-id)
selected (->> state selected (->> state
(wsh/lookup-selected) (wsh/lookup-selected)
(cph/clean-loops objects)) (cph/clean-loops objects))
[rchanges uchanges] changes (reduce
(reduce (fn [changes id] (fn [changes id]
(dwlh/concat-changes (dwlh/generate-detach-instance changes container id))
changes (-> (pcb/empty-changes it)
(dwlh/generate-detach-instance container id))) (pcb/with-container container)
dwlh/empty-changes (pcb/with-objects objects))
selected)] selected)]
(rx/of (dch/commit-changes {:redo-changes rchanges (rx/of (dch/commit-changes changes))))))
:undo-changes uchanges
:origin it}))))))
(defn nav-to-component-file (defn nav-to-component-file
[file-id] [file-id]
@ -553,21 +441,22 @@
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(log/info :msg "RESET-COMPONENT of shape" :id (str id)) (log/info :msg "RESET-COMPONENT of shape" :id (str id))
(let [file (dwlh/get-local-file state) (let [file (wsh/get-local-file state)
libraries (dwlh/get-libraries state) libraries (wsh/get-libraries state)
page-id (:current-page-id state) page-id (:current-page-id state)
container (cph/get-container file :page page-id) container (cph/get-container file :page page-id)
[rchanges uchanges] changes
(dwlh/generate-sync-shape-direct libraries container id true)] (-> (pcb/empty-changes it)
(pcb/with-container container)
(pcb/with-objects (:objects container))
(dwlh/generate-sync-shape-direct libraries container id true))]
(log/debug :msg "RESET-COMPONENT finished" :js/rchanges (log-changes (log/debug :msg "RESET-COMPONENT finished" :js/rchanges (log-changes
rchanges (:redo-changes changes)
file)) file))
(rx/of (dch/commit-changes {:redo-changes rchanges (rx/of (dch/commit-changes changes))))))
:undo-changes uchanges
:origin it}))))))
(defn update-component (defn update-component
"Modify the component linked to the shape with the given id, in the "Modify the component linked to the shape with the given id, in the
@ -586,51 +475,51 @@
(log/info :msg "UPDATE-COMPONENT of shape" :id (str id)) (log/info :msg "UPDATE-COMPONENT of shape" :id (str id))
(let [page-id (get state :current-page-id) (let [page-id (get state :current-page-id)
local-file (dwlh/get-local-file state) local-file (wsh/get-local-file state)
libraries (dwlh/get-libraries state) libraries (wsh/get-libraries state)
container (cph/get-container local-file :page page-id) container (cph/get-container local-file :page page-id)
shape (cph/get-shape container id) shape (cph/get-shape container id)
[rchanges uchanges] changes
(dwlh/generate-sync-shape-inverse libraries container id) (-> (pcb/empty-changes it)
(pcb/with-container container)
(dwlh/generate-sync-shape-inverse libraries container id))
file-id (:component-file shape) file-id (:component-file shape)
file (dwlh/get-file state file-id) file (wsh/get-file state file-id)
xf-filter (comp xf-filter (comp
(filter :local-change?) (filter :local-change?)
(map #(dissoc % :local-change?))) (map #(dissoc % :local-change?)))
local-rchanges (into [] xf-filter rchanges) local-changes (-> changes
local-uchanges (into [] xf-filter uchanges) (update :redo-changes #(into [] xf-filter %))
(update :undo-changes #(into [] xf-filter %)))
xf-remove (comp xf-remove (comp
(remove :local-change?) (remove :local-change?)
(map #(dissoc % :local-change?))) (map #(dissoc % :local-change?)))
rchanges (into [] xf-remove rchanges) nonlocal-changes (-> changes
uchanges (into [] xf-remove uchanges)] (update :redo-changes #(into [] xf-remove %))
(update :undo-changes #(into [] xf-remove %)))]
(log/debug :msg "UPDATE-COMPONENT finished" (log/debug :msg "UPDATE-COMPONENT finished"
:js/local-rchanges (log-changes :js/local-changes (log-changes
local-rchanges (:redo-changes local-changes)
file) file)
:js/rchanges (log-changes :js/nonlocal-changes (log-changes
rchanges (:redo-changes nonlocal-changes)
file)) file))
(rx/of (rx/of
(when (seq local-rchanges) (when (seq (:redo-changes local-changes))
(dch/commit-changes {:redo-changes local-rchanges (dch/commit-changes (assoc local-changes
:undo-changes local-uchanges :file-id (:id local-file))))
:origin it (when (seq (:redo-changes nonlocal-changes))
:file-id (:id local-file)})) (dch/commit-changes (assoc nonlocal-changes
(when (seq rchanges) :file-id file-id))))))))
(dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it
:file-id file-id})))))))
(defn update-component-sync (defn update-component-sync
[shape-id file-id] [shape-id file-id]
@ -678,34 +567,31 @@
(log/info :msg "SYNC-FILE" (log/info :msg "SYNC-FILE"
:file (dwlh/pretty-file file-id state) :file (dwlh/pretty-file file-id state)
:library (dwlh/pretty-file library-id state)) :library (dwlh/pretty-file library-id state))
(let [file (dwlh/get-file state file-id) (let [file (wsh/get-file state file-id)
library-changes [(dwlh/generate-sync-library file-id :components library-id state)
(dwlh/generate-sync-library file-id :colors library-id state)
(dwlh/generate-sync-library file-id :typographies library-id state)]
file-changes [(dwlh/generate-sync-file file-id :components library-id state)
(dwlh/generate-sync-file file-id :colors library-id state)
(dwlh/generate-sync-file file-id :typographies library-id state)]
xf-fcat (comp (remove nil?) (map first) (mapcat identity)) library-changes (reduce
rchanges (d/concat-vec pcb/concat-changes
(sequence xf-fcat library-changes) (pcb/empty-changes it)
(sequence xf-fcat file-changes)) [(dwlh/generate-sync-library it file-id :components library-id state)
(dwlh/generate-sync-library it file-id :colors library-id state)
(dwlh/generate-sync-library it file-id :typographies library-id state)])
file-changes (reduce
pcb/concat-changes
(pcb/empty-changes it)
[(dwlh/generate-sync-file it file-id :components library-id state)
(dwlh/generate-sync-file it file-id :colors library-id state)
(dwlh/generate-sync-file it file-id :typographies library-id state)])
xf-scat (comp (remove nil?) (map second) (mapcat identity)) changes (pcb/concat-changes library-changes file-changes)]
uchanges (d/concat-vec
(sequence xf-scat library-changes)
(sequence xf-scat file-changes))]
(log/debug :msg "SYNC-FILE finished" :js/rchanges (log-changes (log/debug :msg "SYNC-FILE finished" :js/rchanges (log-changes
rchanges (:redo-changes changes)
file)) file))
(rx/concat (rx/concat
(rx/of (dm/hide-tag :sync-dialog)) (rx/of (dm/hide-tag :sync-dialog))
(when rchanges (when (seq (:redo-changes changes))
(rx/of (dch/commit-changes {:redo-changes rchanges (rx/of (dch/commit-changes (assoc changes ;; TODO a ver qué pasa con esto
:undo-changes uchanges :file-id file-id))))
:origin it
:file-id file-id})))
(when (not= file-id library-id) (when (not= file-id library-id)
;; When we have just updated the library file, give some time for the ;; When we have just updated the library file, give some time for the
;; update to finish, before marking this file as synced. ;; update to finish, before marking this file as synced.
@ -717,7 +603,7 @@
(rp/mutation :update-sync (rp/mutation :update-sync
{:file-id file-id {:file-id file-id
:library-id library-id}))) :library-id library-id})))
(when (some? library-changes) (when (seq (:redo-changes library-changes))
(rx/of (sync-file-2nd-stage file-id library-id)))))))) (rx/of (sync-file-2nd-stage file-id library-id))))))))
(defn sync-file-2nd-stage (defn sync-file-2nd-stage
@ -738,19 +624,17 @@
(log/info :msg "SYNC-FILE (2nd stage)" (log/info :msg "SYNC-FILE (2nd stage)"
:file (dwlh/pretty-file file-id state) :file (dwlh/pretty-file file-id state)
:library (dwlh/pretty-file library-id state)) :library (dwlh/pretty-file library-id state))
(let [file (dwlh/get-file state file-id) (let [file (wsh/get-file state file-id)
[rchanges1 uchanges1] (dwlh/generate-sync-file file-id :components library-id state) changes (reduce
[rchanges2 uchanges2] (dwlh/generate-sync-library file-id :components library-id state) pcb/concat-changes
rchanges (d/concat-vec rchanges1 rchanges2) (pcb/empty-changes it)
uchanges (d/concat-vec uchanges1 uchanges2)] [(dwlh/generate-sync-file it file-id :components library-id state)
(when rchanges (dwlh/generate-sync-library it file-id :components library-id state)])]
(when (seq (:redo-changes changes))
(log/debug :msg "SYNC-FILE (2nd stage) finished" :js/rchanges (log-changes (log/debug :msg "SYNC-FILE (2nd stage) finished" :js/rchanges (log-changes
rchanges (:redo-changes changes)
file)) file))
(rx/of (dch/commit-changes {:redo-changes rchanges (rx/of (dch/commit-changes (assoc changes :file-id file-id))))))))
:undo-changes uchanges
:origin it
:file-id file-id})))))))
(def ignore-sync (def ignore-sync
(ptk/reify ::ignore-sync (ptk/reify ::ignore-sync

649
frontend/src/app/main/data/workspace/libraries_helpers.cljs
View file

File diff suppressed because it is too large Load diff

6
frontend/src/app/main/data/workspace/selection.cljs
View file

@ -314,7 +314,7 @@
(geom/move delta) (geom/move delta)
(d/update-when :interactions #(cti/remap-interactions % ids-map objects))) (d/update-when :interactions #(cti/remap-interactions % ids-map objects)))
changes (-> (pcb/add-obj changes new-frame) changes (-> (pcb/add-object changes new-frame)
(pcb/amend-last-change #(assoc % :old-id (:id obj)))) (pcb/amend-last-change #(assoc % :old-id (:id obj))))
changes (reduce (fn [changes child] changes (reduce (fn [changes child]
@ -349,8 +349,8 @@
(geom/move delta) (geom/move delta)
(d/update-when :interactions #(cti/remap-interactions % ids-map objects))) (d/update-when :interactions #(cti/remap-interactions % ids-map objects)))
changes (pcb/add-obj changes new-obj {:ignore-touched true}) changes (pcb/add-object changes new-obj {:ignore-touched true})
changes (-> (pcb/add-obj changes new-obj {:ignore-touched true}) changes (-> (pcb/add-object changes new-obj {:ignore-touched true})
(pcb/amend-last-change #(assoc % :old-id (:id obj))))] (pcb/amend-last-change #(assoc % :old-id (:id obj))))]
(reduce (fn [changes child] (reduce (fn [changes child]

22
frontend/src/app/main/data/workspace/state_helpers.cljs
View file

@ -37,7 +37,6 @@
(get-in state [:workspace-data :components]))) (get-in state [:workspace-data :components])))
;; TODO: improve performance of this ;; TODO: improve performance of this
(defn lookup-selected (defn lookup-selected
([state] ([state]
(lookup-selected state nil)) (lookup-selected state nil))
@ -68,3 +67,24 @@
([state page-id filter-fn] ([state page-id filter-fn]
(let [objects (lookup-page-objects state page-id)] (let [objects (lookup-page-objects state page-id)]
(into [] (filter filter-fn) (vals objects))))) (into [] (filter filter-fn) (vals objects)))))
(defn get-local-file
"Get the data content of the file you are currently working with."
[state]
(get state :workspace-data))
(defn get-file
"Get the data content of the given file (it may be the current file
or one library)."
[state file-id]
(if (= file-id (:current-file-id state))
(get state :workspace-data)
(get-in state [:workspace-libraries file-id :data])))
(defn get-libraries
"Retrieve all libraries, including the local file."
[state]
(let [{:keys [id] :as local} (:workspace-data state)]
(-> (:workspace-libraries state)
(assoc id {:id id
:data local}))))

4
frontend/src/app/main/data/workspace/svg_upload.cljs
View file

@ -399,7 +399,7 @@
new-shape (dwc/make-new-shape shape objects selected) new-shape (dwc/make-new-shape shape objects selected)
changes (-> changes changes (-> changes
(pcb/with-objects objects) (pcb/with-objects objects)
(pcb/add-obj new-shape) (pcb/add-object new-shape)
(pcb/change-parent parent-id [new-shape] index)) (pcb/change-parent parent-id [new-shape] index))
unames (conj unames (:name new-shape)) unames (conj unames (:name new-shape))
@ -480,7 +480,7 @@
;; Creates the root shape ;; Creates the root shape
new-shape (dwc/make-new-shape root-shape objects selected) new-shape (dwc/make-new-shape root-shape objects selected)
changes (-> (pcb/empty-changes it page-id) changes (-> (pcb/empty-changes it page-id)
(pcb/add-obj new-shape)) (pcb/add-object new-shape))
root-attrs (-> (:attrs svg-data) root-attrs (-> (:attrs svg-data)
(usvg/format-styles)) (usvg/format-styles))

3
frontend/src/app/main/ui/workspace/context_menu.cljs
View file

@ -395,12 +395,13 @@
:shortcut (sc/get-tooltip :create-component) :shortcut (sc/get-tooltip :create-component)
:on-click do-add-component}] :on-click do-add-component}]
(when has-component? (when has-component?
[:*
[:& menu-entry {:title (tr "workspace.shape.menu.detach-instances-in-bulk") [:& menu-entry {:title (tr "workspace.shape.menu.detach-instances-in-bulk")
:shortcut (sc/get-tooltip :detach-component) :shortcut (sc/get-tooltip :detach-component)
:on-click do-detach-component-in-bulk}] :on-click do-detach-component-in-bulk}]
(when (not single?) (when (not single?)
[:& menu-entry {:title (tr "workspace.shape.menu.update-components-in-bulk") [:& menu-entry {:title (tr "workspace.shape.menu.update-components-in-bulk")
:on-click do-update-in-bulk}]))]) :on-click do-update-in-bulk}])])])
(when is-component? (when is-component?
;; WARNING: this menu is the same as the context menu at the sidebar. ;; WARNING: this menu is the same as the context menu at the sidebar.

57
frontend/src/debug.cljs
View file

@ -148,36 +148,51 @@
(clj->js (get-in @st/state path))) (clj->js (get-in @st/state path)))
nil) nil)
(defn ^:export dump-objects [] (defn dump-objects'
(let [page-id (get @st/state :current-page-id) [state]
objects (get-in @st/state [:workspace-data :pages-index page-id :objects])] (let [page-id (get state :current-page-id)
objects (get-in state [:workspace-data :pages-index page-id :objects])]
(logjs "objects" objects) (logjs "objects" objects)
nil)) nil))
(defn ^:export dump-object [name] (defn ^:export dump-objects
(let [page-id (get @st/state :current-page-id) []
objects (get-in @st/state [:workspace-data :pages-index page-id :objects]) (dump-objects' @st/state))
(defn dump-object'
[state name]
(let [page-id (get state :current-page-id)
objects (get-in state [:workspace-data :pages-index page-id :objects])
result (or (d/seek (fn [[_ shape]] (= name (:name shape))) objects) result (or (d/seek (fn [[_ shape]] (= name (:name shape))) objects)
(get objects (uuid/uuid name)))] (get objects (uuid/uuid name)))]
(logjs name result) (logjs name result)
nil)) nil))
(defn ^:export dump-selected [] (defn ^:export dump-object
(let [page-id (get @st/state :current-page-id) [name]
objects (get-in @st/state [:workspace-data :pages-index page-id :objects]) (dump-object' @st/state name))
selected (get-in @st/state [:workspace-local :selected])
(defn dump-selected'
[state]
(let [page-id (get state :current-page-id)
objects (get-in state [:workspace-data :pages-index page-id :objects])
selected (get-in state [:workspace-local :selected])
result (->> selected (map (d/getf objects)))] result (->> selected (map (d/getf objects)))]
(logjs "selected" result) (logjs "selected" result)
nil)) nil))
(defn ^:export dump-tree (defn ^:export dump-selected
([] (dump-tree false false)) []
([show-ids] (dump-tree show-ids false)) (dump-selected' @st/state))
([show-ids show-touched]
(let [page-id (get @st/state :current-page-id) (defn dump-tree'
objects (get-in @st/state [:workspace-data :pages-index page-id :objects]) ([state ] (dump-tree' state false false))
components (get-in @st/state [:workspace-data :components]) ([state show-ids] (dump-tree' state show-ids false))
libraries (get @st/state :workspace-libraries) ([state show-ids show-touched]
(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 state :workspace-libraries)
root (d/seek #(nil? (:parent-id %)) (vals objects))] root (d/seek #(nil? (:parent-id %)) (vals objects))]
(letfn [(show-shape [shape-id level objects] (letfn [(show-shape [shape-id level objects]
@ -243,6 +258,11 @@
(println (str/format "[%s]" (:name component))) (println (str/format "[%s]" (:name component)))
(show-shape (:id component) 0 (:objects component))))))))) (show-shape (:id component) 0 (:objects component)))))))))
(defn ^:export dump-tree
([] (dump-tree' @st/state))
([show-ids] (dump-tree' @st/state show-ids))
([show-ids show-touched] (dump-tree' @st/state show-ids show-touched)))
(when *assert* (when *assert*
(defonce debug-subscription (defonce debug-subscription
(->> st/stream (->> st/stream
@ -274,7 +294,6 @@
dw/reset-zoom dw/reset-zoom
(dw/update-viewport-position {:x (constantly 0) :y (constantly 0)}))) (dw/update-viewport-position {:x (constantly 0) :y (constantly 0)})))
(defn ^:export hide-ui (defn ^:export hide-ui
[] []
(st/emit! (st/emit!

556
frontend/test/app/components_basic_test.cljs
View file

@ -4,6 +4,7 @@
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw] [app.main.data.workspace :as dw]
[app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.libraries :as dwl] [app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.libraries-helpers :as dwlh] [app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.state-helpers :as wsh] [app.main.data.workspace.state-helpers :as wsh]
@ -14,63 +15,66 @@
[cljs.pprint :refer [pprint]] [cljs.pprint :refer [pprint]]
[cljs.test :as t :include-macros true] [cljs.test :as t :include-macros true]
[clojure.stacktrace :as stk] [clojure.stacktrace :as stk]
[linked.core :as lks])) [linked.core :as lks]
[potok.core :as ptk]))
(t/use-fixtures :each (t/use-fixtures :each
{:before thp/reset-idmap!}) {:before thp/reset-idmap!})
;; Test using potok (t/deftest test-add-component-from-single-shape
#_(t/deftest test-add-component-from-single-shape
(t/testing "test-add-component-from-single-shape" (t/testing "test-add-component-from-single-shape"
(t/async (t/async
done done
(let [state (-> thp/initial-state (let [state (-> thp/initial-state
(thp/sample-page) (thp/sample-page)
(thp/sample-shape :shape1 :rect (thp/sample-shape :shape1 :rect
{:name "Rect 1"})) {:name "Rect-1"}))
store (ptk/store {:state state})
stream (ptk/input-stream store)
end? (->> stream (rx/filter #(= ::end %)))]
(->> stream store (the/prepare-store state done
(rx/take-until end?) (fn [new-state]
(rx/last) ; Expected shape tree:
(rx/do ;
(fn [] ; [Page]
(let [new-state @store ; Root Frame
shape1 (thp/get-shape new-state :shape1) ; Rect-2 #--> Rect-2
; Rect-1 ---> Rect-1
;
; [Rect-1]
; Rect-2
; Rect-1
;
(let [shape1 (thp/get-shape new-state :shape1)
[[group shape1] [c-group c-shape1] component] [[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main (thl/resolve-instance-and-main
new-state new-state
(:parent-id shape1)) (:parent-id shape1))
file (dwlh/get-local-file new-state)] file (wsh/get-local-file new-state)]
(t/is (= (:name shape1) "Rect 1")) (t/is (= (:name shape1) "Rect-1"))
(t/is (= (:name group) "Component-1")) (t/is (= (:name group) "Rect-2"))
(t/is (= (:name component) "Component-1")) (t/is (= (:name component) "Rect-1"))
(t/is (= (:name c-shape1) "Rect 1")) (t/is (= (:name c-shape1) "Rect-1"))
(t/is (= (:name c-group) "Component-1")) (t/is (= (:name c-group) "Rect-2"))
(thl/is-from-file group file)))) (thl/is-from-file group file))))]
(rx/subs done #(throw %)))
(ptk/emit! (ptk/emit!
store store
(dw/select-shape (thp/id :shape1)) (dw/select-shape (thp/id :shape1))
(dwl/add-component) (dwl/add-component)
::end))))) :the/end)))))
;; FAILING ;; Remove definitely when we ensure that the other method works
;; well in more advanced tests.
#_(t/deftest test-add-component-from-single-shape #_(t/deftest test-add-component-from-single-shape
(t/async (t/async
done done
(let [state (-> thp/initial-state (let [state (-> thp/initial-state
(thp/sample-page) (thp/sample-page)
(thp/sample-shape :shape1 :rect (thp/sample-shape :shape1 :rect
{:name "Rect 1"}))] {:name "Rect-1"}))]
(->> state (->> state
(the/do-update (dw/select-shape (thp/id :shape1))) (the/do-update (dw/select-shape (thp/id :shape1)))
@ -84,36 +88,43 @@
new-state new-state
(:parent-id shape1)) (:parent-id shape1))
file (dwlh/get-local-file new-state)] file (wsh/get-local-file new-state)]
(t/is (= (:name shape1) "Rect 1")) (t/is (= (:name shape1) "Rect-1"))
(t/is (= (:name group) "Component-1")) (t/is (= (:name group) "Component-1"))
(t/is (= (:name component) "Component-1")) (t/is (= (:name component) "Component-1"))
(t/is (= (:name c-shape1) "Rect 1")) (t/is (= (:name c-shape1) "Rect-1"))
(t/is (= (:name c-group) "Component-1")) (t/is (= (:name c-group) "Component-1"))
(thl/is-from-file group file)))) (thl/is-from-file group file))))
(rx/subs done #(throw %)))))) (rx/subs done #(throw %))))))
;; FAILING (t/deftest test-add-component-from-several-shapes
#_(t/deftest test-add-component-from-several-shapes
(t/async (t/async
done done
(let [state (-> thp/initial-state (let [state (-> thp/initial-state
(thp/sample-page) (thp/sample-page)
(thp/sample-shape :shape1 :rect (thp/sample-shape :shape1 :rect
{:name "Rect 1"}) {:name "Rect-1"})
(thp/sample-shape :shape2 :rect (thp/sample-shape :shape2 :rect
{:name "Rect 2"}))] {:name "Rect-2"}))
(->> state store (the/prepare-store state done
(the/do-update (dw/select-shapes (lks/set
(thp/id :shape1)
(thp/id :shape2))))
(the/do-watch-update dwl/add-component)
(rx/do
(fn [new-state] (fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1 #--> Component-1
; Rect-1 ---> Rect-1
; Rect-2 ---> Rect-2
;
; [Component-1]
; Component-1
; Rect-1
; Rect-2
;
(let [shape1 (thp/get-shape new-state :shape1) (let [shape1 (thp/get-shape new-state :shape1)
[[group shape1 shape2] [[group shape1 shape2]
@ -123,41 +134,53 @@
new-state new-state
(:parent-id shape1)) (:parent-id shape1))
file (dwlh/get-local-file new-state)] file (wsh/get-local-file new-state)]
;; NOTE: the group name depends on having executed
;; the previous test.
(t/is (= (:name group) "Component-1")) (t/is (= (:name group) "Component-1"))
(t/is (= (:name shape1) "Rect 1")) (t/is (= (:name shape1) "Rect-1"))
(t/is (= (:name shape2) "Rect 2")) (t/is (= (:name shape2) "Rect-2"))
(t/is (= (:name component) "Component-1")) (t/is (= (:name component) "Component-1"))
(t/is (= (:name c-group) "Component-1")) (t/is (= (:name c-group) "Component-1"))
(t/is (= (:name c-shape1) "Rect 1")) (t/is (= (:name c-shape1) "Rect-1"))
(t/is (= (:name c-shape2) "Rect 2")) (t/is (= (:name c-shape2) "Rect-2"))
(thl/is-from-file group file)))) (thl/is-from-file group file))))]
(rx/subs done #(throw %)))))) (ptk/emit!
store
(dw/select-shapes (lks/set (thp/id :shape1)
(thp/id :shape2)))
(dwl/add-component)
:the/end))))
(t/deftest test-add-component-from-group
#_(t/deftest test-add-component-from-group
(t/async (t/async
done done
(let [state (-> thp/initial-state (let [state (-> thp/initial-state
(thp/sample-page) (thp/sample-page)
(thp/sample-shape :shape1 :rect (thp/sample-shape :shape1 :rect
{:name "Rect 1"}) {:name "Rect-1"})
(thp/sample-shape :shape2 :rect (thp/sample-shape :shape2 :rect
{:name "Rect 2"}) {:name "Rect-2"})
(thp/group-shapes :group1 (thp/group-shapes :group1
[(thp/id :shape1) [(thp/id :shape1)
(thp/id :shape2)]))] (thp/id :shape2)]))
(->> state store (the/prepare-store state done
(the/do-update (dw/select-shape (thp/id :group1)))
(the/do-watch-update dwl/add-component)
(rx/do
(fn [new-state] (fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Group-1 #--> Group-1
; Rect-1 ---> Rect-1
; Rect-2 ---> Rect-2
;
; [Group-1]
; Group-1
; Rect-1
; Rect-2
;
(let [[[group shape1 shape2] (let [[[group shape1 shape2]
[c-group c-shape1 c-shape2] [c-group c-shape1 c-shape2]
component] component]
@ -165,19 +188,23 @@
new-state new-state
(thp/id :group1)) (thp/id :group1))
file (dwlh/get-local-file new-state)] file (wsh/get-local-file new-state)]
(t/is (= (:name shape1) "Rect 1")) (t/is (= (:name shape1) "Rect-1"))
(t/is (= (:name shape2) "Rect 2")) (t/is (= (:name shape2) "Rect-2"))
(t/is (= (:name group) "Group-1")) (t/is (= (:name group) "Group-1"))
(t/is (= (:name component) "Group-1")) (t/is (= (:name component) "Group-1"))
(t/is (= (:name c-shape1) "Rect 1")) (t/is (= (:name c-shape1) "Rect-1"))
(t/is (= (:name c-shape2) "Rect 2")) (t/is (= (:name c-shape2) "Rect-2"))
(t/is (= (:name c-group) "Group-1")) (t/is (= (:name c-group) "Group-1"))
(thl/is-from-file group file)))) (thl/is-from-file group file))))]
(rx/subs done #(throw %)))))) (ptk/emit!
store
(dw/select-shape (thp/id :group1))
(dwl/add-component)
:the/end))))
(t/deftest test-rename-component (t/deftest test-rename-component
(t/async (t/async
@ -185,26 +212,35 @@
(let [state (-> thp/initial-state (let [state (-> thp/initial-state
(thp/sample-page) (thp/sample-page)
(thp/sample-shape :shape1 :rect (thp/sample-shape :shape1 :rect
{:name "Rect 1"}) {:name "Rect-1"})
(thp/make-component :instance1 (thp/make-component :instance1 :component-1
[(thp/id :shape1)])) [(thp/id :shape1)]))
instance1 (thp/get-shape state :instance1)] instance1 (thp/get-shape state :instance1)
(->> state store (the/prepare-store state done
(the/do-watch-update (dwl/rename-component
(:component-id instance1)
"Renamed component"))
(rx/do
(fn [new-state] (fn [new-state]
(let [libs (dwlh/get-libraries new-state) ; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> Renamed component
; Rect-1 ---> Rect-1
;
; [Renamed]
; Renamed component
; Rect-1
(let [libs (wsh/get-libraries new-state)
component (cph/get-component libs component (cph/get-component libs
(:component-file instance1) (:component-file instance1)
(:component-id instance1))] (:component-id instance1))]
(t/is (= (:name component) (t/is (= (:name component)
"Renamed component"))))) "Renamed component")))))]
(rx/subs done #(throw %)))))) (ptk/emit!
store
(dwl/rename-component (:component-id instance1) "Renamed component")
:the/end))))
(t/deftest test-duplicate-component (t/deftest test-duplicate-component
(t/async (t/async
@ -213,17 +249,29 @@
(thp/sample-page) (thp/sample-page)
(thp/sample-shape :shape1 :rect (thp/sample-shape :shape1 :rect
{:name "Rect-1"}) {:name "Rect-1"})
(thp/make-component :instance1 (thp/make-component :instance1 :component-1
[(thp/id :shape1)])) [(thp/id :shape1)]))
instance1 (thp/get-shape state :instance1) instance1 (thp/get-shape state :instance1)
component-id (:component-id instance1)] component-id (:component-id instance1)
(->> state store (the/prepare-store state done
(the/do-watch-update (dwl/duplicate-component
{:id component-id}))
(rx/do
(fn [new-state] (fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> Rect-2
; Rect-1 ---> Rect-1
;
; [Rect-1]
; Rect-2
; Rect-1
;
; [Rect-2]
; Rect-2
; Rect-1
;
(let [new-component-id (->> (get-in new-state (let [new-component-id (->> (get-in new-state
[:workspace-data [:workspace-data
:components]) :components])
@ -244,9 +292,12 @@
new-state new-state
new-component-id)] new-component-id)]
(t/is (= (:name component2) "Rect-2"))))) (t/is (= (:name component2) "Rect-2")))))]
(rx/subs done #(throw %)))))) (ptk/emit!
store
(dwl/duplicate-component {:id component-id})
:the/end))))
(t/deftest test-delete-component (t/deftest test-delete-component
(t/async (t/async
@ -254,30 +305,43 @@
(let [state (-> thp/initial-state (let [state (-> thp/initial-state
(thp/sample-page) (thp/sample-page)
(thp/sample-shape :shape1 :rect (thp/sample-shape :shape1 :rect
{:name "Rect 1"}) {:name "Rect-1"})
(thp/make-component :instance1 (thp/make-component :instance1 :component-1
[(thp/id :shape1)])) [(thp/id :shape1)]))
instance1 (thp/get-shape state :instance1) file (wsh/get-local-file state)
component-id (:component-id instance1)]
(->> state instance1 (thp/get-shape state :instance1)
(the/do-watch-update (dwl/delete-component component-id (:component-id instance1)
{:id component-id}))
(rx/do store (the/prepare-store state done
(fn [new-state] (fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2
; Rect-1
;
(let [[instance1 shape1] (let [[instance1 shape1]
(thl/resolve-instance (thl/resolve-noninstance
new-state new-state
(:id instance1)) (:id instance1))
libs (dwlh/get-libraries new-state) libs (wsh/get-libraries new-state)
component (cph/get-component libs component (cph/get-component libs
(:component-file instance1) (:component-file instance1)
(:component-id instance1))] (:component-id instance1))]
(t/is (nil? component)))))
(rx/subs done #(throw %)))))) (t/is (some? instance1))
(t/is (some? shape1))
(t/is (nil? component)))))]
(ptk/emit!
store
(dwl/delete-component {:id component-id})
(dwl/sync-file (:id file) (:id file))
:the/end))))
(t/deftest test-instantiate-component (t/deftest test-instantiate-component
(t/async (t/async
@ -286,20 +350,28 @@
(thp/sample-page) (thp/sample-page)
(thp/sample-shape :shape1 :rect (thp/sample-shape :shape1 :rect
{:name "Rect-1"}) {:name "Rect-1"})
(thp/make-component :instance1 (thp/make-component :instance1 :component-1
[(thp/id :shape1)])) [(thp/id :shape1)]))
file (dwlh/get-local-file state) file (wsh/get-local-file state)
component-id (thp/id :component-1)
instance1 (thp/get-shape state :instance1) instance1 (thp/get-shape state :instance1)
component-id (:component-id instance1)]
(->> state store (the/prepare-store state done
(the/do-watch-update (dwl/instantiate-component
(:id file)
(:component-id instance1)
(gpt/point 100 100)))
(rx/do
(fn [new-state] (fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> Rect-2
; Rect-1 ---> Rect-1
; Rect-3 #--> Rect-2
; Rect-1 ---> Rect-1
;
; [Rect-2]
; Rect-2
; Rect-1
;
(let [new-instance-id (-> new-state (let [new-instance-id (-> new-state
wsh/lookup-selected wsh/lookup-selected
first) first)
@ -316,9 +388,65 @@
(t/is (= (:name instance2) "Rect-3")) (t/is (= (:name instance2) "Rect-3"))
(t/is (= (:name shape2) "Rect-1")) (t/is (= (:name shape2) "Rect-1"))
(t/is (= (:name c-instance2) "Rect-2")) (t/is (= (:name c-instance2) "Rect-2"))
(t/is (= (:name c-shape2) "Rect-1"))))) (t/is (= (:name c-shape2) "Rect-1"))
(t/is (= (:component-file instance2)
thp/current-file-id)))))]
(rx/subs done #(throw %)))))) (ptk/emit!
store
(dwl/instantiate-component (:id file)
component-id
(gpt/point 100 100))
:the/end))))
(t/deftest test-instantiate-component-from-lib
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/move-to-library :lib1 "Library 1")
(thp/sample-page))
library-id (thp/id :lib1)
component-id (thp/id :component-1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> <Library 1> Rect-2
; Rect-1 ---> <Library 1> Rect-1
;
(let [new-instance-id (-> new-state
wsh/lookup-selected
first)
[[instance2 shape2]
[c-instance2 c-shape2]
component]
(thl/resolve-instance-and-main
new-state
new-instance-id)]
(t/is (= (:id component) component-id))
(t/is (= (:name instance2) "Rect-2"))
(t/is (= (:name shape2) "Rect-1"))
(t/is (= (:name c-instance2) "Rect-2"))
(t/is (= (:name c-shape2) "Rect-1"))
(t/is (= (:component-file instance2) library-id)))))]
(ptk/emit!
store
(dwl/instantiate-component library-id
component-id
(gpt/point 100 100))
:the/end))))
(t/deftest test-detach-component (t/deftest test-detach-component
(t/async (t/async
@ -326,24 +454,222 @@
(let [state (-> thp/initial-state (let [state (-> thp/initial-state
(thp/sample-page) (thp/sample-page)
(thp/sample-shape :shape1 :rect (thp/sample-shape :shape1 :rect
{:name "Rect 1"}) {:name "Rect-1"})
(thp/make-component :instance1 (thp/make-component :instance1 :component-1
[(thp/id :shape1)])) [(thp/id :shape1)]))
instance1 (thp/get-shape state :instance1) instance1 (thp/get-shape state :instance1)
component-id (:component-id instance1)] component-id (:component-id instance1)
(->> state store (the/prepare-store state done
(the/do-watch-update (dwl/detach-component
(:id instance1)))
(rx/do
(fn [new-state] (fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2
; Rect-1
;
; [Rect-2]
; Rect-2
; Rect-1
;
(let [[instance1 shape1] (let [[instance1 shape1]
(thl/resolve-noninstance (thl/resolve-noninstance
new-state new-state
(:id instance1))] (:id instance1))]
(t/is (= (:name "Rect 1")))))) (t/is (some? instance1))
(t/is (some? shape1)))))]
(rx/subs done #(throw %)))))) (ptk/emit!
store
(dwl/detach-component (:id instance1))
:the/end))))
(t/deftest test-add-nested-component
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"}))
file (wsh/get-local-file state)
instance1 (thp/get-shape state :instance1)
component-id (:component-id instance1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Group-1 #--> Group-1
; Rect-2 @--> Rect-2
; Rect-1 ---> Rect-1
;
; [Rect-1]
; Rect-2
; Rect-1
;
; [Group-1]
; Group-1
; Rect-2 @--> Rect-2
; Rect-1 ---> Rect-1
;
(let [page (thp/current-page new-state)
shape1 (thp/get-shape new-state :shape1)
parent1 (cph/get-shape page (:parent-id shape1))
[[group shape1 shape2]
[c-group c-shape1 c-shape2]
component]
(thl/resolve-instance-and-main
new-state
(:parent-id parent1))]
(t/is (= (:name group) "Group-1"))
(t/is (= (:name shape1) "Rect-2"))
(t/is (= (:name shape2) "Rect-1"))
(t/is (= (:name component) "Group-1"))
(t/is (= (:name c-group) "Group-1"))
(t/is (= (:name c-shape1) "Rect-2"))
(t/is (= (:name c-shape2) "Rect-1")))))]
(ptk/emit!
store
(dw/select-shape (thp/id :shape1))
(dwl/add-component)
dwg/group-selected
(dwl/add-component)
:the/end))))
(t/deftest test-instantiate-nested-component
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/group-shapes :group1
[(thp/id :instance1)])
(thp/make-component :instance2 :component-2
[(thp/id :group1)]))
file (wsh/get-local-file state)
instance1 (thp/get-shape state :instance1)
instance2 (thp/get-shape state :instance2)
component-id (:component-id instance2)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> Rect-2
; Rect-2 @--> Rect-2
; Rect-1 ---> Rect-1
; Rect-3 #--> Rect-2
; Rect-2 @--> Rect-2
; Rect-1 ---> Rect-1
;
; [Rect-1]
; Rect-2
; Rect-1
;
; [Rect-2]
; Rect-2
; Rect-2 @--> Rect-2
; Rect-1 ---> Rect-1
;
(let [new-instance-id (-> new-state
wsh/lookup-selected
first)
[[instance3 shape3 shape4]
[c-instance3 c-shape3 c-shape4]
component]
(thl/resolve-instance-and-main
new-state
new-instance-id)]
(t/is (not= (:id instance1) (:id instance3)))
(t/is (= (:id component) component-id))
(t/is (= (:name instance3) "Rect-3"))
(t/is (= (:name shape3) "Rect-2"))
(t/is (= (:name shape4) "Rect-1"))
(t/is (= (:name c-instance3) "Rect-2"))
(t/is (= (:name c-shape3) "Rect-2"))
(t/is (= (:name c-shape4) "Rect-1")))))]
(ptk/emit!
store
(dwl/instantiate-component (:id file)
(:component-id instance2)
(gpt/point 100 100))
:the/end))))
(t/deftest test-instantiate-nested-component-from-lib
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/move-to-library :lib1 "Library 1")
(thp/sample-page)
(thp/instantiate-component :instance2
(thp/id :component-1)
(thp/id :lib1)))
library-id (thp/id :lib1)
component-id (thp/id :component-1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Group-1 #--> Group-1
; Rect-2 @--> <Library 1> Rect-2
; Rect-1 ---> <Library 1> Rect-1
;
; [Group-1]
; Group-1
; Rect-2 @--> <Library 1> Rect-2
; Rect-1 ---> <Library 1> Rect-1
;
(let [instance2 (thp/get-shape new-state :instance2)
[[group1 shape1 shape2] [c-group1 c-shape1 c-shape2] component]
(thl/resolve-instance-and-main
new-state
(:parent-id instance2))]
(t/is (= (:name group1) "Group-1"))
(t/is (= (:name shape1) "Rect-2"))
(t/is (= (:name shape2) "Rect-1"))
(t/is (= (:name c-group1) "Group-1"))
(t/is (= (:name c-shape1) "Rect-2"))
(t/is (= (:name c-shape2) "Rect-1"))
(t/is (= (:component-file group1) thp/current-file-id))
(t/is (= (:component-file shape1) library-id))
(t/is (= (:component-file shape2) nil))
(t/is (= (:component-file c-group1) nil))
(t/is (= (:component-file c-shape1) library-id))
(t/is (= (:component-file c-shape2) nil)))))]
(ptk/emit!
store
(dw/select-shape (thp/id :instance2))
dwg/group-selected
(dwl/add-component)
:the/end))))

789
frontend/test/app/components_sync_test.cljs
View file

@ -3,16 +3,21 @@
[app.common.colors :as clr] [app.common.colors :as clr]
[app.common.data :as d] [app.common.data :as d]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.main.data.workspace.changes :as dwc] [app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.libraries :as dwl] [app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.libraries-helpers :as dwlh] [app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.state-helpers :as wsh]
[app.test-helpers.events :as the] [app.test-helpers.events :as the]
[app.test-helpers.libraries :as thl] [app.test-helpers.libraries :as thl]
[app.test-helpers.pages :as thp] [app.test-helpers.pages :as thp]
[beicon.core :as rx] [beicon.core :as rx]
[cljs.pprint :refer [pprint]] [cljs.pprint :refer [pprint]]
[cljs.test :as t :include-macros true] [cljs.test :as t :include-macros true]
[linked.core :as lks])) [linked.core :as lks]
[potok.core :as ptk]))
(t/use-fixtures :each (t/use-fixtures :each
{:before thp/reset-idmap!}) {:before thp/reset-idmap!})
@ -26,46 +31,221 @@
{:name "Rect 1" {:name "Rect 1"
:fill-color clr/white :fill-color clr/white
:fill-opacity 1}) :fill-opacity 1})
(thp/make-component :instance1 (thp/make-component :instance1 :component-1
[(thp/id :shape1)])) [(thp/id :shape1)]))
shape1 (thp/get-shape state :shape1) shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
update-shape (fn [shape] update-fn (fn [shape]
(merge shape {:fill-color clr/test (merge shape {:fill-color clr/test
:fill-opacity 0.5}))] :fill-opacity 0.5}))
(->> state store (the/prepare-store state done
(the/do-watch-update (dwc/update-shapes [(:id shape1)]
update-shape))
(rx/do
(fn [new-state] (fn [new-state]
(let [shape1 (thp/get-shape new-state :shape1) ; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1* ---> Rect 1
; #{:fill-group}
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance1 (thp/get-shape new-state :instance1)
shape1 (thp/get-shape new-state :shape1)
[[group shape1] [c-group c-shape1] component] [[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main (thl/resolve-instance-and-main
new-state new-state
(:id instance1)) (:id instance1))]
file (dwlh/get-local-file new-state)]
(t/is (= (:touched instance1) nil))
(t/is (= (:touched shape1) #{:fill-group}))
(t/is (= (:fill-color shape1) clr/test)) (t/is (= (:fill-color shape1) clr/test))
(t/is (= (:fill-opacity shape1) 0.5)) (t/is (= (:fill-opacity shape1) 0.5))
(t/is (= (:touched shape1) #{:fill-group})) (t/is (= (:touched c-group) nil))
(t/is (= (:touched c-shape1) nil))
(t/is (= (:fill-color c-shape1) clr/white)) (t/is (= (:fill-color c-shape1) clr/white))
(t/is (= (:fill-opacity c-shape1) 1)) (t/is (= (:fill-opacity c-shape1) 1)))))]
(t/is (= (:touched c-shape1) nil)))))
(rx/subs (ptk/emit!
done store
#(do (dch/update-shapes [(:id shape1)] update-fn)
(println (.-stack %)) :the/end)))))
(done)))))
(catch :default e (t/deftest test-touched-children-add
(println (.-stack e)) (t/async done
(done))))) (try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/sample-shape :shape2 :circle
{:name "Circle 1"}))
instance1 (thp/get-shape state :instance1)
shape2 (thp/get-shape state :shape2)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1* #--> Rect 1-1
; #{:shapes-group}
; Circle 1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1 shape2] [c-group c-shape1] component]
(thl/resolve-instance-and-main-allow-dangling
new-state
(:id instance1))]
(t/is (= (:touched group) #{:shapes-group}))
(t/is (nil? (:touched shape1)))
(t/is (= (:name shape1) "Circle 1"))
(t/is (nil? (:shape-ref shape1)))
(t/is (nil? (:touched shape2)))
(t/is (= (:name shape2) "Rect 1"))
(t/is (some? (:shape-ref shape2)))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape1))))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape2)} (:id instance1) 0)
:the/end)))))
(t/deftest test-touched-children-delete
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)]))
shape1 (thp/get-shape state :shape1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1* #--> Component-1
; #{:shapes-group}
; Rect 2 ---> Rect 2
;
; [Component-1]
; Component-1
; Rect 1
; Rect 2
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape2] [c-group c-shape2] component]
(thl/resolve-instance-and-main-allow-dangling
new-state
(:id instance1))]
(t/is (= (:touched group) #{:shapes-group}))
(t/is (nil? (:touched shape2)))
(t/is (= (:name shape2) "Rect 2"))
(t/is (some? (:shape-ref shape2)))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape2))))))]
(ptk/emit!
store
(dwc/delete-shapes #{(:id shape1)})
:the/end)))))
(t/deftest test-touched-children-move
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/sample-shape :shape3 :rect
{:name "Rect 3"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)
(thp/id :shape3)]))
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1* #--> Component-1
; #{:shapes-group}
; Rect 2 ---> Rect 2
; Rect 1 ---> Rect 1
; Rect 3 ---> Rect 3
;
; [Component-1]
; Component-1
; Rect 1
; Rect 2
; Rect 3
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1 shape2 shape3]
[c-group c-shape1 c-shape2 c-shape3] component]
(thl/resolve-instance-and-main-allow-dangling
new-state
(:id instance1))]
(t/is (= (:touched group) #{:shapes-group}))
(t/is (nil? (:touched shape1)))
(t/is (some? (:shape-ref shape1)))
(t/is (= (:name shape1) "Rect 2"))
(t/is (nil? (:touched shape2)))
(t/is (some? (:shape-ref shape2)))
(t/is (= (:name shape2) "Rect 1"))
(t/is (nil? (:touched shape3)))
(t/is (some? (:shape-ref shape3)))
(t/is (= (:name shape3) "Rect 3"))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape1)))
(t/is (= (:name c-shape1) "Rect 1"))
(t/is (nil? (:touched c-shape2)))
(t/is (= (:name c-shape2) "Rect 2"))
(t/is (nil? (:touched c-shape3)))
(t/is (= (:name c-shape3) "Rect 3")))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape1)} (:id instance1) 2)
:the/end)))))
(t/deftest test-reset-changes (t/deftest test-reset-changes
(t/async done (t/async done
@ -76,48 +256,561 @@
{:name "Rect 1" {:name "Rect 1"
:fill-color clr/white :fill-color clr/white
:fill-opacity 1}) :fill-opacity 1})
(thp/make-component :instance1 (thp/make-component :instance1 :component-1
[(thp/id :shape1)])) [(thp/id :shape1)]))
shape1 (thp/get-shape state :shape1) shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1) instance1 (thp/get-shape state :instance1)
update-shape (fn [shape] update-fn (fn [shape]
(merge shape {:fill-color clr/test (merge shape {:fill-color clr/test
:fill-opacity 0.5}))] :fill-opacity 0.5}))
(->> state store (the/prepare-store state done
(the/do-watch-update (dwc/update-shapes [(:id shape1)]
update-shape))
(rx/mapcat #(the/do-watch-update
(dwl/reset-component (:id instance1)) %))
(rx/do
(fn [new-state] (fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [shape1 (thp/get-shape new-state :shape1) (let [shape1 (thp/get-shape new-state :shape1)
[[group shape1] [c-group c-shape1] component] [[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main (thl/resolve-instance-and-main
new-state new-state
(:id instance1)) (:id instance1))]
file (dwlh/get-local-file new-state)]
(t/is (= (:fill-color shape1) clr/white)) (t/is (= (:fill-color shape1) clr/white))
(t/is (= (:fill-opacity shape1) 1)) (t/is (= (:fill-opacity shape1) 1))
(t/is (= (:touched shape1) nil)) (t/is (= (:touched shape1) nil))
(t/is (= (:fill-color c-shape1) clr/white)) (t/is (= (:fill-color c-shape1) clr/white))
(t/is (= (:fill-opacity c-shape1) 1)) (t/is (= (:fill-opacity c-shape1) 1))
(t/is (= (:touched c-shape1) nil))))) (t/is (= (:touched c-shape1) nil)))))]
(rx/subs (ptk/emit!
done store
#(do (dch/update-shapes [(:id shape1)] update-fn)
(println (.-stack %)) (dwl/reset-component (:id instance1))
(done))))) :the/end)))))
(catch :default e (t/deftest test-reset-children-add
(println (.-stack e)) (t/async done
(done))))) (try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/sample-shape :shape2 :circle
{:name "Circle 1"}))
instance1 (thp/get-shape state :instance1)
shape2 (thp/get-shape state :shape2)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched instance1)))
(t/is (= (:name shape1) "Rect 1"))
(t/is (some? (:shape-ref shape1))))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape2)} (:id instance1) 0)
(dwl/reset-component (:id instance1))
:the/end)))))
(t/deftest test-reset-children-delete
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)]))
instance1 (thp/get-shape state :instance1)
shape1 (thp/get-shape state :shape1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched instance1)))
(t/is (= (:name shape1) "Rect 1"))
(t/is (some? (:shape-ref shape1))))))]
(ptk/emit!
store
(dwc/delete-shapes #{(:id shape1)})
(dwl/reset-component (:id instance1))
:the/end)))))
(t/deftest test-reset-children-move
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/sample-shape :shape3 :rect
{:name "Rect 3"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)
(thp/id :shape3)]))
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1 #--> Component-1
; Rect 1 ---> Rect 1
; Rect 2 ---> Rect 2
; Rect 3 ---> Rect 3
;
; [Component-1]
; Component-1
; Rect 1
; Rect 2
; Rect 3
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1 shape2 shape3] [c-group c-shape1 c-shape2 c-shape3] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched group)))
(t/is (nil? (:touched shape1)))
(t/is (some? (:shape-ref shape1)))
(t/is (= (:name shape1) "Rect 1"))
(t/is (nil? (:touched shape2)))
(t/is (some? (:shape-ref shape2)))
(t/is (= (:name shape2) "Rect 2"))
(t/is (nil? (:touched shape3)))
(t/is (some? (:shape-ref shape3)))
(t/is (= (:name shape3) "Rect 3"))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape1)))
(t/is (= (:name c-shape1) "Rect 1"))
(t/is (nil? (:touched c-shape2)))
(t/is (= (:name c-shape2) "Rect 2"))
(t/is (nil? (:touched c-shape3)))
(t/is (= (:name c-shape3) "Rect 3")))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape1)} (:id instance1) 2)
(dwl/reset-component (:id instance1))
:the/end)))))
(t/deftest test-update-component
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)]))
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
update-fn (fn [shape]
(merge shape {:fill-color clr/test
:fill-opacity 0.5}))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (= (:fill-color shape1) clr/test))
(t/is (= (:fill-opacity shape1) 0.5))
(t/is (= (:touched shape1) nil))
(t/is (= (:fill-color c-shape1) clr/test))
(t/is (= (:fill-opacity c-shape1) 0.5))
(t/is (= (:touched c-shape1) nil)))))]
(ptk/emit!
store
(dch/update-shapes [(:id shape1)] update-fn)
(dwl/update-component (:id instance1))
:the/end)))))
(t/deftest test-update-component-and-sync
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/instantiate-component :instance2
(thp/id :component-1)))
file (wsh/get-local-file state)
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
update-fn (fn [shape]
(merge shape {:fill-color clr/test
:fill-opacity 0.5}))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
; Rect 1-2 #--> Rect 1-1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance2 (thp/get-shape state :instance2)
[[group shape2] [c-group c-shape2] component]
(thl/resolve-instance-and-main
new-state
(:id instance2))]
(t/is (= (:fill-color shape2) clr/test))
(t/is (= (:fill-opacity shape2) 0.5))
(t/is (= (:touched shape2) nil))
(t/is (= (:fill-color c-shape2) clr/test))
(t/is (= (:fill-opacity c-shape2) 0.5))
(t/is (= (:touched c-shape2) nil)))))]
(ptk/emit!
store
(dch/update-shapes [(:id shape1)] update-fn)
(dwl/update-component-sync (:id instance1) (:id file))
:the/end)))))
(t/deftest test-update-preserve-touched
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/instantiate-component :instance2
(thp/id :component-1)))
file (wsh/get-local-file state)
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
instance2 (thp/get-shape state :instance2)
shape2 (cph/get-shape (wsh/lookup-page state)
(first (:shapes instance2)))
update-fn1 (fn [shape]
(merge shape {:fill-color clr/test
:stroke-width 0.5}))
update-fn2 (fn [shape]
(merge shape {:stroke-width 0.2}))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
; Rect 1-2 #--> Rect 1-1
; Rect 1* ---> Rect 1
; #{:stroke-group}
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance2 (thp/get-shape state :instance2)
[[group shape2] [c-group c-shape2] component]
(thl/resolve-instance-and-main
new-state
(:id instance2))]
(t/is (= (:fill-color shape2) clr/test))
(t/is (= (:stroke-width shape2) 0.2))
(t/is (= (:touched shape2 #{:stroke-group})))
(t/is (= (:fill-color c-shape2) clr/test))
(t/is (= (:stroke-width c-shape2) 0.5))
(t/is (= (:touched c-shape2) nil)))))]
(ptk/emit!
store
(dch/update-shapes [(:id shape1)] update-fn1)
(dch/update-shapes [(:id shape2)] update-fn2)
(dwl/update-component-sync (:id instance1) (:id file))
:the/end)))))
(t/deftest test-update-children-add
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/sample-shape :shape2 :circle
{:name "Circle 1"}))
file (wsh/get-local-file state)
instance1 (thp/get-shape state :instance1)
shape2 (thp/get-shape state :shape2)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Circle 1 ---> Circle 1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Circle 1
; Rect 1
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1 shape2] [c-group c-shape1 c-shape2] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched group)))
(t/is (nil? (:touched shape1)))
(t/is (= (:name shape1) "Circle 1"))
(t/is (some? (:shape-ref shape1)))
(t/is (nil? (:touched shape2)))
(t/is (= (:name shape2) "Rect 1"))
(t/is (some? (:shape-ref shape2)))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape1)))
(t/is (= (:name c-shape1) "Circle 1"))
(t/is (nil? (:touched c-shape2)))
(t/is (= (:name c-shape2) "Rect 1")))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape2)} (:id instance1) 0)
(dwl/update-component-sync (:id instance1) (:id file))
:the/end)))))
(t/deftest test-update-children-delete
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)]))
file (wsh/get-local-file state)
instance1 (thp/get-shape state :instance1)
shape1 (thp/get-shape state :shape1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1 #--> Component-1
; Rect 2 ---> Rect 2
;
; [Component-1]
; Component-1
; Rect 2
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape2] [c-group c-shape2] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched group)))
(t/is (nil? (:touched shape2)))
(t/is (= (:name shape2) "Rect 2"))
(t/is (some? (:shape-ref shape2)))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape2)))
(t/is (= (:name c-shape2) "Rect 2")))))]
(ptk/emit!
store
(dwc/delete-shapes #{(:id shape1)})
(dwl/update-component-sync (:id instance1) (:id file))
:the/end)))))
(t/deftest test-update-children-move
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/sample-shape :shape3 :rect
{:name "Rect 3"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)
(thp/id :shape3)]))
file (wsh/get-local-file state)
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1 #--> Component-1
; Rect 2 ---> Rect 2
; Rect 1 ---> Rect 1
; Rect 3 ---> Rect 3
;
; [Component-1]
; Component-1
; Rect 2
; Rect 1
; Rect 3
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1 shape2 shape3] [c-group c-shape1 c-shape2 c-shape3] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched group)))
(t/is (nil? (:touched shape1)))
(t/is (some? (:shape-ref shape1)))
(t/is (= (:name shape1) "Rect 2"))
(t/is (nil? (:touched shape2)))
(t/is (some? (:shape-ref shape2)))
(t/is (= (:name shape2) "Rect 1"))
(t/is (nil? (:touched shape3)))
(t/is (some? (:shape-ref shape3)))
(t/is (= (:name shape3) "Rect 3"))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape1)))
(t/is (= (:name c-shape1) "Rect 2"))
(t/is (nil? (:touched c-shape2)))
(t/is (= (:name c-shape2) "Rect 1"))
(t/is (nil? (:touched c-shape3)))
(t/is (= (:name c-shape3) "Rect 3")))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape1)} (:id instance1) 2)
(dwl/update-component-sync (:id instance1) (:id file))
:the/end)))))

28
frontend/test/app/shapes_test.cljs
View file

@ -12,7 +12,8 @@
[cljs.pprint :refer [pprint]] [cljs.pprint :refer [pprint]]
[cljs.test :as t :include-macros true] [cljs.test :as t :include-macros true]
[clojure.stacktrace :as stk] [clojure.stacktrace :as stk]
[linked.core :as lks])) [linked.core :as lks]
[potok.core :as ptk]))
(t/use-fixtures :each (t/use-fixtures :each
{:before thp/reset-idmap!}) {:before thp/reset-idmap!})
@ -33,27 +34,20 @@
shape (thp/get-shape state :shape1)] shape (thp/get-shape state :shape1)]
(t/is (= (:name shape) "Rect 1"))))) (t/is (= (:name shape) "Rect 1")))))
(t/deftest synctest
(t/testing "synctest"
(let [state {:workspace-local {:color-for-rename "something"}}
new-state (->> state
(the/do-update
dwl/clear-color-for-rename))]
(t/is (= (get-in new-state [:workspace-local :color-for-rename])
nil)))))
(t/deftest asynctest (t/deftest asynctest
(t/testing "asynctest" (t/testing "asynctest"
(t/async done (t/async done
(let [state {} (let [state {}
color {:color clr/white}] color {:color clr/white}
(->> state
(the/do-watch-update store (the/prepare-store state done
(dwl/add-recent-color color))
(rx/map
(fn [new-state] (fn [new-state]
(t/is (= (get-in new-state [:workspace-data (t/is (= (get-in new-state [:workspace-data
:recent-colors]) :recent-colors])
[color])))) [color]))))]
(rx/subs done done))))))
(ptk/emit!
store
(dwl/add-recent-color color)
:the/end)))))

35
frontend/test/app/test_helpers/events.cljs
View file

@ -1,31 +1,50 @@
(ns app.test-helpers.events (ns app.test-helpers.events
(:require (:require
[cljs.test :as t :include-macros true]
[cljs.pprint :refer [pprint]]
[beicon.core :as rx]
[potok.core :as ptk]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw])) [app.main.data.workspace :as dw]
[cljs.test :as t :include-macros true]
[cljs.pprint :refer [pprint]]
[beicon.core :as rx]
[potok.core :as ptk]))
;; ---- Helpers to manage global events ;; ---- Helpers to manage global events
(defn do-update
(defn prepare-store
"Create a store with the given initial state. Wait until
a :the/end event occurs, and then call the function with
the final state at this point."
[state done completed-cb]
(let [store (ptk/store {:state state})
stream (ptk/input-stream store)
stream (->> stream
(rx/take-until (rx/filter #(= :the/end %) stream))
(rx/last)
(rx/do
(fn []
(completed-cb @store)))
(rx/subs done #(throw %)))]
store))
;; Remove definitely when we ensure that the above method works
;; well in more advanced tests.
#_(defn do-update
"Execute an update event and returns the new state." "Execute an update event and returns the new state."
[event state] [event state]
(ptk/update event state)) (ptk/update event state))
(defn do-watch #_(defn do-watch
"Execute a watch event and return an observable, that "Execute a watch event and return an observable, that
emits once a list with all new events." emits once a list with all new events."
[event state] [event state]
(->> (ptk/watch event state nil) (->> (ptk/watch event state nil)
(rx/reduce conj []))) (rx/reduce conj [])))
(defn do-watch-update #_(defn do-watch-update
"Execute a watch event and return an observable, that "Execute a watch event and return an observable, that
emits once the new state, after all new events applied emits once the new state, after all new events applied
in sequence (considering they are all update events)." in sequence (considering they are all update events)."

73
frontend/test/app/test_helpers/libraries.cljs
View file

@ -10,6 +10,7 @@
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw] [app.main.data.workspace :as dw]
[app.main.data.workspace.libraries-helpers :as dwlh] [app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.state-helpers :as wsh]
[app.test-helpers.pages :as thp])) [app.test-helpers.pages :as thp]))
;; ---- Helpers to manage libraries and synchronization ;; ---- Helpers to manage libraries and synchronization
@ -26,11 +27,6 @@
(t/is (some? (:component-id shape))) (t/is (some? (:component-id shape)))
(t/is (nil? (:component-root? shape)))) (t/is (nil? (:component-root? shape))))
(defn is-instance-head
[shape]
(t/is (some? (:shape-ref shape)))
(t/is (some? (:component-id shape))))
(defn is-instance-child (defn is-instance-child
[shape] [shape]
(t/is (some? (:shape-ref shape))) (t/is (some? (:shape-ref shape)))
@ -38,6 +34,12 @@
(t/is (nil? (:component-file shape))) (t/is (nil? (:component-file shape)))
(t/is (nil? (:component-root? shape)))) (t/is (nil? (:component-root? shape))))
(defn is-instance-inner
[shape]
(if (some? (:component-id shape))
(is-instance-subroot shape)
(is-instance-child shape)))
(defn is-noninstance (defn is-noninstance
[shape] [shape]
(t/is (nil? (:shape-ref shape))) (t/is (nil? (:shape-ref shape)))
@ -53,34 +55,38 @@
(:id file)))) (:id file))))
(defn resolve-instance (defn resolve-instance
"Get the shape with the given id and all its children, and
verify that they are a well constructed instance tree."
[state root-inst-id] [state root-inst-id]
(let [page (thp/current-page state) (let [page (thp/current-page state)
root-inst (cph/get-shape page root-inst-id) root-inst (cph/get-shape page root-inst-id)
shapes-inst (cph/get-children-with-self (:objects page) shapes-inst (cph/get-children-with-self (:objects page)
root-inst-id)] root-inst-id)]
;; Validate that the instance tree is well constructed
(is-instance-root (first shapes-inst)) (is-instance-root (first shapes-inst))
(run! is-instance-child (rest shapes-inst)) (run! is-instance-child (rest shapes-inst))
shapes-inst)) shapes-inst))
(defn resolve-noninstance (defn resolve-noninstance
"Get the shape with the given id and all its children, and
verify that they are not a component instance."
[state root-inst-id] [state root-inst-id]
(let [page (thp/current-page state) (let [page (thp/current-page state)
root-inst (cph/get-shape page root-inst-id) root-inst (cph/get-shape page root-inst-id)
shapes-inst (cph/get-children-with-self (:objects page) shapes-inst (cph/get-children-with-self (:objects page)
root-inst-id)] root-inst-id)]
;; Validate that the tree is not an instance
(run! is-noninstance shapes-inst) (run! is-noninstance shapes-inst)
shapes-inst)) shapes-inst))
(defn resolve-instance-and-main (defn resolve-instance-and-main
"Get the shape with the given id and all its children, and also
the main component and all its shapes."
[state root-inst-id] [state root-inst-id]
(let [page (thp/current-page state) (let [page (thp/current-page state)
root-inst (cph/get-shape page root-inst-id) root-inst (cph/get-shape page root-inst-id)
libs (dwlh/get-libraries state) libs (wsh/get-libraries state)
component (cph/get-component libs (:component-id root-inst)) component (cph/get-component libs (:component-id root-inst))
shapes-inst (cph/get-children-with-self (:objects page) root-inst-id) shapes-inst (cph/get-children-with-self (:objects page) root-inst-id)
@ -89,13 +95,20 @@
unique-refs (into #{} (map :shape-ref) shapes-inst) unique-refs (into #{} (map :shape-ref) shapes-inst)
main-exists? (fn [shape] main-exists? (fn [shape]
(t/is (some #(= (:id %) (:shape-ref shape)) (let [component-shape
shapes-main)))] (cph/get-component-shape (:objects page) shape)
component
(cph/get-component libs (:component-id component-shape))
main-shape
(cph/get-shape component (:shape-ref shape))]
(t/is (some? main-shape))))]
;; Validate that the instance tree is well constructed ;; Validate that the instance tree is well constructed
(is-instance-root (first shapes-inst)) (is-instance-root (first shapes-inst))
(run! is-instance-child (rest shapes-inst)) (run! is-instance-inner (rest shapes-inst))
(run! is-noninstance shapes-main)
(t/is (= (count shapes-inst) (t/is (= (count shapes-inst)
(count shapes-main) (count shapes-main)
(count unique-refs))) (count unique-refs)))
@ -103,10 +116,44 @@
[shapes-inst shapes-main component])) [shapes-inst shapes-main component]))
(defn resolve-instance-and-main-allow-dangling
"Get the shape with the given id and all its children, and also
the main component and all its shapes. Allows shapes with the
corresponding component shape missing."
[state root-inst-id]
(let [page (thp/current-page state)
root-inst (cph/get-shape page root-inst-id)
libs (wsh/get-libraries state)
component (cph/get-component libs (:component-id root-inst))
shapes-inst (cph/get-children-with-self (:objects page) root-inst-id)
shapes-main (cph/get-children-with-self (:objects component) (:shape-ref root-inst))
unique-refs (into #{} (map :shape-ref) shapes-inst)
main-exists? (fn [shape]
(let [component-shape
(cph/get-component-shape (:objects page) shape)
component
(cph/get-component libs (:component-id component-shape))
main-shape
(cph/get-shape component (:shape-ref shape))]
(t/is (some? main-shape))))]
;; Validate that the instance tree is well constructed
(is-instance-root (first shapes-inst))
[shapes-inst shapes-main component]))
(defn resolve-component (defn resolve-component
"Get the component with the given id and all its shapes."
[state component-id] [state component-id]
(let [page (thp/current-page state) (let [page (thp/current-page state)
libs (dwlh/get-libraries state) libs (wsh/get-libraries state)
component (cph/get-component libs component-id) component (cph/get-component libs component-id)
root-main (cph/get-component-root component) root-main (cph/get-component-root component)
shapes-main (cph/get-children-with-self (:objects component) (:id root-main))] shapes-main (cph/get-children-with-self (:objects component) (:id root-main))]

48
frontend/test/app/test_helpers/pages.cljs
View file

@ -10,10 +10,10 @@
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw] [app.main.data.workspace :as dw]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.groups :as dwg] [app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.layout :as layout] [app.main.data.workspace.layout :as layout]
[app.main.data.workspace.libraries-helpers :as dwlh])) [app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.state-helpers :as wsh]))
;; ---- Helpers to manage pages and objects ;; ---- Helpers to manage pages and objects
@ -96,19 +96,53 @@
cp/process-changes (:redo-changes changes))))))) cp/process-changes (:redo-changes changes)))))))
(defn make-component (defn make-component
[state label ids] [state instance-label component-label shape-ids]
(let [page (current-page state) (let [page (current-page state)
objects (wsh/lookup-page-objects state (:id page)) objects (wsh/lookup-page-objects state (:id page))
shapes (dwg/shapes-for-grouping objects ids) shapes (dwg/shapes-for-grouping objects shape-ids)
[group rchanges uchanges] [group component-root changes]
(dwlh/generate-add-component nil (dwlh/generate-add-component nil
shapes shapes
(:objects page) (:objects page)
(:id page) (:id page)
current-file-id)] current-file-id)]
(swap! idmap assoc label (:id group)) (swap! idmap assoc instance-label (:id group)
component-label (:id component-root))
(update state :workspace-data (update state :workspace-data
cp/process-changes rchanges))) cp/process-changes (:redo-changes changes))))
(defn instantiate-component
([state label component-id]
(instantiate-component state label component-id current-file-id))
([state label component-id file-id]
(let [page (current-page state)
libraries (wsh/get-libraries state)
[new-shape changes]
(dwlh/generate-instantiate-component nil
file-id
component-id
(gpt/point 100 100)
page
libraries)]
(swap! idmap assoc label (:id new-shape))
(update state :workspace-data
cp/process-changes (:redo-changes changes)))))
(defn move-to-library
[state label name]
(let [library-id (uuid/next)
data (get state :workspace-data)]
(swap! idmap assoc label library-id)
(-> state
(update :workspace-libraries
assoc library-id {:id library-id
:name name
:data {:id library-id
:components (:components data)}})
(update :workspace-data
assoc :components {} :pages [] :pages-index {}))))