johanels/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-12-11 22:14:05 +01:00
Code Issues Actions 9 Packages Projects Releases Wiki Activity

Merge tag '2.11.0-RC3'
Some checks failed
Commit Message Check / Check Commit Message (push) Has been cancelled
Details

Browse Source
This commit is contained in:
Andrey Antukh
2025-11-04 16:43:32 +01:00
parent 245190f4f9 37aa59b164
commit 4a01121043
745 changed files with 78479 additions and 39907 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
common/deps.edn
View File

@@ -6,26 +6,28 @@
org.clojure/data.fressian {:mvn/version "1.1.0"}
org.clojure/clojurescript {:mvn/version "1.12.42"}
org.apache.commons/commons-pool2 {:mvn/version "2.12.1"}
;; Logging
org.apache.logging.log4j/log4j-api {:mvn/version "2.24.3"}
org.apache.logging.log4j/log4j-core {:mvn/version "2.24.3"}
org.apache.logging.log4j/log4j-web {:mvn/version "2.24.3"}
org.apache.logging.log4j/log4j-jul {:mvn/version "2.24.3"}
org.apache.logging.log4j/log4j-slf4j2-impl {:mvn/version "2.24.3"}
org.apache.logging.log4j/log4j-api {:mvn/version "2.25.1"}
org.apache.logging.log4j/log4j-core {:mvn/version "2.25.1"}
org.apache.logging.log4j/log4j-web {:mvn/version "2.25.1"}
org.apache.logging.log4j/log4j-jul {:mvn/version "2.25.1"}
org.apache.logging.log4j/log4j-slf4j2-impl {:mvn/version "2.25.1"}
org.slf4j/slf4j-api {:mvn/version "2.0.17"}
pl.tkowalcz.tjahzi/log4j2-appender {:mvn/version "0.9.32"}
pl.tkowalcz.tjahzi/log4j2-appender {:mvn/version "0.9.40"}
selmer/selmer {:mvn/version "1.12.62"}
criterium/criterium {:mvn/version "0.4.6"}
metosin/jsonista {:mvn/version "0.3.13"}
metosin/malli {:mvn/version "0.18.0"}
metosin/malli {:mvn/version "0.19.1"}
expound/expound {:mvn/version "0.9.0"}
com.cognitect/transit-clj {:mvn/version "1.0.333"}
com.cognitect/transit-cljs {:mvn/version "0.8.280"}
java-http-clj/java-http-clj {:mvn/version "0.4.3"}
integrant/integrant {:mvn/version "0.13.1"}
integrant/integrant {:mvn/version "1.0.0"}
funcool/tubax {:mvn/version "2021.05.20-0"}
funcool/cuerdas {:mvn/version "2025.06.16-414"}
@@ -47,7 +49,7 @@
org.la4j/la4j {:mvn/version "0.6.0"}
;; exception printing
fipp/fipp {:mvn/version "0.6.27"}
fipp/fipp {:mvn/version "0.6.29"}
me.flowthing/pp {:mvn/version "2024-11-13.77"}
@@ -59,7 +61,7 @@
{:dev
{:extra-deps
{org.clojure/tools.namespace {:mvn/version "RELEASE"}
thheller/shadow-cljs {:mvn/version "3.1.5"}
thheller/shadow-cljs {:mvn/version "3.2.0"}
com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
com.bhauman/rebel-readline {:mvn/version "RELEASE"}
criterium/criterium {:mvn/version "RELEASE"}
@@ -68,7 +70,7 @@
:build
{:extra-deps
{io.github.clojure/tools.build {:git/tag "v0.10.9" :git/sha "e405aac"}}
{io.github.clojure/tools.build {:mvn/version "0.10.10"}}
:ns-default build}
:test

82
common/src/app/common/buffer.cljc
View File

@@ -50,6 +50,13 @@
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
`(long (.getInt ~target (unchecked-int ~offset))))))
(defmacro read-long
[target offset]
(if (:ns &env)
`(.getInt64 ~target ~offset true)
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
`(.getLong ~target (unchecked-int ~offset)))))
(defmacro read-float
[target offset]
(if (:ns &env)
@@ -75,6 +82,40 @@
(finally
(.order ~target ByteOrder/LITTLE_ENDIAN))))))
(defmacro read-bytes
"Get a byte array from buffer. It is potentially unsafe because on
JS/CLJS it returns a subarray without doing any copy of data."
[target offset size]
(if (:ns &env)
`(new js/Uint8Array
(.-buffer ~target)
(+ (.-byteOffset ~target) ~offset)
~size)
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})
bbuf (with-meta (gensym "bbuf") {:tag bytes})]
`(let [~bbuf (byte-array ~size)]
(.get ~target
(unchecked-int ~offset)
~bbuf
0
~size)
~bbuf))))
;; FIXME: implement in cljs
(defmacro write-bytes
([target offset src size]
`(write-bytes ~target ~offset ~src 0 ~size))
([target offset src src-offset size]
(if (:ns &env)
(throw (ex-info "not implemented" {}))
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})
src (with-meta src {:tag 'bytes})]
`(.put ~target
(unchecked-int ~offset)
~src
(unchecked-int ~src-offset)
(unchecked-int ~size))))))
(defmacro write-byte
[target offset value]
(if (:ns &env)
@@ -144,13 +185,15 @@
(.setUint32 ~target (+ ~offset 12) (aget barray# 3) true))
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})
value (with-meta value {:tag 'java.util.UUID})]
`(try
(.order ~target ByteOrder/BIG_ENDIAN)
(.putLong ~target (unchecked-int (+ ~offset 0)) (.getMostSignificantBits ~value))
(.putLong ~target (unchecked-int (+ ~offset 8)) (.getLeastSignificantBits ~value))
(finally
(.order ~target ByteOrder/LITTLE_ENDIAN))))))
value (with-meta value {:tag 'java.util.UUID})
prev (with-meta (gensym "prev-") {:tag 'java.nio.ByteOrder})]
`(let [~prev (.order ~target)]
(try
(.order ~target ByteOrder/BIG_ENDIAN)
(.putLong ~target (unchecked-int (+ ~offset 0)) (.getMostSignificantBits ~value))
(.putLong ~target (unchecked-int (+ ~offset 8)) (.getLeastSignificantBits ~value))
(finally
(.order ~target ~prev)))))))
(defn wrap
[data]
@@ -160,7 +203,7 @@
(defn allocate
[size]
#?(:clj (let [buffer (ByteBuffer/allocate (int size))]
#?(:clj (let [buffer (ByteBuffer/allocate (unchecked-int size))]
(.order buffer ByteOrder/LITTLE_ENDIAN))
:cljs (new js/DataView (new js/ArrayBuffer size))))
@@ -181,6 +224,14 @@
(.set dst-view src-view)
(js/DataView. dst-buff))))
;; FIXME: cljs impl
#?(:clj
(defn copy-bytes
[src src-offset size dst dst-offset]
(let [tmp (byte-array size)]
(.get ^ByteBuffer src src-offset tmp 0 size)
(.put ^ByteBuffer dst dst-offset tmp 0 size))))
(defn equals?
[buffer-a buffer-b]
#?(:clj
@@ -208,3 +259,18 @@
[o]
#?(:clj (instance? ByteBuffer o)
:cljs (instance? js/DataView o)))
(defn slice
[buffer offset size]
#?(:cljs
(let [offset (+ (.-byteOffset buffer) offset)]
(new js/DataView (.-buffer buffer) offset size))
:clj
(-> (.slice ^ByteBuffer buffer (unchecked-int offset) (unchecked-int size))
(.order ByteOrder/LITTLE_ENDIAN))))
(defn size
[o]
#?(:cljs (.-byteLength ^js o)
:clj (.capacity ^ByteBuffer o)))

23
common/src/app/common/data.cljc
View File

@@ -1024,6 +1024,29 @@
:clj
(sort comp-fn items))))
(defn reorder
"Reorder a vector by moving one of their items from some position to some space between positions.
It clamps the position numbers to a valid range."
[v from-pos to-space-between-pos]
(let [max-space-pos (count v)
max-prop-pos (dec max-space-pos)
from-pos (max 0 (min max-prop-pos from-pos))
to-space-between-pos (max 0 (min max-space-pos to-space-between-pos))]
(if (= from-pos to-space-between-pos)
v
(let [elem (nth v from-pos)
without-elem (-> []
(into (subvec v 0 from-pos))
(into (subvec v (inc from-pos))))
insert-pos (if (< from-pos to-space-between-pos)
(dec to-space-between-pos)
to-space-between-pos)]
(-> []
(into (subvec without-elem 0 insert-pos))
(into [elem])
(into (subvec without-elem insert-pos)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; String Functions

19
common/src/app/common/features.cljc
View File

@@ -51,6 +51,7 @@
"styles/v2"
"layout/grid"
"plugins/runtime"
"tokens/numeric-input"
"design-tokens/v1"
"text-editor/v2"
"render-wasm/v1"
@@ -75,6 +76,7 @@
#{"styles/v2"
"plugins/runtime"
"text-editor/v2"
"tokens/numeric-input"
"render-wasm/v1"})
;; Features that are mainly backend only or there are a proper
@@ -98,17 +100,19 @@
"design-tokens/v1"
"fdata/shape-data-type"
"fdata/path-data"
"tokens/numeric-input"
"variants/v1"}
(into frontend-only-features)
(into backend-only-features)))
(sm/register!
^{::sm/type ::features}
[:schema
{:title "FileFeatures"
::smdj/inline true
:gen/gen (smg/subseq supported-features)}
[::sm/set :string]])
(def schema:features
(sm/register!
^{::sm/type ::features}
[:schema
{:title "FileFeatures"
::smdj/inline true
:gen/gen (smg/subseq supported-features)}
[::sm/set :string]]))
(defn- flag->feature
"Translate a flag to a feature name"
@@ -122,6 +126,7 @@
:feature-text-editor-v2 "text-editor/v2"
:feature-render-wasm "render-wasm/v1"
:feature-variants "variants/v1"
:feature-token-input "tokens/numeric-input"
nil))
(defn migrate-legacy-features

22
common/src/app/common/files/builder.cljc
View File

@@ -8,11 +8,11 @@
"Internal implementation of file builder. Mainly used as base impl
for penpot library"
(:require
;; [app.common.features :as cfeat]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.files.changes :as ch]
;; [app.common.features :as cfeat]
[app.common.files.helpers :as cph]
[app.common.files.migrations :as fmig]
[app.common.geom.shapes :as gsh]
@@ -26,6 +26,7 @@
[app.common.types.path :as types.path]
[app.common.types.shape :as types.shape]
[app.common.types.typography :as types.typography]
[app.common.types.variant :as types.variant]
[app.common.uuid :as uuid]
[cuerdas.core :as str]))
@@ -126,10 +127,12 @@
[:map
[:component-id ::sm/uuid]
[:file-id {:optional true} ::sm/uuid]
[:name {:optional true} ::sm/text]
[:path {:optional true} ::sm/text]
[:page-id {:optional true} ::sm/uuid]
[:frame-id {:optional true} ::sm/uuid]
[:page-id {:optional true} ::sm/uuid]])
[:name {:optional true} :string]
[:path {:optional true} :string]
[:variant-id {:optional true} ::sm/uuid]
[:variant-properties {:optional true} [:vector types.variant/schema:variant-property]]])
(def ^:private check-add-component
(sm/check-fn schema:add-component
@@ -200,7 +203,8 @@
"layout/grid"
"components/v2"
"plugins/runtime"
"design-tokens/v1"})
"design-tokens/v1"
"variants/v1"})
;; WORKAROUND: the same as features
(def available-migrations
@@ -443,7 +447,7 @@
(defn add-component
[state params]
(let [{:keys [component-id file-id page-id frame-id name path]}
(let [{:keys [component-id file-id page-id frame-id name path variant-id variant-properties]}
(-> (check-add-component params)
(update :component-id default-uuid))
@@ -461,9 +465,11 @@
{:type :add-component
:id component-id
:name (or name "anonmous")
:path path
:path (d/nilv path "")
:main-instance-id frame-id
:main-instance-page page-id})
:main-instance-page page-id
:variant-id variant-id
:variant-properties variant-properties})
change2
{:type :mod-obj

124
common/src/app/common/files/changes.cljc
View File

@@ -317,17 +317,19 @@
[:type [:= :add-component]]
[:id ::sm/uuid]
[:name :string]
[:shapes {:optional true} [:vector {:gen/max 3} ::sm/any]]
[:path {:optional true} :string]
[:path :string]
[:main-instance-id ::sm/uuid]
[:main-instance-page ::sm/uuid]]]
[:main-instance-page ::sm/uuid]
;; Only used by external processes (like Penpot SDK)
[:variant-id {:optional true} ::sm/uuid]
[:variant-properties {:optional true} [:vector ctv/schema:variant-property]]]]
[:mod-component
[:map {:title "ModCompoenentChange"}
[:map {:title "ModComponentChange"}
[:type [:= :mod-component]]
[:id ::sm/uuid]
[:shapes {:optional true} [:vector {:gen/max 3} ::sm/any]]
[:name {:optional true} :string]
[:path {:optional true} :string]
[:variant-id {:optional true} ::sm/uuid]
[:variant-properties {:optional true} [:vector ctv/schema:variant-property]]]]
@@ -366,9 +368,33 @@
[:type [:= :del-typography]]
[:id ::sm/uuid]]]
[:update-active-token-themes
[:map {:title "UpdateActiveTokenThemes"}
[:type [:= :update-active-token-themes]]
[:set-tokens-lib
[:map {:title "SetTokensLib"}
[:type [:= :set-tokens-lib]]
[:tokens-lib ::sm/any]]] ;; TODO: we should define a plain object schema for tokens-lib
[:set-token
[:map {:title "SetTokenChange"}
[:type [:= :set-token]]
[:set-id ::sm/uuid]
[:token-id ::sm/uuid]
[:attrs [:maybe ctob/schema:token-attrs]]]]
[:set-token-set
[:map {:title "SetTokenSetChange"}
[:type [:= :set-token-set]]
[:id ::sm/uuid]
[:attrs [:maybe ctob/schema:token-set-attrs]]]]
[:set-token-theme
[:map {:title "SetTokenThemeChange"}
[:type [:= :set-token-theme]]
[:id ::sm/uuid]
[:attrs [:maybe ctob/schema:token-theme-attrs]]]]
[:set-active-token-themes
[:map {:title "SetActiveTokenThemes"}
[:type [:= :set-active-token-themes]]
[:theme-paths [:set :string]]]]
[:rename-token-set-group
@@ -393,39 +419,6 @@
[:before-path [:maybe [:vector :string]]]
[:before-group [:maybe :boolean]]]]
[:set-token-theme
[:map {:title "SetTokenThemeChange"}
[:type [:= :set-token-theme]]
[:theme-name :string]
[:group :string]
[:theme [:maybe ctob/schema:token-theme-attrs]]]]
[:set-tokens-lib
[:map {:title "SetTokensLib"}
[:type [:= :set-tokens-lib]]
[:tokens-lib ::sm/any]]]
[:set-token-set
[:map {:title "SetTokenSetChange"}
[:type [:= :set-token-set]]
[:set-name :string]
[:group? :boolean]
;; FIXME: we should not pass private types as part of changes
;; protocol, the changes protocol should reflect a
;; method/protocol for perform surgical operations on file data,
;; this has nothing todo with internal types of a file data
;; structure.
[:token-set {:gen/gen (sg/generator ctob/schema:token-set)}
[:maybe [:fn ctob/token-set?]]]]]
[:set-token
[:map {:title "SetTokenChange"}
[:type [:= :set-token]]
[:set-name :string]
[:token-id ::sm/uuid]
[:token [:maybe ctob/schema:token-attrs]]]]
[:set-base-font-size
[:map {:title "ModBaseFontSize"}
[:type [:= :set-base-font-size]]
@@ -978,64 +971,63 @@
[data {:keys [id]}]
(ctyl/delete-typography data id))
;; -- Tokens
;; -- Design Tokens
(defmethod process-change :set-tokens-lib
[data {:keys [tokens-lib]}]
(assoc data :tokens-lib tokens-lib))
(defmethod process-change :set-token
[data {:keys [set-name token-id token]}]
[data {:keys [set-id token-id attrs]}]
(update data :tokens-lib
(fn [lib]
(let [lib' (ctob/ensure-tokens-lib lib)]
(cond
(not token)
(ctob/delete-token-from-set lib' set-name token-id)
(not attrs)
(ctob/delete-token lib' set-id token-id)
(not (ctob/get-token-in-set lib' set-name token-id))
(ctob/add-token-in-set lib' set-name (ctob/make-token token))
(not (ctob/get-token lib' set-id token-id))
(ctob/add-token lib' set-id (ctob/make-token attrs))
:else
(ctob/update-token-in-set lib' set-name token-id (fn [prev-token]
(ctob/make-token (merge prev-token token)))))))))
(ctob/update-token lib' set-id token-id
(fn [prev-token]
(ctob/make-token (merge prev-token attrs)))))))))
(defmethod process-change :set-token-set
[data {:keys [set-name group? token-set]}]
[data {:keys [id attrs]}]
(update data :tokens-lib
(fn [lib]
(let [lib' (ctob/ensure-tokens-lib lib)]
(cond
(not token-set)
(if group?
(ctob/delete-set-group lib' set-name)
(ctob/delete-set lib' set-name))
(not attrs)
(ctob/delete-set lib' id)
(not (ctob/get-set lib' set-name))
(ctob/add-set lib' token-set)
(not (ctob/get-set lib' id))
(ctob/add-set lib' (ctob/make-token-set attrs))
:else
(ctob/update-set lib' set-name (fn [_] token-set)))))))
(ctob/update-set lib' id (fn [_] (ctob/make-token-set attrs))))))))
(defmethod process-change :set-token-theme
[data {:keys [group theme-name theme]}]
[data {:keys [id attrs]}]
(update data :tokens-lib
(fn [lib]
(let [lib' (ctob/ensure-tokens-lib lib)]
(cond
(not theme)
(ctob/delete-theme lib' group theme-name)
(not attrs)
(ctob/delete-theme lib' id)
(not (ctob/get-theme lib' group theme-name))
(ctob/add-theme lib' (ctob/make-token-theme theme))
(not (ctob/get-theme lib' id))
(ctob/add-theme lib' (ctob/make-token-theme attrs))
:else
(ctob/update-theme lib'
group theme-name
id
(fn [prev-token-theme]
(ctob/make-token-theme (merge prev-token-theme theme)))))))))
(ctob/make-token-theme (merge prev-token-theme attrs)))))))))
(defmethod process-change :update-active-token-themes
(defmethod process-change :set-active-token-themes
[data {:keys [theme-paths]}]
(update data :tokens-lib #(-> % (ctob/ensure-tokens-lib)
(ctob/set-active-themes theme-paths))))
@@ -1059,7 +1051,7 @@
(ctob/ensure-tokens-lib)
(ctob/move-set-group from-path to-path before-path before-group))))
;; === Base font size
;; === Design Tokens configuration
(defmethod process-change :set-base-font-size
[data {:keys [base-font-size]}]

308
common/src/app/common/files/changes_builder.cljc
View File

@@ -21,7 +21,8 @@
[app.common.types.path :as path]
[app.common.types.shape.layout :as ctl]
[app.common.types.tokens-lib :as ctob]
[app.common.uuid :as uuid]))
[app.common.uuid :as uuid]
[clojure.datafy :refer [datafy]]))
;; Auxiliary functions to help create a set of changes (undo + redo)
;; TODO: this is a duplicate schema
@@ -717,6 +718,7 @@
(reduce resize-parent changes all-parents)))
;; Library changes
(defn add-color
[changes color]
(-> changes
@@ -798,160 +800,6 @@
(update :undo-changes conj {:type :add-typography :typography prev-typography})
(apply-changes-local))))
(defn update-active-token-themes
[changes active-theme-paths prev-active-theme-paths]
(-> changes
(update :redo-changes conj {:type :update-active-token-themes :theme-paths active-theme-paths})
(update :undo-changes conj {:type :update-active-token-themes :theme-paths prev-active-theme-paths})
(apply-changes-local)))
(defn set-token-theme [changes group theme-name theme]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-theme (some-> (get library-data :tokens-lib)
(ctob/get-theme group theme-name))]
(-> changes
(update :redo-changes conj {:type :set-token-theme
:theme-name theme-name
:group group
:theme theme})
(update :undo-changes conj (if prev-theme
{:type :set-token-theme
:group group
:theme-name (or
;; Undo of edit
(:name theme)
;; Undo of delete
theme-name)
:theme prev-theme}
;; Undo of create
{:type :set-token-theme
:group group
:theme-name theme-name
:theme nil}))
(apply-changes-local))))
(defn rename-token-set-group
[changes set-group-path set-group-fname]
(let [undo-path (ctob/replace-last-path-name set-group-path set-group-fname)
undo-fname (last set-group-path)]
(-> changes
(update :redo-changes conj {:type :rename-token-set-group :set-group-path set-group-path :set-group-fname set-group-fname})
(update :undo-changes conj {:type :rename-token-set-group :set-group-path undo-path :set-group-fname undo-fname})
(apply-changes-local))))
(defn move-token-set
[changes {:keys [from-path to-path before-path before-group? prev-before-path prev-before-group?] :as opts}]
(-> changes
(update :redo-changes conj {:type :move-token-set
:from-path from-path
:to-path to-path
:before-path before-path
:before-group before-group?})
(update :undo-changes conj {:type :move-token-set
:from-path to-path
:to-path from-path
:before-path prev-before-path
:before-group prev-before-group?})
(apply-changes-local)))
(defn move-token-set-group
[changes {:keys [from-path to-path before-path before-group? prev-before-path prev-before-group?]}]
(-> changes
(update :redo-changes conj {:type :move-token-set-group
:from-path from-path
:to-path to-path
:before-path before-path
:before-group before-group?})
(update :undo-changes conj {:type :move-token-set-group
:from-path to-path
:to-path from-path
:before-path prev-before-path
:before-group prev-before-group?})
(apply-changes-local)))
(defn set-tokens-lib
[changes tokens-lib]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-tokens-lib (get library-data :tokens-lib)]
(-> changes
(update :redo-changes conj {:type :set-tokens-lib :tokens-lib tokens-lib})
(update :undo-changes conj {:type :set-tokens-lib :tokens-lib prev-tokens-lib})
(apply-changes-local))))
(defn set-token [changes set-name token-id token]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-token (some-> (get library-data :tokens-lib)
(ctob/get-set set-name)
(ctob/get-token token-id))]
(-> changes
(update :redo-changes conj {:type :set-token
:set-name set-name
:token-id token-id
:token token})
(update :undo-changes conj (if prev-token
{:type :set-token
:set-name set-name
:token-id (or
;; Undo of edit
(:id token)
;; Undo of delete
token-id)
:token prev-token}
;; Undo of create token
{:type :set-token
:set-name set-name
:token-id token-id
:token nil}))
(apply-changes-local))))
(defn rename-token-set
[changes name new-name]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-token-set (some-> (get library-data :tokens-lib)
(ctob/get-set name))]
(-> changes
(update :redo-changes conj {:type :set-token-set
:set-name name
:token-set (ctob/rename prev-token-set new-name)
:group? false})
(update :undo-changes conj {:type :set-token-set
:set-name new-name
:token-set prev-token-set
:group? false})
(apply-changes-local))))
(defn set-token-set
[changes set-name group? token-set]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-token-set (some-> (get library-data :tokens-lib)
(ctob/get-set set-name))]
(-> changes
(update :redo-changes conj {:type :set-token-set
:set-name set-name
:token-set token-set
:group? group?})
(update :undo-changes conj (if prev-token-set
{:type :set-token-set
:set-name (if token-set
;; Undo of edit
(ctob/get-name token-set)
;; Undo of delete
set-name)
:token-set prev-token-set
:group? group?}
;; Undo of create
{:type :set-token-set
:set-name set-name
:token-set nil
:group? group?}))
(apply-changes-local))))
(defn add-component
([changes id path name updated-shapes main-instance-id main-instance-page]
(add-component changes id path name updated-shapes main-instance-id main-instance-page nil nil nil))
@@ -1081,6 +929,144 @@
:id id
:delta delta})))
;; Design Tokens changes
(defn set-tokens-lib
[changes tokens-lib]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-tokens-lib (get library-data :tokens-lib)]
(-> changes
(update :redo-changes conj {:type :set-tokens-lib :tokens-lib tokens-lib})
(update :undo-changes conj {:type :set-tokens-lib :tokens-lib prev-tokens-lib})
(apply-changes-local))))
(defn set-token [changes set-id token-id token]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-token (some-> (get library-data :tokens-lib)
(ctob/get-token set-id token-id))]
(-> changes
(update :redo-changes conj {:type :set-token
:set-id set-id
:token-id token-id
:attrs (datafy token)})
(update :undo-changes conj {:type :set-token
:set-id set-id
:token-id token-id
:attrs (datafy prev-token)})
(apply-changes-local))))
(defn set-token-set
[changes id token-set]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-token-set (some-> (get library-data :tokens-lib)
(ctob/get-set id))]
(-> changes
(update :redo-changes conj {:type :set-token-set
:id id
:attrs (datafy token-set)})
(update :undo-changes conj {:type :set-token-set
:id id
:attrs (datafy prev-token-set)})
(apply-changes-local))))
(defn rename-token-set
[changes id new-name]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-token-set (some-> (get library-data :tokens-lib)
(ctob/get-set id))]
(-> changes
(update :redo-changes conj {:type :set-token-set
:id id
:attrs (datafy (ctob/rename prev-token-set new-name))})
(update :undo-changes conj {:type :set-token-set
:id id
:attrs (datafy prev-token-set)})
(apply-changes-local))))
(defn set-token-theme [changes id theme]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-theme (some-> (get library-data :tokens-lib)
(ctob/get-theme id))]
(-> changes
(update :redo-changes conj {:type :set-token-theme
:id id
:attrs (datafy theme)})
(update :undo-changes conj {:type :set-token-theme
:id id
:attrs (datafy prev-theme)})
(apply-changes-local))))
(defn set-active-token-themes
[changes active-theme-paths]
(assert-library! changes)
(let [library-data (::library-data (meta changes))
prev-active-theme-paths (d/nilv (some-> (get library-data :tokens-lib)
(ctob/get-active-theme-paths))
#{})]
(-> changes
(update :redo-changes conj {:type :set-active-token-themes :theme-paths active-theme-paths})
(update :undo-changes conj {:type :set-active-token-themes :theme-paths prev-active-theme-paths})
(apply-changes-local))))
(defn rename-token-set-group
[changes set-group-path set-group-fname]
(let [undo-path (ctob/replace-last-path-name set-group-path set-group-fname)
undo-fname (last set-group-path)]
(-> changes
(update :redo-changes conj {:type :rename-token-set-group :set-group-path set-group-path :set-group-fname set-group-fname})
(update :undo-changes conj {:type :rename-token-set-group :set-group-path undo-path :set-group-fname undo-fname})
(apply-changes-local))))
(defn move-token-set
[changes {:keys [from-path to-path before-path before-group? prev-before-path prev-before-group?] :as opts}]
(-> changes
(update :redo-changes conj {:type :move-token-set
:from-path from-path
:to-path to-path
:before-path before-path
:before-group before-group?})
(update :undo-changes conj {:type :move-token-set
:from-path to-path
:to-path from-path
:before-path prev-before-path
:before-group prev-before-group?})
(apply-changes-local)))
(defn move-token-set-group
[changes {:keys [from-path to-path before-path before-group? prev-before-path prev-before-group?]}]
(-> changes
(update :redo-changes conj {:type :move-token-set-group
:from-path from-path
:to-path to-path
:before-path before-path
:before-group before-group?})
(update :undo-changes conj {:type :move-token-set-group
:from-path to-path
:to-path from-path
:before-path prev-before-path
:before-group prev-before-group?})
(apply-changes-local)))
(defn set-base-font-size
[changes new-base-font-size]
(assert-file-data! changes)
(let [file-data (::file-data (meta changes))
previous-font-size (ctf/get-base-font-size file-data)]
(-> changes
(update :redo-changes conj {:type :set-base-font-size
:base-font-size new-base-font-size})
(update :undo-changes conj {:type :set-base-font-size
:base-font-size previous-font-size})
(apply-changes-local))))
;; Misc changes
(defn reorder-children
[changes id children]
(assert-page-id! changes)
@@ -1163,15 +1149,3 @@
[changes]
(::page-id (meta changes)))
(defn set-base-font-size
[changes new-base-font-size]
(assert-file-data! changes)
(let [file-data (::file-data (meta changes))
previous-font-size (ctf/get-base-font-size file-data)]
(-> changes
(update :redo-changes conj {:type :set-base-font-size
:base-font-size new-base-font-size})
(update :undo-changes conj {:type :set-base-font-size
:base-font-size previous-font-size})
(apply-changes-local))))

122
common/src/app/common/files/helpers.cljc
View File

@@ -692,129 +692,9 @@
(walk/postwalk process-form data)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SHAPES ORGANIZATION (PATH MANAGEMENT)
;; SHAPES ORGANIZATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn split-path
"Decompose a string in the form 'one / two / three' into
a vector of strings, normalizing spaces."
[path]
(let [xf (comp (map str/trim)
(remove str/empty?))]
(->> (str/split path "/")
(into [] xf))))
(defn join-path
"Regenerate a path as a string, from a vector."
[path-vec]
(str/join " / " path-vec))
(defn join-path-with-dot
"Regenerate a path as a string, from a vector."
[path-vec]
(str/join "\u00A0\u2022\u00A0" path-vec))
(defn clean-path
"Remove empty items from the path."
[path]
(->> (split-path path)
(join-path)))
(defn parse-path-name
"Parse a string in the form 'group / subgroup / name'.
Retrieve the path and the name in separated values, normalizing spaces."
[path-name]
(let [path-name-split (split-path path-name)
path (str/join " / " (butlast path-name-split))
name (or (last path-name-split) "")]
[path name]))
(defn merge-path-item
"Put the item at the end of the path."
[path name]
(if-not (empty? path)
(if-not (empty? name)
(str path " / " name)
path)
name))
(defn merge-path-item-with-dot
"Put the item at the end of the path."
[path name]
(if-not (empty? path)
(if-not (empty? name)
(str path "\u00A0\u2022\u00A0" name)
path)
name))
(defn compact-path
"Separate last item of the path, and truncate the others if too long:
'one' -> ['' 'one' false]
'one / two / three' -> ['one / two' 'three' false]
'one / two / three / four' -> ['one / two / ...' 'four' true]
'one-item-but-very-long / two' -> ['...' 'two' true] "
[path max-length dot?]
(let [path-split (split-path path)
last-item (last path-split)
merge-path (if dot?
merge-path-item-with-dot
merge-path-item)]
(loop [other-items (seq (butlast path-split))
other-path ""]
(if-let [item (first other-items)]
(let [full-path (-> other-path
(merge-path item)
(merge-path last-item))]
(if (> (count full-path) max-length)
[(merge-path other-path "...") last-item true]
(recur (next other-items)
(merge-path other-path item))))
[other-path last-item false]))))
(defn butlast-path
"Remove the last item of the path."
[path]
(let [split (split-path path)]
(if (= 1 (count split))
""
(join-path (butlast split)))))
(defn butlast-path-with-dots
"Remove the last item of the path."
[path]
(let [split (split-path path)]
(if (= 1 (count split))
""
(join-path-with-dot (butlast split)))))
(defn last-path
"Returns the last item of the path."
[path]
(last (split-path path)))
(defn compact-name
"Append the first item of the path and the name."
[path name]
(let [path-split (split-path path)]
(merge-path-item (first path-split) name)))
(defn inside-path? [child parent]
(let [child-path (split-path child)
parent-path (split-path parent)]
(and (<= (count parent-path) (count child-path))
(= parent-path (take (count parent-path) child-path)))))
(defn split-by-last-period
"Splits a string into two parts:
the text before and including the last period,
and the text after the last period."
[s]
(if-let [last-period (str/last-index-of s ".")]
[(subs s 0 (inc last-period)) (subs s (inc last-period))]
[s ""]))
(defn get-frame-objects
"Retrieves a new objects map only with the objects under frame-id (with frame-id)"
[objects frame-id]

18
common/src/app/common/files/migrations.cljc
View File

@@ -33,6 +33,7 @@
[app.common.types.shape.shadow :as ctss]
[app.common.types.shape.text :as ctst]
[app.common.types.text :as types.text]
[app.common.types.tokens-lib :as types.tokens-lib]
[app.common.uuid :as uuid]
[clojure.set :as set]
[cuerdas.core :as str]))
@@ -74,7 +75,9 @@
data
(-> data
(assoc :id id)
(dissoc :version :libs))]
(dissoc :version)
(dissoc :libs)
(ctf/check-file-data))]
(-> file
(assoc :data data)
@@ -1538,6 +1541,13 @@
(update :pages-index d/update-vals update-container)
(d/update-when :components d/update-vals update-container))))
(defmethod migrate-data "0013-fix-component-path"
[data _]
(let [update-component
(fn [component]
(update component :path #(d/nilv % "")))]
(d/update-when data :components d/update-vals update-component)))
(def ^:private valid-stroke?
(sm/lazy-validator cts/schema:stroke))
@@ -1608,6 +1618,10 @@
(update :pages-index d/update-vals update-container)
(d/update-when :components d/update-vals update-container))))
(defmethod migrate-data "0014-fix-tokens-lib-duplicate-ids"
[data _]
(d/update-when data :tokens-lib types.tokens-lib/fix-duplicate-token-set-ids))
(defmethod migrate-data "0014-clear-components-nil-objects"
[data _]
;; Because of a bug in migrations, several files have migrations
@@ -1684,5 +1698,7 @@
"0010-fix-swap-slots-pointing-non-existent-shapes"
"0011-fix-invalid-text-touched-flags"
"0012-fix-position-data"
"0013-fix-component-path"
"0013-clear-invalid-strokes-and-fills"
"0014-fix-tokens-lib-duplicate-ids"
"0014-clear-components-nil-objects"]))

25
common/src/app/common/files/repair.cljc
View File

@@ -320,6 +320,31 @@
(pcb/with-file-data file-data)
(pcb/update-shapes shape-ids detach-shape))))))
(defmethod repair-error :ref-shape-is-not-head
[_ {:keys [shape page-id] :as error} file-data _]
(let [repair-shape
(fn [shape]
; Convert shape in a normal copy, removing nested copy status
(log/debug :hint " -> unhead shape")
(ctk/unhead-shape shape))]
(log/dbg :hint "repairing shape :shape-ref-is-not-head" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
(defmethod repair-error :ref-shape-is-head
[_ {:keys [shape page-id args] :as error} file-data _]
(let [repair-shape
(fn [shape]
; Convert shape in a nested head, adding component info
(log/debug :hint " -> reroot shape")
(ctk/rehead-shape shape (:component-file args) (:component-id args)))]
(log/dbg :hint "repairing shape :shape-ref-is-head" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
(defmethod repair-error :shape-ref-cycle
[_ {:keys [shape args] :as error} file-data _]

50
common/src/app/common/files/validate.cljc
View File

@@ -11,6 +11,7 @@
[app.common.exceptions :as ex]
[app.common.files.helpers :as cfh]
[app.common.files.variant :as cfv]
[app.common.path-names :as cpn]
[app.common.schema :as sm]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
@@ -47,6 +48,8 @@
:should-be-component-root
:should-not-be-component-root
:ref-shape-not-found
:ref-shape-is-head
:ref-shape-is-not-head
:shape-ref-in-main
:root-main-not-allowed
:nested-main-not-allowed
@@ -301,6 +304,28 @@
"Shape inside main instance should not have shape-ref"
shape file page)))
(defn- check-ref-is-not-head
"Validate that the referenced shape is not a nested copy root."
[shape file page libraries]
(let [ref-shape (ctf/find-ref-shape file page libraries shape :include-deleted? true)]
(when (and (some? ref-shape)
(ctk/instance-head? ref-shape))
(report-error :ref-shape-is-head
(str/ffmt "Referenced shape % is a component, so the copy must also be" (:shape-ref shape))
shape file page))))
(defn- check-ref-is-head
"Validate that the referenced shape is a nested copy root."
[shape file page libraries]
(let [ref-shape (ctf/find-ref-shape file page libraries shape :include-deleted? true)]
(when (and (some? ref-shape)
(not (ctk/instance-head? ref-shape)))
(report-error :ref-shape-is-not-head
(str/ffmt "Referenced shape % of a head copy must also be a head" (:shape-ref shape))
shape file page
:component-file (:component-file ref-shape)
:component-id (:component-id ref-shape)))))
(defn- check-empty-swap-slot
"Validate that this shape does not have any swap slot."
[shape file page]
@@ -378,6 +403,7 @@
(check-component-not-main-head shape file page libraries)
(check-component-root shape file page)
(check-component-ref shape file page libraries)
(check-ref-is-head shape file page libraries)
(check-empty-swap-slot shape file page)
(check-duplicate-swap-slot shape file page)
(check-valid-touched shape file page)
@@ -395,7 +421,8 @@
;; We can have situations where the nested copy and the ancestor copy come from different libraries and some of them have been dettached
;; so we only validate the shape-ref if the ancestor is from a valid library
(when library-exists
(check-component-ref shape file page libraries))
(check-component-ref shape file page libraries)
(check-ref-is-head shape file page libraries))
(run! #(check-shape % file page libraries :context :copy-nested) (:shapes shape)))
(defn- check-shape-main-not-root
@@ -413,6 +440,7 @@
(check-component-not-main-not-head shape file page)
(check-component-not-root shape file page)
(check-component-ref shape file page libraries)
(check-ref-is-not-head shape file page libraries)
(check-empty-swap-slot shape file page)
(check-valid-touched shape file page)
(run! #(check-shape % file page libraries :context :copy-any) (:shapes shape)))
@@ -481,7 +509,7 @@
(report-error :variant-bad-name
(str/ffmt "Variant % has an invalid name" (:id shape))
shape file page))
(when-not (= (:name parent) (cfh/merge-path-item (:path component) (:name component)))
(when-not (= (:name parent) (cpn/merge-path-item (:path component) (:name component)))
(report-error :variant-component-bad-name
(str/ffmt "Component % has an invalid name" (:id shape))
shape file page))
@@ -540,7 +568,7 @@
;; mains can't be nested into mains
(if (or (= context :not-component) (= context :main-top))
(report-error :nested-main-not-allowed
"Nested main component only allowed inside other component"
"Component main not allowed inside other component"
shape file page)
(check-shape-main-root-nested shape file page libraries))
@@ -606,6 +634,20 @@
(str/ffmt "Shape % should be a variant" (:id main-component))
main-component file component-page))))
(defn- check-main-inside-main
[component file]
(let [component-page (ctf/get-component-page (:data file) component)
main-instance (ctst/get-shape component-page (:main-instance-id component))
main-parents? (->> main-instance
:id
(cfh/get-parents (:objects component-page))
(some ctk/main-instance?)
boolean)]
(when main-parents?
(report-error :nested-main-not-allowed
"Component main not allowed inside other component"
main-instance file component-page))))
(defn- check-component
"Validate semantic coherence of a component. Report all errors found."
[component file]
@@ -613,6 +655,8 @@
(report-error :component-nil-objects-not-allowed
"Objects list cannot be nil"
component file nil))
(when-not (:deleted component)
(check-main-inside-main component file))
(when (:deleted component)
(check-component-duplicate-swap-slot component file)
(check-ref-cycles component file))

17
common/src/app/common/flags.cljc
View File

@@ -120,6 +120,7 @@
:tiered-file-data-storage
:token-units
:token-base-font-size
:token-color
:token-typography-types
:token-typography-composite
:transit-readable-response
@@ -133,8 +134,19 @@
:hide-release-modal
:subscriptions
:subscriptions-old
:frontend-binary-fills
:inspect-styles})
:inspect-styles
;; Security layer middleware that filters request by fetch
;; metadata headers
:sec-fetch-metadata-middleware
;; Security layer middleware that check the precense of x-client
;; http headers and enables an addtional csrf protection
:client-header-check-middleware
;; A temporal flag, enables backend code use more extensivelly
;; redis for caching data
:redis-cache})
(def all-flags
(set/union email login varia))
@@ -159,6 +171,7 @@
:enable-render-wasm-dpr
:enable-token-units
:enable-token-typography-types
:enable-token-typography-composite
:enable-feature-fdata-objects-map])
(defn parse

58
common/src/app/common/generic_pool.clj Normal file
View File

@@ -0,0 +1,58 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.generic-pool
(:refer-clojure :exclude [get])
(:import
java.lang.AutoCloseable
org.apache.commons.pool2.ObjectPool
org.apache.commons.pool2.PooledObject
org.apache.commons.pool2.PooledObjectFactory
org.apache.commons.pool2.impl.DefaultPooledObject
org.apache.commons.pool2.impl.SoftReferenceObjectPool))
(defn pool?
[o]
(instance? ObjectPool o))
(defn create
[& {:keys [create-fn destroy-fn validate-fn dispose-fn]}]
(SoftReferenceObjectPool.
(reify PooledObjectFactory
(activateObject [_ _])
(destroyObject [_ o]
(let [object (.getObject ^PooledObject o)]
(destroy-fn object)))
(destroyObject [_ o _]
(let [object (.getObject ^PooledObject o)]
(destroy-fn object)))
(passivateObject [_ o]
(when (fn? dispose-fn)
(let [object (.getObject ^PooledObject o)]
(dispose-fn object))))
(validateObject [_ o]
(if (fn? validate-fn)
(let [object (.getObject ^PooledObject o)]
(validate-fn object))
true))
(makeObject [_]
(let [object (create-fn)]
(DefaultPooledObject. object))))))
(defn get
[^ObjectPool pool]
(let [object (.borrowObject pool)]
(reify
clojure.lang.IDeref
(deref [_] object)
AutoCloseable
(close [_]
(.returnObject pool object)))))

7
common/src/app/common/geom/shapes/bounds.cljc
View File

@@ -88,8 +88,11 @@
([shape]
(get-shape-filter-bounds shape false))
([shape ignore-shadow-margin?]
(if (and (cfh/svg-raw-shape? shape)
(not= :svg (dm/get-in shape [:content :tag])))
(if (or (and (cfh/svg-raw-shape? shape)
(not= :svg (dm/get-in shape [:content :tag])))
;; If no shadows or blur, we return the selrect as is
(and (empty? (-> shape :shadow))
(zero? (-> shape :blur :value (or 0)))))
(dm/get-prop shape :selrect)
(let [filters (shape->filters shape)
blur-value (or (-> shape :blur :value) 0)

58
common/src/app/common/logging.cljc
View File

@@ -49,6 +49,7 @@
[app.common.exceptions :as ex]
[app.common.pprint :as pp]
[app.common.schema :as sm]
[app.common.time :as ct]
[app.common.uuid :as uuid]
[cuerdas.core :as str]
[promesa.exec :as px]
@@ -221,36 +222,42 @@
#?(:clj (inst-ms (java.time.Instant/now))
:cljs (js/Date.now)))
(defn emit-log
[props cause context logger level sync?]
(let [props (cond-> props sync? deref)
ts (current-timestamp)
gcontext *context*
logfn (fn []
(let [props (if sync? props (deref props))
props (into (d/ordered-map) props)
context (if (and (empty? gcontext)
(empty? context))
{}
(d/without-nils (merge gcontext context)))
lrecord {::id (uuid/next)
::timestamp ts
::message (delay (build-message props))
::props props
::context context
::level level
::logger logger}
lrecord (cond-> lrecord
(some? cause)
(assoc ::cause cause
::trace (delay (build-stack-trace cause))))]
(swap! log-record (constantly lrecord))))]
(if sync?
(logfn)
(px/exec! *default-executor* logfn))))
(defmacro log!
"Emit a new log record to the global log-record state (asynchronously). "
[& props]
(let [{:keys [::level ::logger ::context ::sync? cause] :or {sync? false}} props
props (into [] msg-props-xf props)]
`(when (enabled? ~logger ~level)
(let [props# (cond-> (delay ~props) ~sync? deref)
ts# (current-timestamp)
context# *context*
logfn# (fn []
(let [props# (if ~sync? props# (deref props#))
props# (into (d/ordered-map) props#)
cause# ~cause
context# (d/without-nils
(merge context# ~context))
lrecord# {::id (uuid/next)
::timestamp ts#
::message (delay (build-message props#))
::props props#
::context context#
::level ~level
::logger ~logger}
lrecord# (cond-> lrecord#
(some? cause#)
(assoc ::cause cause#
::trace (delay (build-stack-trace cause#))))]
(swap! log-record (constantly lrecord#))))]
(if ~sync?
(logfn#)
(px/exec! *default-executor* logfn#))))))
(emit-log (delay ~props) ~cause ~context ~logger ~level ~sync?))))
#?(:clj
(defn slf4j-log-handler
@@ -276,7 +283,8 @@
(when (enabled? logger level)
(let [hstyles (str/ffmt "font-weight: 600; color: %" (level->color level))
mstyles (str/ffmt "font-weight: 300; color: %" (level->color level))
header (str/concat "%c" (level->name level) " [" logger "] ")
ts (ct/format-inst (ct/now) "kk:mm:ss.SSSS")
header (str/concat "%c" (level->name level) " " ts " [" logger "] ")
message (str/concat header "%c" @message)]
(js/console.group message hstyles mstyles)

212
common/src/app/common/logic/libraries.cljc
View File

@@ -11,11 +11,13 @@
[app.common.data.macros :as dm]
[app.common.files.changes-builder :as pcb]
[app.common.files.helpers :as cfh]
[app.common.files.variant :as cfv]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.logging :as log]
[app.common.logic.shapes :as cls]
[app.common.logic.variant-properties :as clvp]
[app.common.path-names :as cpn]
[app.common.spec :as us]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
@@ -553,13 +555,20 @@
(pcb/with-objects (:objects container)))]
(if-let [shape (first shapes)]
(recur (next shapes)
(generate-sync-shape asset-type
changes
library-id
container
shape
libraries
current-file-id))
(let [objects' (pcb/get-objects changes)
shape' (get objects' (:id shape))]
;; The shape could have been deleted in previous changes, if this nested component
;; comes from components-v1 era or if there has been some error with the swap slot.
;; In that case, we just skip it.
(if shape'
(generate-sync-shape asset-type
changes
library-id
container
shape'
libraries
current-file-id)
changes)))
changes))))
(defmulti uses-assets?
@@ -655,7 +664,8 @@
(if (= new-content old-content)
changes
changes')))
(-> changes'
(pcb/apply-changes-local)))))
;; ---- Component synchronization helpers ----
@@ -985,7 +995,7 @@
(defn generate-rename-component
"Generate the changes for rename the component with the given id, in the current file library."
[changes id new-name library-data]
(let [[path name] (cfh/parse-path-name new-name)]
(let [[path name] (cpn/split-group-name new-name)]
(-> changes
(pcb/with-library-data library-data)
(pcb/update-component id #(assoc % :path path :name name)))))
@@ -1178,6 +1188,7 @@
(let [child-inst (first children-inst)
child-main (first children-main)]
(shape-log :trace (:id shape-inst) container-inst
:msg "Comparing"
:main (str (:name child-main) " " (pretty-uuid (:id child-main)))
:inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))))
(cond
@@ -1192,7 +1203,8 @@
:else
(if (or (ctk/is-main-of? child-main child-inst)
(and (ctf/match-swap-slot? child-main child-inst container-inst container-main file libraries) (not reset?)))
(and (ctf/match-swap-slot? child-main child-inst container-inst container-main file libraries)
(not reset?)))
(recur (next children-inst)
(next children-main)
(if (ctk/is-main-of? child-main child-inst)
@@ -1200,10 +1212,12 @@
(swapped-cb changes child-inst child-main)))
(let [child-inst' (d/seek #(or (ctk/is-main-of? child-main %)
(and (ctf/match-swap-slot? child-main % container-inst container-main file libraries) (not reset?)))
(and (ctf/match-swap-slot? child-main % container-inst container-main file libraries)
(not reset?)))
children-inst)
child-main' (d/seek #(or (ctk/is-main-of? % child-inst)
(and (ctf/match-swap-slot? % child-inst container-inst container-main file libraries) (not reset?)))
(and (ctf/match-swap-slot? % child-inst container-inst container-main file libraries)
(not reset?)))
children-main)]
(cond
(nil? child-inst')
@@ -1313,7 +1327,8 @@
(if (and (ctk/touched-group? parent-shape :shapes-group) omit-touched?)
changes
changes')))
(-> changes'
(pcb/apply-changes-local)))))
(defn- add-shape-to-main
[changes shape index component component-container page root-instance root-main]
@@ -1417,7 +1432,8 @@
changes' (reduce mod-obj-change changes' updated-shapes)
changes' (reduce del-obj-change changes' new-shapes)]
changes'))
(-> changes'
(pcb/apply-changes-local))))
(defn- remove-shape
[changes shape container omit-touched?]
@@ -1470,7 +1486,8 @@
(if (and (ctk/touched-group? parent :shapes-group) omit-touched?)
changes
changes')))
(-> changes'
(pcb/apply-changes-local)))))
(defn- move-shape
[changes shape index-before index-after container omit-touched?]
@@ -1507,7 +1524,8 @@
(if (and (ctk/touched-group? parent :shapes-group) omit-touched?)
changes
changes')))
(-> changes'
(pcb/apply-changes-local)))))
(defn change-touched
[changes dest-shape origin-shape container
@@ -1551,7 +1569,8 @@
:id (:id dest-shape)
:operations
[{:type :set-touched
:touched (:touched dest-shape)}]})))))))
:touched (:touched dest-shape)}]}))
(pcb/apply-changes-local))))))
(defn- change-remote-synced
[changes shape container remote-synced?]
@@ -1580,7 +1599,8 @@
:id (:id shape)
:operations
[{:type :set-remote-synced
:remote-synced (:remote-synced shape)}]}))))))
:remote-synced (:remote-synced shape)}]}))
(pcb/apply-changes-local)))))
(defn- update-tokens
"Token synchronization algorithm. Copy the applied tokens that have changed
@@ -1618,10 +1638,12 @@
:operations [{:type :set
:attr :applied-tokens
:val dest-tokens
:ignore-touched true}]}))))))
:ignore-touched true}]}))
(pcb/apply-changes-local)))))
(defn- generate-update-tokens
[changes container dest-shape origin-shape touched omit-touched?]
[changes container dest-shape origin-shape touched omit-touched? valid-attrs]
;; valid-attrs is a set of attrs to consider on the update. If it is nil, it will consider all the attrs
(let [attrs (->> (seq (keys ctk/sync-attrs))
;; We don't update the flex-child attrs
(remove #(= :layout-grid-cells %)))
@@ -1629,8 +1651,8 @@
applied-tokens (reduce (fn [applied-tokens attr]
(let [attr-group (get ctk/sync-attrs attr)
token-attrs (cto/shape-attr->token-attrs attr)]
(if (not (and (touched attr-group)
omit-touched?))
(if (and (or (not omit-touched?) (not (touched attr-group)))
(or (empty? valid-attrs) (contains? valid-attrs attr)))
(into applied-tokens token-attrs)
applied-tokens)))
#{}
@@ -1661,7 +1683,8 @@
(update :undo-changes concat [(make-change
container
{:type :reg-objects
:shapes all-parents})]))))
:shapes all-parents})])
(pcb/apply-changes-local))))
(defn- text-change-value
@@ -1733,6 +1756,17 @@
[(conj roperations roperation)
(conj uoperations uoperation)]))
(defn- check-detached-main
[changes dest-shape origin-shape]
;; Only for direct updates (from main to copy). Check if the main shape
;; has been detached. If so, the copy shape must be unheaded (i.e. converted
;; into a normal copy and not a nested instance).
(if (and (= (:shape-ref dest-shape) (:id origin-shape))
(ctk/subcopy-head? dest-shape)
(not (ctk/instance-head? origin-shape)))
(pcb/update-shapes changes [(:id dest-shape)] ctk/unhead-shape {:ignore-touched true})
changes))
(defn- update-attrs
"The main function that implements the attribute sync algorithm. Copy
attributes that have changed in the origin shape to the dest shape.
@@ -1773,7 +1807,9 @@
(seq roperations)
(add-update-attr-changes dest-shape container roperations uoperations)
:always
(generate-update-tokens container dest-shape origin-shape touched omit-touched?))
(check-detached-main dest-shape origin-shape)
:always
(generate-update-tokens container dest-shape origin-shape touched omit-touched? nil))
(let [attr-group (get ctk/sync-attrs attr)
;; position-data is a special case because can be affected by
@@ -1796,7 +1832,6 @@
(= :content attr)
(touched attr-group))
skip-operations?
(or (= (get origin-shape attr) (get dest-shape attr))
(and (touched attr-group)
@@ -1995,10 +2030,14 @@
reset-pos-data? (and
(not skip-operations?)
(cfh/text-shape? previous-shape)
(= attr :position-data)
(or (= attr :position-data) (= attr :selrect))
(not= (:position-data previous-shape) (:position-data current-shape))
(touched :geometry-group))
skip-operations? (or skip-operations?
;; If we are going to reset the position data, skip the selrect attr
(and reset-pos-data? (= attr :selrect)))
attr-val
(when-not skip-operations?
(cond
@@ -2044,12 +2083,14 @@
(recur (next attrs)
roperations'
uoperations'))
(cond-> changes
(> (count roperations) 1)
(add-update-attr-changes current-shape container roperations uoperations)
:always
(generate-update-tokens container current-shape previous-shape touched false))))))
(let [updated-attrs (into #{} (comp (filter #(= :set (:type %)))
(map :attr))
roperations)]
(cond-> changes
(> (count roperations) 1)
(-> (add-update-attr-changes current-shape container roperations uoperations)
(generate-update-tokens container current-shape previous-shape touched false updated-attrs))))))))
(defn- propagate-attrs
"Helper that puts the origin attributes (attrs) into dest but only if
@@ -2222,7 +2263,7 @@
variant-id (when (ctk/is-variant? root) (:parent-id root))
props (when (ctk/is-variant? root) (get variant-props (:component-id root)))
[path name] (cfh/parse-path-name name)
[path name] (cpn/split-group-name name)
[root-shape updated-shapes]
(ctn/convert-shape-in-component root objects file-id)
@@ -2514,9 +2555,10 @@
frames)))
(defn- duplicate-variant
[changes library component base-pos parent-id page-id]
[changes library component base-pos parent page-id into-new-variant?]
(let [component-page (ctpl/get-page (:data library) (:main-instance-page component))
component-shape (dm/get-in component-page [:objects (:main-instance-id component)])
objects (:objects component-page)
component-shape (get objects (:main-instance-id component))
orig-pos (gpt/point (:x component-shape) (:y component-shape))
delta (gpt/subtract base-pos orig-pos)
new-component-id (uuid/next)
@@ -2526,11 +2568,27 @@
new-component-id
{:apply-changes-local-library? true
:delta delta
:new-variant-id parent-id
:page-id page-id})]
:new-variant-id (if into-new-variant? nil (:id parent))
:page-id page-id})
value (when into-new-variant?
(str ctv/value-prefix
(-> (cfv/extract-properties-values (:data library) objects (:id parent))
last
:value
count
inc)))]
[shape
(-> changes
(pcb/change-parent parent-id [shape]))]))
(cond-> changes
into-new-variant?
(clvp/generate-make-shapes-variant [shape] parent)
;; If it has the same parent, update the value of the last property
(and into-new-variant? (= (:variant-id component) (:id parent)))
(clvp/generate-update-property-value new-component-id (-> component :variant-properties count dec) value)
:always
(pcb/change-parent (:id parent) [shape] 0))]))
(defn generate-duplicate-component-change
@@ -2542,11 +2600,13 @@
pos (as-> (gsh/move main delta) $
(gpt/point (:x $) (:y $)))
parent (get objects parent-id)
;; When we duplicate a variant alone, we will instanciate it
;; When we duplicate a variant along with its variant-container, we will duplicate it
in-variant-container? (contains? ids-map (:variant-id main))
restore-component
#(let [{:keys [shape changes]}
(prepare-restore-component changes
@@ -2559,29 +2619,42 @@
frame-id)]
[shape changes])
[_shape changes]
(if (nil? component)
(restore-component)
(if (and (ctk/is-variant? main) in-variant-container?)
(duplicate-variant changes
(get libraries file-id)
component
pos
parent-id
(:id page))
(generate-instantiate-component changes
objects
file-id
component-id
pos
page
libraries
main-id
parent-id
frame-id
ids-map
{})))]
[_shape changes]
(cond
(nil? component)
(restore-component)
(and (ctk/is-variant? main) in-variant-container?)
(duplicate-variant changes
(get libraries file-id)
component
pos
parent
(:id page)
false)
(ctk/is-variant-container? parent)
(duplicate-variant changes
(get libraries file-id)
component
pos
parent
(:id page)
true)
:else
(generate-instantiate-component changes
objects
file-id
component-id
pos
page
libraries
main-id
parent-id
frame-id
ids-map
{}))]
changes))
(defn generate-duplicate-shape-change
@@ -2728,7 +2801,7 @@
(defn generate-duplicate-changes
"Prepare objects to duplicate: generate new id, give them unique names,
move to the desired position, and recalculate parents and frames as needed."
[changes all-objects page ids delta libraries library-data file-id & {:keys [variant-props]}]
[changes all-objects page ids delta libraries library-data file-id & {:keys [variant-props alt-duplication?]}]
(let [shapes (map (d/getf all-objects) ids)
unames (volatile! (cfh/get-used-names (:objects page)))
update-unames! (fn [new-name] (vswap! unames conj new-name))
@@ -2738,9 +2811,22 @@
;; we calculate a new one because the components will have created new shapes.
ids-map (into {} (map #(vector % (uuid/next))) all-ids)
;; If there is an alt-duplication of a variant, change its parent to root
;; so the copy is made as a child of root
;; This is because inside a variant-container can't be a copy
shapes (map (fn [shape]
(if (and alt-duplication? (ctk/is-variant? shape))
(assoc shape :parent-id uuid/zero :frame-id nil)
shape))
shapes)
changes (-> changes
(pcb/with-page page)
(pcb/with-objects all-objects))
(pcb/with-objects all-objects)
(pcb/with-library-data library-data))
changes
(->> shapes
(reduce #(generate-duplicate-shape-change %1

18
common/src/app/common/logic/shapes.cljc
View File

@@ -185,15 +185,17 @@
interactions)))
(vals objects))
id-to-delete? (set ids-to-delete)
changes
(reduce (fn [changes {:keys [id] :as flow}]
(if (contains? ids-to-delete (:starting-frame flow))
(-> changes
(pcb/with-page page)
(pcb/set-flow id nil))
changes))
changes
(:flows page))
(->> (:flows page)
(reduce
(fn [changes [id flow]]
(if (id-to-delete? (:starting-frame flow))
(-> changes
(pcb/with-page page)
(pcb/set-flow id nil))
changes))
changes))
all-parents

27
common/src/app/common/logic/tokens.cljc
View File

@@ -17,18 +17,16 @@
Use this for managing sets active state without having to modify a
user created theme (\"no themes selected\" state in the ui)."
[changes tokens-lib update-theme-fn]
(let [prev-active-token-themes (ctob/get-active-theme-paths tokens-lib)
active-token-set-names (ctob/get-active-themes-set-names tokens-lib)
(let [active-token-set-names (ctob/get-active-themes-set-names tokens-lib)
prev-hidden-theme (ctob/get-hidden-theme tokens-lib)
hidden-theme (-> (some-> prev-hidden-theme (ctob/set-sets active-token-set-names))
(update-theme-fn))]
hidden-theme (ctob/get-hidden-theme tokens-lib)
hidden-theme' (-> (some-> hidden-theme
(ctob/set-sets active-token-set-names))
(update-theme-fn))]
(-> changes
(pcb/update-active-token-themes #{(ctob/theme-path hidden-theme)} prev-active-token-themes)
(pcb/set-token-theme (:group prev-hidden-theme)
(:name prev-hidden-theme)
hidden-theme))))
(pcb/set-active-token-themes #{(ctob/get-theme-path hidden-theme')})
(pcb/set-token-theme (ctob/get-id hidden-theme)
hidden-theme'))))
(defn generate-toggle-token-set
"Toggle a token set at `set-name` in `tokens-lib` without modifying a
@@ -139,3 +137,12 @@
(if-let [params (calculate-move-token-set-or-set-group tokens-lib params)]
(pcb/move-token-set-group changes params)
changes))
(defn generate-delete-token-set-group
"Create changes for deleting a token set group."
[changes tokens-lib path]
(let [sets (ctob/get-sets-at-path tokens-lib path)]
(reduce (fn [changes set]
(pcb/set-token-set changes (ctob/get-id set) nil))
changes
sets)))

36
common/src/app/common/logic/variant_properties.cljc
View File

@@ -7,8 +7,8 @@
(:require
[app.common.data :as d]
[app.common.files.changes-builder :as pcb]
[app.common.files.helpers :as cfh]
[app.common.files.variant :as cfv]
[app.common.path-names :as cpn]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctcl]
[app.common.types.variant :as ctv]
@@ -28,11 +28,7 @@
(pcb/update-component
changes (:id component)
(fn [component]
(d/update-in-when component [:variant-properties pos]
(fn [property]
(-> property
(assoc :name new-name)
(with-meta nil)))))
(d/update-in-when component [:variant-properties pos] #(assoc % :name new-name)))
{:apply-changes-local-library? true}))
changes
related-components)))
@@ -81,6 +77,26 @@
#(assoc % :variant-error value))))))
(defn generate-reorder-variant-poperties
[changes variant-id from-pos to-space-between-pos]
(let [data (pcb/get-library-data changes)
objects (pcb/get-objects changes)
related-components (cfv/find-variant-components data objects variant-id)]
(reduce (fn [changes component]
(let [props (:variant-properties component)
props (d/reorder props from-pos to-space-between-pos)
main-id (:main-instance-id component)
name (ctv/properties-to-name props)]
(-> changes
(pcb/update-component (:id component)
#(assoc % :variant-properties props)
{:apply-changes-local-library? true})
(pcb/update-shapes [main-id]
#(assoc % :variant-name name)))))
changes
related-components)))
(defn generate-add-new-property
[changes variant-id & {:keys [fill-values? editing? property-name property-value]}]
(let [data (pcb/get-library-data changes)
@@ -127,7 +143,7 @@
(defn- generate-make-shape-no-variant
[changes shape]
(let [new-name (ctv/variant-name-to-name shape)
[cpath cname] (cfh/parse-path-name new-name)]
[cpath cname] (cpn/split-group-name new-name)]
(-> changes
(pcb/update-component (:component-id shape)
#(-> (dissoc % :variant-id :variant-properties)
@@ -146,8 +162,8 @@
(defn- create-new-properties-from-variant
[shape min-props data container-name base-properties]
(let [component (ctcl/get-component data (:component-id shape) true)
add-name? (not= (:name component) container-name)
component-full-name (cpn/merge-path-item (:path component) (:name component))
add-name? (not= component-full-name container-name)
props (ctv/merge-properties base-properties
(:variant-properties component))
new-props (- min-props
@@ -188,7 +204,7 @@
(map #(assoc % :value "")))
num-base-props (count base-props)
[cpath cname] (cfh/parse-path-name (:name variant-container))
[cpath cname] (cpn/split-group-name (:name variant-container))
container-name (:name variant-container)
create-new-properties

55
common/src/app/common/logic/variants.cljc
View File

@@ -11,7 +11,8 @@
[app.common.types.container :as ctn]
[app.common.types.file :as ctf]
[app.common.types.variant :as ctv]
[app.common.uuid :as uuid]))
[app.common.uuid :as uuid]
[clojure.set :as set]))
(defn generate-add-new-variant
[changes shape variant-id new-component-id new-shape-id prop-num]
@@ -67,7 +68,6 @@
[[] {}]
shapes))))
(defn- keep-swapped-item
"As part of the keep-touched process on a switch, given a child on the original
copy that was swapped (orig-swapped-child), and its related shape on the new copy
@@ -88,7 +88,6 @@
current-parent (get objects (:parent-id related-shape-in-new))
pos (d/index-of (:shapes current-parent) (:id related-shape-in-new))]
(-> (pcb/concat-changes before-changes changes)
;; Move the previous shape to the new parent
@@ -122,6 +121,44 @@
(subvec (vec ancestors) 1 (dec num-ancestors)))]
(some ctk/get-swap-slot ancestors)))
(defn- find-shape-ref-child-of
"Get the shape referenced by the shape-ref of the near main of the shape,
recursively repeated until find a shape-ref with parent-id as ancestor.
It will return the shape or nil if it doesn't found any"
[container libraries shape parent-id]
(let [ref-shape (ctf/find-ref-shape nil container libraries shape
:with-context? true)
ref-shape-container (when ref-shape (:container (meta ref-shape)))
ref-shape-parents-set (when ref-shape
(->> (cfh/get-parents (:objects ref-shape-container) (:id ref-shape))
(into #{} d/xf:map-id)))]
(if (or (nil? ref-shape) (contains? ref-shape-parents-set parent-id))
ref-shape
(find-shape-ref-child-of ref-shape-container libraries ref-shape parent-id))))
(defn- get-ref-chain
"Returns a vector with the shape ref chain including itself"
[container libraries shape]
(loop [chain [shape]
current shape]
(if-let [ref (ctf/find-ref-shape nil container libraries current :with-context? true)]
(recur (conj chain ref) ref)
chain)))
(defn- add-touched-from-ref-chain
"Adds to the :touched attr of a shape the content of
the :touched of all its chain of ref shapes"
[container libraries shape]
(let [chain (get-ref-chain container libraries shape)
more-touched (->> chain
(map :touched)
(remove nil?)
(apply set/union)
(remove ctk/swap-slot?)
set)]
(update shape :touched #(set/union (or % #{}) more-touched))))
(defn generate-keep-touched
"This is used as part of the switch process, when you switch from
@@ -141,7 +178,10 @@
;; Ignore children of swapped items, because
;; they will be moved without change when
;; managing their swapped ancestor
orig-touched (->> (filter (comp seq :touched) original-shapes)
orig-touched (->> original-shapes
;; Add to each shape also the touched of its ref chain
(map #(add-touched-from-ref-chain container libraries %))
(filter (comp seq :touched))
(remove
#(child-of-swapped? %
page-objects
@@ -158,7 +198,7 @@
;; The original-shape is in a copy. For the relation rules, we need the referenced
;; shape on the main component
orig-ref-shape (ctf/find-ref-shape nil container libraries original-shape {:with-context? true})
orig-ref-shape (ctf/find-remote-shape container libraries original-shape {:with-context? true})
orig-ref-objects (:objects (:container (meta orig-ref-shape)))
;; Adds a :shape-path attribute to the children of the orig-ref-shape,
@@ -171,7 +211,6 @@
;; Creates a map to quickly find a child of the orig-ref-shape by its shape-path
o-ref-shapes-p-map (into {} (map (juxt :id :shape-path)) o-ref-shapes-wp)
;; Process each touched children of the original-shape
[changes parents-of-swapped]
(reduce
@@ -182,8 +221,7 @@
;; orig-child-touched is in a copy. Get the referenced shape on the main component
;; If there is a swap slot, we will get the referenced shape in another way
orig-ref-shape (when-not swap-slot
;; TODO Maybe just get it from o-ref-shapes-wp
(ctf/find-ref-shape nil container libraries orig-child-touched))
(find-shape-ref-child-of container libraries orig-child-touched (:id orig-ref-shape)))
orig-ref-id (if swap-slot
;; If there is a swap slot, find the referenced shape id
@@ -196,6 +234,7 @@
;; Get its related shape in the children of new-shape: the one that
;; has the same shape-path
related-shape-in-new (get new-shapes-map shape-path)
parents-of-swapped (if related-shape-in-new
(conj parent-of-swapped (:parent-id related-shape-in-new))
parent-of-swapped)

134
common/src/app/common/path_names.cljc Normal file
View File

@@ -0,0 +1,134 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.path-names
(:require
[cuerdas.core :as str]))
"Functions to manipulate entity names that represent groups with paths,
e.g. 'Group / Subgroup / Name'.
Some naming conventions:
- Path string: the full string with groups and name, e.g. 'Group / Subgroup / Name'.
- Path: a vector of strings with the full path, e.g. ['Group' 'Subgroup' 'Name'].
- Group string: the group part of the path string, e.g. 'Group / Subgroup'.
- Group: a vector of strings with the group part of the path, e.g. ['Group' 'Subgroup'].
- Name: the final name part of the path, e.g. 'Name'."
(defn split-path
"Decompose a path string in the form 'one / two / three' into a vector
of strings, trimming spaces (e.g. ['one' 'two' 'three'])."
[path-str & {:keys [separator] :or {separator "/"}}]
(let [xf (comp (map str/trim)
(remove str/empty?))]
(->> (str/split path-str separator)
(into [] xf))))
(defn join-path
"Regenerate a path as a string, from a vector.
(e.g. ['one' 'two' 'three'] -> 'one / two / three')"
[path & {:keys [separator with-spaces?] :or {separator "/" with-spaces? true}}]
(if with-spaces?
(str/join (str " " separator " ") path)
(str/join separator path)))
(defn split-group-name
"Parse a path string. Retrieve the group and the name in separated values,
normalizing spaces (e.g. 'group / subgroup / name' -> ['group / subgroup' 'name'])."
[path-str & {:keys [separator with-spaces?] :or {separator "/" with-spaces? true}}]
(let [path (split-path path-str :separator separator)
group-str (join-path (butlast path) :separator separator :with-spaces? with-spaces?)
name (or (last path) "")]
[group-str name]))
(defn join-path-with-dot
"Regenerate a path as a string, from a vector."
[path-vec]
(str/join "\u00A0\u2022\u00A0" path-vec))
(defn clean-path
"Remove empty items from the path."
[path]
(->> (split-path path)
(join-path)))
(defn merge-path-item
"Put the item at the end of the path."
[path name]
(if-not (empty? path)
(if-not (empty? name)
(str path " / " name)
path)
name))
(defn merge-path-item-with-dot
"Put the item at the end of the path."
[path name]
(if-not (empty? path)
(if-not (empty? name)
(str path "\u00A0\u2022\u00A0" name)
path)
name))
(defn compact-path
"Separate last item of the path, and truncate the others if too long:
'one' -> ['' 'one' false]
'one / two / three' -> ['one / two' 'three' false]
'one / two / three / four' -> ['one / two / ...' 'four' true]
'one-item-but-very-long / two' -> ['...' 'two' true] "
[path max-length dot?]
(let [path-split (split-path path)
last-item (last path-split)
merge-path (if dot?
merge-path-item-with-dot
merge-path-item)]
(loop [other-items (seq (butlast path-split))
other-path ""]
(if-let [item (first other-items)]
(let [full-path (-> other-path
(merge-path item)
(merge-path last-item))]
(if (> (count full-path) max-length)
[(merge-path other-path "...") last-item true]
(recur (next other-items)
(merge-path other-path item))))
[other-path last-item false]))))
(defn butlast-path
"Remove the last item of the path."
[path]
(let [split (split-path path)]
(if (= 1 (count split))
""
(join-path (butlast split)))))
(defn butlast-path-with-dots
"Remove the last item of the path."
[path]
(let [split (split-path path)]
(if (= 1 (count split))
""
(join-path-with-dot (butlast split)))))
(defn last-path
"Returns the last item of the path."
[path]
(last (split-path path)))
(defn inside-path? [child parent]
(let [child-path (split-path child)
parent-path (split-path parent)]
(and (<= (count parent-path) (count child-path))
(= parent-path (take (count parent-path) child-path)))))
(defn split-by-last-period
"Splits a string into two parts:
the text before and including the last period,
and the text after the last period."
[s]
(if-let [last-period (str/last-index-of s ".")]
[(subs s 0 (inc last-period)) (subs s (inc last-period))]
[s ""]))

7
common/src/app/common/schema.cljc
View File

@@ -861,6 +861,11 @@
;; ::oapi/type "string"
;; ::oapi/format "number"}})
#?(:clj
(register!
{:type ::atom
:pred #(instance? clojure.lang.Atom %)}))
(register!
{:type ::fn
:pred fn?})
@@ -922,6 +927,8 @@
:gen/gen (sg/uri)
:decode/string decode-uri
:decode/json decode-uri
:encode/json str
:encode/string str
::oapi/type "string"
::oapi/format "uri"}})

7
common/src/app/common/test_helpers/components.cljc
View File

@@ -12,6 +12,7 @@
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.logic.libraries :as cll]
[app.common.path-names :as cpn]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
@@ -36,7 +37,7 @@
updated-root (first updated-shapes) ; Can't use new-root because it has a new id
[path name] (cfh/parse-path-name (:name updated-root))]
[path name] (cpn/split-group-name (:name updated-root))]
(thi/set-id! label (:component-id updated-root))
(ctf/update-file-data
@@ -72,6 +73,10 @@
[file id]
(ctkl/get-component (:data file) id))
(defn get-components
[file]
(ctkl/components (:data file)))
(defn- set-children-labels!
[file shape-label children-labels]
(doseq [[label id]

3
common/src/app/common/test_helpers/files.cljc
View File

@@ -108,7 +108,8 @@
page (if (some? page-label)
(:id (get-page file page-label))
(current-page-id file))
libraries (or libraries {})]
libraries (or libraries
{(:id file) file})]
(ctf/dump-tree file page libraries params)))

6
common/src/app/common/test_helpers/tokens.cljc
View File

@@ -28,12 +28,10 @@
(ctf/update-file-data file #(update % :tokens-lib f)))
(defn get-token
[file set-name token-id]
[file set-id token-id]
(let [tokens-lib (:tokens-lib (:data file))]
(when tokens-lib
(-> tokens-lib
(ctob/get-set set-name)
(ctob/get-token token-id)))))
(ctob/get-token tokens-lib set-id token-id))))
(defn token-data-eq?
"Compare token data without comparing unstable fields."

8
common/src/app/common/time.cljc
View File

@@ -52,6 +52,7 @@
[cuerdas.core :as str])
#?(:clj
(:import
java.time.Clock
java.time.Duration
java.time.Instant
java.time.OffsetDateTime
@@ -63,9 +64,11 @@
java.time.temporal.TemporalAmount
java.time.temporal.TemporalUnit)))
#?(:clj (def ^:dynamic *clock* (Clock/systemDefaultZone)))
(defn now
[]
#?(:clj (Instant/now)
#?(:clj (Instant/now *clock*)
:cljs (new js/Date)))
;; --- DURATION
@@ -130,7 +133,6 @@
ms-or-obj
(integer? ms-or-obj)
(Duration/ofMillis ms-or-obj)
:else
@@ -433,4 +435,4 @@
#?(:cljs
(extend-protocol cljs.core/IEncodeJS
js/Date
(-clj->js [x] x)))
(-clj->js [x] x)))

30
common/src/app/common/types/component.cljc
View File

@@ -23,7 +23,7 @@
[:map
[:id ::sm/uuid]
[:name :string]
[:path {:optional true} [:maybe :string]]
[:path :string]
[:modified-at {:optional true} ::ct/inst]
[:objects {:gen/max 10 :optional true} ctp/schema:objects]
[:main-instance-id ::sm/uuid]
@@ -145,9 +145,12 @@
(defn component-attr?
"Check if some attribute is one that is involved in component syncrhonization.
Note that design tokens also are involved, although they go by an alternate
route and thus they are not part of :sync-attrs."
route and thus they are not part of :sync-attrs.
Also when detaching a nested copy it also needs to trigger a synchronization,
even though :shape-ref is not a synced attribute per se"
[attr]
(or (get sync-attrs attr)
(= :shape-ref attr)
(= :applied-tokens attr)))
(defn instance-root?
@@ -217,19 +220,16 @@
(and (= shape-id (:main-instance-id component))
(= page-id (:main-instance-page component))))
(defn is-variant?
"Check if this shape or component is a variant component"
[item]
(some? (:variant-id item)))
(defn is-variant-container?
"Check if this shape is a variant container"
[shape]
(:is-variant-container shape))
(defn set-touched-group
[touched group]
(when group
@@ -256,7 +256,7 @@
(defn group->swap-slot
[group]
(parse-uuid (subs (name group) 10)))
(parse-uuid (subs (name group) 10))) ;; 10 is the length of "swap-slot-"
(defn get-swap-slot
"If the shape has a :touched group in the form :swap-slot-<uuid>, get the id."
@@ -286,7 +286,7 @@
(fn [touched]
(into #{} (remove #(str/starts-with? (name %) "swap-slot-") touched)))))
(defn get-component-root
(defn get-deleted-component-root
[component]
(if (some? (:main-instance-id component))
(get-in component [:objects (:main-instance-id component)])
@@ -310,6 +310,22 @@
:shape-ref
:touched))
(defn unhead-shape
"Make the shape not be a component head, but keep its :shape-ref and :touched if it was a nested copy"
[shape]
(dissoc shape
:component-root
:component-file
:component-id
:main-instance))
(defn rehead-shape
"Make the shape a component head, by adding component info"
[shape component-file component-id]
(assoc shape
:component-file component-file
:component-id component-id))
(defn- extract-ids [shape]
(if (map? shape)
(let [current-id (:id shape)

73
common/src/app/common/types/components_list.cljc
View File

@@ -8,7 +8,6 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.features :as cfeat]
[app.common.time :as dt]
[app.common.types.component :as ctk]
[clojure.set :as set]))
@@ -35,7 +34,7 @@
(defn add-component
[fdata {:keys [id name path main-instance-id main-instance-page annotation variant-id variant-properties]}]
(let [fdata (update fdata :components assoc id (touch {:id id :name name :path path}))]
(let [fdata (update fdata :components assoc id (touch {:id id :name name :path path}))]
(cond-> (update-in fdata [:components id] assoc :main-instance-id main-instance-id :main-instance-page main-instance-page)
annotation (update-in [:components id] assoc :annotation annotation)
variant-id (update-in [:components id] assoc :variant-id variant-id)
@@ -43,53 +42,53 @@
(defn mod-component
[file-data {:keys [id name path main-instance-id main-instance-page objects annotation variant-id variant-properties modified-at]}]
(let [wrap-objects-fn cfeat/*wrap-with-objects-map-fn*]
(d/update-in-when file-data [:components id]
(fn [component]
(let [objects (some-> objects wrap-objects-fn)
new-comp (cond-> component
(some? name)
(assoc :name name)
(d/update-in-when file-data [:components id]
(fn [component]
(let [new-comp (cond-> component
(some? name)
(assoc :name name)
(some? path)
(assoc :path path)
(some? path)
(assoc :path path)
(some? main-instance-id)
(assoc :main-instance-id main-instance-id)
(some? main-instance-id)
(assoc :main-instance-id main-instance-id)
(some? main-instance-page)
(assoc :main-instance-page main-instance-page)
(some? main-instance-page)
(assoc :main-instance-page main-instance-page)
(some? objects)
(assoc :objects objects)
(some? objects)
(assoc :objects objects)
(some? modified-at)
(assoc :modified-at modified-at)
(some? modified-at)
(assoc :modified-at modified-at)
(some? annotation)
(assoc :annotation annotation)
(some? annotation)
(assoc :annotation annotation)
(nil? annotation)
(dissoc :annotation)
(nil? annotation)
(dissoc :annotation)
(some? variant-id)
(assoc :variant-id variant-id)
(some? variant-id)
(assoc :variant-id variant-id)
(nil? variant-id)
(dissoc :variant-id)
(nil? variant-id)
(dissoc :variant-id)
(some? variant-properties)
(assoc :variant-properties variant-properties)
(some? variant-properties)
(assoc :variant-properties variant-properties)
(nil? variant-properties)
(dissoc :variant-properties))
diff (set/difference
(ctk/diff-components component new-comp)
#{:annotation :modified-at :variant-id :variant-properties})] ;; The set of properties that doesn't mark a component as touched
(nil? variant-properties)
(dissoc :variant-properties))
(if (empty? diff)
new-comp
(touch new-comp)))))))
;; The set of properties that doesn't mark a component as touched
diff (set/difference
(ctk/diff-components component new-comp)
#{:annotation :modified-at :variant-id :variant-properties})]
(if (empty? diff)
new-comp
(touch new-comp))))))
(defn get-component
([file-data component-id]

47
common/src/app/common/types/container.cljc
View File

@@ -7,7 +7,6 @@
(ns app.common.types.container
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
@@ -77,11 +76,8 @@
(defn get-shape
[container shape-id]
(assert (check-container container))
(assert (uuid? shape-id)
"expected valid uuid for `shape-id`")
(-> container
(get :objects)
(get shape-id)))
@@ -494,29 +490,40 @@
all-main?
(every? ctk/main-instance? top-children)
ascendants (cfh/get-parents-with-self objects parent-id)
any-main-ascendant (some ctk/main-instance? ascendants)
any-variant-container-ascendant (some ctk/is-variant-container? ascendants)
get-variant-id (fn [shape]
(when (:component-id shape)
(-> (get-component-from-shape shape libraries)
:variant-id)))
descendants (mapcat #(cfh/get-children-with-self objects %) children-ids)
any-variant-container-descendant (some ctk/is-variant-container? descendants)
descendants-variant-ids-set (->> descendants
(map get-variant-id)
set)
any-main-descendant
(some
(fn [shape]
(some ctk/main-instance? (cfh/get-children-with-self objects (:id shape))))
children)
children)]
;; Are all the top-children a main-instance of a cutted component?
all-comp-cut?
(when all-main?
(->> top-children
(map #(ctkl/get-component (dm/get-in libraries [(:component-file %) :data])
(:component-id %)
true))
(every? :deleted)))]
(if (or no-changes?
(and (not (invalid-structure-for-component? objects parent children pasting? libraries))
;; If we are moving into a main component, no descendant can be main
(or (nil? any-main-descendant) (not (ctk/main-instance? parent)))
;; If we are moving into a variant-container, all the items should be main
;; so if we are pasting, only allow main instances that are cut-and-pasted
(or (not (ctk/is-variant-container? parent))
(and (not pasting?) all-main?)
all-comp-cut?)))
;; If we are moving (not pasting) into a main component, no descendant can be main
(or pasting? (nil? any-main-descendant) (not (ctk/main-instance? parent)))
;; Don't allow variant-container inside variant container nor main
(or (not any-variant-container-descendant)
(and (not any-variant-container-ascendant) (not any-main-ascendant)))
;; If the parent is a variant-container, all the items should be main
(or (not (ctk/is-variant-container? parent)) all-main?)
;; If we are pasting, the parent can't be a "brother" of any of the pasted items,
;; so not have the same variant-id of any descendant
(or (not pasting?)
(not (ctk/is-variant? parent))
(not (contains? descendants-variant-ids-set (:variant-id parent))))))
[parent-id (get-frame parent-id)]
(recur (:parent-id parent) objects children pasting? libraries))))))

23
common/src/app/common/types/file.cljc
View File

@@ -114,10 +114,10 @@
(sm/register! ::typographies schema:typographies)
(def check-file
(sm/check-fn schema:file :hint "check error on validating file"))
(sm/check-fn schema:file :hint "invalid file"))
(def check-file-data
(sm/check-fn schema:data))
(sm/check-fn schema:data :hint "invalid file data"))
(def check-file-media
(sm/check-fn schema:media))
@@ -155,7 +155,7 @@
(defn make-file
[{:keys [id project-id name revn is-shared features migrations
ignore-sync-until created-at modified-at deleted-at]
metadata backend ignore-sync-until created-at modified-at deleted-at]
:as params}
& {:keys [create-page with-data page-id]
@@ -186,8 +186,9 @@
:data data
:features features
:migrations migrations
:metadata metadata
:backend backend
:ignore-sync-until ignore-sync-until
:has-media-trimmed false
:created-at created-at
:modified-at modified-at
:deleted-at deleted-at})]
@@ -275,7 +276,7 @@
(-> file-data
(get-component-page component)
(ctn/get-shape (:main-instance-id component)))
(ctk/get-component-root component)))
(ctk/get-deleted-component-root component)))
(defn get-component-shape
"Retrieve one shape in the component by id. If with-context? is true, add the
@@ -354,7 +355,7 @@
(defn find-remote-shape
"Recursively go back by the :shape-ref of the shape until find the correct shape of the original component"
[container libraries shape]
[container libraries shape & {:keys [with-context?] :or {with-context? false}}]
(let [top-instance (ctn/get-component-shape (:objects container) shape)
component-file (get-in libraries [(:component-file top-instance) :data])
component (ctkl/get-component component-file (:component-id top-instance) true)
@@ -374,8 +375,12 @@
(if (nil? remote-shape)
nil
(if (nil? (:shape-ref remote-shape))
remote-shape
(find-remote-shape component-container libraries remote-shape)))))
(cond-> remote-shape
(and remote-shape with-context?)
(with-meta {:file {:id (:id file-data)
:data file-data}
:container component-container}))
(find-remote-shape component-container libraries remote-shape :with-context? with-context?)))))
(defn direct-copy?
"Check if the shape is in a direct copy of the component (i.e. the shape-ref points to shapes inside
@@ -900,7 +905,7 @@
(println))
(when (seq (:objects component))
(let [root (ctk/get-component-root component)]
(let [root (ctk/get-deleted-component-root component)]
(dump-shape (:id root)
1
(:objects component)

16
common/src/app/common/types/text.cljc
View File

@@ -249,12 +249,16 @@
(defn equal-attrs?
"Given a text structure, and a map of attrs, check that all the internal attrs in
paragraphs and sentences have the same attrs"
[item attrs]
(let [item-attrs (dissoc item :text :type :key :children)]
(and
(or (empty? item-attrs)
(= attrs (dissoc item :text :type :key :children)))
(every? #(equal-attrs? % attrs) (:children item)))))
([item attrs]
;; Ignore the root attrs of the content. We only want to check paragraphs and sentences
(equal-attrs? item attrs true))
([item attrs ignore?]
(let [item-attrs (dissoc item :text :type :key :children)]
(and
(or ignore?
(empty? item-attrs)
(= attrs (dissoc item :text :type :key :children)))
(every? #(equal-attrs? % attrs false) (:children item))))))
(defn get-first-paragraph-text-attrs
"Given a content text structure, extract it's first paragraph

73
common/src/app/common/types/token.cljc
View File

@@ -26,6 +26,27 @@
(mu/keys)
(into #{})))
(defn find-token-value-references
"Returns set of token references found in `token-value`.
Used for checking if a token has a reference in the value.
Token references are strings delimited by curly braces.
E.g.: {foo.bar.baz} -> foo.bar.baz"
[token-value]
(if (string? token-value)
(some->> (re-seq #"\{([^}]*)\}" token-value)
(map second)
(into #{}))
#{}))
(defn token-value-self-reference?
"Check if the token is self referencing with its `token-name` in `token-value`.
Simple 1 level check, doesn't account for circular self refernces across multiple tokens."
[token-name token-value]
(let [token-references (find-token-value-references token-value)
self-reference? (get token-references token-name)]
self-reference?))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEMA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -52,7 +73,24 @@
:typography "typography"})
(def dtcg-token-type->token-type
(set/map-invert token-type->dtcg-token-type))
(-> (set/map-invert token-type->dtcg-token-type)
;; Allow these properties to be imported with singular key names for backwards compability
(assoc "fontWeight" :font-weight
"fontSize" :font-size
"fontFamily" :font-family)))
(def composite-token-type->dtcg-token-type
"Custom set of conversion keys for composite typography token with `:line-height` available.
(Penpot doesn't support `:line-height` token)"
(assoc token-type->dtcg-token-type
:line-height "lineHeights"))
(def composite-dtcg-token-type->token-type
"Custom set of conversion keys for composite typography token with `:line-height` available.
(Penpot doesn't support `:line-height` token)"
(assoc dtcg-token-type->token-type
"lineHeights" :line-height
"lineHeight" :line-height))
(def token-types
(into #{} (keys token-type->dtcg-token-type)))
@@ -217,7 +255,8 @@
text-case-keys
text-decoration-keys
font-weight-keys
typography-token-keys))
typography-token-keys
#{:line-height}))
;; TODO: Created to extract the font-size feature from the typography feature flag.
;; Delete this once the typography feature flag is removed.
@@ -289,6 +328,7 @@
(font-size-keys shape-attr) #{shape-attr :typography}
(letter-spacing-keys shape-attr) #{shape-attr :typography}
(font-family-keys shape-attr) #{shape-attr :typography}
(= :line-height shape-attr) #{:line-height :typography}
(= :text-transform shape-attr) #{:text-case :typography}
(text-decoration-keys shape-attr) #{shape-attr :typography}
(font-weight-keys shape-attr) #{shape-attr :typography}
@@ -468,3 +508,32 @@
(when (font-weight-values weight)
(cond-> {:weight weight}
italic? (assoc :style "italic")))))
(defn typography-composite-token-reference?
"Predicate if a typography composite token is a reference value - a string pointing to another reference token."
[token-value]
(string? token-value))
(def tokens-by-input
"A map from input name to applicable token for that input."
{:width #{:sizing :dimensions}
:height #{:sizing :dimensions}
:max-width #{:sizing :dimensions}
:max-height #{:sizing :dimensions}
:x #{:spacing :dimensions}
:y #{:spacing :dimensions}
:rotation #{:number :rotation}
:border-radius #{:border-radius :dimensions}
:row-gap #{:spacing :dimensions}
:column-gap #{:spacing :dimensions}
:horizontal-padding #{:spacing :dimensions}
:vertical-padding #{:spacing :dimensions}
:sided-paddings #{:spacing :dimensions}
:horizontal-margin #{:spacing :dimensions}
:vertical-margin #{:spacing :dimensions}
:sided-margins #{:spacing :dimensions}
:line-height #{:line-height :number}
:font-size #{:font-size}
:letter-spacing #{:letter-spacing}
:fill #{:color}
:stroke-color #{:color}})

1024
common/src/app/common/types/tokens_lib.cljc
View File

File diff suppressed because it is too large Load Diff

15
common/src/app/common/types/variant.cljc
View File

@@ -7,8 +7,8 @@
(ns app.common.types.variant
(:require
[app.common.data :as d]
[app.common.files.helpers :as cfh]
[app.common.math :as math]
[app.common.path-names :as cpn]
[app.common.schema :as sm]
[cuerdas.core :as str]))
@@ -50,7 +50,6 @@
(def property-max-length 60)
(def value-prefix "Value ")
(defn properties-to-name
"Transform the properties into a name, with the values separated by comma"
[properties]
@@ -59,7 +58,6 @@
(remove str/empty?)
(str/join ", ")))
(defn next-property-number
"Returns the next property number, to avoid duplicates on the property names"
[properties]
@@ -92,7 +90,7 @@
([path properties]
(path-to-properties path properties 0))
([path properties min-props]
(let [cpath (cfh/split-path path)
(let [cpath (cpn/split-path path)
total-props (max (count cpath) min-props)
assigned (mapv #(assoc % :value (nth cpath %2 "")) properties (range))
;; Add empty strings to the end of cpath to reach the minimum number of properties
@@ -100,7 +98,6 @@
remaining (drop (count properties) cpath)]
(add-new-props assigned remaining))))
(defn properties-map->formula
"Transforms a map of properties to a formula of properties omitting the empty ones"
[properties]
@@ -110,7 +107,6 @@
(str name "=" value))))
(str/join ", ")))
(defn properties-formula->map
"Transforms a formula of properties to a map of properties"
[s]
@@ -121,7 +117,6 @@
{:name (str/trim k)
:value (str/trim v)}))))
(defn valid-properties-formula?
"Checks if a formula is valid"
[s]
@@ -138,21 +133,18 @@
(let [upd-names (set (map :name upd-props))]
(filterv #(not (contains? upd-names (:name %))) prev-props)))
(defn find-properties-to-update
"Compares two property maps to find which properties should be updated"
[prev-props upd-props]
(filterv #(some (fn [prop] (and (= (:name %) (:name prop))
(not= (:value %) (:value prop)))) prev-props) upd-props))
(defn find-properties-to-add
"Compares two property maps to find which properties should be added"
[prev-props upd-props]
(let [prev-names (set (map :name prev-props))]
(filterv #(not (contains? prev-names (:name %))) upd-props)))
(defn- split-base-name-and-number
"Extract the number in parentheses from an item, if present, and return both the base name and the number"
[item]
@@ -192,7 +184,6 @@
:value (:value prop)}))
[])))
(defn find-index-for-property-name
"Finds the index of a name in a property map"
[props name]
@@ -318,4 +309,4 @@
"Transforms a variant-name (its properties values) into a standard name:
the real name of the shape joined by the properties values separated by '/'"
[variant]
(cfh/merge-path-item (:name variant) (str/replace (:variant-name variant) #", " " / ")))
(cpn/merge-path-item (:name variant) (str/replace (:variant-name variant) #", " " / ")))

2
common/src/app/common/weak.cljc
View File

@@ -22,7 +22,7 @@
#?(:cljs
(defn weak-map
"Create a WeakMap like instance what uses clojure equality
"Create a WeakMap-like instance what uses clojure equality
semantics."
[]
(new wm/WeakEqMap #js {:hash hash :equals =})))

11
common/test/common_tests/data_test.cljc
View File

@@ -102,3 +102,14 @@
(t/is (= (d/insert-at-index [:a :b :c :d] 1 [:a])
[:a :b :c :d])))
(t/deftest reorder
(let [v ["a" "b" "c" "d"]]
(t/is (= (d/reorder v 0 2) ["b" "a" "c" "d"]))
(t/is (= (d/reorder v 0 3) ["b" "c" "a" "d"]))
(t/is (= (d/reorder v 0 4) ["b" "c" "d" "a"]))
(t/is (= (d/reorder v 3 0) ["d" "a" "b" "c"]))
(t/is (= (d/reorder v 3 2) ["a" "b" "d" "c"]))
(t/is (= (d/reorder v 0 5) ["b" "c" "d" "a"]))
(t/is (= (d/reorder v 3 -1) ["d" "a" "b" "c"]))
(t/is (= (d/reorder v 5 -1) ["d" "a" "b" "c"]))
(t/is (= (d/reorder v -1 5) ["b" "c" "d" "a"]))))

1
common/test/common_tests/files_changes_test.cljc
View File

@@ -14,7 +14,6 @@
[app.common.types.file :as ctf]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[clojure.pprint :refer [pprint]]
[clojure.test :as t]
[common-tests.types.shape-decode-encode-test :refer [json-roundtrip]]))

4
common/test/common_tests/files_migrations_test.cljc
View File

@@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.files.migrations :as cfm]
[app.common.pprint :as pp]
[app.common.types.file :as ctf]
[clojure.test :as t]))
(defmethod cfm/migrate-data "test/1" [data _] (update data :sum inc))
@@ -17,7 +18,8 @@
(t/deftest generic-migration-subsystem-1
(let [migrations (into (d/ordered-set) ["test/1" "test/2" "test/3"])]
(with-redefs [cfm/available-migrations migrations]
(with-redefs [cfm/available-migrations migrations
ctf/check-file-data identity]
(let [file {:data {:sum 1}
:id 1
:migrations (d/ordered-set "test/1")}

32
common/test/common_tests/logic/comp_detach_with_nested_test.cljc
View File

@@ -446,3 +446,35 @@
(t/is (= (count fills') 1))
(t/is (= (:fill-color fill') "#fabada"))
(t/is (= (:fill-opacity fill') 1))))
(t/deftest test-detach-copy-in-main
(let [;; ==== Setup
file (-> (setup-file)
(thc/instantiate-component :c-big-board
:copy-big-board
:children-labels [:copy-h-board-with-ellipse
:copy-nested-h-ellipse
:copy-nested-ellipse]))
page (thf/current-page file)
;; ==== Action
changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
(pcb/with-page page)
(pcb/with-objects (:objects page)))
page
{(:id file) file}
(thi/id :nested-h-ellipse))
file' (-> (thf/apply-changes file changes)
(tho/propagate-component-changes :c-board-with-ellipse)
(tho/propagate-component-changes :c-big-board))
;; ==== Get
nested2-h-ellipse (ths/get-shape file' :nested-h-ellipse)
copy-nested2-h-ellipse (ths/get-shape file' :copy-nested-h-ellipse)]
;; ==== Check
;; When the nested copy inside the main is detached, their copies are unheaded.
(t/is (not (ctk/subcopy-head? nested2-h-ellipse)))
(t/is (not (ctk/subcopy-head? copy-nested2-h-ellipse)))))

23
common/test/common_tests/logic/move_shapes_test.cljc
View File

@@ -144,20 +144,21 @@
file (-> (thf/sample-file :file1)
(tht/add-tokens-lib)
(tht/update-tokens-lib #(-> %
(ctob/add-set (ctob/make-token-set :name "test-token-set"))
(ctob/add-set (ctob/make-token-set :id (thi/new-id! :test-token-set)
:name "test-token-set"))
(ctob/add-theme (ctob/make-token-theme :name "test-theme"
:sets #{"test-token-set"}))
(ctob/set-active-themes #{"/test-theme"})
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-sizing)
:name "token-sizing"
:type :sizing
:value 10))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-spacing)
:name "token-spacing"
:type :spacing
:value 30))))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-sizing)
:name "token-sizing"
:type :sizing
:value 10))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-spacing)
:name "token-spacing"
:type :spacing
:value 30))))
(tho/add-frame :frame-1
:layout :flex ;; TODO: those values come from main.data.workspace.shape_layout/default-layout-params
:layout-flex-dir :row ;; it should be good to use it directly, but first it should be moved to common.logic

135
common/test/common_tests/logic/token_apply_test.cljc
View File

@@ -27,65 +27,66 @@
(-> (thf/sample-file :file1)
(tht/add-tokens-lib)
(tht/update-tokens-lib #(-> %
(ctob/add-set (ctob/make-token-set :name "test-token-set"))
(ctob/add-set (ctob/make-token-set :id (thi/new-id! :test-token-set)
:name "test-token-set"))
(ctob/add-theme (ctob/make-token-theme :name "test-theme"
:sets #{"test-token-set"}))
(ctob/set-active-themes #{"/test-theme"})
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-radius)
:name "token-radius"
:type :border-radius
:value 10))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-rotation)
:name "token-rotation"
:type :rotation
:value 30))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-opacity)
:name "token-opacity"
:type :opacity
:value 0.7))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-stroke-width)
:name "token-stroke-width"
:type :stroke-width
:value 2))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-color)
:name "token-color"
:type :color
:value "#00ff00"))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-dimensions)
:name "token-dimensions"
:type :dimensions
:value 100))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-font-size)
:name "token-font-size"
:type :font-size
:value 24))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-letter-spacing)
:name "token-letter-spacing"
:type :letter-spacing
:value 2))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-font-family)
:name "token-font-family"
:type :font-family
:value ["Helvetica" "Arial" "sans-serif"]))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-sizing)
:name "token-sizing"
:type :sizing
:value 10))
(ctob/add-token-in-set "test-token-set"
(ctob/make-token :id (thi/new-id! :token-spacing)
:name "token-spacing"
:type :spacing
:value 30))))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-radius)
:name "token-radius"
:type :border-radius
:value 10))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-rotation)
:name "token-rotation"
:type :rotation
:value 30))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-opacity)
:name "token-opacity"
:type :opacity
:value 0.7))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-stroke-width)
:name "token-stroke-width"
:type :stroke-width
:value 2))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-color)
:name "token-color"
:type :color
:value "#00ff00"))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-dimensions)
:name "token-dimensions"
:type :dimensions
:value 100))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-font-size)
:name "token-font-size"
:type :font-size
:value 24))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-letter-spacing)
:name "token-letter-spacing"
:type :letter-spacing
:value 2))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-font-family)
:name "token-font-family"
:type :font-family
:value ["Helvetica" "Arial" "sans-serif"]))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-sizing)
:name "token-sizing"
:type :sizing
:value 10))
(ctob/add-token (thi/id :test-token-set)
(ctob/make-token :id (thi/new-id! :token-spacing)
:name "token-spacing"
:type :spacing
:value 30))))
(tho/add-frame :frame1
:layout :flex ;; TODO: those values come from main.data.workspace.shape_layout/default-layout-params
:layout-flex-dir :row ;; it should be good to use it directly, but first it should be moved to common.logic
@@ -131,17 +132,17 @@
frame1 (ths/get-shape file :frame1)
text1 (ths/get-shape file :text1)
circle1 (ths/get-shape file :circle1)
token-radius (tht/get-token file "test-token-set" (thi/id :token-radius))
token-rotation (tht/get-token file "test-token-set" (thi/id :token-rotation))
token-opacity (tht/get-token file "test-token-set" (thi/id :token-opacity))
token-stroke-width (tht/get-token file "test-token-set" (thi/id :token-stroke-width))
token-color (tht/get-token file "test-token-set" (thi/id :token-color))
token-dimensions (tht/get-token file "test-token-set" (thi/id :token-dimensions))
token-font-size (tht/get-token file "test-token-set" (thi/id :token-font-size))
token-letter-spacing (tht/get-token file "test-token-set" (thi/id :token-letter-spacing))
token-font-family (tht/get-token file "test-token-set" (thi/id :token-font-family))
token-sizing (tht/get-token file "test-token-set" (thi/id :token-sizing))
token-spacing (tht/get-token file "test-token-set" (thi/id :token-spacing))
token-radius (tht/get-token file (thi/id :test-token-set) (thi/id :token-radius))
token-rotation (tht/get-token file (thi/id :test-token-set) (thi/id :token-rotation))
token-opacity (tht/get-token file (thi/id :test-token-set) (thi/id :token-opacity))
token-stroke-width (tht/get-token file (thi/id :test-token-set) (thi/id :token-stroke-width))
token-color (tht/get-token file (thi/id :test-token-set) (thi/id :token-color))
token-dimensions (tht/get-token file (thi/id :test-token-set) (thi/id :token-dimensions))
token-font-size (tht/get-token file (thi/id :test-token-set) (thi/id :token-font-size))
token-letter-spacing (tht/get-token file (thi/id :test-token-set) (thi/id :token-letter-spacing))
token-font-family (tht/get-token file (thi/id :test-token-set) (thi/id :token-font-family))
token-sizing (tht/get-token file (thi/id :test-token-set) (thi/id :token-sizing))
token-spacing (tht/get-token file (thi/id :test-token-set) (thi/id :token-spacing))
;; ==== Action
changes (-> (-> (pcb/empty-changes nil)

189
common/test/common_tests/logic/token_test.cljc
View File

@@ -13,6 +13,7 @@
[app.common.test-helpers.tokens :as tht]
[app.common.types.tokens-lib :as ctob]
[app.common.uuid :as uuid]
[clojure.datafy :refer [datafy]]
[clojure.test :as t]))
(t/use-fixtures :each thi/test-fixture)
@@ -33,6 +34,7 @@
(pcb/with-library-data (:data file))
(clt/generate-toggle-token-set (tht/get-tokens-lib file) "foo/bar"))
_ (prn "changes" changes)
redo (thf/apply-changes file changes)
redo-lib (tht/get-tokens-lib redo)
undo (thf/apply-undo-changes redo changes)
@@ -83,127 +85,133 @@
(t/deftest set-token-theme-test
(t/testing "delete token theme"
(let [theme-name "foo"
group "main"
(let [theme-id (uuid/next)
file (setup-file #(-> %
(ctob/add-theme (ctob/make-token-theme :name theme-name
:group group))))
(ctob/add-theme (ctob/make-token-theme :id theme-id
:name "foo"
:group "main"))))
changes (-> (pcb/empty-changes)
(pcb/with-library-data (:data file))
(pcb/set-token-theme group theme-name nil))
(pcb/set-token-theme theme-id nil))
redo (thf/apply-changes file changes)
redo-lib (tht/get-tokens-lib redo)
undo (thf/apply-undo-changes redo changes)
undo-lib (tht/get-tokens-lib undo)]
;; Redo
(t/is (nil? (ctob/get-theme redo-lib group theme-name)))
(t/is (nil? (ctob/get-theme redo-lib theme-id)))
;; Undo
(t/is (some? (ctob/get-theme undo-lib group theme-name)))))
(t/is (some? (ctob/get-theme undo-lib theme-id)))))
(t/testing "add token theme"
(let [theme-name "foo"
group "main"
theme (ctob/make-token-theme :name theme-name
:group group)
(let [theme-id (uuid/next)
theme (ctob/make-token-theme :id theme-id
:name "foo"
:group "main")
file (setup-file identity)
changes (-> (pcb/empty-changes)
(pcb/with-library-data (:data file))
(pcb/set-token-theme group theme-name theme))
(pcb/set-token-theme theme-id theme))
redo (thf/apply-changes file changes)
redo-lib (tht/get-tokens-lib redo)
undo (thf/apply-undo-changes redo changes)
undo-lib (tht/get-tokens-lib undo)]
;; Redo
(t/is (some? (ctob/get-theme redo-lib group theme-name)))
(t/is (some? (ctob/get-theme redo-lib theme-id)))
;; Undo
(t/is (nil? (ctob/get-theme undo-lib group theme-name)))))
(t/is (nil? (ctob/get-theme undo-lib theme-id)))))
(t/testing "update token theme"
(let [theme-name "foo"
group "main"
prev-theme (ctob/make-token-theme :name theme-name
:group group)
(let [theme-id (uuid/next)
prev-theme-name "foo"
prev-theme (ctob/make-token-theme :id theme-id
:name prev-theme-name
:group "main")
file (setup-file #(ctob/add-theme % prev-theme))
new-theme-name "foo1"
changes (-> (pcb/empty-changes)
(pcb/with-library-data (:data file))
(pcb/set-token-theme group new-theme-name prev-theme))
(pcb/set-token-theme theme-id (ctob/rename prev-theme new-theme-name)))
redo (thf/apply-changes file changes)
redo-lib (tht/get-tokens-lib redo)
redo-theme (ctob/get-theme redo-lib theme-id)
undo (thf/apply-undo-changes redo changes)
undo-lib (tht/get-tokens-lib undo)]
undo-lib (tht/get-tokens-lib undo)
undo-theme (ctob/get-theme undo-lib theme-id)]
;; Redo
(t/is (some? (ctob/get-theme redo-lib group theme-name)))
(t/is (nil? (ctob/get-theme redo-lib group new-theme-name)))
(t/is (= new-theme-name (ctob/get-name redo-theme)))
;; Undo
(t/is (some? (ctob/get-theme undo-lib group theme-name)))
(t/is (nil? (ctob/get-theme undo-lib group new-theme-name)))))
(t/is (= prev-theme-name (ctob/get-name undo-theme)))))
(t/testing "toggling token theme updates using changes history"
(let [theme-name "foo-theme"
group "main"
(let [theme-id (uuid/next)
theme (ctob/make-token-theme :id theme-id
:name "foo-theme"
:group "main")
set-name "bar-set"
token-set (ctob/make-token-set :name set-name)
theme (ctob/make-token-theme :name theme-name
:group group)
file (setup-file #(-> %
(ctob/add-theme theme)
(ctob/add-set token-set)))
theme' (assoc theme :sets #{set-name})
changes (-> (pcb/empty-changes)
(pcb/with-library-data (:data file))
(pcb/set-token-theme group theme-name theme'))
(pcb/set-token-theme theme-id theme'))
changed-file (-> file
(thf/apply-changes changes)
(thf/apply-undo-changes changes)
(thf/apply-changes changes))
changed-lib (tht/get-tokens-lib changed-file)]
(t/is (= #{set-name}
(-> changed-lib (ctob/get-theme group theme-name) :sets))))))
(-> changed-lib (ctob/get-theme theme-id) :sets))))))
(t/deftest set-token-test
(t/testing "delete token"
(let [set-name "foo"
set-id (uuid/next)
token-id (uuid/next)
file (setup-file #(-> %
(ctob/add-set (ctob/make-token-set :name set-name))
(ctob/add-token-in-set set-name (ctob/make-token {:name "to.delete.color.red"
:id token-id
:value "red"
:type :color}))))
(ctob/add-set (ctob/make-token-set :id set-id
:name set-name))
(ctob/add-token set-id (ctob/make-token {:name "to.delete.color.red"
:id token-id
:value "red"
:type :color}))))
changes (-> (pcb/empty-changes)
(pcb/with-library-data (:data file))
(pcb/set-token set-name token-id nil))
(pcb/set-token set-id token-id nil))
redo (thf/apply-changes file changes)
redo-lib (tht/get-tokens-lib redo)
undo (thf/apply-undo-changes redo changes)
undo-lib (tht/get-tokens-lib undo)]
(t/is (nil? (ctob/get-token-in-set redo-lib set-name token-id)))
(t/is (nil? (ctob/get-token redo-lib set-id token-id)))
;; Undo
(t/is (some? (ctob/get-token-in-set undo-lib set-name token-id)))))
(t/is (some? (ctob/get-token undo-lib set-id token-id)))))
(t/testing "add token"
(let [set-name "foo"
set-id (uuid/next)
token (ctob/make-token {:name "to.add.color.red"
:value "red"
:type :color})
file (setup-file #(-> % (ctob/add-set (ctob/make-token-set :name set-name))))
file (setup-file #(-> % (ctob/add-set (ctob/make-token-set :id set-id
:name set-name))))
changes (-> (pcb/empty-changes)
(pcb/with-library-data (:data file))
(pcb/set-token set-name (:id token) token))
(pcb/set-token set-id (:id token) token))
redo (thf/apply-changes file changes)
redo-lib (tht/get-tokens-lib redo)
undo (thf/apply-undo-changes redo changes)
undo-lib (tht/get-tokens-lib undo)]
(t/is (= token (ctob/get-token-in-set redo-lib set-name (:id token))))
(t/is (= token (ctob/get-token redo-lib set-id (:id token))))
;; Undo
(t/is (nil? (ctob/get-token-in-set undo-lib set-name (:id token))))))
(t/is (nil? (ctob/get-token undo-lib set-id (:id token))))))
(t/testing "update token"
(let [set-name "foo"
set-id (uuid/next)
prev-token (ctob/make-token {:name "to.update.color.red"
:value "red"
:type :color})
@@ -211,27 +219,29 @@
(assoc :name "color.red.changed")
(assoc :value "blue"))
file (setup-file #(-> %
(ctob/add-set (ctob/make-token-set :name set-name))
(ctob/add-token-in-set set-name prev-token)))
(ctob/add-set (ctob/make-token-set :id set-id
:name set-name))
(ctob/add-token set-id prev-token)))
changes (-> (pcb/empty-changes)
(pcb/with-library-data (:data file))
(pcb/set-token set-name (:id prev-token) token))
(pcb/set-token set-id (:id prev-token) token))
redo (thf/apply-changes file changes)
redo-lib (tht/get-tokens-lib redo)
undo (thf/apply-undo-changes redo changes)
undo-lib (tht/get-tokens-lib undo)]
(t/is (tht/token-data-eq? token (ctob/get-token-in-set redo-lib set-name (:id token))))
(t/is (tht/token-data-eq? token (ctob/get-token redo-lib set-id (:id token))))
;; Undo
(t/is (tht/token-data-eq? prev-token (ctob/get-token-in-set undo-lib set-name (:id prev-token)))))))
(t/is (tht/token-data-eq? prev-token (ctob/get-token undo-lib set-id (:id prev-token)))))))
(t/deftest set-token-set-test
(t/testing "delete token set"
(let [set-name "foo"
file (setup-file #(ctob/add-set % (ctob/make-token-set :name set-name)))
set-id (uuid/next)
file (setup-file #(ctob/add-set % (ctob/make-token-set :id set-id :name set-name)))
changes (-> (pcb/empty-changes)
(pcb/with-library-data (:data file))
(pcb/set-token-set set-name false nil))
(pcb/set-token-set set-id nil))
redo (thf/apply-changes file changes)
redo-lib (tht/get-tokens-lib redo)
@@ -243,11 +253,12 @@
(t/testing "add token set"
(let [set-name "foo"
token-set (ctob/make-token-set :name set-name)
set-id (uuid/next)
token-set (ctob/make-token-set :id set-id :name set-name)
file (setup-file identity)
changes (-> (pcb/empty-changes)
(pcb/with-library-data (:data file))
(pcb/set-token-set set-name false token-set))
(pcb/set-token-set set-id token-set))
redo (thf/apply-changes file changes)
redo-lib (tht/get-tokens-lib redo)
@@ -259,28 +270,26 @@
(t/testing "update token set"
(let [set-name "foo"
token-name "bar"
token (ctob/make-token {:name token-name
:value "red"
:type :color})
file (setup-file #(-> (ctob/add-set % (ctob/make-token-set :name set-name))
(ctob/add-token-in-set set-name token)))
prev-token-set (-> file tht/get-tokens-lib (ctob/get-set set-name))
set-id (uuid/next)
token-set (ctob/make-token-set :id set-id :name set-name)
file (setup-file #(-> (ctob/add-set % token-set)))
new-set-name "foo1"
changes (-> (pcb/empty-changes)
(pcb/with-library-data (:data file))
(pcb/set-token-set set-name false (ctob/rename prev-token-set new-set-name)))
(pcb/set-token-set set-id (ctob/rename token-set new-set-name)))
redo (thf/apply-changes file changes)
redo-lib (tht/get-tokens-lib redo)
undo (thf/apply-undo-changes redo changes)
undo-lib (tht/get-tokens-lib undo)]
redo-token-set (ctob/get-set redo-lib set-id)
undo (thf/apply-undo-changes redo changes)
undo-lib (tht/get-tokens-lib undo)
undo-token-set (ctob/get-set undo-lib set-id)]
(t/is (= (ctob/get-name redo-token-set) new-set-name))
;; Undo
(t/is (some? (ctob/get-token-in-set undo-lib set-name (:id token))))
(t/is (nil? (ctob/get-token-in-set undo-lib new-set-name (:id token))))
;; Redo
(t/is (nil? (ctob/get-token-in-set redo-lib set-name (:id token))))
(t/is (some? (ctob/get-token-in-set redo-lib new-set-name (:id token)))))))
(t/is (= (ctob/get-name undo-token-set) set-name)))))
(t/deftest generate-toggle-token-set-group-test
(t/testing "toggling set group with no active sets inside will activate all child sets"
@@ -361,13 +370,13 @@
:position :top})
redo (thf/apply-changes file changes)
redo-sets (-> (tht/get-tokens-lib redo)
(ctob/get-ordered-set-names))
(ctob/get-set-names))
undo (thf/apply-undo-changes redo changes)
undo-sets (-> (tht/get-tokens-lib undo)
(ctob/get-ordered-set-names))]
(ctob/get-set-names))]
(t/is (= ["bar" "foo" "baz"] (vec redo-sets)))
(t/testing "undo"
(t/is (= (ctob/get-ordered-set-names lib) undo-sets)))))
(t/is (= (ctob/get-set-names lib) undo-sets)))))
(t/testing "at bottom"
(let [file (setup-file #(-> %
@@ -380,13 +389,13 @@
:position :bot})
redo (thf/apply-changes file changes)
redo-sets (-> (tht/get-tokens-lib redo)
(ctob/get-ordered-set-names))
(ctob/get-set-names))
undo (thf/apply-undo-changes redo changes)
undo-sets (-> (tht/get-tokens-lib undo)
(ctob/get-ordered-set-names))]
(ctob/get-set-names))]
(t/is (= ["bar" "baz" "foo"] (vec redo-sets)))
(t/testing "undo"
(t/is (= (ctob/get-ordered-set-names lib) undo-sets)))))
(t/is (= (ctob/get-set-names lib) undo-sets)))))
(t/testing "dropping out of set group"
(let [file (setup-file #(-> %
@@ -398,13 +407,13 @@
:position :top})
redo (thf/apply-changes file changes)
redo-sets (-> (tht/get-tokens-lib redo)
(ctob/get-ordered-set-names))
(ctob/get-set-names))
undo (thf/apply-undo-changes redo changes)
undo-sets (-> (tht/get-tokens-lib undo)
(ctob/get-ordered-set-names))]
(ctob/get-set-names))]
(t/is (= ["bar" "foo"] (vec redo-sets)))
(t/testing "undo"
(t/is (= (ctob/get-ordered-set-names lib) undo-sets)))))
(t/is (= (ctob/get-set-names lib) undo-sets)))))
(t/testing "into set group"
(let [file (setup-file #(-> %
@@ -416,13 +425,13 @@
:position :bot})
redo (thf/apply-changes file changes)
redo-sets (-> (tht/get-tokens-lib redo)
(ctob/get-ordered-set-names))
(ctob/get-set-names))
undo (thf/apply-undo-changes redo changes)
undo-sets (-> (tht/get-tokens-lib undo)
(ctob/get-ordered-set-names))]
(ctob/get-set-names))]
(t/is (= ["foo/bar" "foo/foo"] (vec redo-sets)))
(t/testing "undo"
(t/is (= (ctob/get-ordered-set-names lib) undo-sets)))))
(t/is (= (ctob/get-set-names lib) undo-sets)))))
(t/testing "edge-cases:"
(t/testing "prevent overriding set to identical path"
@@ -454,13 +463,13 @@
:collapsed-paths #{["foo"]}})
redo (thf/apply-changes file changes)
redo-sets (-> (tht/get-tokens-lib redo)
(ctob/get-ordered-set-names))
(ctob/get-set-names))
undo (thf/apply-undo-changes redo changes)
undo-sets (-> (tht/get-tokens-lib undo)
(ctob/get-ordered-set-names))]
(ctob/get-set-names))]
(t/is (= ["foo/bar" "foo"] (vec redo-sets)))
(t/testing "undo"
(t/is (= (ctob/get-ordered-set-names lib) undo-sets))))))))
(t/is (= (ctob/get-set-names lib) undo-sets))))))))
(t/deftest generate-move-token-group-test
(t/testing "Ignore dropping set group to the same position"
@@ -496,14 +505,14 @@
:position :top})
redo (thf/apply-changes file changes)
redo-sets (-> (tht/get-tokens-lib redo)
(ctob/get-ordered-set-names))
(ctob/get-set-names))
undo (thf/apply-undo-changes redo changes)
undo-sets (-> (tht/get-tokens-lib undo)
(ctob/get-ordered-set-names))]
(ctob/get-set-names))]
(t/is (= ["bar/bar" "foo/foo" "baz/baz"] (vec redo-sets)))
(t/testing "undo"
(t/is (= (ctob/get-ordered-set-names lib) undo-sets)))))
(t/is (= (ctob/get-set-names lib) undo-sets)))))
(t/testing "to bottom"
(let [file (setup-file #(-> %
@@ -515,14 +524,14 @@
:position :bot})
redo (thf/apply-changes file changes)
redo-sets (-> (tht/get-tokens-lib redo)
(ctob/get-ordered-set-names))
(ctob/get-set-names))
undo (thf/apply-undo-changes redo changes)
undo-sets (-> (tht/get-tokens-lib undo)
(ctob/get-ordered-set-names))]
(ctob/get-set-names))]
(t/is (= ["bar" "foo/foo"] (vec redo-sets)))
(t/testing "undo"
(t/is (= (ctob/get-ordered-set-names lib) undo-sets)))))
(t/is (= (ctob/get-set-names lib) undo-sets)))))
(t/testing "into set group"
(let [file (setup-file #(-> %
@@ -534,13 +543,13 @@
:position :bot})
redo (thf/apply-changes file changes)
redo-sets (-> (tht/get-tokens-lib redo)
(ctob/get-ordered-set-names))
(ctob/get-set-names))
undo (thf/apply-undo-changes redo changes)
undo-sets (-> (tht/get-tokens-lib undo)
(ctob/get-ordered-set-names))]
(ctob/get-set-names))]
(t/is (= ["bar/foo/foo" "bar/bar"] (vec redo-sets)))
(t/testing "undo"
(t/is (= (ctob/get-ordered-set-names lib) undo-sets))))
(t/is (= (ctob/get-set-names lib) undo-sets))))
(t/testing "edge-cases:"
(t/testing "prevent overriding set to identical path"

126
common/test/common_tests/logic/variants_switch_test.cljc
View File

@@ -45,7 +45,6 @@
;; The rect has width 15 after the switch
(t/is (= (:width rect02') 15))))
(t/deftest test-switch-with-override
(let [;; ==== Setup
file (-> (thf/sample-file :file1)
@@ -125,12 +124,10 @@
;; The rect has width 15 after the switch
(t/is (= (:width rect02') 15))))
(def font-size-path-paragraph [:content :children 0 :children 0 :font-size])
(def font-size-path-0 [:content :children 0 :children 0 :children 0 :font-size])
(def font-size-path-1 [:content :children 0 :children 0 :children 1 :font-size])
(def text-path-0 [:content :children 0 :children 0 :children 0 :text])
(def text-path-1 [:content :children 0 :children 0 :children 1 :text])
(def text-lines-path [:content :children 0 :children 0 :children])
@@ -188,6 +185,8 @@
;; The copy clean has no overrides
copy-clean (ths/get-shape file :copy-clean)
copy-clean-t (ths/get-shape file :copy-clean-t)
@@ -209,6 +208,8 @@
;; ==== Action: Switch all the copies
file' (-> file
(tho/swap-component copy-clean :c02 {:new-shape-label :copy-clean-2 :keep-touched? true})
(tho/swap-component copy-font-size :c02 {:new-shape-label :copy-font-size-2 :keep-touched? true})
@@ -234,6 +235,8 @@
;; Before the switch:
;; * font size 14
;; * text "hello world"
(t/is (= (get-in copy-clean-t font-size-path-0) "14"))
(t/is (= (get-in copy-clean-t text-path-0) "hello world"))
@@ -248,6 +251,8 @@
;; Before the switch:
;; * font size 25
;; * text "hello world"
(t/is (= (get-in copy-font-size-t font-size-path-0) "25"))
(t/is (= (get-in copy-font-size-t text-path-0) "hello world"))
@@ -306,6 +311,8 @@
;; The copy clean has no overrides
copy-clean (ths/get-shape file :copy-clean)
copy-clean-t (ths/get-shape file :copy-clean-t)
@@ -327,6 +334,8 @@
;; ==== Action: Switch all the copies
file' (-> file
(tho/swap-component copy-clean :c02 {:new-shape-label :copy-clean-2 :keep-touched? true})
(tho/swap-component copy-font-size :c02 {:new-shape-label :copy-font-size-2 :keep-touched? true})
@@ -352,6 +361,8 @@
;; Before the switch:
;; * font size 14
;; * text "hello world"
(t/is (= (get-in copy-clean-t font-size-path-0) "14"))
(t/is (= (get-in copy-clean-t text-path-0) "hello world"))
@@ -366,6 +377,8 @@
;; Before the switch:
;; * font size 25
;; * text "hello world"
(t/is (= (get-in copy-font-size-t font-size-path-0) "25"))
(t/is (= (get-in copy-font-size-t text-path-0) "hello world"))
@@ -401,7 +414,6 @@
(t/is (= (get-in copy-both-t' font-size-path-0) "50"))
(t/is (= (get-in copy-both-t' text-path-0) "text overriden"))))
(t/deftest test-switch-with-different-text-text-override
(let [;; ==== Setup
file (-> (thf/sample-file :file1)
@@ -423,6 +435,8 @@
;; The copy clean has no overrides
copy-clean (ths/get-shape file :copy-clean)
copy-clean-t (ths/get-shape file :copy-clean-t)
@@ -444,6 +458,8 @@
;; ==== Action: Switch all the copies
file' (-> file
(tho/swap-component copy-clean :c02 {:new-shape-label :copy-clean-2 :keep-touched? true})
(tho/swap-component copy-font-size :c02 {:new-shape-label :copy-font-size-2 :keep-touched? true})
@@ -469,6 +485,8 @@
;; Before the switch:
;; * font size 14
;; * text "hello world"
(t/is (= (get-in copy-clean-t font-size-path-0) "14"))
(t/is (= (get-in copy-clean-t text-path-0) "hello world"))
@@ -483,6 +501,8 @@
;; Before the switch:
;; * font size 25
;; * text "hello world"
(t/is (= (get-in copy-font-size-t font-size-path-0) "25"))
(t/is (= (get-in copy-font-size-t text-path-0) "hello world"))
@@ -518,7 +538,6 @@
(t/is (= (get-in copy-both-t' font-size-path-0) "25"))
(t/is (= (get-in copy-both-t' text-path-0) "bye"))))
(t/deftest test-switch-with-different-text-and-prop-text-override
(let [;; ==== Setup
file (-> (thf/sample-file :file1)
@@ -542,6 +561,8 @@
;; The copy clean has no overrides
copy-clean (ths/get-shape file :copy-clean)
copy-clean-t (ths/get-shape file :copy-clean-t)
@@ -563,6 +584,8 @@
;; ==== Action: Switch all the copies
file' (-> file
(tho/swap-component copy-clean :c02 {:new-shape-label :copy-clean-2 :keep-touched? true})
(tho/swap-component copy-font-size :c02 {:new-shape-label :copy-font-size-2 :keep-touched? true})
@@ -588,6 +611,8 @@
;; Before the switch:
;; * font size 14
;; * text "hello world"
(t/is (= (get-in copy-clean-t font-size-path-0) "14"))
(t/is (= (get-in copy-clean-t text-path-0) "hello world"))
@@ -602,6 +627,8 @@
;; Before the switch:
;; * font size 25
;; * text "hello world"
(t/is (= (get-in copy-font-size-t font-size-path-0) "25"))
(t/is (= (get-in copy-font-size-t text-path-0) "hello world"))
@@ -637,7 +664,6 @@
(t/is (= (get-in copy-both-t' font-size-path-0) "50"))
(t/is (= (get-in copy-both-t' text-path-0) "bye"))))
(t/deftest test-switch-with-identical-structure-text-override
(let [;; ==== Setup
file (-> (thf/sample-file :file1)
@@ -657,6 +683,8 @@
;; Duplicate a text line in copy-structure-clean
file (change-structure file :copy-structure-clean-t)
copy-structure-clean (ths/get-shape file :copy-structure-clean)
copy-structure-clean-t (ths/get-shape file :copy-structure-clean-t)
@@ -678,6 +706,8 @@
;; ==== Action: Switch all the copies
file' (-> file
(tho/swap-component copy-structure-clean :c02 {:new-shape-label :copy-structure-clean-2 :keep-touched? true})
(tho/swap-component copy-structure-unif :c02 {:new-shape-label :copy-structure-unif-2 :keep-touched? true})
@@ -763,7 +793,6 @@
(t/is (= (get-in copy-structure-mixed-t' font-size-path-1) "40"))
(t/is (= (get-in copy-structure-mixed-t' text-path-1) "new line 2"))))
(t/deftest test-switch-with-different-prop-structure-text-override
(let [;; ==== Setup
file (-> (thf/sample-file :file1)
@@ -784,6 +813,8 @@
;; Duplicate a text line in copy-structure-clean
file (change-structure file :copy-structure-clean-t)
copy-structure-clean (ths/get-shape file :copy-structure-clean)
copy-structure-clean-t (ths/get-shape file :copy-structure-clean-t)
@@ -805,6 +836,8 @@
;; ==== Action: Switch all the copies
file' (-> file
(tho/swap-component copy-structure-clean :c02 {:new-shape-label :copy-structure-clean-2 :keep-touched? true})
(tho/swap-component copy-structure-unif :c02 {:new-shape-label :copy-structure-unif-2 :keep-touched? true})
@@ -906,6 +939,8 @@
;; Duplicate a text line in copy-structure-clean
file (change-structure file :copy-structure-clean-t)
copy-structure-clean (ths/get-shape file :copy-structure-clean)
copy-structure-clean-t (ths/get-shape file :copy-structure-clean-t)
@@ -927,6 +962,8 @@
;; ==== Action: Switch all the copies
file' (-> file
(tho/swap-component copy-structure-clean :c02 {:new-shape-label :copy-structure-clean-2 :keep-touched? true})
(tho/swap-component copy-structure-unif :c02 {:new-shape-label :copy-structure-unif-2 :keep-touched? true})
@@ -971,6 +1008,8 @@
;; Second line:
;; * font size 25
;; * text "new line 2"
(t/is (= (get-in copy-structure-unif-t font-size-path-0) "25"))
(t/is (= (get-in copy-structure-unif-t text-path-0) "new line 1"))
(t/is (= (get-in copy-structure-unif-t font-size-path-1) "25"))
@@ -992,6 +1031,8 @@
;; Before the switch, second line:
;; * font size 40
;; * text "new line 2"
(t/is (= (get-in copy-structure-mixed-t font-size-path-0) "35"))
(t/is (= (get-in copy-structure-mixed-t text-path-0) "new line 1"))
(t/is (= (get-in copy-structure-mixed-t font-size-path-1) "40"))
@@ -1025,6 +1066,8 @@
;; Duplicate a text line in copy-structure-clean
file (change-structure file :copy-structure-clean-t)
copy-structure-clean (ths/get-shape file :copy-structure-clean)
copy-structure-clean-t (ths/get-shape file :copy-structure-clean-t)
@@ -1046,6 +1089,8 @@
;; ==== Action: Switch all the copies
file' (-> file
(tho/swap-component copy-structure-clean :c02 {:new-shape-label :copy-structure-clean-2 :keep-touched? true})
(tho/swap-component copy-structure-unif :c02 {:new-shape-label :copy-structure-unif-2 :keep-touched? true})
@@ -1090,6 +1135,8 @@
;; Second line:
;; * font size 25
;; * text "new line 2"
(t/is (= (get-in copy-structure-unif-t font-size-path-0) "25"))
(t/is (= (get-in copy-structure-unif-t text-path-0) "new line 1"))
(t/is (= (get-in copy-structure-unif-t font-size-path-1) "25"))
@@ -1111,6 +1158,8 @@
;; Before the switch, second line:
;; * font size 40
;; * text "new line 2"
(t/is (= (get-in copy-structure-mixed-t font-size-path-0) "35"))
(t/is (= (get-in copy-structure-mixed-t text-path-0) "new line 1"))
(t/is (= (get-in copy-structure-mixed-t font-size-path-1) "40"))
@@ -1124,7 +1173,6 @@
(t/is (= (get-in copy-structure-mixed-t' text-path-0) "bye"))
(t/is (nil? (get-in copy-structure-mixed-t' font-size-path-1)))))
(t/deftest test-switch-variant-for-other-with-same-nested-component
(let [;; ==== Setup
file (-> (thf/sample-file :file1)
@@ -1144,6 +1192,8 @@
;; On :copy-cp01, change the width of the rect
changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
#{copy-cp01-rect-id}
(fn [shape]
@@ -1166,8 +1216,6 @@
;; The width of copy-cp02-rect' is 25 (change is preserved)
(t/is (= (:width copy-cp02-rect') 25))))
(t/deftest test-switch-variant-that-has-swaped-copy
(let [;; ==== Setup
file (-> (thf/sample-file :file1)
@@ -1193,7 +1241,6 @@
;; Switch :c01 for :c02
file' (tho/swap-component file copy01 :c02 {:new-shape-label :copy02 :keep-touched? true})
copy02' (ths/get-shape file' :copy02)
copy-cp02' (ths/get-shape file' :copy-cp02)]
(thf/dump-file file')
@@ -1207,7 +1254,6 @@
;;copy-02' had copy-cp02' as child
(t/is (= (-> copy02' :shapes first) (:id copy-cp02')))))
(t/deftest test-switch-variant-that-has-swaped-copy-with-changed-attr
(let [;; ==== Setup
file (-> (thf/sample-file :file1)
@@ -1244,7 +1290,6 @@
;; Switch :c01 for :c02
file' (tho/swap-component file copy01 :c02 {:new-shape-label :copy02 :keep-touched? true})
copy02' (ths/get-shape file' :copy02)
copy-cp02' (ths/get-shape file' :copy-cp02)
copy-cp02-rect' (ths/get-shape-by-id file' (-> copy-cp02' :shapes first))]
@@ -1262,3 +1307,58 @@
(t/is (= (-> copy02' :shapes first) (:id copy-cp02')))
;; The width of copy-cp02-rect' is 25 (change is preserved)
(t/is (= (:width copy-cp02-rect') 25))))
(t/deftest test-switch-variant-without-touched-but-touched-parent
(let [;; ==== Setup
file (-> (thf/sample-file :file1)
(thv/add-variant-with-child
:v01 :c01 :m01 :c02 :m02 :r01 :r02
{:child1-params {:width 5}
:child2-params {:width 5}})
(tho/add-simple-component :external01 :external01-root :external01-child)
(thc/instantiate-component :c01
:c01-in-root
:children-labels [:r01-in-c01-in-root]
:parent-label :external01-root))
;; Make a change on r01-in-c01-in-root so it is touched
page (thf/current-page file)
r01-in-c01-in-root (ths/get-shape file :r01-in-c01-in-root)
changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
#{(:id r01-in-c01-in-root)}
(fn [shape]
(assoc shape :width 25))
(:objects page)
{})
file (thf/apply-changes file changes)
;; Instantiate the component :external01
file (thc/instantiate-component file
:external01
:external-copy01
:children-labels [:external-copy01-rect :c01-in-copy])
page (thf/current-page file)
c01-in-copy (ths/get-shape file :c01-in-copy)
rect01 (get-in page [:objects (-> c01-in-copy :shapes first)])
;; ==== Action
file' (tho/swap-component file c01-in-copy :c02 {:new-shape-label :c02-in-copy :keep-touched? true})
page' (thf/current-page file')
c02-in-copy' (ths/get-shape file' :c02-in-copy)
rect02' (get-in page' [:objects (-> c02-in-copy' :shapes first)])]
(thf/dump-file file :keys [:width :touched])
;; The rect had width 25 before the switch
(t/is (= (:width rect01) 25))
;; The rect still has width 25 after the switch
(t/is (= (:width rect02') 25))))

19
common/test/common_tests/pages_helpers_test.cljc
View File

@@ -1,19 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns common-tests.pages-helpers-test
(:require
[app.common.files.helpers :as cfh]
[clojure.pprint :refer [pprint]]
[clojure.test :as t]))
(t/deftest parse-path-name
(t/is (= ["foo" "bar"] (cfh/parse-path-name "foo/bar")))
(t/is (= ["" "foo"] (cfh/parse-path-name "foo")))
(t/is (= ["" "foo"] (cfh/parse-path-name "/foo")))
(t/is (= ["" ""] (cfh/parse-path-name "")))
(t/is (= ["" ""] (cfh/parse-path-name nil))))

33
common/test/common_tests/path_names_test.cljc Normal file
View File

@@ -0,0 +1,33 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns common-tests.path-names-test
(:require
[app.common.path-names :as cpn]
[clojure.test :as t]))
(t/deftest split-group-name
(t/is (= ["foo" "bar"] (cpn/split-group-name "foo/bar")))
(t/is (= ["" "foo"] (cpn/split-group-name "foo")))
(t/is (= ["" "foo"] (cpn/split-group-name "/foo")))
(t/is (= ["" ""] (cpn/split-group-name "")))
(t/is (= ["" ""] (cpn/split-group-name nil))))
(t/deftest split-and-join-path
(let [name "group/subgroup/name"
path (cpn/split-path name :separator "/")
name' (cpn/join-path path :separator "/" :with-spaces? false)]
(t/is (= (first path) "group"))
(t/is (= (second path) "subgroup"))
(t/is (= (nth path 2) "name"))
(t/is (= name' name))))
(t/deftest split-and-join-path-with-spaces
(let [name "group / subgroup / name"
path (cpn/split-path name :separator "/")]
(t/is (= (first path) "group"))
(t/is (= (second path) "subgroup"))
(t/is (= (nth path 2) "name"))))

4
common/test/common_tests/runner.cljc
View File

@@ -30,7 +30,7 @@
[common-tests.logic.swap-as-override-test]
[common-tests.logic.token-test]
[common-tests.media-test]
[common-tests.pages-helpers-test]
[common-tests.path-names-test]
[common-tests.record-test]
[common-tests.schema-test]
[common-tests.svg-path-test]
@@ -82,7 +82,7 @@
'common-tests.logic.swap-as-override-test
'common-tests.logic.token-test
'common-tests.media-test
'common-tests.pages-helpers-test
'common-tests.path-names-test
'common-tests.record-test
'common-tests.schema-test
'common-tests.svg-path-test

26
common/test/common_tests/types/data/tokens-font-family-example.json Normal file
View File

@@ -0,0 +1,26 @@
{
"fonts": {
"string-font-family": {
"$value": "Arial, Helvetica, sans-serif",
"$type": "fontFamilies",
"$description": "A font family defined as a string"
},
"array-font-family": {
"$value": ["Inter", "system-ui", "sans-serif"],
"$type": "fontFamilies",
"$description": "A font family defined as an array"
},
"single-font-family": {
"$value": "Georgia",
"$type": "fontFamilies"
},
"complex-font-family": {
"$value": "Times New Roman, serif",
"$type": "fontFamilies"
},
"font-with-spaces": {
"$value": "Source Sans Pro, Arial, sans-serif",
"$type": "fontFamilies"
}
}
}

53
common/test/common_tests/types/data/tokens-typography-example.json Normal file
View File

@@ -0,0 +1,53 @@
{
"test": {
"typo": {
"$value": {
"fontWeight": "100",
"fontSize": "16px",
"letterSpacing": "0.1em"
},
"$type": "typography"
},
"typo2": {
"$value": "{typo}",
"$type": "typography"
},
"font-weight": {
"$value": "200",
"$type": "fontWeights"
},
"typo-to-single": {
"$value": "{font-weight}",
"$type": "typography"
},
"test-empty": {
"$value": {},
"$type": "typography"
},
"font-size": {
"$value": "18px",
"$type": "fontSizes"
},
"typo-complex": {
"$value": {
"fontWeight": "bold",
"fontSize": "24px",
"letterSpacing": "0.05em",
"lineHeights": "100%",
"fontFamilies": ["Arial", "sans-serif"],
"textCase": "uppercase"
},
"$type": "typography",
"$description": "A complex typography token"
},
"typo-with-string-font-family": {
"$value": {
"fontWeight": "600",
"fontSize": "20px",
"fontFamilies": "Roboto, Helvetica, sans-serif"
},
"$type": "typography",
"$description": "Typography token with string font family"
}
}
}

1069
common/test/common_tests/types/tokens_lib_test.cljc
View File

File diff suppressed because it is too large Load Diff