🔧 Refactor frontend unit tests and some fixes

This commit is contained in:
Andrés Moya 2022-03-14 13:14:07 +01:00
parent 5a33a002e4
commit 48624b1db6
7 changed files with 550 additions and 318 deletions

View file

@ -34,7 +34,7 @@
[potok.core :as ptk])) [potok.core :as ptk]))
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default ;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
(log/set-level! :debug) (log/set-level! :warn)
(defn- log-changes (defn- log-changes
[changes file] [changes file]
@ -610,15 +610,18 @@
:library (dwlh/pretty-file library-id state)) :library (dwlh/pretty-file library-id state))
(let [file (dwlh/get-file state file-id) (let [file (dwlh/get-file state file-id)
changes (-> (pcb/empty-changes it)) library-changes (reduce
library-changes (-> changes pcb/concat-changes
(dwlh/generate-sync-library file-id :components library-id state) (pcb/empty-changes it)
(dwlh/generate-sync-library file-id :colors library-id state) [(dwlh/generate-sync-library it file-id :components library-id state)
(dwlh/generate-sync-library file-id :typographies library-id state)) (dwlh/generate-sync-library it file-id :colors library-id state)
file-changes (-> library-changes (dwlh/generate-sync-library it file-id :typographies library-id state)])
(dwlh/generate-sync-file file-id :components library-id state) file-changes (reduce
(dwlh/generate-sync-file file-id :colors library-id state) pcb/concat-changes
(dwlh/generate-sync-file file-id :typographies library-id state)) (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)])
changes (pcb/concat-changes library-changes file-changes)] changes (pcb/concat-changes library-changes file-changes)]
@ -663,9 +666,11 @@
: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 (dwlh/get-file state file-id)
changes (-> (pcb/empty-changes it) changes (reduce
(dwlh/generate-sync-file file-id :components library-id state) pcb/concat-changes
(dwlh/generate-sync-library file-id :components library-id state))] (pcb/empty-changes it)
[(dwlh/generate-sync-file it file-id :components library-id state)
(dwlh/generate-sync-library it file-id :components library-id state)])]
(when (seq (:redo-changes changes)) (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
(:redo-changes changes) (:redo-changes changes)

View file

@ -22,8 +22,6 @@
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default ;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
(log/set-level! :warn) (log/set-level! :warn)
;; (defonce empty-changes [[] []])
(defonce color-sync-attrs (defonce color-sync-attrs
[[:fill-color-ref-id :fill-color-ref-file :color :fill-color] [[:fill-color-ref-id :fill-color-ref-file :color :fill-color]
[:fill-color-ref-id :fill-color-ref-file :gradient :fill-color-gradient] [:fill-color-ref-id :fill-color-ref-file :gradient :fill-color-gradient]
@ -128,7 +126,7 @@
[it shapes objects page-id file-id] [it shapes objects page-id file-id]
(if (and (= (count shapes) 1) (if (and (= (count shapes) 1)
(:component-id (first shapes))) (:component-id (first shapes)))
(pcb/empty-changes it) [(first shapes) (pcb/empty-changes it)]
(let [name (if (= 1 (count shapes)) (:name (first shapes)) "Component-1") (let [name (if (= 1 (count shapes)) (:name (first shapes)) "Component-1")
[path name] (cph/parse-path-name name) [path name] (cph/parse-path-name name)
@ -185,7 +183,7 @@
(defn generate-sync-file (defn generate-sync-file
"Generate changes to synchronize all shapes in all pages of the given file, "Generate changes to synchronize all shapes in all pages of the given file,
that use assets of the given type in the given library." that use assets of the given type in the given library."
[changes file-id asset-type library-id state] [it file-id asset-type library-id state]
(s/assert #{:colors :components :typographies} asset-type) (s/assert #{:colors :components :typographies} asset-type)
(s/assert ::us/uuid file-id) (s/assert ::us/uuid file-id)
(s/assert ::us/uuid library-id) (s/assert ::us/uuid library-id)
@ -197,21 +195,23 @@
(let [file (get-file state file-id)] (let [file (get-file state file-id)]
(loop [pages (vals (get file :pages-index)) (loop [pages (vals (get file :pages-index))
changes changes] changes (pcb/empty-changes it)]
(if-let [page (first pages)] (if-let [page (first pages)]
(recur (next pages) (recur (next pages)
(generate-sync-container changes (pcb/concat-changes
asset-type changes
library-id (generate-sync-container it
state asset-type
(cph/make-container page :page))) library-id
state
(cph/make-container page :page))))
changes)))) changes))))
(defn generate-sync-library (defn generate-sync-library
"Generate changes to synchronize all shapes in all components of the "Generate changes to synchronize all shapes in all components of the
local library of the given file, that use assets of the given type in local library of the given file, that use assets of the given type in
the given library." the given library."
[changes file-id asset-type library-id state] [it file-id asset-type library-id state]
(log/info :msg "Sync local components with library" (log/info :msg "Sync local components with library"
:asset-type asset-type :asset-type asset-type
@ -220,20 +220,22 @@
(let [file (get-file state file-id)] (let [file (get-file state file-id)]
(loop [local-components (vals (get file :components)) (loop [local-components (vals (get file :components))
changes changes] changes (pcb/empty-changes it)]
(if-let [local-component (first local-components)] (if-let [local-component (first local-components)]
(recur (next local-components) (recur (next local-components)
(generate-sync-container changes (pcb/concat-changes
asset-type changes
library-id (generate-sync-container it
state asset-type
(cph/make-container local-component :component))) library-id
state
(cph/make-container local-component :component))))
changes)))) changes))))
(defn- generate-sync-container (defn- generate-sync-container
"Generate changes to synchronize all shapes in a particular container (a page "Generate changes to synchronize all shapes in a particular container (a page
or a component) that use assets of the given type in the given library." or a component) that use assets of the given type in the given library."
[changes asset-type library-id state container] [it asset-type library-id state container]
(if (cph/page? container) (if (cph/page? container)
(log/debug :msg "Sync page in local file" :page-id (:id container)) (log/debug :msg "Sync page in local file" :page-id (:id container))
@ -243,7 +245,9 @@
linked-shapes (->> (vals (:objects container)) linked-shapes (->> (vals (:objects container))
(filter has-asset-reference?))] (filter has-asset-reference?))]
(loop [shapes (seq linked-shapes) (loop [shapes (seq linked-shapes)
changes changes] changes (-> (pcb/empty-changes it)
(pcb/with-container container)
(pcb/with-objects (:objects container)))]
(if-let [shape (first shapes)] (if-let [shape (first shapes)]
(recur (next shapes) (recur (next shapes)
(generate-sync-shape asset-type (generate-sync-shape asset-type
@ -530,12 +534,14 @@
component (cph/get-component libraries component (cph/get-component libraries
(:component-file shape-inst) (:component-file shape-inst)
(:component-id shape-inst)) (:component-id shape-inst))
shape-main (cph/get-shape component (:shape-ref shape-inst)) shape-main (when component
(cph/get-shape component (:shape-ref shape-inst)))
initial-root? (:component-root? shape-inst) initial-root? (:component-root? shape-inst)
root-inst shape-inst root-inst shape-inst
root-main (cph/get-component-root component)] root-main (when component
(cph/get-component-root component))]
(if component (if component
(generate-sync-shape-direct-recursive changes (generate-sync-shape-direct-recursive changes
@ -549,7 +555,7 @@
initial-root?) initial-root?)
; If the component is not found, because the master component has been ; If the component is not found, because the master component has been
; deleted or the library unlinked, detach the instance. ; deleted or the library unlinked, detach the instance.
(generate-detach-instance changes shape-id container)))) (generate-detach-instance changes container shape-id))))
(defn- generate-sync-shape-direct-recursive (defn- generate-sync-shape-direct-recursive
[changes container shape-inst component shape-main root-inst root-main reset? initial-root?] [changes container shape-inst component shape-main root-inst root-main reset? initial-root?]
@ -559,7 +565,7 @@
(if (nil? shape-main) (if (nil? shape-main)
;; This should not occur, but protect against it in any case ;; This should not occur, but protect against it in any case
(generate-detach-instance changes (:id shape-inst) container) (generate-detach-instance changes container (:id shape-inst))
(let [omit-touched? (not reset?) (let [omit-touched? (not reset?)
clear-remote-synced? (and initial-root? reset?) clear-remote-synced? (and initial-root? reset?)
set-remote-synced? (and (not initial-root?) reset?) set-remote-synced? (and (not initial-root?) reset?)

View file

@ -1,76 +1,80 @@
(ns app.components-basic-test (ns app.components-basic-test
(: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.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 :as dwl] [app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.libraries-helpers :as dwlh] [app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.state-helpers :as wsh] [app.main.data.workspace.libraries-helpers :as dwlh]
[app.test-helpers.events :as the] [app.main.data.workspace.state-helpers :as wsh]
[app.test-helpers.libraries :as thl] [app.test-helpers.events :as the]
[app.test-helpers.pages :as thp] [app.test-helpers.libraries :as thl]
[beicon.core :as rx] [app.test-helpers.pages :as thp]
[cljs.pprint :refer [pprint]] [beicon.core :as rx]
[cljs.test :as t :include-macros true] [cljs.pprint :refer [pprint]]
[clojure.stacktrace :as stk] [cljs.test :as t :include-macros true]
[linked.core :as lks])) [clojure.stacktrace :as stk]
[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 (dwlh/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)))
@ -86,98 +90,119 @@
file (dwlh/get-local-file new-state)] file (dwlh/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"}))
store (the/prepare-store state done
(->> state (fn [new-state]
(the/do-update (dw/select-shapes (lks/set ; Expected shape tree:
(thp/id :shape1) ;
(thp/id :shape2)))) ; [Page]
(the/do-watch-update dwl/add-component) ; Root Frame
(rx/do ; Component-1 #--> Component-1
(fn [new-state] ; 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]
[c-group c-shape1 c-shape2] [c-group c-shape1 c-shape2]
component] 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 (dwlh/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)]))
store (the/prepare-store state done
(->> state (fn [new-state]
(the/do-update (dw/select-shape (thp/id :group1))) ; Expected shape tree:
(the/do-watch-update dwl/add-component) ;
(rx/do ; [Page]
(fn [new-state] ; 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]
(thl/resolve-instance-and-main (thl/resolve-instance-and-main
new-state new-state
(thp/id :group1)) (thp/id :group1))
file (dwlh/get-local-file new-state)] file (dwlh/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 +210,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
[(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 (fn [new-state]
(:component-id instance1) ; Expected shape tree:
"Renamed component")) ;
(rx/do ; [Page]
(fn [new-state] ; Root Frame
(let [libs (dwlh/get-libraries new-state) ; Rect-2 #--> Renamed component
component (cph/get-component libs ; Rect-1 ---> Rect-1
(:component-file instance1) ;
(:component-id instance1))] ; [Renamed]
(t/is (= (:name component) ; Renamed component
"Renamed component"))))) ; Rect-1
(let [libs (dwlh/get-libraries new-state)
component (cph/get-component libs
(:component-file instance1)
(:component-id instance1))]
(t/is (= (:name 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
@ -217,36 +251,51 @@
[(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 (fn [new-state]
{:id component-id})) ; Expected shape tree:
(rx/do ;
(fn [new-state] ; [Page]
(let [new-component-id (->> (get-in new-state ; Root Frame
[:workspace-data ; Rect-2 #--> Rect-2
:components]) ; Rect-1 ---> Rect-1
(keys) ;
(filter #(not= % component-id)) ; [Rect-1]
(first)) ; Rect-2
; Rect-1
;
; [Rect-2]
; Rect-2
; Rect-1
;
(let [new-component-id (->> (get-in new-state
[:workspace-data
:components])
(keys)
(filter #(not= % component-id))
(first))
[[instance1 shape1] [[instance1 shape1]
[c-instance1 c-shape1] [c-instance1 c-shape1]
component1] component1]
(thl/resolve-instance-and-main (thl/resolve-instance-and-main
new-state new-state
(:id instance1)) (:id instance1))
[[c-component2 c-shape2] [[c-component2 c-shape2]
component2] component2]
(thl/resolve-component (thl/resolve-component
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 +303,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
[(thp/id :shape1)])) [(thp/id :shape1)]))
instance1 (thp/get-shape state :instance1) file (dwlh/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]
(let [[instance1 shape1] ; Expected shape tree:
(thl/resolve-instance ;
; [Page]
; Root Frame
; Rect-2
; Rect-1
;
(let [[instance1 shape1]
(thl/resolve-noninstance
new-state new-state
(:id instance1)) (:id instance1))
libs (dwlh/get-libraries new-state) libs (dwlh/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
@ -291,34 +353,47 @@
file (dwlh/get-local-file state) file (dwlh/get-local-file state)
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/instantiate-component (fn [new-state]
(:id file) ; Expected shape tree:
(:component-id instance1) ;
(gpt/point 100 100))) ; [Page]
(rx/do ; Root Frame
(fn [new-state] ; Rect-2 #--> Rect-2
(let [new-instance-id (-> new-state ; Rect-1 ---> Rect-1
wsh/lookup-selected ; Rect-3 #--> Rect-2
first) ; Rect-1 ---> Rect-1
;
; [Rect-2]
; Rect-2
; Rect-1
;
(let [new-instance-id (-> new-state
wsh/lookup-selected
first)
[[instance2 shape2] [[instance2 shape2]
[c-instance2 c-shape2] [c-instance2 c-shape2]
component] component]
(thl/resolve-instance-and-main (thl/resolve-instance-and-main
new-state new-state
new-instance-id)] new-instance-id)]
(t/is (not= (:id instance1) (:id instance2))) (t/is (not= (:id instance1) (:id instance2)))
(t/is (= (:id component) component-id)) (t/is (= (:id component) component-id))
(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")))))]
(rx/subs done #(throw %)))))) (ptk/emit!
store
(dwl/instantiate-component (:id file)
(:component-id instance1)
(gpt/point 100 100))
:the/end))))
(t/deftest test-detach-component (t/deftest test-detach-component
(t/async (t/async
@ -326,24 +401,162 @@
(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
[(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 (fn [new-state]
(:id instance1))) ; Expected shape tree:
(rx/do ;
(fn [new-state] ; [Page]
(let [[instance1 shape1] ; Root Frame
(thl/resolve-noninstance ; Rect-2
; Rect-1
;
; [Rect-2]
; Rect-2
; Rect-1
;
(let [[instance1 shape1]
(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 (dwlh/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
[(thp/id :shape1)])
(thp/group-shapes :group1
[(thp/id :instance1)])
(thp/make-component :instance2
[(thp/id :group1)]))
file (dwlh/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))))

View file

@ -12,7 +12,8 @@
[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!})
@ -34,38 +35,30 @@
update-shape (fn [shape] update-shape (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)] (fn [new-state]
update-shape)) (let [shape1 (thp/get-shape new-state :shape1)
(rx/do
(fn [new-state]
(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)] file (dwlh/get-local-file new-state)]
(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 shape1) #{:fill-group}))
(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 (dwc/update-shapes [(:id shape1)] update-shape)
(println (.-stack %)) :the/end)))))
(done)))))
(catch :default e
(println (.-stack e))
(done)))))
(t/deftest test-reset-changes (t/deftest test-reset-changes
(t/async done (t/async done
@ -84,40 +77,29 @@
update-shape (fn [shape] update-shape (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)] (fn [new-state]
update-shape)) (let [shape1 (thp/get-shape new-state :shape1)
(rx/mapcat #(the/do-watch-update [[group shape1] [c-group c-shape1] component]
(dwl/reset-component (:id instance1)) %)) (thl/resolve-instance-and-main
new-state
(:id instance1))
(rx/do file (dwlh/get-local-file new-state)]
(fn [new-state]
(let [shape1 (thp/get-shape new-state :shape1)
[[group shape1] [c-group c-shape1] component] (t/is (= (:fill-color shape1) clr/white))
(thl/resolve-instance-and-main (t/is (= (:fill-opacity shape1) 1))
new-state (t/is (= (:touched shape1) nil))
(:id instance1)) (t/is (= (:fill-color c-shape1) clr/white))
(t/is (= (:fill-opacity c-shape1) 1))
(t/is (= (:touched c-shape1) nil)))))]
file (dwlh/get-local-file new-state)] (ptk/emit!
store
(t/is (= (:fill-color shape1) clr/white)) (dwc/update-shapes [(:id shape1)] update-shape)
(t/is (= (:fill-opacity shape1) 1)) (dwl/reset-component (:id instance1))
(t/is (= (:touched shape1) nil)) :the/end)))))
(t/is (= (:fill-color c-shape1) clr/white))
(t/is (= (:fill-opacity c-shape1) 1))
(t/is (= (:touched c-shape1) nil)))))
(rx/subs
done
#(do
(println (.-stack %))
(done)))))
(catch :default e
(println (.-stack e))
(done)))))

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)) (fn [new-state]
(rx/map (t/is (= (get-in new-state [:workspace-data
(fn [new-state] :recent-colors])
(t/is (= (get-in new-state [:workspace-data [color]))))]
:recent-colors])
[color])))) (ptk/emit!
(rx/subs done done)))))) store
(dwl/add-recent-color color)
:the/end)))))

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)."

View file

@ -26,11 +26,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 +33,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,29 +54,33 @@
(: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)
@ -89,13 +94,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)))
@ -104,6 +116,7 @@
[shapes-inst shapes-main component])) [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 (dwlh/get-libraries state)