Revert "add new configurations"

add new configurations

CHANGES.md

@@ -1,5 +1,99 @@
 # CHANGELOG
 
+## 2.8.0 (Next / Unreleased)
+
+### :rocket: Epics and highlights
+
+### :boom: Breaking changes & Deprecations
+
+**Breaking changes on penpot library:**
+
+- Change the signature of the `addPage` method: it now accepts an object (as a single argument) where you can pass `id`,
+  `name`, and `background` props (instead of the previous positional arguments)
+- Rename the `file.createRect` method to `file.addRect`
+- Rename the `file.createCircle` method to `file.addCircle`
+- Rename the `file.createPath` method to `file.addPath`
+- Rename the `file.createText` method to `file.addText`
+- Rename `file.startComponent` to `file.addComponent` (to preserve the naming style)
+- Rename `file.createComponentInstance` to `file.addComponentInstance` (to preserve the naming style)
+- Rename `file.lookupShape` to `file.getShape`
+- Rename `file.asMap` to `file.toMap`
+- Remove `file.updateLibraryColor` (use `file.addLibraryColor` if you just need to replace a color)
+- Remove `file.deleteLibraryColor` (this library is intended to build files)
+- Remove `file.updateLibraryTypography` (use `file.addLibraryTypography` if you just need to replace a typography)
+- Remove `file.deleteLibraryTypography` (this library is intended to build files)
+- Remove `file.add/update/deleteLibraryMedia` (they are no longer supported by Penpot and have been replaced by components)
+- Remove `file.deleteObject` (this library is intended to build files)
+- Remove `file.updateObject` (this library is intended to build files)
+- Remove `file.finishComponent` (it is no longer necessary; see below for more details on component creation changes)
+- Change the `file.getCurrentPageId` function to a read-only `file.currentPageId` property
+- Add `file.currentFrameId` read-only property
+- Add `file.lastId` read-only property
+
+There are also relevant semantic changes in how components should be created: this refactor removes
+all notions of the old components (v1). Since v2, the shapes that are part of a component live on a
+page. So, from now on, to create a component, you should first create a frame, then add shapes
+and/or groups to that frame, and then create a component by declaring that frame as the component
+root.
+
+### :heart: Community contributions (Thank you!)
+
+### :sparkles: New features
+
+- Optimize profile setup flow for better user experience [Taiga #10028](https://tree.taiga.io/project/penpot/us/10028)
+
+### :bug: Bugs fixed
+
+
+## 2.7.0 (Unreleased)
+
+### :rocket: Epics and highlights
+
+### :boom: Breaking changes & Deprecations
+
+### :heart: Community contributions (Thank you!)
+
+- Design improvements to the Invitations page with an empty state [GitHub #2608](https://github.com/penpot/penpot/issues/2608) by [@iprithvitharun](https://github.com/iprithvitharun)
+
+### :sparkles: New features
+
+- Update board presets with a newer devices [Taiga #10610](https://tree.taiga.io/project/penpot/us/10610)
+- Propagate "sharing a prototype" to editors and viewers [Taiga #8853](https://tree.taiga.io/project/penpot/us/8853)
+- Design improvements to the Invitations page with an empty state [Taiga #4554](https://tree.taiga.io/project/penpot/us/4554)
+- Duplicate token sets [Taiga #10694](https://tree.taiga.io/project/penpot/issue/10694)
+- Add set selection in create Token themes flow [Taiga #10746](https://tree.taiga.io/project/penpot/issue/10746)
+- Display indicator on not active sets [Taiga #10668](https://tree.taiga.io/project/penpot/issue/10668)
+- Create `input*` wrapper component, and `label*`, `input-field*` and `hint-message*` components [Taiga #10713](https://tree.taiga.io/project/penpot/us/10713)
+
+### :bug: Bugs fixed
+
+- Fix problem in viewer with the back button [Taiga #10907](https://tree.taiga.io/project/penpot/issue/10907)
+- Fix resize bar background on tokens panel [Taiga #10811](https://tree.taiga.io/project/penpot/issue/10811)
+- Fix shortcut for history version panel [Taiga #11006](https://tree.taiga.io/project/penpot/issue/11006)
+- Fix positioning of comment drafts when near the right / bottom edges of viewport [Taiga #10534](https://tree.taiga.io/project/penpot/issue/10534)
+- Fix path having a wrong selrect [Taiga #10257](https://tree.taiga.io/project/penpot/issue/10257)
+- Fix SVG `stroke-linecap` property when importing SVGs [Taiga #9489](https://tree.taiga.io/project/penpot/issue/9489)
+- Fix position problems cutting-pasting a component [Taiga #10677](https://tree.taiga.io/project/penpot/issue/10677)
+- Fix design tab has a horizontal scroll [Taiga #10660](https://tree.taiga.io/project/penpot/issue/10660)
+- Fix long file names being clipped when longer than allowed length [Taiga #10662](https://tree.taiga.io/project/penpot/issue/10662)
+- Fix problem with error detail in toast [Taiga #10519](https://tree.taiga.io/project/penpot/issue/10519)
+- Fix view mode error when an external user tries to export something from a prototype using a shared link [Taiga #10251](https://tree.taiga.io/project/penpot/issue/10251)
+- Fix merge path nodes with only one node selected [Taiga #9626](https://tree.taiga.io/project/penpot/issue/9626)
+- Fix problem with import errors [Taiga #10040](https://tree.taiga.io/project/penpot/issue/10040)
+- Fix color gradient on texts [Taiga Issue #7488](https://tree.taiga.io/project/penpot/issue/7488)
+- Add support for self mentions [Taiga #10809](https://tree.taiga.io/project/penpot/issue/10809)
+- Fix team info settings alignment [Taiga #10869](https://tree.taiga.io/project/penpot/issue/10869)
+- Fix left sidebar horizontal scroll on nested layers [Taiga #10791](https://tree.taiga.io/project/penpot/issue/10791)
+- Improve error message details importing tokens [Taiga Issue #10772](https://tree.taiga.io/project/penpot/issue/10772)
+- Fix no selected set after Drag & Drop [Github #71](https://github.com/tokens-studio/penpot/issues/71)
+- Styledictionary v5 Update [Github #6283](https://github.com/penpot/penpot/pull/6283)
+- Fix Rename a set throws an internal error [Github #78](https://github.com/tokens-studio/penpot/issues/78)
+- Fix Out of Sync Token Value & Color Picker [Github #102](https://github.com/tokens-studio/penpot/issues/102)
+- Fix Color should preserve color space [Github #69](https://github.com/tokens-studio/penpot/issues/69)
+- Fix cannot rename Design Token Sets when group of same name exists [Taiga Issue #10773](https://tree.taiga.io/project/penpot/issue/10773)
+- Fix problem when duplicating grid layout [Github #6391](https://github.com/penpot/penpot/issues/6391)
+- Fix issue that makes workspace shortcuts stop working [Taiga #11062](https://tree.taiga.io/project/penpot/issue/11062)
+
 ## 2.6.2
 
 ### :bug: Bugs fixed

README.md

@@ -16,18 +16,18 @@
 </p>
 
 <p align="center">
-    <a href="https://penpot.app/"><b>Website</b></a>  •  
-    <a href="https://help.penpot.app/technical-guide/getting-started/"><b>Getting Started</b></a>  •  
-    <a href="https://help.penpot.app/user-guide/"><b>User Guide</b></a>  •  
-    <a href="https://help.penpot.app/user-guide/introduction/info/"><b>Tutorials & Info</b></a>  •  
+    <a href="https://penpot.app/"><b>Website</b></a>  •
+    <a href="https://help.penpot.app/user-guide/"><b>User Guide</b></a>  •
+    <a href="https://penpot.app/learning-center"><b>Learning Center</b></a>  •
     <a href="https://community.penpot.app/"><b>Community</b></a>
 </p>
 <p align="center">
-    <a href="https://www.youtube.com/@Penpot"><b>Youtube</b></a>  •  
-    <a href="https://peertube.kaleidos.net/a/penpot_app/video-channels"><b>Peertube</b></a>  •  
-    <a href="https://www.linkedin.com/company/penpot/"><b>Linkedin</b></a>  •  
-    <a href="https://instagram.com/penpot.app"><b>Instagram</b></a>  •  
-    <a href="https://fosstodon.org/@penpot/"><b>Mastodon</b></a>  •  
+    <a href="https://www.youtube.com/@Penpot"><b>Youtube</b></a>  •
+    <a href="https://peertube.kaleidos.net/a/penpot_app/video-channels"><b>Peertube</b></a>  •
+    <a href="https://www.linkedin.com/company/penpot/"><b>Linkedin</b></a>  •
+    <a href="https://instagram.com/penpot.app"><b>Instagram</b></a>  •
+    <a href="https://fosstodon.org/@penpot/"><b>Mastodon</b></a>  •
+    <a href="https://bsky.app/profile/penpot.app"><b>Bluesky</b></a>  •
     <a href="https://twitter.com/penpotapp"><b>X</b></a>
 
 </p>
@@ -40,12 +40,13 @@
 
 Penpot is the first **open-source** design tool for design and code collaboration. Designers can create stunning designs, interactive prototypes, design systems at scale, while developers enjoy ready-to-use code and make their workflow easy and fast. And all of this with no handoff drama.
 
-Penpot is available on browser and [self host](https://penpot.app/self-host). It’s web-based and works with open standards (SVG, CSS and HTML). And last but not least, it’s free! 
+Available on browser or self-hosted, Penpot works with open standards like SVG, CSS, HTML and JSON, and it’s free!
 
-Penpot’s latest [huge release 2.0](https://penpot.app/dev-diaries), takes the platform to a whole new level. This update introduces the ground-breaking [CSS Grid Layout feature](https://penpot.app/penpot-2.0), a complete UI redesign, a new Components system, and much more. Plus, it's faster and more accessible. 
+The latest updates take Penpot even further. It’s the first design tool to integrate native [design tokens](https://penpot.dev/collaboration/design-tokens)—a single source of truth to improve efficiency and collaboration between product design and development.
+With the [huge 2.0 release](https://penpot.app/dev-diaries), Penpot took the platform to a whole new level. This update introduces the ground-breaking [CSS Grid Layout feature](https://penpot.app/penpot-2.0), a complete UI redesign, a new Components system, and much more.
+For organizations that need extra service for its teams, [get in touch](https://cal.com/team/penpot/talk-to-us)
 
-
-🎇 **Penpot Fest** is our design, code & Open Source event. Check out the highlights from [Penpot Fest 2023 edition](https://www.youtube.com/watch?v=sOpLZaK5mDc)!
+🎇 Design, code, and Open Source meet at [Penpot Fest](https://penpot.app/penpotfest)! Be part of the 2025 edition in Madrid, Spain, on October 9-10.
 
 ## Table of contents ##
 
@@ -61,7 +62,7 @@ Penpot’s latest [huge release 2.0](https://penpot.app/dev-diaries), takes the
 Penpot expresses designs as code. Designers can do their best work and see it will be beautifully implemented by developers in a two-way collaboration.
 
 ### Plugin system ###
-[Penpot plugins](https://penpot.app/penpothub/plugins) let you expand the platform's capabilities, give you the flexibility to integrate it with other apps, and design custom solutions. 
+[Penpot plugins](https://penpot.app/penpothub/plugins) let you expand the platform's capabilities, give you the flexibility to integrate it with other apps, and design custom solutions.
 
 ### Designed for developers ###
 Penpot was built to serve both designers and developers and create a fluid design-code process. You have the choice to enjoy real-time collaboration or play "solo".
@@ -78,6 +79,10 @@ Penpot offers integration into the development toolchain, thanks to its support
 ### What’s great for design ###
 With Penpot you can design libraries to share and reuse; turn design elements into components and tokens to allow reusability and scalability; and build realistic user flows and interactions.
 
+### Design Tokens ###
+With Penpot’s standardized [design tokens](https://penpot.dev/collaboration/design-tokens) format, you can easily reuse and sync tokens across different platforms, workflows, and disciplines.
+
+
 <br />
 
 <p align="center">
@@ -125,13 +130,13 @@ You will find the following categories:
 
 ## Contributing ##
 
-Any contribution will make a difference to improve Penpot. How can you get involved? 
+Any contribution will make a difference to improve Penpot. How can you get involved?
 
-Choose your way: 
+Choose your way:
 
 - Create and [share Libraries & Templates](https://penpot.app/libraries-templates.html) that will be helpful for the community
 - Invite your [team to join](https://design.penpot.app/#/auth/register)
-- Star this repo and follow us on Social Media: [Mastodon](https://fosstodon.org/@penpot/), [Youtube](https://www.youtube.com/c/Penpot), [Instagram](https://instagram.com/penpot.app), [Linkedin](https://www.linkedin.com/company/penpotdesign),  [Peertube](https://peertube.kaleidos.net/a/penpot_app) and [X](https://twitter.com/penpotapp).
+- Give this repo a star and follow us on Social Media: [Mastodon](https://fosstodon.org/@penpot/), [Youtube](https://www.youtube.com/c/Penpot), [Instagram](https://instagram.com/penpot.app), [Linkedin](https://www.linkedin.com/company/penpotdesign),  [Peertube](https://peertube.kaleidos.net/a/penpot_app), [X](https://twitter.com/penpotapp) and [BlueSky](https://bsky.app/profile/penpot.app)
 - Participate in the [Community](https://community.penpot.app/) space by asking and answering questions; reacting to others’ articles;  opening your own conversations and following along on decisions affecting the project.
 - Report bugs with our easy [guide for bugs hunting](https://help.penpot.app/contributing-guide/reporting-bugs/) or [GitHub issues](https://github.com/penpot/penpot/issues)
 - Become a [translator](https://help.penpot.app/contributing-guide/translations)

backend/scripts/manage.py

@@ -35,40 +35,35 @@ def get_prepl_conninfo():
 
     return host, port
 
-def send_eval(expr):
+def send(data):
     host, port = get_prepl_conninfo()
+    with socket.create_connection((host, port)) as s:
+        f = s.makefile(mode="rw")
 
-    with socket.socket(socket.AF_INET, socket.SOCK_STREAM) as s:
-        s.connect((host, port))
-        s.send(expr.encode("utf-8"))
-        s.send(b":repl/quit\n\n")
+        json.dump(data, f)
+        f.write("\n")
+        f.flush()
 
-        with s.makefile() as f:
-            while True:
-                line = f.readline()
-                result = json.loads(line)
-                tag = result.get("tag", None)
-                if tag == "ret":
-                    return result.get("val", None), result.get("exception", None)
-                elif tag == "out":
-                    print(result.get("val"), end="")
-                else:
-                    raise RuntimeError("unexpected response from PREPL")
+        while True:
+            line = f.readline()
+            result = json.loads(line)
+            tag = result.get("tag", None)
 
-def encode(val):
-    return json.dumps(json.dumps(val))
+            if tag == "ret":
+                return result.get("val", None), result.get("err", None)
+            elif tag == "out":
+                print(result.get("val"), end="")
+            else:
+                raise RuntimeError("unexpected response from PREPL")
 
-def print_error(res):
-    for error in res["via"]:
-        print("ERR:", error["message"])
-        break
+def print_error(error):
+    print("ERR:", error["hint"])
 
 def run_cmd(params):
     try:
-        expr = "(app.srepl.cli/exec {})".format(encode(params))
-        res, failed = send_eval(expr)
-        if failed:
-            print_error(res)
+        res, err = send(params)
+        if err:
+            print_error(err)
             sys.exit(-1)
 
         return res
@@ -96,7 +91,7 @@ def update_profile(email, fullname, password, is_active):
             "email": email,
             "fullname": fullname,
             "password": password,
-            "is_active": is_active
+            "isActive": is_active
         }
     }
 
@@ -138,7 +133,7 @@ def derive_password(password):
     params = {
         "cmd": "derive-password",
         "params": {
-            "password": password,
+            "password": password
         }
     }
 

backend/scripts/repl

@@ -31,7 +31,8 @@ export PENPOT_FLAGS="\
        enable-tiered-file-data-storage \
        enable-file-validation \
        enable-file-schema-validation \
-       enable-subscriptions-old";
+       enable-subscriptons \
+       enable-subscriptons-old";
 
 # Default deletion delay for devenv
 export PENPOT_DELETION_DELAY="24h"
@@ -71,15 +72,18 @@ export PENPOT_OBJECTS_STORAGE_S3_ENDPOINT=http://minio:9000
 export PENPOT_OBJECTS_STORAGE_S3_BUCKET=penpot
 export PENPOT_OBJECTS_STORAGE_FS_DIRECTORY="assets"
 
-export JAVA_OPTS="--enable-preview \
+export JAVA_OPTS="\
        -Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
        -Djdk.attach.allowAttachSelf \
        -Dlog4j2.configurationFile=log4j2-devenv-repl.xml \
        -Djdk.tracePinnedThreads=full \
        -XX:+EnableDynamicAgentLoading \
-       -XX:-OmitStackTraceInFastThrow \
+       -XX:-OmitStackTraceInFastThrow                    \
        -XX:+UnlockDiagnosticVMOptions \
-       -XX:+DebugNonSafepoints";
+       -XX:+DebugNonSafepoints \
+       --sun-misc-unsafe-memory-access=allow \
+       --enable-preview \
+       --enable-native-access=ALL-UNNAMED";
 
 export OPTIONS="-A:jmx-remote -A:dev"
 

backend/scripts/run.template.sh

@@ -18,7 +18,7 @@ if [ -f ./environ ]; then
     source ./environ
 fi
 
-export JVM_OPTS="-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -Dlog4j2.configurationFile=log4j2.xml -XX:-OmitStackTraceInFastThrow --enable-preview $JVM_OPTS"
+export JVM_OPTS="-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -Dlog4j2.configurationFile=log4j2.xml -XX:-OmitStackTraceInFastThrow --enable-native-access=ALL-UNNAMED --enable-preview $JVM_OPTS"
 
 ENTRYPOINT=${1:-app.main};
 

backend/scripts/start-dev

@@ -24,18 +24,8 @@ export PENPOT_FLAGS="\
        enable-tiered-file-data-storage \
        enable-file-validation \
        enable-file-schema-validation \
-       enable-subscriptions-old";
-
-export OPTIONS="
-       -A:jmx-remote -A:dev \
-       -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-       -J-Djdk.attach.allowAttachSelf \
-       -J-Dpolyglot.engine.WarnInterpreterOnly=false \
-       -J-Dlog4j2.configurationFile=log4j2-devenv.xml \
-       -J-XX:+EnableDynamicAgentLoading \
-       -J-XX:-OmitStackTraceInFastThrow \
-       -J-XX:+UnlockDiagnosticVMOptions \
-       -J-XX:+DebugNonSafepoints"
+       enable-subscriptons \
+       enable-subscriptons-old ";
 
 # Default deletion delay for devenv
 export PENPOT_DELETION_DELAY="24h"
@@ -66,6 +56,20 @@ export PENPOT_OBJECTS_STORAGE_S3_BUCKET=penpot
 
 entrypoint=${1:-app.main};
 
-set -ex
+export JAVA_OPTS="\
+       -Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
+       -Djdk.attach.allowAttachSelf \
+       -Dlog4j2.configurationFile=log4j2-devenv.xml \
+       -Djdk.tracePinnedThreads=full \
+       -XX:+EnableDynamicAgentLoading \
+       -XX:-OmitStackTraceInFastThrow                    \
+       -XX:+UnlockDiagnosticVMOptions \
+       -XX:+DebugNonSafepoints \
+       --sun-misc-unsafe-memory-access=allow \
+       --enable-preview \
+       --enable-native-access=ALL-UNNAMED";
 
-clojure $OPTIONS -A:dev -M -m $entrypoint;
+export OPTIONS="-A:jmx-remote -A:dev"
+
+set -ex
+clojure $OPTIONS -M -m $entrypoint;

backend/src/app/binfile/cleaner.clj

@@ -9,8 +9,28 @@
   for recently imported shapes."
   (:require
    [app.common.data :as d]
+   [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PRE DECODE
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn clean-shape-pre-decode
+  "Applies a pre-decode phase migration to the shape"
+  [shape]
+  (if (= "bool" (:type shape))
+    (if-let [content (get shape :bool-content)]
+      (-> shape
+          (assoc :content content)
+          (dissoc :bool-content))
+      shape)
+    shape))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; POST DECODE
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defn- fix-shape-shadow-color
   "Some shapes can come with invalid `id` property on shadow colors
   caused by incorrect uuid parsing bug that should be already fixed;
@@ -36,9 +56,52 @@
                    (fn [shadows]
                      (into [] xform shadows)))))
 
+(defn- fix-root-shape
+  "Ensure all root objects are well formed shapes"
+  [shape]
+  (if (= (:id shape) uuid/zero)
+    (-> shape
+        (assoc :parent-id uuid/zero)
+        (assoc :frame-id uuid/zero)
+        ;; We explicitly dissoc them and let the shape-setup
+        ;; to regenerate it with valid values.
+        (dissoc :selrect)
+        (dissoc :points)
+        (cts/setup-shape))
+    shape))
+
+(defn- fix-legacy-flex-dir
+  "This operation is only relevant to old data and it is fixed just
+  for convenience."
+  [shape]
+  (d/update-when shape :layout-flex-dir
+                 (fn [dir]
+                   (case dir
+                     :reverse-row :row-reverse
+                     :reverse-column :column-reverse
+                     dir))))
+
 (defn clean-shape-post-decode
   "A shape procesor that expected to be executed after schema decoding
   process but before validation."
   [shape]
   (-> shape
-      (fix-shape-shadow-color)))
+      (fix-shape-shadow-color)
+      (fix-root-shape)
+      (fix-legacy-flex-dir)))
+
+(defn- fix-container
+  [container]
+  (-> container
+      ;; Remove possible `nil` keys on objects
+      (d/update-when :objects dissoc nil)
+      (d/update-when :objects d/update-vals clean-shape-post-decode)))
+
+(defn clean-file
+  [file & {:as _opts}]
+  (update file :data
+          (fn [data]
+            (-> data
+                (d/update-when :pages-index d/update-vals fix-container)
+                (d/update-when :components d/update-vals fix-container)
+                (d/without-nils)))))

backend/src/app/binfile/common.clj

@@ -431,15 +431,21 @@
                           (update :components relink-shapes)
                           (update :media relink-media)
                           (update :colors relink-colors)
-                          (d/without-nils))))))
+                          (d/without-nils))))
+
+      ;; NOTE: this is necessary because when we just creating a new
+      ;; file from imported artifact or cloned file there are no
+      ;; migrations registered on the database, so we need to persist
+      ;; all of them, not only the applied
+      (vary-meta dissoc ::fmg/migrated)))
 
 (defn encode-file
-  [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
-  (let [file (if (contains? (:features file) "fdata/objects-map")
+  [{:keys [::db/conn] :as cfg} {:keys [id features] :as file}]
+  (let [file (if (contains? features "fdata/objects-map")
                (feat.fdata/enable-objects-map file)
                file)
 
-        file (if (contains? (:features file) "fdata/pointer-map")
+        file (if (contains? features "fdata/pointer-map")
                (binding [pmap/*tracked* (pmap/create-tracked)]
                  (let [file (feat.fdata/enable-pointer-map file)]
                    (feat.fdata/persist-pointers! cfg id)

backend/src/app/binfile/v3.clj

@@ -603,10 +603,20 @@
                            (reduce-kv (fn [objects id shape]
                                         (assoc objects id (bfl/clean-shape-post-decode shape)))
                                       objects
+                                      objects))))
+        clean-component-pre-decode
+        (fn [component]
+          (d/update-when component :objects
+                         (fn [objects]
+                           (reduce-kv (fn [objects id shape]
+                                        (assoc objects id (bfl/clean-shape-pre-decode shape)))
+                                      objects
                                       objects))))]
+
     (->> (keep (match-component-entry-fn file-id) entries)
          (reduce (fn [result {:keys [id entry]}]
                    (let [object (->> (read-entry input entry)
+                                     (clean-component-pre-decode)
                                      (decode-component)
                                      (clean-component-post-decode)
                                      (validate-component))]
@@ -641,10 +651,10 @@
   (->> (keep (match-shape-entry-fn file-id page-id) entries)
        (reduce (fn [result {:keys [id entry]}]
                  (let [object (->> (read-entry input entry)
+                                   (bfl/clean-shape-pre-decode)
                                    (decode-shape)
                                    (bfl/clean-shape-post-decode)
                                    (validate-shape))]
-
                    (if (= id (:id object))
                      (assoc result id object)
                      result)))
@@ -746,15 +756,7 @@
                    (assoc :name file-name)
                    (assoc :project-id project-id)
                    (dissoc :options)
-                   (bfc/process-file)
-
-                   ;; NOTE: this is necessary because when we just
-                   ;; creating a new file from imported artifact,
-                   ;; there are no migrations registered on the
-                   ;; database, so we need to persist all of them, not
-                   ;; only the applied
-                   (vary-meta dissoc ::fmg/migrated))]
-
+                   (bfc/process-file))]
 
       (bfm/register-pending-migrations! cfg file)
       (bfc/save-file! cfg file ::db/return-keys false)

backend/src/app/db.clj

@@ -42,6 +42,8 @@
    org.postgresql.util.PGInterval
    org.postgresql.util.PGobject))
 
+(def ^:dynamic *conn* nil)
+
 (declare open)
 (declare create-pool)
 

backend/src/app/features/components_v2.clj

@@ -20,7 +20,6 @@
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
-   [app.common.geom.shapes.path :as gshp]
    [app.common.logging :as l]
    [app.common.logic.libraries :as cll]
    [app.common.math :as mth]
@@ -36,9 +35,9 @@
    [app.common.types.modifiers :as ctm]
    [app.common.types.page :as ctp]
    [app.common.types.pages-list :as ctpl]
+   [app.common.types.path :as path]
    [app.common.types.shape :as cts]
    [app.common.types.shape-tree :as ctst]
-   [app.common.types.shape.path :as ctsp]
    [app.common.types.shape.text :as ctsx]
    [app.common.uuid :as uuid]
    [app.config :as cf]
@@ -127,10 +126,10 @@
   (sm/lazy-validator ::ctsx/content))
 
 (def valid-path-content?
-  (sm/lazy-validator ::ctsp/content))
+  (sm/lazy-validator ::path/segments))
 
 (def valid-path-segment?
-  (sm/lazy-validator ::ctsp/segment))
+  (sm/lazy-validator ::path/segment))
 
 (def valid-rgb-color-string?
   (sm/lazy-validator ::ctc/rgb-color))
@@ -580,12 +579,10 @@
                       (let [shape (update shape :content fix-path-content)]
                         (if (not (valid-path-content? (:content shape)))
                           shape
-                          (let [[points selrect] (gshp/content->points+selrect shape (:content shape))]
-                            (-> shape
-                                (dissoc :bool-content)
-                                (dissoc :bool-type)
-                                (assoc :points points)
-                                (assoc :selrect selrect)))))
+                          (-> shape
+                              (dissoc :bool-content)
+                              (dissoc :bool-type)
+                              (path/update-geometry))))
 
                       ;; When we fount a bool shape with no content,
                       ;; we convert it to a simple rect
@@ -1462,8 +1459,6 @@
                                     (:objects page)
                                     (:id page)
                                     file-id
-                                    true
-                                    nil
                                     cfsh/prepare-create-artboard-from-selection)]
 
     (shape-cb shape)

backend/src/app/features/fdata.clj

@@ -9,7 +9,10 @@
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
+   [app.common.files.helpers :as cfh]
+   [app.common.files.migrations :as fmg]
    [app.common.logging :as l]
+   [app.common.types.path :as path]
    [app.db :as db]
    [app.db.sql :as-alias sql]
    [app.storage :as sto]
@@ -30,7 +33,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn enable-objects-map
-  [file]
+  [file & _opts]
   (let [update-page
         (fn [page]
           (if (and (pmap/pointer-map? page)
@@ -136,10 +139,56 @@
 
 (defn enable-pointer-map
   "Enable the fdata/pointer-map feature on the file."
-  [file]
+  [file & _opts]
   (-> file
       (update :data (fn [fdata]
                       (-> fdata
                           (update :pages-index d/update-vals pmap/wrap)
                           (d/update-when :components pmap/wrap))))
       (update :features conj "fdata/pointer-map")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PATH-DATA
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn enable-path-data
+  "Enable the fdata/path-data feature on the file."
+  [file & _opts]
+  (letfn [(update-object [object]
+            (if (or (cfh/path-shape? object)
+                    (cfh/bool-shape? object))
+              (update object :content path/content)
+              object))
+
+          (update-container [container]
+            (d/update-when container :objects d/update-vals update-object))]
+
+    (-> file
+        (update :data (fn [data]
+                        (-> data
+                            (update :pages-index d/update-vals update-container)
+                            (d/update-when :components d/update-vals update-container))))
+        (update :features conj "fdata/path-data"))))
+
+(defn disable-path-data
+  [file & _opts]
+  (letfn [(update-object [object]
+            (if (or (cfh/path-shape? object)
+                    (cfh/bool-shape? object))
+              (update object :content vec)
+              object))
+
+          (update-container [container]
+            (d/update-when container :objects d/update-vals update-object))]
+
+    (when-let [conn db/*conn*]
+      (db/delete! conn :file-migration {:file-id (:id file)
+                                        :name "0003-convert-path-content"}))
+    (-> file
+        (update :data (fn [data]
+                        (-> data
+                            (update :pages-index d/update-vals update-container)
+                            (d/update-when :components d/update-vals update-container))))
+        (update :features disj "fdata/path-data")
+        (update :migrations disj "0003-convert-path-content")
+        (vary-meta update ::fmg/migrated disj "0003-convert-path-content"))))

backend/src/app/loggers/audit.clj

@@ -108,6 +108,7 @@
    [::ip-addr {:optional true} ::sm/text]
    [::props {:optional true} [:map-of :keyword :any]]
    [::context {:optional true} [:map-of :keyword :any]]
+   [::tracked-at {:optional true} ::sm/inst]
    [::webhooks/event? {:optional true} ::sm/boolean]
    [::webhooks/batch-timeout {:optional true} ::dt/duration]
    [::webhooks/batch-key {:optional true}
@@ -118,12 +119,12 @@
 
 (defn prepare-event
   [cfg mdata params result]
-  (let [resultm    (meta result)
-        request    (-> params meta ::http/request)
-        profile-id (or (::profile-id resultm)
-                       (:profile-id result)
-                       (::rpc/profile-id params)
-                       uuid/zero)
+  (let [resultm      (meta result)
+        request      (-> params meta ::http/request)
+        profile-id   (or (::profile-id resultm)
+                         (:profile-id result)
+                         (::rpc/profile-id params)
+                         uuid/zero)
 
         session-id   (get params ::rpc/external-session-id)
         event-origin (get params ::rpc/external-event-origin)
@@ -135,14 +136,14 @@
 
                          (clean-props))
 
-        token-id  (::actoken/id request)
-        context   (-> (::context resultm)
-                      (assoc :external-session-id session-id)
-                      (assoc :external-event-origin event-origin)
-                      (assoc :access-token-id (some-> token-id str))
-                      (d/without-nils))
+        token-id     (::actoken/id request)
+        context      (-> (::context resultm)
+                         (assoc :external-session-id session-id)
+                         (assoc :external-event-origin event-origin)
+                         (assoc :access-token-id (some-> token-id str))
+                         (d/without-nils))
 
-        ip-addr   (inet/parse-request request)]
+        ip-addr      (inet/parse-request request)]
 
     {::type (or (::type resultm)
                 (::rpc/type cfg))

backend/src/app/loggers/webhooks.clj

@@ -15,6 +15,7 @@
    [app.config :as cf]
    [app.db :as db]
    [app.http.client :as http]
+   [app.loggers.audit :as audit]
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.data.json :as json]
@@ -67,18 +68,27 @@
 (defmethod ig/init-key ::process-event-handler
   [_ cfg]
   (fn [{:keys [props] :as task}]
-    (l/dbg :hint "process webhook event" :name (:name props))
 
-    (when-let [items (lookup-webhooks cfg props)]
-      (l/trc :hint "webhooks found for event" :total (count items))
-      (db/tx-run! cfg (fn [cfg]
-                        (doseq [item items]
-                          (wrk/submit! (-> cfg
-                                           (assoc ::wrk/task :run-webhook)
-                                           (assoc ::wrk/queue :webhooks)
-                                           (assoc ::wrk/max-retries 3)
-                                           (assoc ::wrk/params {:event props
-                                                                :config item})))))))))
+    (let [items (lookup-webhooks cfg props)
+          event {::audit/profile-id (:profile-id props)
+                 ::audit/name "webhook"
+                 ::audit/type "trigger"
+                 ::audit/props {:name (get props :name)
+                                :event-id (get props :id)
+                                :total-affected (count items)}}]
+
+      (audit/insert! cfg event)
+
+      (when items
+        (l/trc :hint "webhooks found for event" :total (count items))
+        (db/tx-run! cfg (fn [cfg]
+                          (doseq [item items]
+                            (wrk/submit! (-> cfg
+                                             (assoc ::wrk/task :run-webhook)
+                                             (assoc ::wrk/queue :webhooks)
+                                             (assoc ::wrk/max-retries 3)
+                                             (assoc ::wrk/params {:event props
+                                                                  :config item}))))))))))
 ;; --- RUN
 
 (declare interpret-exception)

backend/src/app/rpc/commands/auth.clj

@@ -231,7 +231,7 @@
               :hint "email has complaint reports")))
 
 (defn prepare-register
-  [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [email accept-newsletter-updates] :as params}]
 
   (validate-register-attempt! cfg params)
 
@@ -243,7 +243,8 @@
                  :backend "penpot"
                  :iss :prepared-register
                  :profile-id (:id profile)
-                 :exp (dt/in-future {:days 7})}
+                 :exp (dt/in-future {:days 7})
+                 :props {:newsletter-updates (or accept-newsletter-updates false)}}
 
         params (d/without-nils params)
         token  (tokens/generate (::setup/props cfg) params)]

backend/src/app/rpc/commands/files.clj

@@ -208,7 +208,7 @@
    [:project-id {:optional true} ::sm/uuid]])
 
 (defn- migrate-file
-  [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
+  [{:keys [::db/conn] :as cfg} {:keys [id] :as file} {:keys [read-only?]}]
   (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
             pmap/*tracked* (pmap/create-tracked)]
     (let [;; For avoid unnecesary overhead of creating multiple pointers and
@@ -219,43 +219,45 @@
           file (-> file
                    (update :data feat.fdata/process-pointers deref)
                    (update :data feat.fdata/process-objects (partial into {}))
-                   (fmg/migrate-file))
+                   (fmg/migrate-file))]
 
-          ;; When file is migrated, we break the rule of no perform
-          ;; mutations on get operations and update the file with all
-          ;; migrations applied
-          ;;
-          ;; WARN: he following code will not work on read-only mode,
-          ;; it is a known issue; we keep is not implemented until we
-          ;; really need this.
-          file (if (contains? (:features file) "fdata/objects-map")
-                 (feat.fdata/enable-objects-map file)
-                 file)
-          file (if (contains? (:features file) "fdata/pointer-map")
-                 (feat.fdata/enable-pointer-map file)
-                 file)]
+      (if (or read-only? (db/read-only? conn))
+        file
+        (let [;; When file is migrated, we break the rule of no perform
+              ;; mutations on get operations and update the file with all
+              ;; migrations applied
+              file (if (contains? (:features file) "fdata/objects-map")
+                     (feat.fdata/enable-objects-map file)
+                     file)
+              file (if (contains? (:features file) "fdata/pointer-map")
+                     (feat.fdata/enable-pointer-map file)
+                     file)]
 
-      (db/update! conn :file
-                  {:data (blob/encode (:data file))
-                   :version (:version file)
-                   :features (db/create-array conn "text" (:features file))}
-                  {:id id})
+          (db/update! conn :file
+                      {:data (blob/encode (:data file))
+                       :version (:version file)
+                       :features (db/create-array conn "text" (:features file))}
+                      {:id id}
+                      {::db/return-keys false})
 
-      (when (contains? (:features file) "fdata/pointer-map")
-        (feat.fdata/persist-pointers! cfg id))
+          (when (contains? (:features file) "fdata/pointer-map")
+            (feat.fdata/persist-pointers! cfg id))
 
-      (feat.fmigr/upsert-migrations! conn file)
-      (feat.fmigr/resolve-applied-migrations cfg file))))
+          (feat.fmigr/upsert-migrations! conn file)
+          (feat.fmigr/resolve-applied-migrations cfg file))))))
 
 (defn get-file
   [{:keys [::db/conn ::wrk/executor] :as cfg} id
    & {:keys [project-id
              migrate?
              include-deleted?
-             lock-for-update?]
+             lock-for-update?
+             preload-pointers?]
       :or {include-deleted? false
            lock-for-update? false
-           migrate? true}}]
+           migrate? true
+           preload-pointers? false}
+      :as options}]
 
   (assert (db/connection? conn) "expected cfg with valid connection")
 
@@ -273,10 +275,16 @@
         ;; because it has heavy and synchronous operations for
         ;; decoding file body that are not very friendly with virtual
         ;; threads.
-        file   (px/invoke! executor #(decode-row file))]
+        file   (px/invoke! executor #(decode-row file))
+
+        file   (if (and migrate? (fmg/need-migration? file))
+                 (migrate-file cfg file options)
+                 file)]
+
+    (if preload-pointers?
+      (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
+        (update file :data feat.fdata/process-pointers deref))
 
-    (if (and migrate? (fmg/need-migration? file))
-      (migrate-file cfg file)
       file)))
 
 (defn get-minimal-file
@@ -474,7 +482,7 @@
   (update page :objects update-vals #(dissoc % :thumbnail)))
 
 (defn get-page
-  [{:keys [::db/conn] :as cfg} {:keys [profile-id file-id page-id object-id] :as params}]
+  [{:keys [::db/conn] :as cfg} {:keys [profile-id file-id page-id object-id share-id] :as params}]
 
   (when (and (uuid? object-id)
              (not (uuid? page-id)))
@@ -482,22 +490,30 @@
               :code :params-validation
               :hint "page-id is required when object-id is provided"))
 
-  (let [team (teams/get-team conn
-                             :profile-id profile-id
-                             :file-id file-id)
+  (let [perms (get-permissions conn profile-id file-id share-id)
 
-        file (get-file cfg file-id)
+        file  (get-file cfg file-id :read-only? true)
 
-        _    (-> (cfeat/get-team-enabled-features cf/flags team)
-                 (cfeat/check-client-features! (:features params))
-                 (cfeat/check-file-features! (:features file)))
+        proj  (db/get conn :project {:id (:project-id file)})
 
-        page (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
-               (let [page-id (or page-id (-> file :data :pages first))
-                     page    (dm/get-in file [:data :pages-index page-id])]
-                 (if (pmap/pointer-map? page)
-                   (deref page)
-                   page)))]
+        team  (-> (db/get conn :team {:id (:team-id proj)})
+                  (teams/decode-row))
+
+        _     (-> (cfeat/get-team-enabled-features cf/flags team)
+                  (cfeat/check-client-features! (:features params))
+                  (cfeat/check-file-features! (:features file)))
+
+        page  (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
+                (let [page-id (or page-id (-> file :data :pages first))
+                      page    (dm/get-in file [:data :pages-index page-id])]
+                  (if (pmap/pointer-map? page)
+                    (deref page)
+                    page)))]
+
+    (when-not perms
+      (ex/raise :type :not-found
+                :code :object-not-found
+                :hint "object not found"))
 
     (cond-> (prune-thumbnails page)
       (some? object-id)
@@ -733,7 +749,9 @@
                              :project-id project-id
                              :file-id id)
 
-        file (get-file cfg id :project-id project-id)]
+        file (get-file cfg id
+                       :project-id project-id
+                       :read-only? true)]
 
     (-> (cfeat/get-team-enabled-features cf/flags team)
         (cfeat/check-client-features! (:features params))

backend/src/app/rpc/commands/files_create.clj

@@ -55,8 +55,8 @@
                                :features features
                                :ignore-sync-until ignore-sync-until
                                :modified-at modified-at
-                               :deleted-at deleted-at
-                               :create-page create-page
+                               :deleted-at deleted-at}
+                              {:create-page create-page
                                :page-id page-id})
           file (-> (bfc/insert-file! cfg file)
                    (bfc/decode-row))]
@@ -111,18 +111,21 @@
                         ::quotes/profile-id profile-id
                         ::quotes/project-id project-id})
 
-    ;; FIXME: IMPORTANT: this code can have race
-    ;; conditions, because we have no locks for updating
-    ;; team so, creating two files concurrently can lead
-    ;; to lost team features updating
+    ;; FIXME: IMPORTANT: this code can have race conditions, because
+    ;; we have no locks for updating team so, creating two files
+    ;; concurrently can lead to lost team features updating
 
-    ;; When newly computed features does not match exactly with
-    ;; the features defined on team row, we update it
-    (when (not= features (:features team))
-      (let [features (db/create-array conn "text" features)]
+    (when-let [features (-> features
+                            (set/difference (:features team))
+                            (set/difference cfeat/no-team-inheritable-features)
+                            (not-empty))]
+      (let [features (->> features
+                          (set/union (:features team))
+                          (db/create-array conn "text"))]
         (db/update! conn :team
                     {:features features}
-                    {:id team-id})))
+                    {:id (:id team)}
+                    {::db/return-keys false})))
 
     (-> (create-file cfg params)
         (vary-meta assoc ::audit/props {:team-id team-id}))))

backend/src/app/rpc/commands/files_thumbnails.clj

@@ -10,7 +10,6 @@
    [app.common.data.macros :as dm]
    [app.common.features :as cfeat]
    [app.common.files.helpers :as cfh]
-   [app.common.files.migrations :as fmg]
    [app.common.geom.shapes :as gsh]
    [app.common.schema :as sm]
    [app.common.thumbnails :as thc]
@@ -18,7 +17,6 @@
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as-alias sql]
-   [app.features.fdata :as feat.fdata]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.media :as media]
@@ -200,14 +198,13 @@
   (db/run! cfg (fn [{:keys [::db/conn] :as cfg}]
                  (files/check-read-permissions! conn profile-id file-id)
 
-                 (let [team     (teams/get-team conn
-                                                :profile-id profile-id
-                                                :file-id file-id)
+                 (let [team (teams/get-team conn
+                                            :profile-id profile-id
+                                            :file-id file-id)
 
-                       file     (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
-                                  (-> (files/get-file cfg file-id :migrate? false)
-                                      (update :data feat.fdata/process-pointers deref)
-                                      (fmg/migrate-file)))]
+                       file (files/get-file cfg file-id
+                                            :preload-pointers? true
+                                            :read-only? true)]
 
                    (-> (cfeat/get-team-enabled-features cf/flags team)
                        (cfeat/check-file-features! (:features file)))

backend/src/app/rpc/commands/files_update.clj

@@ -177,12 +177,19 @@
                                             :stored-revn (:revn file)}))
 
                       ;; When newly computed features does not match exactly with
-                      ;; the features defined on team row, we update it.
-                      (when (not= features (:features team))
-                        (let [features (db/create-array conn "text" features)]
+                      ;; the features defined on team row, we update it
+                      (when-let [features (-> features
+                                              (set/difference (:features team))
+                                              (set/difference cfeat/no-team-inheritable-features)
+                                              (not-empty))]
+                        (let [features (->> features
+                                            (set/union (:features team))
+                                            (db/create-array conn "text"))]
                           (db/update! conn :team
                                       {:features features}
-                                      {:id (:id team)})))
+                                      {:id (:id team)}
+                                      {::db/return-keys false})))
+
 
                       (mtx/run! metrics {:id :update-file-changes :inc (count changes)})
 

backend/src/app/rpc/commands/teams.clj

@@ -76,9 +76,10 @@
   (perms/make-check-fn has-read-permissions?))
 
 (defn decode-row
-  [{:keys [features] :as row}]
+  [{:keys [features subscription] :as row}]
   (cond-> row
-    (some? features) (assoc :features (db/decode-pgarray features #{}))))
+    (some? features) (assoc :features (db/decode-pgarray features #{}))
+    (some? subscription) (assoc :subscription (db/decode-transit-pgobject subscription))))
 
 ;; FIXME: move
 
@@ -126,16 +127,40 @@
     (get-teams conn profile-id)))
 
 (def sql:get-teams-with-permissions
-  "select t.*,
+  "SELECT t.*,
           tp.is_owner,
           tp.is_admin,
           tp.can_edit,
-          (t.id = ?) as is_default
-     from team_profile_rel as tp
-     join team as t on (t.id = tp.team_id)
-    where t.deleted_at is null
-      and tp.profile_id = ?
-    order by tp.created_at asc")
+          (t.id = ?) AS is_default
+     FROM team_profile_rel AS tp
+     JOIN team AS t ON (t.id = tp.team_id)
+    WHERE t.deleted_at IS null
+      AND tp.profile_id = ?
+    ORDER BY tp.created_at ASC")
+
+(def sql:get-teams-with-permissions-and-subscription
+  "SELECT t.*,
+          tp.is_owner,
+          tp.is_admin,
+          tp.can_edit,
+          (t.id = ?) AS is_default,
+
+          jsonb_build_object(
+            '~:type', COALESCE(p.props->'~:subscription'->>'~:type', 'professional'),
+            '~:status', CASE COALESCE(p.props->'~:subscription'->>'~:type', 'professional')
+                          WHEN 'professional' THEN 'active'
+                          ELSE COALESCE(p.props->'~:subscription'->>'~:status', 'incomplete')
+                       END
+          ) AS subscription
+     FROM team_profile_rel AS tp
+     JOIN team AS t ON (t.id = tp.team_id)
+     JOIN team_profile_rel AS tpr
+       ON (tpr.team_id = t.id AND tpr.is_owner IS true)
+     JOIN profile AS p
+       ON (tpr.profile_id = p.id)
+    WHERE t.deleted_at IS null
+      AND tp.profile_id = ?
+    ORDER BY tp.created_at ASC;")
 
 (defn process-permissions
   [team]
@@ -150,13 +175,21 @@
         (dissoc :is-owner :is-admin :can-edit)
         (assoc :permissions permissions))))
 
+(def ^:private
+  xform:process-teams
+  (comp
+   (map decode-row)
+   (map process-permissions)))
+
 (defn get-teams
   [conn profile-id]
-  (let [profile (profile/get-profile conn profile-id)]
-    (->> (db/exec! conn [sql:get-teams-with-permissions (:default-team-id profile) profile-id])
-         (map decode-row)
-         (map process-permissions)
-         (vec))))
+  (let [profile (profile/get-profile conn profile-id)
+        sql     (if (contains? cf/flags :subscriptions)
+                  sql:get-teams-with-permissions-and-subscription
+                  sql:get-teams-with-permissions)]
+
+    (->> (db/exec! conn [sql (:default-team-id profile) profile-id])
+         (into [] xform:process-teams))))
 
 ;; --- Query: Team (by ID)
 

backend/src/app/srepl.clj

@@ -6,13 +6,17 @@
 
 (ns app.srepl
   "Server Repl."
+  (:refer-clojure :exclude [read-line])
   (:require
+   [app.common.exceptions :as ex]
+   [app.common.json :as json]
    [app.common.logging :as l]
    [app.config :as cf]
-   [app.srepl.cli]
+   [app.srepl.cli :as cli]
    [app.srepl.main]
-   [app.util.json :as json]
    [app.util.locks :as locks]
+   [app.util.time :as dt]
+   [clojure.core :as c]
    [clojure.core.server :as ccs]
    [clojure.main :as cm]
    [integrant.core :as ig]))
@@ -28,17 +32,80 @@
    :init repl-init
    :read ccs/repl-read))
 
+(defn- ex->data
+  [cause phase]
+  (let [data (ex-data cause)
+        explain (ex/explain data)]
+    (cond-> {:phase phase
+             :code (get data :code :unknown)
+             :type (get data :type :unknown)
+             :hint (or (get data :hint) (ex-message cause))}
+      (some? explain)
+      (assoc :explain explain))))
+
+(defn read-line
+  []
+  (if-let [line (c/read-line)]
+    (try
+      (l/dbg :hint "decode" :data line)
+      (json/decode line :key-fn json/read-kebab-key)
+      (catch Throwable _cause
+        (l/warn :hint "unable to decode data" :data line)
+        nil))
+    ::eof))
+
 (defn json-repl
   []
-  (let [out  *out*
-        lock (locks/create)]
-    (ccs/prepl *in*
-               (fn [m]
-                 (binding [*out* out,
-                           *flush-on-newline* true,
-                           *print-readably* true]
-                   (locks/locking lock
-                     (println (json/encode-str m))))))))
+  (let [lock (locks/create)
+        out  *out*
+
+        out-fn
+        (fn [m]
+          (locks/locking lock
+            (binding [*out* out]
+              (l/warn :hint "write" :data m)
+              (println (json/encode m :key-fn json/write-camel-key)))))
+
+        tapfn
+        (fn [val]
+          (out-fn {:tag :tap :val val}))]
+
+    (binding [*out* (PrintWriter-on #(out-fn {:tag :out :val %1}) nil true)
+              *err* (PrintWriter-on #(out-fn {:tag :err :val %1}) nil true)]
+      (try
+        (add-tap tapfn)
+        (loop []
+          (when (try
+                  (let [data   (read-line)
+                        tpoint (dt/tpoint)]
+
+                    (l/dbg :hint "received" :data (if (= data ::eof) "EOF" data))
+
+                    (try
+                      (when-not (= data ::eof)
+                        (when-not (nil? data)
+                          (let [result  (cli/exec data)
+                                elapsed (tpoint)]
+                            (l/warn :hint "result" :data result)
+                            (out-fn {:tag :ret
+                                     :val (if (instance? Throwable result)
+                                            (Throwable->map result)
+                                            result)
+                                     :elapsed (inst-ms elapsed)})))
+                        true)
+                      (catch Throwable cause
+                        (let [elapsed (tpoint)]
+                          (out-fn {:tag :ret
+                                   :err (ex->data cause :eval)
+                                   :elapsed (inst-ms elapsed)})
+                          true))))
+                  (catch Throwable cause
+                    (out-fn {:tag :ret
+                             :err (ex->data cause :read)})
+                    true))
+            (recur)))
+        (finally
+          (remove-tap tapfn))))))
 
 ;; --- State initialization
 

backend/src/app/srepl/cli.clj

@@ -9,14 +9,23 @@
   (:require
    [app.auth :as auth]
    [app.common.exceptions :as ex]
+   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.rpc.commands.auth :as cmd.auth]
    [app.rpc.commands.profile :as cmd.profile]
-   [app.util.json :as json]
+   [app.setup :as-alias setup]
+   [app.tokens :as tokens]
    [app.util.time :as dt]
    [cuerdas.core :as str]))
 
+(defn coercer
+  [schema & {:as opts}]
+  (let [decode-fn (sm/decoder schema sm/json-transformer)
+        check-fn (sm/check-fn schema opts)]
+    (fn [data]
+      (-> data decode-fn check-fn))))
+
 (defn- get-current-system
   []
   (or (deref (requiring-resolve 'app.main/system))
@@ -24,16 +33,21 @@
 
 (defmulti ^:private exec-command ::cmd)
 
+(defmethod exec-command :default
+  [{:keys [::cmd]}]
+  (ex/raise :type :internal
+            :code :not-implemented
+            :hint (str/ffmt "command '%' not implemented" cmd)))
+
 (defn exec
   "Entry point with external tools integrations that uses PREPL
   interface for interacting with running penpot backend."
   [data]
-  (let [data (json/decode data)]
-    (-> {::cmd (keyword (:cmd data "default"))}
-        (merge (:params data))
-        (exec-command))))
+  (-> {::cmd (get data :cmd)}
+      (merge (:params data))
+      (exec-command)))
 
-(defmethod exec-command :create-profile
+(defmethod exec-command "create-profile"
   [{:keys [fullname email password is-active]
     :or {is-active true}}]
   (some-> (get-current-system)
@@ -49,7 +63,7 @@
                (->> (cmd.auth/create-profile! conn params)
                     (cmd.auth/create-profile-rels! conn)))))))
 
-(defmethod exec-command :update-profile
+(defmethod exec-command "update-profile"
   [{:keys [fullname email password is-active]}]
   (some-> (get-current-system)
           (db/tx-run!
@@ -70,7 +84,12 @@
                                         :deleted-at nil})]
                    (pos? (db/get-update-count res)))))))))
 
-(defmethod exec-command :delete-profile
+(defmethod exec-command "echo"
+  [params]
+  params)
+
+
+(defmethod exec-command "delete-profile"
   [{:keys [email soft]}]
   (when-not email
     (ex/raise :type :assertion
@@ -88,7 +107,7 @@
                                      {:email email}))]
                (pos? (db/get-update-count res)))))))
 
-(defmethod exec-command :search-profile
+(defmethod exec-command "search-profile"
   [{:keys [email]}]
   (when-not email
     (ex/raise :type :assertion
@@ -102,12 +121,130 @@
                             " where email similar to ? order by created_at desc limit 100")]
                (db/exec! conn [sql email]))))))
 
-(defmethod exec-command :derive-password
+(defmethod exec-command "derive-password"
   [{:keys [password]}]
   (auth/derive-password password))
 
-(defmethod exec-command :default
-  [{:keys [::cmd]}]
-  (ex/raise :type :internal
-            :code :not-implemented
-            :hint (str/ffmt "command '%' not implemented" (name cmd))))
+(defmethod exec-command "authenticate"
+  [{:keys [token]}]
+  (when-let [system (get-current-system)]
+    (let [props  (get system ::setup/props)]
+      (tokens/verify props {:token token :iss "authentication"}))))
+
+(def ^:private schema:get-customer
+  [:map [:id ::sm/uuid]])
+
+(def coerce-get-customer-params
+  (coercer schema:get-customer
+           :type :validation
+           :hint "invalid data provided for `get-customer` rpc call"))
+
+(def sql:get-customer-slots
+  "WITH teams AS (
+    SELECT tpr.team_id AS id,
+           tpr.profile_id AS profile_id
+      FROM team_profile_rel AS tpr
+     WHERE tpr.is_owner IS true
+       AND tpr.profile_id = ?
+  ), teams_with_slots AS (
+    SELECT tpr.team_id AS id,
+           count(*) AS total
+      FROM team_profile_rel AS tpr
+     WHERE tpr.team_id IN (SELECT id FROM teams)
+       AND tpr.can_edit IS true
+     GROUP BY 1
+     ORDER BY 2
+  )
+  SELECT max(total) AS total FROM teams_with_slots;")
+
+(defn- get-customer-slots
+  [system profile-id]
+  (let [result (db/exec-one! system [sql:get-customer-slots profile-id])]
+    (:total result)))
+
+(defmethod exec-command "get-customer"
+  [params]
+  (when-let [system (get-current-system)]
+    (let [{:keys [id] :as params} (coerce-get-customer-params params)
+          {:keys [props] :as profile} (cmd.profile/get-profile system id)]
+      {:id (get profile :id)
+       :name (get profile :fullname)
+       :email (get profile :email)
+       :num-editors (get-customer-slots system id)
+       :subscription (get props :subscription)})))
+
+(def ^:private schema:customer-subscription
+  [:map {:title "CustomerSubscription"}
+   [:id ::sm/text]
+   [:customer-id ::sm/text]
+   [:type [:enum
+           "unlimited"
+           "professional"
+           "enterprise"]]
+   [:status [:enum
+             "active"
+             "canceled"
+             "incomplete"
+             "incomplete_expired"
+             "pass_due"
+             "paused"
+             "trialing"
+             "unpaid"]]
+
+   [:billing-period [:enum
+                     "month"
+                     "day"
+                     "week"
+                     "year"]]
+   [:quantity :int]
+   [:description [:maybe ::sm/text]]
+   [:created-at ::sm/timestamp]
+   [:start-date [:maybe ::sm/timestamp]]
+   [:ended-at [:maybe ::sm/timestamp]]
+   [:trial-end [:maybe ::sm/timestamp]]
+   [:trial-start [:maybe ::sm/timestamp]]
+   [:cancel-at [:maybe ::sm/timestamp]]
+   [:canceled-at [:maybe ::sm/timestamp]]
+
+   [:current-period-end ::sm/timestamp]
+   [:current-period-start ::sm/timestamp]
+   [:cancel-at-period-end :boolean]
+
+   [:cancellation-details
+    [:map {:title "CancellationDetails"}
+     [:comment [:maybe ::sm/text]]
+     [:reason [:maybe ::sm/text]]
+     [:feedback [:maybe
+                 [:enum
+                  "customer_service"
+                  "low_quality"
+                  "missing_feature"
+                  "other"
+                  "switched_service"
+                  "too_complex"
+                  "too_expensive"
+                  "unused"]]]]]])
+
+(def ^:private schema:update-customer-subscription
+  [:map
+   [:id ::sm/uuid]
+   [:subscription [:maybe schema:customer-subscription]]])
+
+(def coerce-update-customer-subscription-params
+  (coercer schema:update-customer-subscription
+           :type :validation
+           :hint "invalid data provided for `update-customer-subscription` rpc call"))
+
+(defmethod exec-command "update-customer-subscription"
+  [params]
+  (when-let [system (get-current-system)]
+    (let [{:keys [id subscription]} (coerce-update-customer-subscription-params params)
+          ;; FIXME: locking
+          {:keys [props] :as profile} (cmd.profile/get-profile system id)
+          props (assoc props :subscription subscription)]
+
+      (db/update! system :profile
+                  {:props (db/tjson props)}
+                  {:id id}
+                  {::db/return-keys false})
+      true)))

backend/src/app/srepl/fixes.clj

@@ -179,7 +179,7 @@
                       component-child (first component-children)]
                   (if (or (nil? child) (nil? component-child))
                     container
-                    (let [container (if (and (not (ctk/is-main-of? component-child child true))
+                    (let [container (if (and (not (ctk/is-main-of? component-child child))
                                              (nil? (ctk/get-swap-slot child))
                                              (ctk/instance-head? child))
                                       (let [slot (guess-swap-slot component-child component-container)]

backend/src/app/srepl/main.clj

@@ -156,6 +156,10 @@
   [file-id & {:as opts}]
   (process-file! file-id feat.fdata/enable-pointer-map opts))
 
+(defn enable-path-data-feature-on-file!
+  [file-id & {:as opts}]
+  (process-file! file-id feat.fdata/enable-path-data opts))
+
 (defn enable-storage-features-on-file!
   [file-id & {:as opts}]
   (enable-objects-map-feature-on-file! file-id opts)
@@ -416,10 +420,12 @@
   "Apply a function to the file. Optionally save the changes or not.
   The function receives the decoded and migrated file data."
   [file-id update-fn & {:keys [rollback?] :or {rollback? true} :as opts}]
-  (db/tx-run! (assoc main/system ::db/rollback rollback?)
-              (fn [system]
-                (binding [h/*system* system]
-                  (h/process-file! system file-id update-fn opts)))))
+  (let [file-id (h/parse-uuid file-id)]
+    (db/tx-run! (assoc main/system ::db/rollback rollback?)
+                (fn [system]
+                  (binding [h/*system* system
+                            db/*conn* (db/get-connection system)]
+                    (h/process-file! system file-id update-fn opts))))))
 
 (defn process-team-files!
   "Apply a function to each file of the specified team."
@@ -431,7 +437,8 @@
                   (when (string? label)
                     (h/take-team-snapshot! system team-id label))
 
-                  (binding [h/*system* system]
+                  (binding [h/*system* system
+                            db/*conn* (db/get-connection system)]
                     (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
                          (reduce (fn [result file-id]
                                    (if (h/process-file! system file-id update-fn opts)

backend/src/app/tasks/file_gc.clj

@@ -10,6 +10,7 @@
   file is eligible to be garbage collected after some period of
   inactivity (the default threshold is 72h)."
   (:require
+   [app.binfile.cleaner :as bfl]
    [app.binfile.common :as bfc]
    [app.common.files.helpers :as cfh]
    [app.common.files.validate :as cfv]
@@ -258,6 +259,7 @@
   (if-let [file (get-file cfg file-id)]
     (let [file (->> file
                     (bfc/decode-file cfg)
+                    (bfl/clean-file)
                     (clean-media! cfg)
                     (clean-fragments! cfg))
           file (assoc file :has-media-trimmed true)]

common/deps.edn

@@ -2,7 +2,7 @@
  {org.clojure/clojure {:mvn/version "1.12.0"}
   org.clojure/data.json {:mvn/version "2.5.1"}
   org.clojure/tools.cli {:mvn/version "1.1.230"}
-  org.clojure/clojurescript {:mvn/version "1.11.132"}
+  org.clojure/clojurescript {:mvn/version "1.12.38"}
   org.clojure/test.check {:mvn/version "1.1.1"}
   org.clojure/data.fressian {:mvn/version "1.1.0"}
 
@@ -59,7 +59,7 @@
  {:dev
   {:extra-deps
    {org.clojure/tools.namespace {:mvn/version "RELEASE"}
-    thheller/shadow-cljs {:mvn/version "2.28.20"}
+    thheller/shadow-cljs {:mvn/version "3.0.3"}
     com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
     com.bhauman/rebel-readline {:mvn/version "RELEASE"}
     criterium/criterium {:mvn/version "RELEASE"}

common/package.json

@@ -17,7 +17,7 @@
   "devDependencies": {
     "concurrently": "^9.0.1",
     "nodemon": "^3.1.7",
-    "shadow-cljs": "2.28.20",
+    "shadow-cljs": "3.0.3",
     "source-map-support": "^0.5.21",
     "ws": "^8.17.0"
   },

common/scripts/repl

@@ -2,16 +2,20 @@
 
 export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
 
-export OPTIONS="
-       -A:dev \
-       -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-       -J-Djdk.attach.allowAttachSelf \
-       -J-Dpolyglot.engine.WarnInterpreterOnly=false \
-       -J-XX:+EnableDynamicAgentLoading \
-       -J-XX:-OmitStackTraceInFastThrow \
-       -J-XX:+UnlockDiagnosticVMOptions \
-       -J-XX:+DebugNonSafepoints \
-       -J-Djdk.tracePinnedThreads=full"
+export JAVA_OPTS="\
+       -Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
+       -Djdk.attach.allowAttachSelf \
+       -Dlog4j2.configurationFile=log4j2-devenv-repl.xml \
+       -Djdk.tracePinnedThreads=full \
+       -XX:+EnableDynamicAgentLoading \
+       -XX:-OmitStackTraceInFastThrow                    \
+       -XX:+UnlockDiagnosticVMOptions \
+       -XX:+DebugNonSafepoints \
+       --sun-misc-unsafe-memory-access=allow \
+       --enable-preview \
+       --enable-native-access=ALL-UNNAMED";
+
+export OPTIONS="-A:dev"
 
 export OPTIONS_EVAL="nil"
 # export OPTIONS_EVAL="(set! *warn-on-reflection* true)"

common/src/app/common/data/macros.cljc

@@ -6,7 +6,7 @@
 
 (ns app.common.data.macros
   "Data retrieval & manipulation specific macros."
-  (:refer-clojure :exclude [get-in select-keys str with-open min max])
+  (:refer-clojure :exclude [get-in select-keys str with-open max])
   #?(:cljs (:require-macros [app.common.data.macros]))
   (:require
    #?(:clj [clojure.core :as c]
@@ -144,3 +144,8 @@
                  (str "expr assert: " (pr-str expr)))]
      (when *assert*
        `(runtime-assert ~hint (fn [] ~expr))))))
+
+(defn truncate
+  "Truncates a string to a certain length"
+  [s max-length]
+  (subs s 0 (min max-length (count s))))

common/src/app/common/features.cljc

@@ -46,6 +46,7 @@
   #{"fdata/objects-map"
     "fdata/pointer-map"
     "fdata/shape-data-type"
+    "fdata/path-data"
     "components/v2"
     "styles/v2"
     "layout/grid"
@@ -58,12 +59,18 @@
 ;; A set of features enabled by default
 (def default-features
   #{"fdata/shape-data-type"
+    "fdata/path-data"
     "styles/v2"
     "layout/grid"
     "components/v2"
     "plugins/runtime"
     "design-tokens/v1"})
 
+;; A set of features that should not be propagated to team on creating
+;; or modifying a file
+(def no-team-inheritable-features
+  #{"fdata/path-data"})
+
 ;; A set of features which only affects on frontend and can be enabled
 ;; and disabled freely by the user any time. This features does not
 ;; persist on file features field but can be permanently enabled on
@@ -86,8 +93,9 @@
 ;; without migration applied)
 (def no-migration-features
   (-> #{"layout/grid"
+        "design-tokens/v1"
         "fdata/shape-data-type"
-        "design-tokens/v1"}
+        "fdata/path-data"}
       (into frontend-only-features)
       (into backend-only-features)))
 
@@ -103,9 +111,7 @@
   "Translate a flag to a feature name"
   [flag]
   (case flag
-    :feature-components-v2 "components/v2"
     :feature-styles-v2 "styles/v2"
-    :feature-grid-layout "layout/grid"
     :feature-fdata-objects-map "fdata/objects-map"
     :feature-fdata-pointer-map "fdata/pointer-map"
     :feature-plugins "plugins/runtime"
@@ -216,6 +222,12 @@
 
     (check-supported-features! file-features)
 
+    ;; Components v1 is deprecated
+    (when-not (contains? file-features "components/v2")
+      (ex/raise :type :restriction
+                :code :file-in-components-v1
+                :hint "components v1 is deprecated"))
+
     (let [not-supported (-> file-features
                             (set/difference enabled-features)
                             (set/difference backend-only-features)

common/src/app/common/files/changes.cljc

@@ -26,11 +26,10 @@
    [app.common.types.pages-list :as ctpl]
    [app.common.types.shape :as cts]
    [app.common.types.shape-tree :as ctst]
-   [app.common.types.token :as cto]
-   [app.common.types.token-theme :as ctot]
    [app.common.types.tokens-lib :as ctob]
    [app.common.types.typographies-list :as ctyl]
    [app.common.types.typography :as ctt]
+   [app.common.types.variant :as ctv]
    [app.common.uuid :as uuid]
    [clojure.set :as set]))
 
@@ -336,13 +335,17 @@
       [:type [:= :mod-component]]
       [:id ::sm/uuid]
       [:shapes {:optional true} [:vector {:gen/max 3} :any]]
-      [:name {:optional true} :string]]]
+      [:name {:optional true} :string]
+      [:variant-id {:optional true} ::sm/uuid]
+      [:variant-properties {:optional true} [:vector ::ctv/variant-property]]]]
 
     [:del-component
      [:map {:title "DelComponentChange"}
       [:type [:= :del-component]]
       [:id ::sm/uuid]
-      [:main-instance {:optional true} :any]
+      ;; when it is an undo of a cut-paste, we need to undo the movement
+      ;; of the shapes so we need to move them delta
+      [:delta {:optional true} ::gpt/point]
       [:skip-undelete? {:optional true} :boolean]]]
 
     [:restore-component
@@ -403,7 +406,7 @@
       [:type [:= :set-token-theme]]
       [:theme-name :string]
       [:group :string]
-      [:theme [:maybe ::ctot/token-theme]]]]
+      [:theme [:maybe ctob/schema:token-theme-attrs]]]]
 
     [:set-tokens-lib
      [:map {:title "SetTokensLib"}
@@ -415,14 +418,14 @@
       [:type [:= :set-token-set]]
       [:set-name :string]
       [:group? :boolean]
-      [:token-set [:maybe ::ctot/token-set]]]]
+      [:token-set [:maybe ctob/schema:token-set-attrs]]]]
 
     [:set-token
      [:map {:title "SetTokenChange"}
       [:type [:= :set-token]]
       [:set-name :string]
       [:token-name :string]
-      [:token [:maybe ::cto/token]]]]]])
+      [:token [:maybe ctob/schema:token-attrs]]]]]])
 
 (def schema:changes
   [:sequential {:gen/max 5 :gen/min 1} schema:change])
@@ -729,20 +732,22 @@
 
           (update-group [group objects]
             (let [lookup   (d/getf objects)
-                  children (->> group :shapes (map lookup))]
+                  children (get group :shapes)]
               (cond
                 ;; If the group is empty we don't make any changes. Will be removed by a later process
                 (empty? children)
                 group
 
                 (= :bool (:type group))
-                (gsh/update-bool-selrect group children objects)
+                (gsh/update-bool group objects)
 
                 (:masked-group group)
-                (set-mask-selrect group children)
+                (->> (map lookup children)
+                     (set-mask-selrect group))
 
                 :else
-                (gsh/update-group-selrect group children))))]
+                (->> (map lookup children)
+                     (gsh/update-group-selrect group)))))]
 
     (if page-id
       (d/update-in-when data [:pages-index page-id :objects] reg-objects)
@@ -956,8 +961,8 @@
   (ctkl/mod-component data params))
 
 (defmethod process-change :del-component
-  [data {:keys [id skip-undelete? main-instance]}]
-  (ctf/delete-component data id skip-undelete? main-instance))
+  [data {:keys [id skip-undelete? delta]}]
+  (ctf/delete-component data id skip-undelete? delta))
 
 (defmethod process-change :restore-component
   [data {:keys [id page-id]}]

common/src/app/common/files/changes_builder.cljc

@@ -8,7 +8,6 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [app.common.features :as cfeat]
    [app.common.files.changes :as cfc]
    [app.common.files.helpers :as cfh]
    [app.common.geom.matrix :as gmt]
@@ -84,8 +83,7 @@
 
 (defn with-objects
   [changes objects]
-  (let [fdata (binding [cfeat/*current* #{"components/v2"}]
-                (ctf/make-file-data (uuid/next) uuid/zero))
+  (let [fdata (ctf/make-file-data (uuid/next) uuid/zero)
         fdata (assoc-in fdata [:pages-index uuid/zero :objects] objects)]
     (vary-meta changes assoc
                ::file-data fdata
@@ -480,9 +478,12 @@
           (let [old-val (get old attr)
                 new-val (get new attr)]
             (not= old-val new-val)))
-        new-obj (if with-objects?
-                  (update-fn object objects)
-                  (update-fn object))]
+
+        new-obj
+        (if with-objects?
+          (update-fn object objects)
+          (update-fn object))]
+
     (when-not (= object new-obj)
       (let [attrs (or attrs (d/concat-set (keys object) (keys new-obj)))]
         (filter (partial changed? object new-obj) attrs)))))
@@ -659,9 +660,13 @@
                                  nil               ;; so it does not need resize
 
                                  (= (:type parent) :bool)
-                                 (gsh/update-bool-selrect parent children objects)
+                                 (gsh/update-bool parent objects)
 
                                  (= (:type parent) :group)
+                                 ;; FIXME: this functions should be
+                                 ;; normalized in the same way as
+                                 ;; update-bool in order to make all
+                                 ;; this code consistent
                                  (if (:masked-group parent)
                                    (gsh/update-mask-selrect parent children)
                                    (gsh/update-group-selrect parent children)))]
@@ -921,11 +926,11 @@
         (apply-changes-local))))
 
 (defn add-component
-  ([changes id path name new-shapes updated-shapes main-instance-id main-instance-page]
-   (add-component changes id path name new-shapes updated-shapes main-instance-id main-instance-page nil nil nil))
-  ([changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation]
-   (add-component changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation nil nil))
-  ([changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation variant-id variant-properties & {:keys [apply-changes-local-library?]}]
+  ([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))
+  ([changes id path name updated-shapes main-instance-id main-instance-page annotation]
+   (add-component changes id path name updated-shapes main-instance-id main-instance-page annotation nil nil))
+  ([changes id path name updated-shapes main-instance-id main-instance-page annotation variant-id variant-properties & {:keys [apply-changes-local-library?]}]
    (assert-page-id! changes)
    (assert-objects! changes)
    (let [page-id (::page-id (meta changes))
@@ -964,11 +969,11 @@
                                       :name name
                                       :main-instance-id main-instance-id
                                       :main-instance-page main-instance-page
-                                      :annotation annotation
-                                      :variant-id variant-id
-                                      :variant-properties variant-properties}
-                               (some? new-shapes)  ;; this will be null in components-v2
-                               (assoc :shapes (vec new-shapes))))
+                                      :annotation annotation}
+                               (some? variant-id)
+                               (assoc :variant-id variant-id)
+                               (seq variant-properties)
+                               (assoc :variant-properties variant-properties)))
                        (into (map mk-change) updated-shapes))))
          (update :undo-changes
                  (fn [undo-changes]
@@ -991,27 +996,39 @@
         new-component  (update-fn prev-component)]
     (if prev-component
       (-> changes
-          (update :redo-changes conj {:type :mod-component
-                                      :id id
-                                      :name (:name new-component)
-                                      :path (:path new-component)
-                                      :main-instance-id (:main-instance-id new-component)
-                                      :main-instance-page (:main-instance-page new-component)
-                                      :annotation (:annotation new-component)
-                                      :variant-id (:variant-id new-component)
-                                      :variant-properties (:variant-properties new-component)
-                                      :objects (:objects new-component) ;; this won't exist in components-v2 (except for deleted components)
-                                      :modified-at (:modified-at new-component)})
-          (update :undo-changes conj {:type :mod-component
-                                      :id id
-                                      :name (:name prev-component)
-                                      :path (:path prev-component)
-                                      :main-instance-id (:main-instance-id prev-component)
-                                      :main-instance-page (:main-instance-page prev-component)
-                                      :annotation (:annotation prev-component)
-                                      :variant-id (:variant-id prev-component)
-                                      :variant-properties (:variant-properties prev-component)
-                                      :objects (:objects prev-component)})
+          (update :redo-changes conj (cond-> {:type :mod-component
+                                              :id id
+                                              :name (:name new-component)
+                                              :path (:path new-component)
+                                              :main-instance-id (:main-instance-id new-component)
+                                              :main-instance-page (:main-instance-page new-component)
+                                              :annotation (:annotation new-component)
+                                              :objects (:objects new-component) ;; for deleted components
+                                              :modified-at (:modified-at new-component)}
+                                       (some? (:variant-id new-component))
+                                       (assoc :variant-id (:variant-id new-component))
+                                       (nil? (:variant-id new-component))
+                                       (dissoc :variant-id)
+                                       (seq (:variant-properties new-component))
+                                       (assoc :variant-properties (:variant-properties new-component))
+                                       (not (seq (:variant-properties new-component)))
+                                       (dissoc :variant-properties)))
+          (update :undo-changes conj (cond-> {:type :mod-component
+                                              :id id
+                                              :name (:name prev-component)
+                                              :path (:path prev-component)
+                                              :main-instance-id (:main-instance-id prev-component)
+                                              :main-instance-page (:main-instance-page prev-component)
+                                              :annotation (:annotation prev-component)
+                                              :objects (:objects prev-component)}
+                                       (some? (:variant-id prev-component))
+                                       (assoc :variant-id (:variant-id prev-component))
+                                       (nil? (:variant-id prev-component))
+                                       (dissoc :variant-id)
+                                       (seq (:variant-properties prev-component))
+                                       (assoc :variant-properties (:variant-properties prev-component))
+                                       (not (seq (:variant-properties prev-component)))
+                                       (dissoc :variant-properties)))
           (cond-> apply-changes-local-library?
             (apply-changes-local {:apply-to-library? true})))
       changes)))
@@ -1027,7 +1044,7 @@
                                   :page-id page-id})))
 
 (defn restore-component
-  [changes id page-id main-instance]
+  [changes id page-id delta]
   (assert-library! changes)
   (-> changes
       (update :redo-changes conj {:type :restore-component
@@ -1035,7 +1052,34 @@
                                   :page-id page-id})
       (update :undo-changes conj {:type :del-component
                                   :id id
-                                  :main-instance main-instance})))
+                                  :delta delta})))
+
+(defn reorder-children
+  [changes id children]
+  (assert-page-id! changes)
+  (assert-objects! changes)
+
+  (let [page-id (::page-id (meta changes))
+        objects (lookup-objects changes)
+        shape (get objects id)
+        old-children (:shapes shape)
+
+        redo-change
+        {:type :reorder-children
+         :parent-id (:id shape)
+         :page-id page-id
+         :shapes children}
+
+        undo-change
+        {:type :reorder-children
+         :parent-id (:id shape)
+         :page-id page-id
+         :shapes old-children}]
+
+    (-> changes
+        (update :redo-changes conj redo-change)
+        (update :undo-changes conj undo-change)
+        (apply-changes-local))))
 
 (defn reorder-grid-children
   [changes ids]
@@ -1083,3 +1127,11 @@
 (defn get-objects
   [changes]
   (dm/get-in (::file-data (meta changes)) [:pages-index uuid/zero :objects]))
+
+(defn get-page
+  [changes]
+  (::page (meta changes)))
+
+(defn get-page-id
+  [changes]
+  (::page-id (meta changes)))

common/src/app/common/files/helpers.cljc

@@ -427,11 +427,6 @@
         (map #(str/concat base-name (suffix-fn %))
              (iterate inc 1))))
 
-(defn ^:private get-suffix
-  "Default suffix impelemtation"
-  [copy-count]
-  (str/concat " " copy-count))
-
 (defn generate-unique-name
   "Generates a unique name by selecting the first available name from a generated sequence.
    The sequence consists of `base-name` and its variants, avoiding conflicts with `existing-names`.
@@ -445,8 +440,7 @@
 
    Returns:
    - A unique name not present in `existing-names`."
-  [base-name existing-names & {:keys [suffix-fn immediate-suffix?]
-                               :or {suffix-fn get-suffix}}]
+  [base-name existing-names & {:keys [suffix-fn immediate-suffix? suffix]}]
   (dm/assert!
    "expected a set of strings"
    (coll? existing-names))
@@ -454,9 +448,21 @@
   (dm/assert!
    "expected a string for `basename`."
    (string? base-name))
-  (let [existing-name-set (cond-> (set existing-names)
+  (let [suffix-fn (if suffix-fn
+                    suffix-fn
+                    (if suffix
+                      (fn [copy-count]
+                        (str/concat "-"
+                                    suffix
+                                    (when (> copy-count 1)
+                                      (str "-" copy-count))))
+                      (fn [copy-count]
+                        (str/concat " " copy-count))))
+
+        existing-name-set (cond-> (set existing-names)
                             immediate-suffix? (conj base-name))
         names (name-seq base-name suffix-fn)]
+
     (->> names
          (remove #(contains? existing-name-set %))
          first)))

common/src/app/common/files/migrations.cljc

@@ -16,7 +16,6 @@
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
-   [app.common.geom.shapes.path :as gsp]
    [app.common.geom.shapes.text :as gsht]
    [app.common.logging :as l]
    [app.common.math :as mth]
@@ -27,6 +26,8 @@
    [app.common.types.component :as ctk]
    [app.common.types.container :as ctn]
    [app.common.types.file :as ctf]
+   [app.common.types.path :as path]
+   [app.common.types.path.segment :as path.segment]
    [app.common.types.shape :as cts]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.shadow :as ctss]
@@ -98,13 +99,13 @@
                     (if (nil? migrations)
                       (generate-migrations-from-version version)
                       migrations)))
-          (update :features (fnil into #{}) (deref cfeat/*new*))
           ;; NOTE: in some future we can consider to apply
           ;; a migration to the whole database and remove
           ;; this code from this function that executes on
           ;; each file migration operation
           (update :features cfeat/migrate-legacy-features)
-          (migrate)))))
+          (migrate)
+          (update :features (fnil into #{}) (deref cfeat/*new*))))))
 
 (defn migrated?
   [file]
@@ -129,8 +130,8 @@
   [data _]
   (letfn [(migrate-path [shape]
             (if-not (contains? shape :content)
-              (let [content (gsp/segments->content (:segments shape) (:close? shape))
-                    selrect (gsh/content->selrect content)
+              (let [content (path.segment/points->content (:segments shape) :close (:close? shape))
+                    selrect (path.segment/content->selrect content)
                     points  (grc/rect->points selrect)]
                 (-> shape
                     (dissoc :segments)
@@ -201,7 +202,7 @@
             (if (= (:type shape) :path)
               (let [{:keys [width height]} (grc/points->rect (:points shape))]
                 (if (or (mth/almost-zero? width) (mth/almost-zero? height))
-                  (let [selrect (gsh/content->selrect (:content shape))
+                  (let [selrect (path.segment/content->selrect (:content shape))
                         points (grc/rect->points selrect)
                         transform (gmt/matrix)
                         transform-inv (gmt/matrix)]
@@ -1264,6 +1265,26 @@
         (update :pages-index d/update-vals update-container)
         (d/update-when :components d/update-vals update-container))))
 
+(defmethod migrate-data "0002-normalize-bool-content"
+  [data _]
+  (letfn [(update-object [object]
+            ;; NOTE: we still preserve the previous value for possible
+            ;; rollback, we still need to perform an other migration
+            ;; for properly delete the bool-content prop from shapes
+            ;; once the know the migration was OK
+            (if (cfh/bool-shape? object)
+              (if-let [content (:bool-content object)]
+                (assoc object :content content)
+                object)
+              (dissoc object :bool-content :bool-type)))
+
+          (update-container [container]
+            (d/update-when container :objects update-vals update-object))]
+
+    (-> data
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
+
 (defmethod migrate-data "0003-fix-root-shape"
   [data _]
   (letfn [(update-object [shape]
@@ -1286,6 +1307,23 @@
         (d/update-when :components d/update-vals update-container)
         (d/without-nils))))
 
+(defmethod migrate-data "0003-convert-path-content"
+  [data _]
+  (some-> cfeat/*new* (swap! conj "fdata/path-data"))
+
+  (letfn [(update-object [object]
+            (if (or (cfh/bool-shape? object)
+                    (cfh/path-shape? object))
+              (update object :content path/content)
+              object))
+
+          (update-container [container]
+            (d/update-when container :objects update-vals update-object))]
+
+    (-> data
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
+
 (def available-migrations
   (into (d/ordered-set)
         ["legacy-2"
@@ -1341,5 +1379,7 @@
          "legacy-66"
          "legacy-67"
          "0001-remove-tokens-from-groups"
+         "0002-normalize-bool-content"
          "0002-clean-shape-interactions"
-         "0003-fix-root-shape"]))
+         "0003-fix-root-shape"
+         "0003-convert-path-content"]))

common/src/app/common/files/repair.cljc

@@ -572,6 +572,51 @@
         (pcb/with-file-data file-data)
         (pcb/update-shapes [(:id shape)] repair-shape))))
 
+(defmethod repair-error :not-a-variant
+  [_ error file _]
+  (log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
+  file)
+
+(defmethod repair-error :invalid-variant-id
+  [_ error file _]
+  (log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
+  file)
+
+(defmethod repair-error :invalid-variant-properties
+  [_ error file _]
+  (log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
+  file)
+
+(defmethod repair-error :variant-not-main
+  [_ error file _]
+  (log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
+  file)
+
+(defmethod repair-error :parent-not-variant
+  [_ error file _]
+  (log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
+  file)
+
+(defmethod repair-error :variant-bad-name
+  [_ error file _]
+  (log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
+  file)
+
+(defmethod repair-error :variant-no-properties
+  [_ error file _]
+  (log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
+  file)
+
+(defmethod repair-error :variant-bad-variant-name
+  [_ error file _]
+  (log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
+  file)
+
+(defmethod repair-error :variant-component-bad-name
+  [_ error file _]
+  (log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
+  file)
+
 (defmethod repair-error :default
   [_ error file _]
   (log/error :hint "Unknown error code, don't know how to repair" :code (:code error))

common/src/app/common/files/shapes_helpers.cljc

@@ -15,6 +15,8 @@
    [app.common.types.shape.layout :as ctl]
    [app.common.uuid :as uuid]))
 
+;; FIXME: move to logic?
+
 (defn prepare-add-shape
   [changes shape objects]
   (let [index   (:index (meta shape))
@@ -35,6 +37,7 @@
                       (pcb/update-shapes [(:parent-id shape)] #(ctl/push-into-cell % [id] row column)))
                     (cond-> (ctl/grid-layout? objects (:parent-id shape))
                       (pcb/update-shapes [(:parent-id shape)] ctl/assign-cells {:with-objects? true})))]
+
     [shape changes]))
 
 (defn prepare-move-shapes-into-frame
@@ -44,6 +47,7 @@
         to-move    (->> shapes
                         (map (d/getf objects))
                         (not-empty))]
+
     (if to-move
       (-> changes
           (cond-> (and remove-layout-data?
@@ -62,6 +66,10 @@
     changes id parent-id objects selected index frame-name without-fill? nil))
 
   ([changes id parent-id objects selected index frame-name without-fill? target-cell-id]
+   (prepare-create-artboard-from-selection
+    changes id parent-id objects selected index frame-name without-fill? target-cell-id nil))
+
+  ([changes id parent-id objects selected index frame-name without-fill? target-cell-id delta]
    (when-let [selected-objs (->> selected
                                  (map (d/getf objects))
                                  (not-empty))]
@@ -99,10 +107,11 @@
                     :id))
              target-cell-id)
 
+
            attrs
            {:type :frame
-            :x (:x srect)
-            :y (:y srect)
+            :x (cond-> (:x srect) delta (+ (:x delta)))
+            :y (cond-> (:y srect) delta (+ (:y delta)))
             :width (:width srect)
             :height (:height srect)}
 

common/src/app/common/files/tokens.cljc

@@ -1,8 +1,13 @@
-(ns app.main.ui.workspace.tokens.token
+;; 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.files.tokens
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [app.main.ui.workspace.tokens.tinycolor :as tinycolor]
    [clojure.set :as set]
    [cuerdas.core :as str]))
 
@@ -128,18 +133,6 @@
 (defn color-token? [token]
   (= (:type token) :color))
 
-
 ;; FIXME: this should be precalculated ?
 (defn is-reference? [token]
   (str/includes? (:value token) "{"))
-
-(defn color-bullet-color [token-color-value]
-  (when-let [tc (tinycolor/valid-color token-color-value)]
-    (if (tinycolor/alpha tc)
-      {:color (tinycolor/->hex-string tc)
-       :opacity (tinycolor/alpha tc)}
-      (tinycolor/->hex-string tc))))
-
-(defn resolved-token-bullet-color [{:keys [resolved-value] :as token}]
-  (when (and resolved-value (color-token? token))
-    (color-bullet-color resolved-value)))

common/src/app/common/files/validate.cljc

@@ -10,12 +10,15 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.files.helpers :as cfh]
+   [app.common.files.variant :as cfv]
    [app.common.schema :as sm]
    [app.common.types.component :as ctk]
+   [app.common.types.components-list :as ctkl]
    [app.common.types.container :as ctn]
    [app.common.types.file :as ctf]
    [app.common.types.pages-list :as ctpl]
    [app.common.types.shape-tree :as ctst]
+   [app.common.types.variant :as ctv]
    [app.common.uuid :as uuid]
    [cuerdas.core :as str]))
 
@@ -56,7 +59,17 @@
     :instance-head-not-frame
     :misplaced-slot
     :missing-slot
-    :shape-ref-cycle})
+    :shape-ref-cycle
+    :not-a-variant
+    :invalid-variant-id
+    :invalid-variant-properties
+    :variant-not-main
+    :parent-not-variant
+    :variant-bad-name
+    :variant-bad-variant-name
+    :variant-component-bad-name
+    :variant-no-properties
+    :variant-component-bad-id})
 
 (def ^:private schema:error
   [:map {:title "ValidationError"}
@@ -401,6 +414,68 @@
   (check-empty-swap-slot shape file page)
   (run! #(check-shape % file page libraries :context :not-component) (:shapes shape)))
 
+(defn- check-variant-container
+  "Shape is a variant container, so:
+     -all its children should be variants with variant-id equals to the shape-id
+     -all the components should have the same properties
+   "
+  [shape file page]
+  (let [shape-id   (:id shape)
+        shapes     (:shapes shape)
+        children   (map #(ctst/get-shape page %) shapes)
+        prop-names (cfv/extract-properties-names (first children) (:data file))]
+    (doseq [child children]
+      (if (not (ctk/is-variant? child))
+        (report-error :not-a-variant
+                      (str/ffmt "Shape % should be a variant" (:id child))
+                      child file page)
+        (do
+          (when (not= (:variant-id child) shape-id)
+            (report-error :invalid-variant-id
+                          (str/ffmt "Variant % has invalid variant-id %" (:id child) (:variant-id child))
+                          child file page))
+          (when (not= prop-names (cfv/extract-properties-names child (:data file)))
+            (report-error :invalid-variant-properties
+                          (str/ffmt "Variant % has invalid properties %" (:id child) (vec prop-names))
+                          child file page)))))))
+
+(defn- check-variant
+  "Shape is a variant, so
+     -it should be a main component
+     -its parent should be a variant-container
+     -its variant-name is derived from the properties
+     -its name should be tha same as its parent's
+   "
+  [shape file page]
+  (let [parent    (ctst/get-shape page (:parent-id shape))
+        component (ctkl/get-component (:data file) (:component-id shape) true)
+        name      (ctv/properties-to-name (:variant-properties component))]
+    (when-not (ctk/main-instance? shape)
+      (report-error :variant-not-main
+                    (str/ffmt "Variant % is not a main instance" (:id shape))
+                    shape file page))
+    (when-not (ctk/is-variant-container? parent)
+      (report-error :parent-not-variant
+                    (str/ffmt "Variant % has an invalid parent" (:id shape))
+                    shape file page))
+
+    (when-not (= name (:variant-name shape))
+      (report-error :variant-bad-variant-name
+                    (str/ffmt "Variant % has an invalid variant-name" (:id shape))
+                    shape file page))
+    (when-not (= (:name parent) (:name shape))
+      (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)))
+      (report-error :variant-component-bad-name
+                    (str/ffmt "Component % has an invalid name" (:id shape))
+                    shape file page))
+    (when-not (= (:variant-id component) (:variant-id shape))
+      (report-error :variant-component-bad-id
+                    (str/ffmt "Variant % has adifferent variant-id than its component" (:id shape))
+                    shape file page))))
+
 (defn- check-shape
   "Validate referential integrity and semantic coherence of
   a shape and all its children. Report all errors found.
@@ -421,6 +496,12 @@
       (check-parent-children shape file page)
       (check-frame shape file page)
 
+      (when (ctk/is-variant-container? shape)
+        (check-variant-container shape file page))
+
+      (when (ctk/is-variant? shape)
+        (check-variant shape file page))
+
       (if (ctk/instance-head? shape)
         (if (not= :frame (:type shape))
           (report-error :instance-head-not-frame
@@ -496,6 +577,24 @@
                     "This deleted component has shapes with shape-ref pointing to self"
                     component file nil :cycles-ids cycles-ids))))
 
+(defn- check-variant-component
+  "Component is a variant, so:
+     -Its main should be a variant
+     -It should have at least one variant property"
+  [component file]
+  (let [component-page (ctf/get-component-page (:data file) component)
+        main-component (if (:deleted component)
+                         (dm/get-in component [:objects (:main-instance-id component)])
+                         (ctst/get-shape component-page (:main-instance-id component)))]
+    (when-not (ctk/is-variant? main-component)
+      (report-error :not-a-variant
+                    (str/ffmt "Shape % should be a variant" (:id main-component))
+                    main-component file component-page))
+    (when (< (count (:variant-properties component)) 1)
+      (report-error :variant-no-properties
+                    (str/ffmt "Component variant % should have properties" (:id main-component))
+                    main-component file nil))))
+
 (defn- check-component
   "Validate semantic coherence of a component. Report all errors found."
   [component file]
@@ -505,7 +604,10 @@
                   component file nil))
   (when (:deleted component)
     (check-component-duplicate-swap-slot component file)
-    (check-ref-cycles component file)))
+    (check-ref-cycles component file))
+
+  (when (ctk/is-variant? component)
+    (check-variant-component component file)))
 
 (defn- get-orphan-shapes
   [{:keys [objects] :as page}]

common/src/app/common/files/variant.cljc

@@ -0,0 +1,84 @@
+;; 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.files.variant
+  (:require
+   [app.common.data.macros :as dm]
+   [app.common.types.component :as ctc]
+   [app.common.types.components-list :as ctcl]
+   [app.common.types.variant :as ctv]
+   [cuerdas.core :as str]))
+
+
+(defn find-variant-components
+  "Find a list of the components thet belongs to this variant-id"
+  [data objects variant-id]
+  ;; We can't simply filter components, because we need to maintain the order
+  (->> (dm/get-in objects [variant-id :shapes])
+       (map #(dm/get-in objects [% :component-id]))
+       (map #(ctcl/get-component data % true))
+       reverse))
+
+(defn- dashes-to-end
+  [property-values]
+  (let [dashes (if (some #(= % "--") property-values) ["--"] [])]
+    (concat (remove #(= % "--") property-values) dashes)))
+
+
+(defn extract-properties-names
+  [shape data]
+  (->> shape
+       (#(ctcl/get-component data (:component-id %) true))
+       :variant-properties
+       (map :name)))
+
+
+(defn extract-properties-values
+  [data objects variant-id]
+  (->> (find-variant-components data objects variant-id)
+       (mapcat :variant-properties)
+       (group-by :name)
+       (map (fn [[k v]]
+              {:name k
+               :value (->> v
+                           (map #(if (str/empty? (:value %)) "--" (:value %)))
+                           distinct
+                           dashes-to-end)}))))
+
+(defn get-variant-mains
+  [component data]
+  (assert (ctv/valid-variant-component? component) "expected valid component variant")
+  (when-let [variant-id (:variant-id component)]
+    (let [page-id (:main-instance-page component)
+          objects (-> (dm/get-in data [:pages-index page-id])
+                      (get :objects))]
+      (dm/get-in objects [variant-id :shapes]))))
+
+
+(defn is-secondary-variant?
+  [component data]
+  (let [shapes  (get-variant-mains component data)]
+    (and (seq shapes)
+         (not= (:main-instance-id component) (last shapes)))))
+
+(defn get-primary-variant
+  [data component]
+  (let [page-id    (:main-instance-page component)
+        objects    (-> (dm/get-in data [:pages-index page-id])
+                       (get :objects))
+        variant-id (:variant-id component)]
+    (->> (dm/get-in objects [variant-id :shapes])
+         peek
+         (get objects))))
+
+(defn get-primary-component
+  [data component-id]
+  (when-let [component (ctcl/get-component data component-id)]
+    (if (ctc/is-variant? component)
+      (->> component
+           (get-primary-variant data)
+           :component-id
+           (ctcl/get-component data))
+      component)))

common/src/app/common/flags.cljc

@@ -79,7 +79,7 @@
     :file-schema-validation
     ;; Reports the schema validation errors internally.
     :soft-file-schema-validation
-    ;; Activates the referential integrity validation during update file; related to components-v2.
+    ;; Activates the referential integrity validation during update file.
     :file-validation
     ;; Reports the referential integrity validation errors internally.
     :soft-file-validation
@@ -125,6 +125,7 @@
     :export-file-v3
     :render-wasm-dpr
     :hide-release-modal
+    :subscriptions
     :subscriptions-old})
 
 (def all-flags

common/src/app/common/geom/matrix.cljc

@@ -126,21 +126,20 @@
       o)))
 
 (def schema:matrix
-  {:type :map
-   :pred valid-matrix?
-   :type-properties
-   {:title "matrix"
-    :description "Matrix instance"
-    :error/message "expected a valid matrix instance"
-    :gen/gen (matrix-generator)
-    :decode/json decode-matrix
-    :decode/string decode-matrix
-    :encode/json matrix->json
-    :encode/string matrix->str
-    ::oapi/type "string"
-    ::oapi/format "matrix"}})
-
-(sm/register! ::matrix schema:matrix)
+  (sm/register!
+   {:type ::matrix
+    :pred valid-matrix?
+    :type-properties
+    {:title "matrix"
+     :description "Matrix instance"
+     :error/message "expected a valid matrix instance"
+     :gen/gen (matrix-generator)
+     :decode/json decode-matrix
+     :decode/string decode-matrix
+     :encode/json matrix->json
+     :encode/string matrix->str
+     ::oapi/type "string"
+     ::oapi/format "matrix"}}))
 
 ;; FIXME: deprecated
 (s/def ::a ::us/safe-float)

common/src/app/common/geom/point.cljc

@@ -5,7 +5,7 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.geom.point
-  (:refer-clojure :exclude [divide min max abs])
+  (:refer-clojure :exclude [divide min max abs zero?])
   (:require
    #?(:clj [app.common.fressian :as fres])
    #?(:cljs [cljs.core :as c]
@@ -85,24 +85,22 @@
     (into {} p)
     p))
 
-;; FIXME: make like matrix
 (def schema:point
-  {:type ::point
-   :pred valid-point?
-   :type-properties
-   {:title "point"
-    :description "Point"
-    :error/message "expected a valid point"
-    :gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
-                  (sg/fmap #(apply pos->Point %)))
-    ::oapi/type "string"
-    ::oapi/format "point"
-    :decode/json decode-point
-    :decode/string decode-point
-    :encode/json point->json
-    :encode/string point->str}})
-
-(sm/register! schema:point)
+  (sm/register!
+   {:type ::point
+    :pred valid-point?
+    :type-properties
+    {:title "point"
+     :description "Point"
+     :error/message "expected a valid point"
+     :gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
+                   (sg/fmap #(apply pos->Point %)))
+     ::oapi/type "string"
+     ::oapi/format "point"
+     :decode/json decode-point
+     :decode/string decode-point
+     :encode/json point->json
+     :encode/string point->str}}))
 
 (defn point-like?
   [{:keys [x y] :as v}]
@@ -470,6 +468,13 @@
   (and ^boolean (mth/almost-zero? (dm/get-prop p :x))
        ^boolean (mth/almost-zero? (dm/get-prop p :y))))
 
+(defn zero?
+  [p]
+  (let [x (dm/get-prop p :x)
+        y (dm/get-prop p :y)]
+    (and ^boolean (== 0 x)
+         ^boolean (== 0 y))))
+
 (defn lerp
   "Calculates a linear interpolation between two points given a tvalue"
   [p1 p2 t]

common/src/app/common/geom/shapes.cljc

@@ -10,13 +10,11 @@
    [app.common.data.macros :as dm]
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
-   [app.common.geom.shapes.bool :as gsb]
    [app.common.geom.shapes.common :as gco]
    [app.common.geom.shapes.constraints :as gct]
    [app.common.geom.shapes.corners :as gsc]
    [app.common.geom.shapes.fit-frame :as gsff]
    [app.common.geom.shapes.intersect :as gsi]
-   [app.common.geom.shapes.path :as gsp]
    [app.common.geom.shapes.transforms :as gtr]
    [app.common.math :as mth]))
 
@@ -166,7 +164,7 @@
 (dm/export gtr/calculate-geometry)
 (dm/export gtr/update-group-selrect)
 (dm/export gtr/update-mask-selrect)
-(dm/export gtr/update-bool-selrect)
+(dm/export gtr/update-bool)
 (dm/export gtr/apply-transform)
 (dm/export gtr/transform-shape)
 (dm/export gtr/transform-selrect)
@@ -180,12 +178,6 @@
 ;; Constratins
 (dm/export gct/calc-child-modifiers)
 
-;; PATHS
-;; FIXME: rename
-(dm/export gsp/content->selrect)
-(dm/export gsp/transform-content)
-(dm/export gsp/open-path?)
-
 ;; Intersection
 (dm/export gsi/overlaps?)
 (dm/export gsi/overlaps-path?)
@@ -193,9 +185,6 @@
 (dm/export gsi/has-point-rect?)
 (dm/export gsi/rect-contains-shape?)
 
-;; Bool
-(dm/export gsb/calc-bool-content)
-
 ;; Constraints
 (dm/export gct/default-constraints-h)
 (dm/export gct/default-constraints-v)

common/src/app/common/geom/shapes/bool.cljc

@@ -1,29 +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 app.common.geom.shapes.bool
-  (:require
-   [app.common.data :as d]
-   [app.common.files.helpers :as cpf]
-   [app.common.svg.path.bool :as pb]
-   [app.common.svg.path.shapes-to-path :as stp]))
-
-(defn calc-bool-content
-  [shape objects]
-
-  (let [extract-content-xf
-        (comp (map (d/getf objects))
-              (filter (comp not :hidden))
-              (remove cpf/svg-raw-shape?)
-              (map #(stp/convert-to-path % objects))
-              (map :content))
-
-        shapes-content
-        (into [] extract-content-xf (:shapes shape))]
-    (pb/content-bool (:bool-type shape) shapes-content)))
-
-
-

common/src/app/common/geom/shapes/bounds.cljc

@@ -10,8 +10,8 @@
    [app.common.data.macros :as dm]
    [app.common.files.helpers :as cfh]
    [app.common.geom.rect :as grc]
-   [app.common.geom.shapes.path :as gsp]
-   [app.common.math :as mth]))
+   [app.common.math :as mth]
+   [app.common.types.path :as path]))
 
 (defn shape-stroke-margin
   [shape stroke-width]
@@ -104,7 +104,7 @@
    (let [strokes (:strokes shape)
 
          open-path?    (and ^boolean (cfh/path-shape? shape)
-                            ^boolean (gsp/open-path? shape))
+                            ^boolean (path/shape-with-open-path? shape))
 
          stroke-width
          (->> strokes

common/src/app/common/geom/shapes/grid_layout/layout_data.cljc

@@ -39,7 +39,7 @@
 ;;
 ;;   5. If any track still has an infinite growth limit set its growth limit to its base size.
 
-;;   - Distribute extra space accross spaned tracks
+;; - Distribute extra space accross spaned tracks
 ;; - Maximize tracks
 ;;
 ;; - Expand flexible tracks
@@ -198,7 +198,7 @@
 
     track-list))
 
-(defn add-auto-size
+(defn stretch-tracks
   [track-list add-size]
   (->> track-list
        (mapv (fn [{:keys [type size max-size] :as track}]
@@ -357,7 +357,8 @@
                       to-idx (+ (dec (get cell prop)) (get cell prop-span))
                       indexed-tracks (subvec (d/enumerate track-list) from-idx to-idx)
 
-                      to-allocate (size-to-allocate type parent (get children-map shape-id) cell bounds objects)
+                      to-allocate
+                      (size-to-allocate type parent (get children-map shape-id) cell bounds objects)
 
                       ;; Remove the size and the tracks that are not allocated
                       [to-allocate total-frs indexed-tracks]
@@ -493,11 +494,11 @@
 
          column-tracks (cond-> column-tracks
                          (= :stretch (:layout-justify-content parent))
-                         (add-auto-size column-add-auto))
+                         (stretch-tracks column-add-auto))
 
          row-tracks    (cond-> row-tracks
                          (= :stretch (:layout-align-content parent))
-                         (add-auto-size row-add-auto))
+                         (stretch-tracks row-add-auto))
 
          column-total-size (tracks-total-size column-tracks)
          row-total-size    (tracks-total-size row-tracks)

common/src/app/common/geom/shapes/intersect.cljc

@@ -13,9 +13,9 @@
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes.common :as gco]
-   [app.common.geom.shapes.path :as gpp]
    [app.common.geom.shapes.text :as gte]
-   [app.common.math :as mth]))
+   [app.common.math :as mth]
+   [app.common.types.path.segment :as path.segm]))
 
 (defn orientation
   "Given three ordered points gives the orientation
@@ -186,7 +186,7 @@
           rect-lines   (points->lines rect-points)
           path-lines   (if simple?
                          (points->lines (:points shape))
-                         (gpp/path->lines shape))
+                         (path.segm/path->lines shape))
           start-point (-> shape :content (first) :params (gpt/point))]
 
       (or (intersects-lines? rect-lines path-lines)

common/src/app/common/geom/shapes/transforms.cljc

@@ -12,11 +12,10 @@
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
    [app.common.geom.rect :as grc]
-   [app.common.geom.shapes.bool :as gshb]
    [app.common.geom.shapes.common :as gco]
-   [app.common.geom.shapes.path :as gpa]
    [app.common.math :as mth]
-   [app.common.types.modifiers :as ctm]))
+   [app.common.types.modifiers :as ctm]
+   [app.common.types.path :as path]))
 
 #?(:clj (set! *warn-on-reflection* true))
 
@@ -77,7 +76,11 @@
               position-data)
         position-data))))
 
-;; FIXME: revist usage of mutability
+;; FIXME: review performance of this; this function is executing too
+;; many times, including when the point vector is 0,0. This function
+;; can be implemented in function of transform which is already mor
+;; performant
+
 (defn move
   "Move the shape relatively to its current
   position applying the provided delta."
@@ -95,8 +98,8 @@
         (d/update-when :x d/safe+ dx)
         (d/update-when :y d/safe+ dy)
         (d/update-when :position-data move-position-data mvec)
-        (cond-> (= :bool type) (update :bool-content gpa/move-content mvec))
-        (cond-> (= :path type) (update :content gpa/move-content mvec)))))
+        (cond-> (or (= :bool type) (= :path type))
+          (update :content path/move-content mvec)))))
 
 ;; --- Absolute Movement
 
@@ -317,14 +320,11 @@
         points  (gco/transform-points  (dm/get-prop shape :points) transform-mtx)
         selrect (gco/transform-selrect (dm/get-prop shape :selrect) transform-mtx)
 
-        shape   (if (= type :bool)
-                  (update shape :bool-content gpa/transform-content transform-mtx)
-                  shape)
         shape   (if (= type :text)
                   (update shape :position-data transform-position-data transform-mtx)
                   shape)
-        shape   (if (= type :path)
-                  (update shape :content gpa/transform-content transform-mtx)
+        shape   (if (or (= type :path) (= type :bool))
+                  (update shape :content path/transform-content transform-mtx)
                   (assoc shape
                          :x (dm/get-prop selrect :x)
                          :y (dm/get-prop selrect :y)
@@ -355,12 +355,9 @@
             rotation (mod (+ (d/nilv (:rotation shape) 0)
                              (d/nilv (dm/get-in shape [:modifiers :rotation]) 0))
                           360)
-            shape    (if (= type :bool)
-                       (update shape :bool-content gpa/transform-content transform-mtx)
-                       shape)
 
-            shape    (if (= type :path)
-                       (update shape :content gpa/transform-content transform-mtx)
+            shape    (if (or (= type :path) (= type :bool))
+                       (update shape :content path/transform-content transform-mtx)
                        (assoc shape
                               :x (dm/get-prop selrect :x)
                               :y (dm/get-prop selrect :y)
@@ -377,8 +374,14 @@
   "Given a new set of points transformed, set up the rectangle so it keeps
   its properties. We adjust de x,y,width,height and create a custom transform"
   [shape transform-mtx]
-  (if ^boolean (gmt/move? transform-mtx)
+  (cond
+    (nil? transform-mtx)
+    shape
+
+    ^boolean (gmt/move? transform-mtx)
     (apply-transform-move shape transform-mtx)
+
+    :else
     (apply-transform-generic shape transform-mtx)))
 
 (defn- update-group-viewbox
@@ -450,20 +453,14 @@
         (assoc :flip-x  (-> mask :flip-x))
         (assoc :flip-y  (-> mask :flip-y)))))
 
-(defn update-bool-selrect
+(defn update-bool
   "Calculates the selrect+points for the boolean shape"
-  [shape children objects]
-
-  (let [bool-content     (gshb/calc-bool-content shape objects)
-        shape            (assoc shape :bool-content bool-content)
-        [points selrect] (gpa/content->points+selrect shape bool-content)]
-
-    (if (and (some? selrect) (d/not-empty? points))
-      (-> shape
-          (assoc :selrect selrect)
-          (assoc :points points))
-      (update-group-selrect shape children))))
+  [shape objects]
+  (let [content (path/calc-bool-content shape objects)
+        shape   (assoc shape :content content)]
+    (path/update-geometry shape)))
 
+;; FIXME: revisit
 (defn update-shapes-geometry
   [objects ids]
   (->> ids
@@ -477,7 +474,7 @@
                   (update-mask-selrect shape children)
 
                   (cfh/bool-shape? shape)
-                  (update-bool-selrect shape children objects)
+                  (update-bool shape objects)
 
                   (cfh/group-shape? shape)
                   (update-group-selrect shape children)

common/src/app/common/logic/shapes.cljc

@@ -10,14 +10,14 @@
    [app.common.files.changes-builder :as pcb]
    [app.common.files.helpers :as cfh]
    [app.common.geom.shapes :as gsh]
-   [app.common.logic.variants :as clv]
+   [app.common.logic.variant-properties :as clvp]
    [app.common.types.component :as ctk]
    [app.common.types.container :as ctn]
+   [app.common.types.pages-list :as ctpl]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.layout :as ctl]
    [app.common.types.token :as cto]
-   [app.common.uuid :as uuid]
-   [cuerdas.core :as str]))
+   [app.common.uuid :as uuid]))
 
 (defn- generate-unapply-tokens
   "When updating attributes that have a token applied, we must unapply it, because the value
@@ -81,163 +81,167 @@
         (pcb/update-shapes ids update-fn {:attrs #{:blocked :hidden}}))))
 
 (defn generate-delete-shapes
-  [changes file page objects ids {:keys [components-v2 ignore-touched component-swap]}]
-  (let [ids           (cfh/clean-loops objects ids)
+  ([changes file page objects ids options]
+   (generate-delete-shapes (-> changes
+                               (pcb/with-page page)
+                               (pcb/with-objects objects)
+                               (pcb/with-library-data file))
+                           ids
+                           options))
+  ([changes ids {:keys [ignore-touched component-swap]}]
+   (let [objects (pcb/get-objects changes)
+         data    (pcb/get-library-data changes)
+         page-id (pcb/get-page-id changes)
+         page    (or (pcb/get-page changes)
+                     (ctpl/get-page data page-id))
 
-        in-component-copy?
-        (fn [shape-id]
+         ids     (cfh/clean-loops objects ids)
+         in-component-copy?
+         (fn [shape-id]
           ;; Look for shapes that are inside a component copy, but are
           ;; not the root. In this case, they must not be deleted,
           ;; but hidden (to be able to recover them more easily).
           ;; Unless we are doing a component swap, in which case we want
           ;; to delete the old shape
-          (let [shape           (get objects shape-id)]
-            (and (ctn/has-any-copy-parent? objects shape)
-                 (not component-swap))))
+           (let [shape           (get objects shape-id)]
+             (and (ctn/has-any-copy-parent? objects shape)
+                  (not component-swap))))
 
-        [ids-to-delete ids-to-hide]
-        (if components-v2
-          (loop [ids-seq       (seq ids)
-                 ids-to-delete []
-                 ids-to-hide   []]
-            (let [id (first ids-seq)]
-              (if (nil? id)
-                [ids-to-delete ids-to-hide]
-                (if (in-component-copy? id)
-                  (recur (rest ids-seq)
-                         ids-to-delete
-                         (conj ids-to-hide id))
-                  (recur (rest ids-seq)
-                         (conj ids-to-delete id)
-                         ids-to-hide)))))
-          [ids []])
+         [ids-to-delete ids-to-hide]
+         (loop [ids-seq       (seq ids)
+                ids-to-delete []
+                ids-to-hide   []]
+           (let [id (first ids-seq)]
+             (if (nil? id)
+               [ids-to-delete ids-to-hide]
+               (if (in-component-copy? id)
+                 (recur (rest ids-seq)
+                        ids-to-delete
+                        (conj ids-to-hide id))
+                 (recur (rest ids-seq)
+                        (conj ids-to-delete id)
+                        ids-to-hide)))))
 
-        changes (-> changes
-                    (pcb/with-page page)
-                    (pcb/with-objects objects)
-                    (pcb/with-library-data file))
+         lookup  (d/getf objects)
 
-        lookup  (d/getf objects)
-
-        groups-to-unmask
-        (reduce (fn [group-ids id]
+         groups-to-unmask
+         (reduce (fn [group-ids id]
                   ;; When the shape to delete is the mask of a masked group,
                   ;; the mask condition must be removed, and it must be
                   ;; converted to a normal group.
-                  (let [obj    (lookup id)
-                        parent (lookup (:parent-id obj))]
-                    (if (and (:masked-group parent)
-                             (= id (first (:shapes parent))))
-                      (conj group-ids (:id parent))
-                      group-ids)))
-                #{}
-                ids-to-delete)
+                   (let [obj    (lookup id)
+                         parent (lookup (:parent-id obj))]
+                     (if (and (:masked-group parent)
+                              (= id (first (:shapes parent))))
+                       (conj group-ids (:id parent))
+                       group-ids)))
+                 #{}
+                 ids-to-delete)
 
-        interacting-shapes
-        (filter (fn [shape]
+         interacting-shapes
+         (filter (fn [shape]
                   ;; If any of the deleted shapes is the destination of
                   ;; some interaction, this must be deleted, too.
-                  (let [interactions (:interactions shape)]
-                    (some #(and (ctsi/has-destination %)
-                                (contains? ids-to-delete (:destination %)))
-                          interactions)))
-                (vals objects))
+                   (let [interactions (:interactions shape)]
+                     (some #(and (ctsi/has-destination %)
+                                 (contains? ids-to-delete (:destination %)))
+                           interactions)))
+                 (vals objects))
 
-        changes
-        (reduce (fn [changes {:keys [id] :as flow}]
-                  (if (contains? ids-to-delete (:starting-frame flow))
-                    (pcb/set-flow changes id nil)
-                    changes))
-                changes
-                (:flows page))
+         changes
+         (reduce (fn [changes {:keys [id] :as flow}]
+                   (if (contains? ids-to-delete (:starting-frame flow))
+                     (pcb/set-flow changes id nil)
+                     changes))
+                 changes
+                 (:flows page))
 
 
-        all-parents
-        (reduce (fn [res id]
+         all-parents
+         (reduce (fn [res id]
                   ;; All parents of any deleted shape must be resized.
-                  (into res (cfh/get-parent-ids objects id)))
-                (d/ordered-set)
-                (concat ids-to-delete ids-to-hide))
+                   (into res (cfh/get-parent-ids objects id)))
+                 (d/ordered-set)
+                 (concat ids-to-delete ids-to-hide))
 
-        all-children
-        (->> ids-to-delete ;; Children of deleted shapes must be also deleted.
-             (reduce (fn [res id]
-                       (into res (cfh/get-children-ids objects id)))
-                     [])
-             (reverse)
-             (into (d/ordered-set)))
+         all-children
+         (->> ids-to-delete ;; Children of deleted shapes must be also deleted.
+              (reduce (fn [res id]
+                        (into res (cfh/get-children-ids objects id)))
+                      [])
+              (reverse)
+              (into (d/ordered-set)))
 
-        find-all-empty-parents
-        (fn recursive-find-empty-parents [empty-parents]
-          (let [all-ids   (into empty-parents ids-to-delete)
-                contains? (partial contains? all-ids)
-                xform     (comp (map lookup)
-                                (filter #(or (cfh/group-shape? %) (cfh/bool-shape? %)))
-                                (remove #(->> (:shapes %) (remove contains?) seq))
-                                (map :id))
-                parents   (into #{} xform all-parents)]
-            (if (= empty-parents parents)
-              empty-parents
-              (recursive-find-empty-parents parents))))
+         find-all-empty-parents
+         (fn recursive-find-empty-parents [empty-parents]
+           (let [all-ids   (into empty-parents ids-to-delete)
+                 contains? (partial contains? all-ids)
+                 xform     (comp (map lookup)
+                                 (filter #(or (cfh/group-shape? %) (cfh/bool-shape? %) (ctk/is-variant-container? %)))
+                                 (remove #(->> (:shapes %) (remove contains?) seq))
+                                 (map :id))
+                 parents   (into #{} xform all-parents)]
+             (if (= empty-parents parents)
+               empty-parents
+               (recursive-find-empty-parents parents))))
 
-        empty-parents
+         empty-parents
         ;; Any parent whose children are all deleted, must be deleted too.
         ;; Unless we are during a component swap: in this case we are replacing a shape by
         ;; other one, so must not delete empty parents.
-        (if-not component-swap
-          (into (d/ordered-set) (find-all-empty-parents #{}))
-          #{})
+         (if-not component-swap
+           (into (d/ordered-set) (find-all-empty-parents #{}))
+           #{})
 
-        components-to-delete
-        (if components-v2
-          (reduce (fn [components id]
-                    (let [shape (get objects id)]
-                      (if (and (= (:component-file shape) (:id file)) ;; Main instances should exist only in local file
-                               (:main-instance shape))                ;; but check anyway
-                        (conj components (:component-id shape))
-                        components)))
-                  []
-                  (into ids-to-delete all-children))
-          [])
+         components-to-delete
+         (reduce (fn [components id]
+                   (let [shape (get objects id)]
+                     (if (and (= (:component-file shape) (:id data)) ;; Main instances should exist only in local file
+                              (:main-instance shape))                ;; but check anyway
+                       (conj components (:component-id shape))
+                       components)))
+                 []
+                 (into ids-to-delete all-children))
 
-        ids-set (set ids-to-delete)
 
-        guides-to-delete
-        (->> (:guides page)
-             (vals)
-             (filter #(contains? ids-set (:frame-id %)))
-             (map :id))
+         ids-set (set ids-to-delete)
 
-        changes (reduce (fn [changes guide-id]
-                          (pcb/set-flow changes guide-id nil))
-                        changes
-                        guides-to-delete)
+         guides-to-delete
+         (->> (:guides page)
+              (vals)
+              (filter #(contains? ids-set (:frame-id %)))
+              (map :id))
 
-        changes (reduce (fn [changes component-id]
+         changes (reduce (fn [changes guide-id]
+                           (pcb/set-flow changes guide-id nil))
+                         changes
+                         guides-to-delete)
+
+         changes (reduce (fn [changes component-id]
                           ;; It's important to delete the component before the main instance, because we
                           ;; need to store the instance position if we want to restore it later.
-                          (pcb/delete-component changes component-id (:id page)))
-                        changes
-                        components-to-delete)
+                           (pcb/delete-component changes component-id (:id page)))
+                         changes
+                         components-to-delete)
 
-        changes (-> changes
-                    (generate-update-shape-flags ids-to-hide objects {:hidden true})
-                    (pcb/remove-objects all-children {:ignore-touched true})
-                    (pcb/remove-objects ids-to-delete {:ignore-touched ignore-touched})
-                    (pcb/remove-objects empty-parents)
-                    (pcb/resize-parents all-parents)
-                    (pcb/update-shapes groups-to-unmask
-                                       (fn [shape]
-                                         (assoc shape :masked-group false)))
-                    (pcb/update-shapes (map :id interacting-shapes)
-                                       (fn [shape]
-                                         (d/update-when shape :interactions
-                                                        (fn [interactions]
-                                                          (into []
-                                                                (remove #(and (ctsi/has-destination %)
-                                                                              (contains? ids-to-delete (:destination %))))
-                                                                interactions))))))]
-    [all-parents changes]))
+         changes (-> changes
+                     (generate-update-shape-flags ids-to-hide objects {:hidden true})
+                     (pcb/remove-objects all-children {:ignore-touched true})
+                     (pcb/remove-objects ids-to-delete {:ignore-touched ignore-touched})
+                     (pcb/remove-objects empty-parents)
+                     (pcb/resize-parents all-parents)
+                     (pcb/update-shapes groups-to-unmask
+                                        (fn [shape]
+                                          (assoc shape :masked-group false)))
+                     (pcb/update-shapes (map :id interacting-shapes)
+                                        (fn [shape]
+                                          (d/update-when shape :interactions
+                                                         (fn [interactions]
+                                                           (into []
+                                                                 (remove #(and (ctsi/has-destination %)
+                                                                               (contains? ids-to-delete (:destination %))))
+                                                                 interactions))))))]
+     [all-parents changes])))
 
 
 (defn generate-relocate
@@ -255,7 +259,7 @@
 
         child-heads-ids (map :id child-heads)
 
-        variant-heads (filter ctk/is-variant? child-heads)
+        variant-shapes (filter ctk/is-variant? shapes)
 
         component-main-parent
         (ctn/find-component-main objects parent false)
@@ -339,7 +343,19 @@
                      (map :id)))
 
         index-cell-data  (when to-index (ctl/get-cell-by-index parent to-index))
-        cell (or cell (and index-cell-data [(:row index-cell-data) (:column index-cell-data)]))]
+        cell (or cell (and index-cell-data [(:row index-cell-data) (:column index-cell-data)]))
+
+
+        ;; Parents that are a variant-container that becomes empty
+        empty-variant-cont (reduce
+                            (fn [to-delete parent-id]
+                              (let [parent (get objects parent-id)]
+                                (if (and (ctk/is-variant-container? parent)
+                                         (empty? (remove (set ids) (:shapes parent))))
+                                  (conj to-delete (:id parent))
+                                  to-delete)))
+                            #{}
+                            (remove #(= % parent-id) all-parents))]
 
     (-> changes
         ;; Remove layout-item properties when moving a shape outside a layout
@@ -368,82 +384,11 @@
 
         ;; Remove variant info and rename when moving outside a variant-container
         (cond-> (not (ctk/is-variant-container? parent))
-          ((fn [changes]
-             (reduce
-              (fn [changes shape]
-                (let [new-name (str/replace (:variant-name shape) #", " " / ")
-                      [cpath cname] (cfh/parse-path-name new-name)]
-                  (-> changes
-                      (pcb/update-component (:component-id shape)
-                                            #(-> (dissoc % :variant-id :variant-properties)
-                                                 (assoc :name cname
-                                                        :path cpath))
-                                            {:apply-changes-local-library? true})
-                      (pcb/update-shapes [(:id shape)]
-                                         #(-> (dissoc % :variant-id :variant-name)
-                                              (assoc :name new-name))))))
-              changes
-              variant-heads))))
+          (clvp/generate-make-shapes-no-variant variant-shapes))
 
         ;; Add variant info and rename when moving into a different variant-container
         (cond-> (ctk/is-variant-container? parent)
-          ((fn [changes]
-             (let [get-base-name      #(if (some? (:variant-name %))
-                                         (str/replace (:variant-name %) #", " " / ")
-                                         (:name %))
-
-                   calc-num-props     #(-> %
-                                           get-base-name
-                                           cfh/split-path
-                                           count)
-
-                   max-path-items     (apply max (map calc-num-props child-heads))
-
-                   first-comp-id      (->> parent
-                                           :shapes
-                                           first
-                                           (get objects)
-                                           :component-id)
-
-                   data               (pcb/get-library-data changes)
-                   variant-properties (get-in data [:components first-comp-id :variant-properties])
-                   num-props          (count variant-properties)
-                   num-new-props      (if (< max-path-items num-props)
-                                        0
-                                        (- max-path-items num-props))
-
-                   changes            (nth
-                                       (iterate #(clv/generate-add-new-property % (:id parent)) changes)
-                                       num-new-props)]
-               (reduce
-                (fn [changes shape]
-                  (if (= (:id parent) (:variant-id shape))
-                    changes ;; do nothing if we aren't changing the parent
-                    (let [base-name           (get-base-name shape)
-
-                          ;; we need to get the updated library data to have access to the current properties
-                          data                (pcb/get-library-data changes)
-
-                          props               (clv/path-to-properties
-                                               base-name
-                                               (get-in data [:components first-comp-id :variant-properties]))
-
-                          variant-name        (clv/properties-to-name props)
-                          [cpath cname]       (cfh/parse-path-name (:name parent))]
-
-                      (-> (pcb/update-component changes
-                                                (:component-id shape)
-                                                #(assoc % :variant-id (:id parent)
-                                                        :variant-properties props
-                                                        :name cname
-                                                        :path cpath)
-                                                {:apply-changes-local-library? true})
-                          (pcb/update-shapes [(:id shape)]
-                                             #(assoc % :variant-id (:id parent)
-                                                     :variant-name variant-name
-                                                     :name (:name parent)))))))
-                changes
-                child-heads)))))
+          (clvp/generate-make-shapes-variant child-heads parent))
 
         ;; Move the shapes
         (pcb/change-parent parent-id
@@ -518,7 +463,11 @@
           (pcb/update-shapes ids #(assoc % :blocked true)))
 
         ;; Resize parent containers that need to
-        (pcb/resize-parents parents))))
+        (pcb/resize-parents parents)
+
+        ;; Remove parents when are a variant-container that becomes empty
+        (cond-> (seq empty-variant-cont)
+          (#(second (generate-delete-shapes % empty-variant-cont {})))))))
 
 (defn change-show-in-viewer
   [shape hide?]

common/src/app/common/logic/variant_properties.cljc

@@ -0,0 +1,201 @@
+;; 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.logic.variant-properties
+  (: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.types.component :as ctk]
+   [app.common.types.components-list :as ctcl]
+   [app.common.types.variant :as ctv]
+   [cuerdas.core :as str]))
+
+(defn generate-update-property-name
+  [changes variant-id pos new-name]
+  (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]
+              (pcb/update-component
+               changes (:id component)
+               #(assoc-in % [:variant-properties pos :name] new-name)
+               {:apply-changes-local-library? true}))
+            changes
+            related-components)))
+
+
+(defn generate-remove-property
+  [changes variant-id 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/remove-at-index props 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-update-property-value
+  [changes component-id pos value]
+  (let [data      (pcb/get-library-data changes)
+        component (ctcl/get-component data component-id true)
+        main-id   (:main-instance-id component)
+        name      (-> (:variant-properties component)
+                      (update pos assoc :value value)
+                      ctv/properties-to-name)]
+    (-> changes
+        (pcb/update-component component-id #(assoc-in % [:variant-properties pos :value] value)
+                              {:apply-changes-local-library? true})
+        (pcb/update-shapes [main-id] #(assoc % :variant-name name)))))
+
+
+(defn generate-add-new-property
+  [changes variant-id & {:keys [fill-values? property-name]}]
+  (let [data               (pcb/get-library-data changes)
+        objects            (pcb/get-objects changes)
+        related-components (cfv/find-variant-components data objects variant-id)
+
+        props              (-> related-components last :variant-properties)
+        next-prop-num      (ctv/next-property-number props)
+        property-name      (or property-name (str ctv/property-prefix next-prop-num))
+
+        [_ changes]
+        (reduce (fn [[num changes] component]
+                  (let [main-id      (:main-instance-id component)
+
+                        update-props #(-> (d/nilv % [])
+                                          (conj {:name property-name
+                                                 :value (if fill-values? (str ctv/value-prefix num) "")}))
+
+                        update-name #(if fill-values?
+                                       (if (str/empty? %)
+                                         (str ctv/value-prefix num)
+                                         (str % ", " ctv/value-prefix num))
+                                       %)]
+                    [(inc num)
+                     (-> changes
+                         (pcb/update-component (:id component)
+                                               #(update % :variant-properties update-props)
+                                               {:apply-changes-local-library? true})
+                         (pcb/update-shapes [main-id] #(update % :variant-name update-name)))]))
+                [1 changes]
+                related-components)]
+    changes))
+
+(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)]
+    (-> changes
+        (pcb/update-component (:component-id shape)
+                              #(-> (dissoc % :variant-id :variant-properties)
+                                   (assoc :name cname
+                                          :path cpath))
+                              {:apply-changes-local-library? true})
+        (pcb/update-shapes [(:id shape)]
+                           #(-> (dissoc % :variant-id :variant-name)
+                                (assoc :name new-name))))))
+
+(defn generate-make-shapes-no-variant
+  [changes shapes]
+  (reduce generate-make-shape-no-variant changes shapes))
+
+
+(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)
+        props     (ctv/merge-properties base-properties
+                                        (:variant-properties component))
+        new-props (- min-props
+                     (+ (count props)
+                        (if add-name? 1 0)))
+        props     (ctv/add-new-props props (repeat new-props ""))]
+
+    (if add-name?
+      (ctv/add-new-prop props (:name component))
+      props)))
+
+(defn- create-new-properties-from-non-variant
+  [shape min-props container-name base-properties]
+  (let [;; Remove container name from shape name if present
+        shape-name (ctv/remove-prefix (:name shape) container-name)]
+    (ctv/path-to-properties shape-name base-properties min-props)))
+
+
+(defn generate-make-shapes-variant
+  [changes shapes variant-container]
+  (let [data           (pcb/get-library-data changes)
+        objects        (pcb/get-objects changes)
+        variant-id     (:id variant-container)
+
+        ;; If we are cut-pasting a variant-container, this will be null
+        ;; because it hasn't any shapes yet
+        first-comp-id  (->> variant-container
+                            :shapes
+                            first
+                            (get objects)
+                            :component-id)
+
+        base-props     (->> (get-in data [:components first-comp-id :variant-properties])
+                            (map #(assoc % :value "")))
+        num-base-props (count base-props)
+
+        [cpath cname]  (cfh/parse-path-name (:name variant-container))
+        container-name (:name variant-container)
+
+        create-new-properties
+        (fn [shape min-props]
+          (if (ctk/is-variant? shape)
+            (create-new-properties-from-variant shape min-props data container-name base-props)
+            (create-new-properties-from-non-variant shape min-props container-name base-props)))
+
+        total-props    (reduce (fn [m shape]
+                                 (max m (count (create-new-properties shape num-base-props))))
+                               0
+                               shapes)
+
+        num-new-props  (if (or (zero? num-base-props)
+                               (< total-props num-base-props))
+                         0
+                         (- total-props num-base-props))
+
+        changes        (nth
+                        (iterate #(generate-add-new-property % variant-id) changes)
+                        num-new-props)
+
+        changes        (pcb/update-shapes changes (map :id shapes)
+                                          #(assoc % :variant-id variant-id
+                                                  :name (:name variant-container)))]
+    (reduce
+     (fn [changes shape]
+       (let [component (ctcl/get-component data (:component-id shape) true)]
+         (if (or (zero? num-base-props)                  ;; do nothing if there are no base props
+                 (and (= variant-id (:variant-id shape)) ;; or we are only moving the shape inside its parent (it is
+                      (not (:deleted component))))       ;; the same parent and the component isn't deleted)
+           changes
+           (let [props               (create-new-properties shape total-props)
+                 variant-name        (ctv/properties-to-name props)]
+             (-> (pcb/update-component changes
+                                       (:component-id shape)
+                                       #(assoc % :variant-id variant-id
+                                               :variant-properties props
+                                               :name cname
+                                               :path cpath)
+                                       {:apply-changes-local-library? true})
+                 (pcb/update-shapes [(:id shape)]
+                                    #(assoc % :variant-name variant-name)))))))
+     changes
+     shapes)))

common/src/app/common/logic/variants.cljc

@@ -1,160 +1,70 @@
-;; 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.logic.variants
   (:require
-   [app.common.data :as d]
-   [app.common.data.macros :as dm]
    [app.common.files.changes-builder :as pcb]
    [app.common.files.helpers :as cfh]
-   [app.common.types.components-list :as ctcl]
-   [cuerdas.core :as str]))
+   [app.common.files.variant :as cfv]
+   [app.common.logic.libraries :as cll]
+   [app.common.logic.variant-properties :as clvp]
+   [app.common.types.container :as ctn]
+   [app.common.types.file :as ctf]
+   [app.common.types.variant :as ctv]))
 
 
+(defn- generate-path
+  [path objects base-id shape]
+  (let [get-type #(case %
+                    :frame :container
+                    :group :container
+                    :rect  :shape
+                    :circle :shape
+                    :bool :shape
+                    :path :shape
+                    %)]
+    (if (= base-id (:id shape))
+      path
+      (generate-path (str path " " (:name shape) (get-type (:type shape))) objects base-id (get objects (:parent-id shape))))))
 
-(def property-prefix "Property")
-(def property-regex (re-pattern (str property-prefix "(\\d+)")))
-(def value-prefix "Value")
+(defn generate-add-new-variant
+  [changes shape variant-id new-component-id new-shape-id prop-num]
+  (let [data                (pcb/get-library-data changes)
+        objects             (pcb/get-objects changes)
+        component-id        (:component-id shape)
+        value               (str ctv/value-prefix
+                                 (-> (cfv/extract-properties-values data objects variant-id)
+                                     last
+                                     :value
+                                     count
+                                     inc))
 
-(defn find-related-components
-  "Find a list of the components thet belongs to this variant-id"
-  [data objects variant-id]
-  (->> (dm/get-in objects [variant-id :shapes])
-       (map #(dm/get-in objects [% :component-id]))
-       (map #(ctcl/get-component data % true))
-       reverse))
-
-
-(defn properties-to-name
-  "Transform the properties into a name, with the values separated by comma"
-  [properties]
-  (->> properties
-       (map :value)
-       (remove str/empty?)
-       (str/join ", ")))
-
-
-(defn next-property-number
-  "Returns the next property number, to avoid duplicates on the property names"
-  [properties]
-  (let [numbers (keep
-                 #(some->> (:name %) (re-find property-regex) second d/parse-integer)
-                 properties)
-        max-num (if (seq numbers)
-                  (apply max numbers)
-                  0)]
-    (inc (max max-num (count properties)))))
-
-
-(defn path-to-properties
-  "From a list of properties and a name with path, assign each token of the
-   path as value of a different property"
-  [path properties]
-  (let [next-prop-num  (next-property-number properties)
-        cpath          (cfh/split-path path)
-        assigned       (mapv #(assoc % :value (nth cpath %2 "")) properties (range))
-        remaining      (drop (count properties) cpath)
-        new-properties (map-indexed (fn [i v] {:name (str property-prefix (+ next-prop-num i))
-                                               :value v}) remaining)]
-    (into assigned new-properties)))
-
-(defn- dashes-to-end
-  [property-values]
-  (let [dashes (if (some #(= % "--") property-values) ["--"] [])]
-    (concat (remove #(= % "--") property-values) dashes)))
-
-
-(defn extract-properties-values
-  [data objects variant-id]
-  (->> (find-related-components data objects variant-id)
-       (mapcat :variant-properties)
-       (group-by :name)
-       (map (fn [[k v]]
-              {:name k
-               :value (->> v
-                           (map #(if (str/empty? (:value %)) "--" (:value %)))
-                           distinct
-                           dashes-to-end)}))))
-
-
-(defn generate-update-property-name
-  [changes variant-id pos new-name]
-  (let [data               (pcb/get-library-data changes)
-        objects            (pcb/get-objects changes)
-        related-components (find-related-components data objects variant-id)]
-    (reduce (fn [changes component]
-              (pcb/update-component
-               changes (:id component)
-               #(assoc-in % [:variant-properties pos :name] new-name)
-               {:apply-changes-local-library? true}))
-            changes
-            related-components)))
-
-
-(defn generate-remove-property
-  [changes variant-id pos]
-  (let [data               (pcb/get-library-data changes)
-        objects            (pcb/get-objects changes)
-        related-components (find-related-components data objects variant-id)]
-    (reduce (fn [changes component]
-              (let [props   (:variant-properties component)
-                    props   (d/remove-at-index props pos)
-                    main-id (:main-instance-id component)
-                    name    (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-update-property-value
-  [changes component-id pos value]
-  (let [data      (pcb/get-library-data changes)
-        component (ctcl/get-component data component-id true)
-        main-id   (:main-instance-id component)
-        name      (-> (:variant-properties component)
-                      (update pos assoc :value value)
-                      properties-to-name)]
+        [new-shape changes] (-> changes
+                                (cll/generate-duplicate-component
+                                 {:data data}
+                                 component-id
+                                 new-component-id
+                                 {:new-shape-id new-shape-id :apply-changes-local-library? true}))]
     (-> changes
-        (pcb/update-component component-id #(assoc-in % [:variant-properties pos :value] value)
-                              {:apply-changes-local-library? true})
-        (pcb/update-shapes [main-id] #(assoc % :variant-name name)))))
+        (clvp/generate-update-property-value new-component-id prop-num value)
+        (pcb/change-parent (:parent-id shape) [new-shape] 0))))
 
+(defn generate-keep-touched
+  [changes new-shape original-shape original-shapes page libraries]
+  (let [objects      (pcb/get-objects changes)
+        new-path-map (into {}
+                           (map (fn [shape] {(generate-path "" objects (:id new-shape) shape) shape}))
+                           (cfh/get-children-with-self objects (:id new-shape)))
 
-(defn generate-add-new-property
-  [changes variant-id & {:keys [fill-values?]}]
-  (let [data               (pcb/get-library-data changes)
-        objects            (pcb/get-objects changes)
-        related-components (find-related-components data objects variant-id)
-
-        props              (-> related-components first :variant-properties)
-        next-prop-num      (next-property-number props)
-        property-name      (str property-prefix next-prop-num)
-
-        [_ changes]
-        (reduce (fn [[num changes] component]
-                  (let [main-id      (:main-instance-id component)
-
-                        update-props #(-> (d/nilv % [])
-                                          (conj {:name property-name
-                                                 :value (if fill-values? (str value-prefix num) "")}))
-
-                        update-name #(if fill-values?
-                                       (if (str/empty? %)
-                                         (str value-prefix num)
-                                         (str % ", " value-prefix num))
-                                       %)]
-                    [(inc num)
-                     (-> changes
-                         (pcb/update-component (:id component)
-                                               #(update % :variant-properties update-props)
-                                               {:apply-changes-local-library? true})
-                         (pcb/update-shapes [main-id] #(update % :variant-name update-name)))]))
-                [1 changes]
-                related-components)]
-    changes))
+        orig-touched (filter (comp seq :touched) original-shapes)
+        orig-objects (into {} (map (juxt :id identity) original-shapes))
+        container    (ctn/make-container page :page)]
+    (reduce
+     (fn [changes touched-shape]
+       (let [path (generate-path "" orig-objects (:id original-shape) touched-shape)
+             related-shape  (get new-path-map path)
+             orig-ref-shape (ctf/find-ref-shape nil container libraries touched-shape)]
+         (if related-shape
+           (cll/update-attrs-on-switch
+            changes related-shape touched-shape new-shape original-shape orig-ref-shape container)
+           changes)))
+     changes
+     orig-touched)))
 

common/src/app/common/schema.cljc

@@ -9,6 +9,7 @@
   #?(:cljs (:require-macros [app.common.schema :refer [ignoring]]))
   (:require
    [app.common.data :as d]
+   [app.common.math :as mth]
    [app.common.pprint :as pp]
    [app.common.schema.generators :as sg]
    [app.common.schema.openapi :as-alias oapi]
@@ -27,10 +28,6 @@
    [malli.transform :as mt]
    [malli.util :as mu]))
 
-(defprotocol ILazySchema
-  (-validate [_ o])
-  (-explain [_ o]))
-
 (def default-options
   {:registry sr/default-registry})
 
@@ -50,10 +47,6 @@
   [s]
   (m/type-properties s))
 
-(defn- lazy-schema?
-  [s]
-  (satisfies? ILazySchema s))
-
 (defn schema
   [s]
   (if (schema? s)
@@ -110,8 +103,16 @@
   (malli.error/error-value exp {:malli.error/mask-valid-values '...}))
 
 (defn optional-keys
-  [schema]
-  (mu/optional-keys schema default-options))
+  ([schema]
+   (mu/optional-keys schema nil default-options))
+  ([schema keys]
+   (mu/optional-keys schema keys default-options)))
+
+(defn required-keys
+  ([schema]
+   (mu/required-keys schema nil default-options))
+  ([schema keys]
+   (mu/required-keys schema keys default-options)))
 
 (defn transformer
   [& transformers]
@@ -145,11 +146,30 @@
 ;;     :else
 ;;     o))
 
+(defn -transform-map-keys
+  ([f]
+   (let [xform (map (fn [[k v]] [(f k) v]))]
+     #(cond->> % (map? %) (into (empty %) xform))))
+  ([ks f]
+   (let [xform (map (fn [[k v]] [(cond-> k (contains? ks k) f) v]))]
+     #(cond->> % (map? %) (into (empty %) xform)))))
+
 (defn json-transformer
   []
-  (mt/transformer
-   (mt/json-transformer)
-   (mt/collection-transformer)))
+  (let [map-of-key-decoders (mt/-string-decoders)]
+    (mt/transformer
+     {:name :json
+      :decoders (-> (mt/-json-decoders)
+                    (assoc :map-of {:compile (fn [schema _]
+                                               (let [key-schema (some-> schema (m/children) (first))]
+                                                 (or (some-> key-schema (m/type) map-of-key-decoders
+                                                             (mt/-interceptor schema {}) (m/-intercepting)
+                                                             (m/-comp m/-keyword->string)
+                                                             (mt/-transform-if-valid key-schema)
+                                                             (-transform-map-keys))
+                                                     (-transform-map-keys m/-keyword->string))))}))
+      :encoders (mt/-json-encoders)}
+     (mt/collection-transformer))))
 
 (defn string-transformer
   []
@@ -205,6 +225,11 @@
   (let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
     (fn [v] (@vfn v))))
 
+(defn decode-fn
+  [s transformer]
+  (let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
+    (fn [v] (@vfn v))))
+
 (defn humanize-explain
   "Returns a string representation of the explain data structure"
   [{:keys [errors value]} & {:keys [length level]}]
@@ -250,38 +275,36 @@
   ([s] (lookup sr/default-registry s))
   ([registry s] (schema (mr/schema registry s))))
 
-(defn- fast-check
-  "A fast path for checking process, assumes the ILazySchema protocol
-  implemented on the provided `s` schema. Sould not be used directly."
-  [s type code hint value]
-  (when-not ^boolean (-validate s value)
-    (let [explain (-explain s value)]
-      (throw (ex-info hint {:type type
-                            :code code
-                            :hint hint
-                            ::explain explain}))))
-  value)
-
-(declare ^:private lazy-schema)
-
 (defn check-fn
   "Create a predefined check function"
   [s & {:keys [hint type code]}]
-  (let [schema (if (lazy-schema? s) s (lazy-schema s))
-        hint   (or ^boolean hint "check error")
-        type   (or ^boolean type :assertion)
-        code   (or ^boolean code :data-validation)]
-    (partial fast-check schema type code hint)))
+  (let [s          (schema s)
+        validator* (delay (m/validator s))
+        explainer* (delay (m/explainer s))
+        hint       (or ^boolean hint "check error")
+        type       (or ^boolean type :assertion)
+        code       (or ^boolean code :data-validation)]
+
+    (fn [value]
+      (let [validate-fn @validator*]
+        (when-not ^boolean (validate-fn value)
+          (let [explain-fn @explainer*
+                explain    (explain-fn value)]
+            (throw (ex-info hint {:type type
+                                  :code code
+                                  :hint hint
+                                  ::explain explain}))))
+        value))))
 
 (defn check
   "A helper intended to be used on assertions for validate/check the
-  schema over provided data. Raises an assertion exception."
-  [s value & {:keys [hint type code]}]
-  (let [s      (if (lazy-schema? s) s (lazy-schema s))
-        hint   (or ^boolean hint "check error")
-        type   (or ^boolean type :assertion)
-        code   (or ^boolean code :data-validation)]
-    (fast-check s type code hint value)))
+  schema over provided data. Raises an assertion exception.
+
+  Use only on non-performance sensitive code, because it creates the
+  check-fn instance all the time it is invoked."
+  [s value & {:as opts}]
+  (let [check-fn (check-fn s opts)]
+    (check-fn value)))
 
 (defn type-schema
   [& {:as params}]
@@ -295,11 +318,14 @@
   ([params]
    (cond
      (map? params)
-     (let [type (get params :type)]
+     (let [mdata (meta params)
+           type  (or (get mdata ::id)
+                     (get mdata ::type)
+                     (get params :type))]
        (assert (qualified-keyword? type) "expected qualified keyword for `type`")
        (let [s (m/-simple-schema params)]
          (swap! sr/registry assoc type s)
-         nil))
+         s))
 
      (vector? params)
      (let [mdata (meta params)
@@ -307,83 +333,19 @@
                      (get mdata ::type))]
        (assert (qualified-keyword? type) "expected qualified keyword to be on metadata")
        (swap! sr/registry assoc type params)
-       nil)
+       params)
 
      (m/into-schema? params)
      (let [type (m/-type params)]
-       (swap! sr/registry assoc type params))
+       (swap! sr/registry assoc type params)
+       params)
 
      :else
      (throw (ex-info "Invalid Arguments" {}))))
 
   ([type params]
-   (let [s (if (map? params)
-             (cond
-               (= :set (:type params))
-               (m/-collection-schema params)
-
-               (= :vector (:type params))
-               (m/-collection-schema params)
-
-               :else
-               (m/-simple-schema params))
-             params)]
-
-     (swap! sr/registry assoc type s)
-     nil)))
-
-(defn- lazy-schema
-  "Create ans instance of ILazySchema"
-  [s]
-  (let [schema      (schema s)
-        validator   (delay (m/validator schema))
-        explainer   (delay (m/explainer schema))]
-
-    (reify
-      m/AST
-      (-to-ast [_ options] (m/-to-ast schema options))
-
-      m/EntrySchema
-      (-entries [_] (m/-entries schema))
-      (-entry-parser [_] (m/-entry-parser schema))
-
-      m/Cached
-      (-cache [_] (m/-cache schema))
-
-      m/LensSchema
-      (-keep [_] (m/-keep schema))
-      (-get [_ key default] (m/-get schema key default))
-      (-set [_ key value] (m/-set schema key value))
-
-      m/Schema
-      (-validator [_]
-        (m/-validator schema))
-      (-explainer [_ path]
-        (m/-explainer schema path))
-      (-parser [_]
-        (m/-parser schema))
-      (-unparser [_]
-        (m/-unparser schema))
-      (-transformer [_ transformer method options]
-        (m/-transformer schema transformer method options))
-      (-walk [_ walker path options]
-        (m/-walk schema walker path options))
-      (-properties [_]
-        (m/-properties schema))
-      (-options [_]
-        (m/-options schema))
-      (-children [_]
-        (m/-children schema))
-      (-parent [_]
-        (m/-parent schema))
-      (-form [_]
-        (m/-form schema))
-
-      ILazySchema
-      (-validate [_ o]
-        (@validator o))
-      (-explain [_ o]
-        (@explainer o)))))
+   (swap! sr/registry assoc type params)
+   params))
 
 ;; --- BUILTIN SCHEMAS
 
@@ -809,7 +771,8 @@
 
           gen  (sg/one-of
                 (sg/small-int :max max :min min)
-                (sg/small-double :max max :min min))]
+                (->> (sg/small-double :max max :min min)
+                     (sg/fmap #(mth/precision % 2))))]
 
       {:pred pred
        :type-properties
@@ -874,7 +837,7 @@
   {:title "inst"
    :description "Satisfies Inst protocol"
    :error/message "should be an instant"
-   :gen/gen (->> (sg/small-int)
+   :gen/gen (->> (sg/small-int :min 0 :max 100000)
                  (sg/fmap (fn [v] (tm/parse-instant v))))
 
    :decode/string tm/parse-instant
@@ -884,6 +847,22 @@
    ::oapi/type "string"
    ::oapi/format "iso"}})
 
+(register!
+ {:type ::timestamp
+  :pred inst?
+  :type-properties
+  {:title "inst"
+   :description "Satisfies Inst protocol"
+   :error/message "should be an instant"
+   :gen/gen (->> (sg/small-int)
+                 (sg/fmap (fn [v] (tm/parse-instant v))))
+   :decode/string tm/parse-instant
+   :encode/string inst-ms
+   :decode/json tm/parse-instant
+   :encode/json inst-ms
+   ::oapi/type "string"
+   ::oapi/format "number"}})
+
 (register!
  {:type ::fn
   :pred fn?})

common/src/app/common/schema/generators.cljc

@@ -5,7 +5,7 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.schema.generators
-  (:refer-clojure :exclude [set subseq uuid filter map let boolean])
+  (:refer-clojure :exclude [set subseq uuid filter map let boolean vector])
   #?(:cljs (:require-macros [app.common.schema.generators]))
   (:require
    [app.common.schema.registry :as sr]
@@ -126,3 +126,7 @@
 (defn tuple
   [& opts]
   (apply tg/tuple opts))
+
+(defn vector
+  [& opts]
+  (apply tg/vector opts))

common/src/app/common/schema/test.cljc

@@ -56,13 +56,8 @@
              (str "(pass=TRUE, tests=" (:num-tests params)  ", seed=" (:seed params) ", elapsed=" time "ms)"))))
 
 (defmethod ct/report #?(:clj ::thrunk :cljs [:cljs.test/default ::thrunk])
-  [{:keys [::params] :as m}]
-  (let [smallest (-> params :shrunk :smallest vec)]
-    (println)
-    (println "Condition failed with the following params:")
-    (println "Seed:" (:seed params))
-    (println)
-    (pp/pprint smallest)))
+  [_]
+  nil)
 
 (defmethod ct/report #?(:clj ::trial :cljs [:cljs.test/default ::trial])
   [_]
@@ -76,9 +71,12 @@
   (let [tvar (get-testing-var)
         tsym (get-testing-sym tvar)
         res  (:result params)]
-    (println)
+
+    (println "---------------------------------------------------------")
     (println "Generative test:" (str "'" tsym "'")
              (str "(pass=FALSE, tests=" (:num-tests params)  ", seed=" (:seed params)  ")"))
+    (pp/pprint (:fail params))
+    (println "---------------------------------------------------------")
 
     (when (ex/exception? res)
       #?(:clj (ex/print-throwable res)

common/src/app/common/svg/path.cljc

@@ -40,76 +40,3 @@
              (map (fn [segment]
                     (.toPersistentMap ^js segment)))
              (parser/parse path-str)))))
-
-#?(:cljs
-   (defn content->buffer
-     "Converts the path content into binary format."
-     [content]
-     (let [total  (count content)
-           ssize  28
-           buffer (new js/ArrayBuffer (* total ssize))
-           dview  (new js/DataView buffer)]
-       (loop [index 0]
-         (when (< index total)
-           (let [segment (nth content index)
-                 offset  (* index ssize)]
-             (case (:command segment)
-               :move-to
-               (let [{:keys [x y]} (:params segment)]
-                 (.setInt16 dview   (+ offset 0) 1)
-                 (.setFloat32 dview (+ offset 20) x)
-                 (.setFloat32 dview (+ offset 24) y))
-               :line-to
-               (let [{:keys [x y]} (:params segment)]
-                 (.setInt16 dview   (+ offset 0) 2)
-                 (.setFloat32 dview (+ offset 20) x)
-                 (.setFloat32 dview (+ offset 24) y))
-               :curve-to
-               (let [{:keys [c1x c1y c2x c2y x y]} (:params segment)]
-                 (.setInt16 dview   (+ offset 0) 3)
-                 (.setFloat32 dview (+ offset 4) c1x)
-                 (.setFloat32 dview (+ offset 8) c1y)
-                 (.setFloat32 dview (+ offset 12) c2x)
-                 (.setFloat32 dview (+ offset 16) c2y)
-                 (.setFloat32 dview (+ offset 20) x)
-                 (.setFloat32 dview (+ offset 24) y))
-
-               :close-path
-               (.setInt16 dview (+ offset 0) 4))
-             (recur (inc index)))))
-       buffer)))
-
-#?(:cljs
-   (defn buffer->content
-     "Converts the a buffer to a path content vector"
-     [buffer]
-     (assert (instance? js/ArrayBuffer buffer) "expected ArrayBuffer instance")
-     (let [ssize  28
-           total  (/ (.-byteLength buffer) ssize)
-           dview  (new js/DataView buffer)]
-       (loop [index  0
-              result []]
-         (if (< index total)
-           (let [offset  (* index ssize)
-                 type    (.getInt16 dview (+ offset 0))
-                 command (case type
-                           1 :move-to
-                           2 :line-to
-                           3 :curve-to
-                           4 :close-path)
-                 params  (case type
-                           1 {:x (.getFloat32 dview (+ offset 20))
-                              :y (.getFloat32 dview (+ offset 24))}
-                           2 {:x (.getFloat32 dview (+ offset 20))
-                              :y (.getFloat32 dview (+ offset 24))}
-                           3 {:c1x (.getFloat32 dview (+ offset 4))
-                              :c1y (.getFloat32 dview (+ offset 8))
-                              :c2x (.getFloat32 dview (+ offset 12))
-                              :c2y (.getFloat32 dview (+ offset 16))
-                              :x   (.getFloat32 dview (+ offset 20))
-                              :y   (.getFloat32 dview (+ offset 24))}
-                           4 {})]
-             (recur (inc index)
-                    (conj result {:command command
-                                  :params params})))
-           result)))))

common/src/app/common/svg/path/bool.cljc

@@ -1,334 +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 app.common.svg.path.bool
-  (:require
-   [app.common.data :as d]
-   [app.common.geom.point :as gpt]
-   [app.common.geom.rect :as grc]
-   [app.common.geom.shapes.path :as gsp]
-   [app.common.svg.path.command :as upc]
-   [app.common.svg.path.subpath :as ups]))
-
-(defn add-previous
-  ([content]
-   (add-previous content nil))
-  ([content first]
-   (->> (d/with-prev content)
-        (mapv (fn [[cmd prev]]
-                (cond-> cmd
-                  (and (nil? prev) (some? first))
-                  (assoc :prev first)
-
-                  (some? prev)
-                  (assoc :prev (gsp/command->point prev))))))))
-
-(defn close-paths
-  "Removes the :close-path commands and replace them for line-to so we can calculate
-  the intersections"
-  [content]
-
-  (loop [head (first content)
-         content (rest content)
-         result []
-         last-move nil
-         last-p nil]
-
-    (if (nil? head)
-      result
-      (let [head-p (gsp/command->point head)
-            head (cond
-                   (and (= :close-path (:command head))
-                        (or (nil? last-p) ;; Ignore consecutive close-paths
-                            (< (gpt/distance last-p last-move) 0.01)))
-                   nil
-
-                   (= :close-path (:command head))
-                   (upc/make-line-to last-move)
-
-                   :else
-                   head)]
-
-        (recur (first content)
-               (rest content)
-               (cond-> result (some? head) (conj head))
-               (if (= :move-to (:command head))
-                 head-p
-                 last-move)
-               head-p)))))
-
-(defn- split-command
-  [cmd values]
-  (case (:command cmd)
-    :line-to  (gsp/split-line-to-ranges (:prev cmd) cmd values)
-    :curve-to (gsp/split-curve-to-ranges (:prev cmd) cmd values)
-    [cmd]))
-
-(defn split-ts [seg-1 seg-2]
-  (cond
-    (and (= :line-to (:command seg-1))
-         (= :line-to (:command seg-2)))
-    (gsp/line-line-intersect (gsp/command->line seg-1) (gsp/command->line seg-2))
-
-    (and (= :line-to (:command seg-1))
-         (= :curve-to (:command seg-2)))
-    (gsp/line-curve-intersect (gsp/command->line seg-1) (gsp/command->bezier seg-2))
-
-    (and (= :curve-to (:command seg-1))
-         (= :line-to (:command seg-2)))
-    (let [[seg-2' seg-1']
-          (gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->bezier seg-1))]
-      ;; Need to reverse because we send the arguments reversed
-      [seg-1' seg-2'])
-
-    (and (= :curve-to (:command seg-1))
-         (= :curve-to (:command seg-2)))
-    (gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2))
-
-    :else
-    [[] []]))
-
-(defn content-intersect-split
-  [content-a content-b sr-a sr-b]
-
-  (let [command->selrect (memoize gsp/command->selrect)]
-
-    (letfn [(overlap-segment-selrect?
-              [segment selrect]
-              (if (= :move-to (:command segment))
-                false
-                (let [r1 (command->selrect segment)]
-                  (grc/overlaps-rects? r1 selrect))))
-
-            (overlap-segments?
-              [seg-1 seg-2]
-              (if (or (= :move-to (:command seg-1))
-                      (= :move-to (:command seg-2)))
-                false
-                (let [r1 (command->selrect seg-1)
-                      r2 (command->selrect seg-2)]
-                  (grc/overlaps-rects? r1 r2))))
-
-            (split
-              [seg-1 seg-2]
-              (if (not (overlap-segments? seg-1 seg-2))
-                [seg-1]
-                (let [[ts-seg-1 _] (split-ts seg-1 seg-2)]
-                  (-> (split-command seg-1 ts-seg-1)
-                      (add-previous (:prev seg-1))))))
-
-            (split-segment-on-content
-              [segment content content-sr]
-
-              (if (overlap-segment-selrect? segment content-sr)
-                (->> content
-                     (filter #(overlap-segments? segment %))
-                     (reduce
-                      (fn [result current]
-                        (into [] (mapcat #(split % current)) result))
-                      [segment]))
-                [segment]))
-
-            (split-content
-              [content-a content-b sr-b]
-              (into []
-                    (mapcat #(split-segment-on-content % content-b sr-b))
-                    content-a))]
-
-      [(split-content content-a content-b sr-b)
-       (split-content content-b content-a sr-a)])))
-
-(defn is-segment?
-  [cmd]
-  (and (contains? cmd :prev)
-       (contains? #{:line-to :curve-to} (:command cmd))))
-
-(defn contains-segment?
-  [segment content content-sr content-geom]
-
-  (let [point (case (:command segment)
-                :line-to  (-> (gsp/command->line segment)
-                              (gsp/line-values 0.5))
-
-                :curve-to (-> (gsp/command->bezier segment)
-                              (gsp/curve-values 0.5)))]
-
-    (and (grc/contains-point? content-sr point)
-         (or
-          (gsp/is-point-in-geom-data? point content-geom)
-          (gsp/is-point-in-border? point content)))))
-
-(defn inside-segment?
-  [segment content-sr content-geom]
-  (let [point (case (:command segment)
-                :line-to  (-> (gsp/command->line segment)
-                              (gsp/line-values 0.5))
-
-                :curve-to (-> (gsp/command->bezier segment)
-                              (gsp/curve-values 0.5)))]
-
-    (and (grc/contains-point? content-sr point)
-         (gsp/is-point-in-geom-data? point content-geom))))
-
-(defn overlap-segment?
-  "Finds if the current segment is overlapping against other
-  segment meaning they have the same coordinates"
-  [segment content]
-
-  (let [overlap-single?
-        (fn [other]
-          (when (and (= (:command segment) (:command other))
-                     (contains? #{:line-to :curve-to} (:command segment)))
-
-            (case (:command segment)
-              :line-to (let [[p1 q1] (gsp/command->line segment)
-                             [p2 q2] (gsp/command->line other)]
-
-                         (when (or (and (< (gpt/distance p1 p2) 0.1)
-                                        (< (gpt/distance q1 q2) 0.1))
-                                   (and (< (gpt/distance p1 q2) 0.1)
-                                        (< (gpt/distance q1 p2) 0.1)))
-                           [segment other]))
-
-              :curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment)
-                              [p2 q2 h12 h22] (gsp/command->bezier other)]
-
-                          (when (or (and (< (gpt/distance p1 p2) 0.1)
-                                         (< (gpt/distance q1 q2) 0.1)
-                                         (< (gpt/distance h11 h12) 0.1)
-                                         (< (gpt/distance h21 h22) 0.1))
-
-                                    (and (< (gpt/distance p1 q2) 0.1)
-                                         (< (gpt/distance q1 p2) 0.1)
-                                         (< (gpt/distance h11 h22) 0.1)
-                                         (< (gpt/distance h21 h12) 0.1)))
-
-                            [segment other])))))]
-
-    (->> content
-         (d/seek overlap-single?)
-         (some?))))
-
-(defn fix-move-to
-  [content]
-  ;; Remove the field `:prev` and makes the necessaries `move-to`
-  ;; then clean the subpaths
-
-  (loop [current (first content)
-         content (rest content)
-         prev nil
-         result []]
-
-    (if (nil? current)
-      result
-
-      (let [result (if (not= (:prev current) prev)
-                     (conj result (upc/make-move-to (:prev current)))
-                     result)]
-        (recur (first content)
-               (rest content)
-               (gsp/command->point current)
-               (conj result (dissoc current :prev)))))))
-
-(defn create-union [content-a content-a-split content-b content-b-split sr-a sr-b]
-  ;; Pick all segments in content-a that are not inside content-b
-  ;; Pick all segments in content-b that are not inside content-a
-  (let [content-a-geom (gsp/content->geom-data content-a)
-        content-b-geom (gsp/content->geom-data content-b)
-
-        content
-        (concat
-         (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
-         (->> content-b-split (filter #(not (contains-segment? % content-a sr-a content-a-geom)))))
-
-        content-geom (gsp/content->geom-data content)
-
-        content-sr (gsp/content->selrect (fix-move-to content))
-
-        ;; Overlapping segments should be added when they are part of the border
-        border-content
-        (->> content-b-split
-             (filter #(and (contains-segment? % content-a sr-a content-a-geom)
-                           (overlap-segment? % content-a-split)
-                           (not (inside-segment? % content-sr content-geom)))))]
-
-    ;; Ensure that the output is always a vector
-    (d/concat-vec content border-content)))
-
-(defn create-difference [content-a content-a-split content-b content-b-split sr-a sr-b]
-  ;; Pick all segments in content-a that are not inside content-b
-  ;; Pick all segments in content b that are inside content-a
-  ;;  removing overlapping
-  (let [content-a-geom (gsp/content->geom-data content-a)
-        content-b-geom (gsp/content->geom-data content-b)]
-    (d/concat-vec
-     (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
-
-     ;; Reverse second content so we can have holes inside other shapes
-     (->> content-b-split
-          (filter #(and (contains-segment? % content-a sr-a content-a-geom)
-                        (not (overlap-segment? % content-a-split))))))))
-
-(defn create-intersection [content-a content-a-split content-b content-b-split sr-a sr-b]
-  ;; Pick all segments in content-a that are inside content-b
-  ;; Pick all segments in content-b that are inside content-a
-  (let [content-a-geom (gsp/content->geom-data content-a)
-        content-b-geom (gsp/content->geom-data content-b)]
-    (d/concat-vec
-     (->> content-a-split (filter #(contains-segment? % content-b sr-b content-b-geom)))
-     (->> content-b-split (filter #(contains-segment? % content-a sr-a content-a-geom))))))
-
-
-(defn create-exclusion [content-a content-b]
-  ;; Pick all segments
-  (d/concat-vec content-a content-b))
-
-(defn content-bool-pair
-  [bool-type content-a content-b]
-
-  (let [;; We need to reverse the second path when making a difference/intersection/exclude
-        ;; and both shapes are in the same direction
-        should-reverse? (and (not= :union bool-type)
-                             (= (ups/clockwise? content-b)
-                                (ups/clockwise? content-a)))
-
-        content-a (-> content-a
-                      (close-paths)
-                      (add-previous))
-
-        content-b (-> content-b
-                      (close-paths)
-                      (cond-> should-reverse? (ups/reverse-content))
-                      (add-previous))
-
-        sr-a (gsp/content->selrect content-a)
-        sr-b (gsp/content->selrect content-b)
-
-        ;; Split content in new segments in the intersection with the other path
-        [content-a-split content-b-split] (content-intersect-split content-a content-b sr-a sr-b)
-        content-a-split (->> content-a-split add-previous (filter is-segment?))
-        content-b-split (->> content-b-split add-previous (filter is-segment?))
-
-        bool-content
-        (case bool-type
-          :union        (create-union        content-a content-a-split content-b content-b-split sr-a sr-b)
-          :difference   (create-difference   content-a content-a-split content-b content-b-split sr-a sr-b)
-          :intersection (create-intersection content-a content-a-split content-b content-b-split sr-a sr-b)
-          :exclude      (create-exclusion    content-a-split content-b-split))]
-
-    (->> (fix-move-to bool-content)
-         (ups/close-subpaths))))
-
-(defn content-bool
-  [bool-type contents]
-  ;; We apply the boolean operation in to each pair and the result to the next
-  ;; element
-  (if (seq contents)
-    (->> contents
-         (reduce (partial content-bool-pair bool-type))
-         (into []))
-    []))
-

common/src/app/common/svg/path/command.cljc

@@ -1,204 +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 app.common.svg.path.command
-  (:require
-   [app.common.data :as d]
-   [app.common.geom.point :as gpt]))
-
-(defn command->point
-  ([prev-pos {:keys [relative params] :as command}]
-   (let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
-     (if relative
-       (-> prev-pos (update :x + x) (update :y + y))
-       (command->point command))))
-
-  ([command]
-   (when command
-     (let [{:keys [x y]} (:params command)]
-       (gpt/point x y)))))
-
-
-(defn make-move-to [to]
-  {:command :move-to
-   :relative false
-   :params {:x (:x to)
-            :y (:y to)}})
-
-(defn make-line-to [to]
-  {:command :line-to
-   :relative false
-   :params {:x (:x to)
-            :y (:y to)}})
-
-(defn make-curve-params
-  ([point]
-   (make-curve-params point point point))
-
-  ([point handler] (make-curve-params point handler point))
-
-  ([point h1 h2]
-   {:x (:x point)
-    :y (:y point)
-    :c1x (:x h1)
-    :c1y (:y h1)
-    :c2x (:x h2)
-    :c2y (:y h2)}))
-
-(defn update-curve-to
-  [command h1 h2]
-  (let [params {:x (-> command :params :x)
-                :y (-> command :params :y)
-                :c1x (:x h1)
-                :c1y (:y h1)
-                :c2x (:x h2)
-                :c2y (:y h2)}]
-    (-> command
-        (assoc :command :curve-to)
-        (assoc :params params))))
-
-(defn make-curve-to
-  [to h1 h2]
-  {:command :curve-to
-   :relative false
-   :params (make-curve-params to h1 h2)})
-
-(defn update-handler
-  [command prefix point]
-  (let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
-    (-> command
-        (assoc-in [:params cox] (:x point))
-        (assoc-in [:params coy] (:y point)))))
-
-(defn apply-content-modifiers
-  "Apply to content a map with point translations"
-  [content modifiers]
-  (letfn [(apply-to-index [content [index params]]
-            (if (contains? content index)
-              (cond-> content
-                (and
-                 (or (:c1x params) (:c1y params) (:c2x params) (:c2y params))
-                 (= :line-to (get-in content [index :command])))
-
-                (-> (assoc-in [index :command] :curve-to)
-                    (assoc-in [index :params]
-                              (make-curve-params
-                               (get-in content [index :params])
-                               (get-in content [(dec index) :params]))))
-
-                (:x params) (update-in [index :params :x] + (:x params))
-                (:y params) (update-in [index :params :y] + (:y params))
-
-                (:c1x params) (update-in [index :params :c1x] + (:c1x params))
-                (:c1y params) (update-in [index :params :c1y] + (:c1y params))
-
-                (:c2x params) (update-in [index :params :c2x] + (:c2x params))
-                (:c2y params) (update-in [index :params :c2y] + (:c2y params)))
-              content))]
-    (let [content (if (vector? content) content (into [] content))]
-      (reduce apply-to-index content modifiers))))
-
-(defn get-handler [{:keys [params] :as command} prefix]
-  (let [cx (d/prefix-keyword prefix :x)
-        cy (d/prefix-keyword prefix :y)]
-    (when (and command
-               (contains? params cx)
-               (contains? params cy))
-      (gpt/point (get params cx)
-                 (get params cy)))))
-
-(defn content->handlers
-  "Retrieve a map where for every point will retrieve a list of
-  the handlers that are associated with that point.
-  point -> [[index, prefix]]"
-  [content]
-  (->> (d/with-prev content)
-       (d/enumerate)
-       (mapcat (fn [[index [cur-cmd pre-cmd]]]
-                 (if (and pre-cmd (= :curve-to (:command cur-cmd)))
-                   (let [cur-pos (command->point cur-cmd)
-                         pre-pos (command->point pre-cmd)]
-                     (-> [[pre-pos [index :c1]]
-                          [cur-pos [index :c2]]]))
-                   [])))
-
-       (group-by first)
-       (d/mapm #(mapv second %2))))
-
-(defn point-indices
-  [content point]
-  (->> (d/enumerate content)
-       (filter (fn [[_ cmd]] (= point (command->point cmd))))
-       (mapv (fn [[index _]] index))))
-
-(defn handler-indices
-  "Return an index where the key is the positions and the values the handlers"
-  [content point]
-  (->> (d/with-prev content)
-       (d/enumerate)
-       (mapcat (fn [[index [cur-cmd pre-cmd]]]
-                 (if (and (some? pre-cmd) (= :curve-to (:command cur-cmd)))
-                   (let [cur-pos (command->point cur-cmd)
-                         pre-pos (command->point pre-cmd)]
-                     (cond-> []
-                       (= pre-pos point) (conj [index :c1])
-                       (= cur-pos point) (conj [index :c2])))
-                   [])))))
-
-(defn opposite-index
-  "Calculates the opposite index given a prefix and an index"
-  [content index prefix]
-
-  (let [point (if (= prefix :c2)
-                (command->point (nth content index))
-                (command->point (nth content (dec index))))
-
-        point->handlers (content->handlers content)
-
-        handlers (->> point
-                      (point->handlers)
-                      (filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)))))]
-
-    (cond
-      (= (count handlers) 1)
-      (->> handlers first)
-
-      (and (= :c1 prefix) (= (count content) index))
-      [(dec index) :c2]
-
-      :else nil)))
-
-
-(defn get-commands
-  "Returns the commands involving a point with its indices"
-  [content point]
-  (->> (d/enumerate content)
-       (filterv (fn [[_ cmd]] (= (command->point cmd) point)))))
-
-
-(defn prefix->coords [prefix]
-  (case prefix
-    :c1 [:c1x :c1y]
-    :c2 [:c2x :c2y]
-    nil))
-
-(defn handler->point [content index prefix]
-  (when (and (some? index)
-             (some? prefix)
-             (contains? content index))
-    (let [[cx cy] (prefix->coords prefix)]
-      (if (= :curve-to (get-in content [index :command]))
-        (gpt/point (get-in content [index :params cx])
-                   (get-in content [index :params cy]))
-
-        (gpt/point (get-in content [index :params :x])
-                   (get-in content [index :params :y]))))))
-
-(defn handler->node [content index prefix]
-  (if (= prefix :c1)
-    (command->point (get content (dec index)))
-    (command->point (get content index))))
-

common/src/app/common/svg/path/legacy_parser1.cljs

@@ -1,324 +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 app.common.svg.path.legacy-parser1
-  "The first SVG Path parser implementation.
-
-  Written in a mix of CLJS and JS code and used in production until
-  1.19, used mainly for tests."
-  (:require
-   [app.common.data :as d]
-   [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.path :as upg]
-   [app.common.svg :as csvg]
-   [app.common.svg.path.arc-to-bezier :as a2b]
-   [app.common.svg.path.command :as upc]
-   [cuerdas.core :as str]))
-
-(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
-
-;; Matches numbers for path values allows values like... -.01, 10, +12.22
-;; 0 and 1 are special because can refer to flags
-(def num-regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
-
-(def flag-regex #"[01]")
-
-(defn extract-params [cmd-str extract-commands]
-  (loop [result []
-         extract-idx 0
-         current {}
-         remain (-> cmd-str (subs 1) (str/trim))]
-
-    (let [[param type] (nth extract-commands extract-idx)
-          regex (case type
-                  :flag     flag-regex
-                  #_:number num-regex)
-          match (re-find regex remain)]
-
-      (if match
-        (let [value (-> match first csvg/fix-dot-number d/read-string)
-              remain (str/replace-first remain regex "")
-              current (assoc current param value)
-              extract-idx (inc extract-idx)
-              [result current extract-idx]
-              (if (>=  extract-idx (count extract-commands))
-                [(conj result current) {} 0]
-                [result current extract-idx])]
-          (recur result
-                 extract-idx
-                 current
-                 remain))
-        (cond-> result
-          (seq current) (conj current))))))
-
-;; Path specification
-;; https://www.w3.org/TR/SVG11/paths.html
-(defmulti parse-command (comp str/upper first))
-
-(defmethod parse-command "M" [cmd]
-  (let [relative (str/starts-with? cmd "m")
-        param-list (extract-params cmd [[:x :number]
-                                        [:y :number]])]
-
-    (into [{:command :move-to
-            :relative relative
-            :params (first param-list)}]
-
-          (for [params (rest param-list)]
-            {:command :line-to
-             :relative relative
-             :params params}))))
-
-(defmethod parse-command "Z" [_]
-  [{:command :close-path}])
-
-(defmethod parse-command "L" [cmd]
-  (let [relative (str/starts-with? cmd "l")
-        param-list (extract-params cmd [[:x :number]
-                                        [:y :number]])]
-    (for [params param-list]
-      {:command :line-to
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "H" [cmd]
-  (let [relative (str/starts-with? cmd "h")
-        param-list (extract-params cmd [[:value :number]])]
-    (for [params param-list]
-      {:command :line-to-horizontal
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "V" [cmd]
-  (let [relative (str/starts-with? cmd "v")
-        param-list (extract-params cmd [[:value :number]])]
-    (for [params param-list]
-      {:command :line-to-vertical
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "C" [cmd]
-  (let [relative (str/starts-with? cmd "c")
-        param-list (extract-params cmd [[:c1x :number]
-                                        [:c1y :number]
-                                        [:c2x :number]
-                                        [:c2y :number]
-                                        [:x   :number]
-                                        [:y   :number]])]
-    (for [params param-list]
-      {:command :curve-to
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "S" [cmd]
-  (let [relative (str/starts-with? cmd "s")
-        param-list (extract-params cmd [[:cx :number]
-                                        [:cy :number]
-                                        [:x  :number]
-                                        [:y  :number]])]
-    (for [params param-list]
-      {:command :smooth-curve-to
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "Q" [cmd]
-  (let [relative (str/starts-with? cmd "q")
-        param-list (extract-params cmd [[:cx :number]
-                                        [:cy :number]
-                                        [:x   :number]
-                                        [:y   :number]])]
-    (for [params param-list]
-      {:command :quadratic-bezier-curve-to
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "T" [cmd]
-  (let [relative (str/starts-with? cmd "t")
-        param-list (extract-params cmd [[:x :number]
-                                        [:y :number]])]
-    (for [params param-list]
-      {:command :smooth-quadratic-bezier-curve-to
-       :relative relative
-       :params params})))
-
-(defmethod parse-command "A" [cmd]
-  (let [relative (str/starts-with? cmd "a")
-        param-list (extract-params cmd [[:rx :number]
-                                        [:ry :number]
-                                        [:x-axis-rotation :number]
-                                        [:large-arc-flag :flag]
-                                        [:sweep-flag :flag]
-                                        [:x :number]
-                                        [:y :number]])]
-    (for [params param-list]
-      {:command :elliptical-arc
-       :relative relative
-       :params params})))
-
-(defn smooth->curve
-  [{:keys [params]} pos handler]
-  (let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
-    {:c1x c1x
-     :c1y c1y
-     :c2x (:cx params)
-     :c2y (:cy params)}))
-
-(defn quadratic->curve
-  [sp ep cp]
-  (let [cp1 (-> (gpt/to-vec sp cp)
-                (gpt/scale (/ 2 3))
-                (gpt/add sp))
-
-        cp2 (-> (gpt/to-vec ep cp)
-                (gpt/scale (/ 2 3))
-                (gpt/add ep))]
-
-    {:c1x (:x cp1)
-     :c1y (:y cp1)
-     :c2x (:x cp2)
-     :c2y (:y cp2)}))
-
-(defn arc->beziers*
-  [from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation]
-  (a2b/calculateBeziers from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation))
-
-(defn arc->beziers [from-p command]
-  (let [to-command
-        (fn [[_ _ c1x c1y c2x c2y x y]]
-          {:command :curve-to
-           :relative (:relative command)
-           :params {:c1x c1x :c1y c1y
-                    :c2x c2x :c2y c2y
-                    :x   x   :y   y}})
-
-        {from-x :x from-y :y} from-p
-        {:keys [rx ry x-axis-rotation large-arc-flag sweep-flag x y]} (:params command)
-        result (arc->beziers* from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation)]
-    (mapv to-command result)))
-
-(defn simplify-commands
-  "Removes some commands and convert relative to absolute coordinates"
-  [commands]
-  (let [simplify-command
-        ;; prev-pos   : previous position for the current path. Necessary for relative commands
-        ;; prev-start : previous move-to necessary for Z commands
-        ;; prev-cc    : previous command control point for cubic beziers
-        ;; prev-qc    : previous command control point for quadratic curves
-        (fn [[result prev-pos prev-start prev-cc prev-qc] [command _prev]]
-          (let [command (assoc command :prev-pos prev-pos)
-
-                command
-                (cond-> command
-                  (:relative command)
-                  (-> (assoc :relative false)
-                      (d/update-in-when [:params :c1x] + (:x prev-pos))
-                      (d/update-in-when [:params :c1y] + (:y prev-pos))
-
-                      (d/update-in-when [:params :c2x] + (:x prev-pos))
-                      (d/update-in-when [:params :c2y] + (:y prev-pos))
-
-                      (d/update-in-when [:params :cx] + (:x prev-pos))
-                      (d/update-in-when [:params :cy] + (:y prev-pos))
-
-                      (d/update-in-when [:params :x] + (:x prev-pos))
-                      (d/update-in-when [:params :y] + (:y prev-pos))
-
-                      (cond->
-                       (= :line-to-horizontal (:command command))
-                        (d/update-in-when [:params :value] + (:x prev-pos))
-
-                        (= :line-to-vertical (:command command))
-                        (d/update-in-when [:params :value] + (:y prev-pos)))))
-
-                params (:params command)
-                orig-command command
-
-                command
-                (cond-> command
-                  (= :line-to-horizontal (:command command))
-                  (-> (assoc :command :line-to)
-                      (update :params dissoc :value)
-                      (assoc-in [:params :x] (:value params))
-                      (assoc-in [:params :y] (:y prev-pos)))
-
-                  (= :line-to-vertical (:command command))
-                  (-> (assoc :command :line-to)
-                      (update :params dissoc :value)
-                      (assoc-in [:params :y] (:value params))
-                      (assoc-in [:params :x] (:x prev-pos)))
-
-                  (= :smooth-curve-to (:command command))
-                  (-> (assoc :command :curve-to)
-                      (update :params dissoc :cx :cy)
-                      (update :params merge (smooth->curve command prev-pos prev-cc)))
-
-                  (= :quadratic-bezier-curve-to (:command command))
-                  (-> (assoc :command :curve-to)
-                      (update :params dissoc :cx :cy)
-                      (update :params merge (quadratic->curve prev-pos (gpt/point params) (gpt/point (:cx params) (:cy params)))))
-
-                  (= :smooth-quadratic-bezier-curve-to (:command command))
-                  (-> (assoc :command :curve-to)
-                      (update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc)))))
-
-                result (if (= :elliptical-arc (:command command))
-                         (into result (arc->beziers prev-pos command))
-                         (conj result command))
-
-                next-cc (case (:command orig-command)
-                          :smooth-curve-to
-                          (gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
-
-                          :curve-to
-                          (gpt/point (get-in orig-command [:params :c2x]) (get-in orig-command [:params :c2y]))
-
-                          (:line-to-horizontal :line-to-vertical)
-                          (gpt/point (get-in command [:params :x]) (get-in command [:params :y]))
-
-                          (gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
-
-                next-qc (case (:command orig-command)
-                          :quadratic-bezier-curve-to
-                          (gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
-
-                          :smooth-quadratic-bezier-curve-to
-                          (upg/calculate-opposite-handler prev-pos prev-qc)
-
-                          (gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
-
-                next-pos (if (= :close-path (:command command))
-                           prev-start
-                           (upc/command->point prev-pos command))
-
-                next-start (if (= :move-to (:command command)) next-pos prev-start)]
-
-            [result next-pos next-start next-cc next-qc]))
-
-        start (first commands)
-        start (cond-> start
-                (:relative start)
-                (assoc :relative false))
-
-        start-pos (gpt/point (:params start))]
-
-    (->> (map vector (rest commands) commands)
-         (reduce simplify-command [[start] start-pos start-pos start-pos start-pos])
-         (first))))
-
-(defn parse [path-str]
-  (if (empty? path-str)
-    path-str
-    (let [clean-path-str
-          (-> path-str
-              (str/trim)
-              ;; Change "commas" for spaces
-              (str/replace #"," " ")
-              ;; Remove all consecutive spaces
-              (str/replace #"\s+" " "))
-          commands (re-seq commands-regex clean-path-str)]
-      (-> (mapcat parse-command commands)
-          (simplify-commands)))))
-

common/src/app/common/svg/path/legacy_parser2.cljc

@@ -12,15 +12,23 @@
   (:require
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.path :as upg]
    [app.common.math :as mth]
    [app.common.svg :as csvg]
-   [app.common.svg.path.command :as upc]
+   [app.common.types.path.helpers :as path.helpers]
+   [app.common.types.path.segment :as path.segment]
    [cuerdas.core :as str]))
 
 (def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
 (def regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
 
+(defn- get-point
+  "Get a point for a segment"
+  [prev-pos {:keys [relative params] :as segment}]
+  (let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
+    (if relative
+      (-> prev-pos (update :x + x) (update :y + y))
+      (path.helpers/segment->point segment))))
+
 (defn extract-params
   [data pattern]
   (loop [result  []
@@ -185,7 +193,7 @@
 
 (defn smooth->curve
   [{:keys [params]} pos handler]
-  (let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
+  (let [{c1x :x c1y :y} (path.segment/calculate-opposite-handler pos handler)]
     {:c1x c1x
      :c1y c1y
      :c2x (:cx params)
@@ -413,7 +421,7 @@
 
                   (= :smooth-quadratic-bezier-curve-to (:command command))
                   (-> (assoc :command :curve-to)
-                      (update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc)))))
+                      (update :params merge (quadratic->curve prev-pos (gpt/point params) (path.segment/calculate-opposite-handler prev-pos prev-qc)))))
 
                 result (if (= :elliptical-arc (:command command))
                          (into result (arc->beziers prev-pos command))
@@ -436,13 +444,13 @@
                           (gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
 
                           :smooth-quadratic-bezier-curve-to
-                          (upg/calculate-opposite-handler prev-pos prev-qc)
+                          (path.segment/calculate-opposite-handler prev-pos prev-qc)
 
                           (gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
 
                 next-pos (if (= :close-path (:command command))
                            prev-start
-                           (upc/command->point prev-pos command))
+                           (get-point prev-pos command))
 
                 next-start (if (= :move-to (:command command)) next-pos prev-start)]
 

common/src/app/common/svg/shapes_builder.cljc

@@ -22,6 +22,7 @@
    [app.common.schema :as sm :refer [max-safe-int min-safe-int]]
    [app.common.svg :as csvg]
    [app.common.svg.path :as path]
+   [app.common.types.path.segment :as path.segm]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
    [cuerdas.core :as str]))
@@ -220,9 +221,9 @@
     (let [transform (csvg/parse-transform (:transform attrs))
           content   (cond-> (path/parse (:d attrs))
                       (some? transform)
-                      (gsh/transform-content transform))
+                      (path.segm/transform-content transform))
 
-          selrect    (gsh/content->selrect content)
+          selrect    (path.segm/content->selrect content)
           points     (grc/rect->points selrect)
           origin     (gpt/negate (gpt/point svg-data))
           attrs      (-> (dissoc attrs :d :transform)
@@ -435,16 +436,12 @@
 
         attrs
         (-> attrs
-            (cond-> linecap
-              (dissoc :strokeLinecap))
             (cond-> (some? color)
               (dissoc :stroke :strokeWidth :strokeOpacity))
             (update
              :style
              (fn [style]
                (-> style
-                   (cond-> linecap
-                     (dissoc :strokeLinecap))
                    (cond-> (some? color)
                      (dissoc :stroke :strokeWidth :strokeOpacity)))))
             (d/without-nils))]
@@ -461,12 +458,14 @@
 
       (and (some? linecap) (cfh/path-shape? shape)
            (or (= linecap :round) (= linecap :square)))
+
       (assoc :stroke-cap-start linecap
-             :stroke-cap-end linecap)
+             :stroke-cap-end linecap
+             :stroke-linecap linecap)
 
       (d/any-key? (dm/get-in shape [:strokes 0])
                   :strokeColor :strokeOpacity :strokeWidth
-                  :strokeCapStart :strokeCapEnd)
+                  :strokeLinecap :strokeCapStart :strokeCapEnd)
       (assoc-in [:strokes 0 :stroke-style] :svg))))
 
 (defn setup-opacity [shape]

common/src/app/common/test_helpers/components.cljc

@@ -31,7 +31,7 @@
      "Need that root is already a frame"
      (cfh/frame-shape? root))
 
-    (let [[_new-root _new-shapes updated-shapes]
+    (let [[_new-root updated-shapes]
           (ctn/convert-shape-in-component root (:objects page) (:id file))
 
           updated-root (first updated-shapes) ; Can't use new-root because it has a new id
@@ -54,8 +54,7 @@
                                         :name name
                                         :path path
                                         :main-instance-id (:id updated-root)
-                                        :main-instance-page (:id page)
-                                        :shapes updated-shapes))))))))
+                                        :main-instance-page (:id page)))))))))
 
 (defn update-component
   [file component-label & {:keys [] :as params}]
@@ -98,7 +97,6 @@
                                      component
                                      (:data library)
                                      (gpt/point 100 100)
-                                     true
                                      {:force-id (thi/new-id! copy-root-label)
                                       :force-frame-id frame-id})
 

common/src/app/common/test_helpers/compositions.cljc

@@ -85,7 +85,7 @@
    & {:keys [component-params root-params child-params]}]
   ;; Generated shape tree:
   ;; {:root-label} [:name Frame1]    # [Component :component-label]
-  ;;     :child-label [:name Rect1]  
+  ;;     :child-label [:name Rect1]
   (-> file
       (add-frame-with-child root-label child-label :frame-params root-params :child-params child-params)
       (thc/make-component component-label root-label component-params)))
@@ -95,7 +95,7 @@
    & {:keys [component-params main-root-params main-child-params copy-root-params]}]
   ;; Generated shape tree:
   ;; {:main-root-label} [:name Frame1]       # [Component :component-label]
-  ;;     :main-child-label [:name Rect1]     
+  ;;     :main-child-label [:name Rect1]
   ;;
   ;; :copy-root-label [:name Frame1]         #--> [Component :component-label] :main-root-label
   ;;     <no-label> [:name Rect1]            ---> :main-child-label
@@ -113,9 +113,9 @@
    & {:keys [component-params root-params child-params-list]}]
   ;; Generated shape tree:
   ;; {:root-label} [:name Frame1]            # [Component :component-label]
-  ;;     :child1-label [:name Rect1]         
-  ;;     :child2-label [:name Rect2]         
-  ;;     :child3-label [:name Rect3]         
+  ;;     :child1-label [:name Rect1]
+  ;;     :child2-label [:name Rect2]
+  ;;     :child3-label [:name Rect3]
   (as-> file $
     (add-frame $ root-label root-params)
     (reduce (fn [file [index [label params]]]
@@ -134,9 +134,9 @@
    & {:keys [component-params main-root-params main-child-params-list copy-root-params]}]
   ;; Generated shape tree:
   ;;  {:root-label} [:name Frame1]            # [Component :component-label]
-  ;;      :child1-label [:name Rect1]         
-  ;;      :child2-label [:name Rect2]         
-  ;;      :child3-label [:name Rect3]         
+  ;;      :child1-label [:name Rect1]
+  ;;      :child2-label [:name Rect2]
+  ;;      :child3-label [:name Rect3]
   ;;
   ;;  :copy-root-label [:name Frame1]         #--> [Component :component-label] :root-label
   ;;      <no-label> [:name Rect1]            ---> :child1-label
@@ -156,7 +156,7 @@
    & {:keys [component1-params root1-params main1-child-params component2-params main2-root-params nested-head-params]}]
   ;; Generated shape tree:
   ;; {:main1-root-label} [:name Frame1]      # [Component :component1-label]
-  ;;     :main1-child-label [:name Rect1]    
+  ;;     :main1-child-label [:name Rect1]
   ;;
   ;; {:main2-root-label} [:name Frame2]      # [Component :component2-label]
   ;;     :nested-head-label [:name Frame1]   @--> [Component :component1-label] :main1-root-label
@@ -183,7 +183,7 @@
    & {:keys [component1-params root1-params main1-child-params component2-params main2-root-params nested-head-params copy2-root-params]}]
   ;; Generated shape tree:
   ;; {:main1-root-label} [:name Frame1]      # [Component :component1-label]
-  ;;     :main1-child-label [:name Rect1]    
+  ;;     :main1-child-label [:name Rect1]
   ;;
   ;; {:main2-root-label} [:name Frame2]      # [Component :component2-label]
   ;;     :nested-head-label [:name Frame1]   @--> [Component :component1-label] :main1-root-label
@@ -336,8 +336,7 @@
                        file
                        {file-id file}
                        (ctn/make-container container :page)
-                       (:id shape)
-                       true))
+                       (:id shape)))
         file' (thf/apply-changes file changes)]
     (if propagate-fn
       (propagate-fn file')
@@ -361,7 +360,7 @@
                                                 (:objects page)
                                                 #{(-> (ths/get-shape file shape-tag :page-label page-label)
                                                       :id)}
-                                                {:components-v2 true})
+                                                {})
         file' (thf/apply-changes file changes)]
     (if propagate-fn
       (propagate-fn file')
@@ -380,7 +379,7 @@
                                             (gpt/point 0 0)         ;; delta
                                             {(:id  file) file}      ;; libraries
                                             (:data file)            ;; library-data
-                                            (:id file))             ;; file-id 
+                                            (:id file))             ;; file-id
             (cll/generate-duplicate-changes-update-indices (:objects page)  ;; objects
                                                            #{(:id shape)}))
         file' (thf/apply-changes file changes)]

common/src/app/common/test_helpers/files.cljc

@@ -23,28 +23,32 @@
 
 (defn sample-file
   [label & {:keys [page-label name view-only?] :as params}]
-  (binding [ffeat/*current* #{"components/v2"}]
-    (let [params (cond-> params
-                   label
-                   (assoc :id (thi/new-id! label))
+  (let [params
+        (cond-> params
+          label
+          (assoc :id (thi/new-id! label))
 
-                   page-label
-                   (assoc :page-id (thi/new-id! page-label))
+          (nil? name)
+          (assoc :name "Test file")
 
-                   (nil? name)
-                   (assoc :name "Test file"))
+          :always
+          (assoc :features ffeat/default-features))
 
-          file (-> (ctf/make-file (dissoc params :page-label))
-                   (assoc :features #{"components/v2"})
-                   (assoc :permissions {:can-edit (not (true? view-only?))}))
+        opts
+        (cond-> {}
+          page-label
+          (assoc :page-id (thi/new-id! page-label)))
 
-          page (-> file
-                   :data
-                   (ctpl/pages-seq)
-                   (first))]
+        file (-> (ctf/make-file params opts)
+                 (assoc :permissions {:can-edit (not (true? view-only?))}))
 
-      (with-meta file
-        {:current-page-id (:id page)}))))
+        page (-> file
+                 :data
+                 (ctpl/pages-seq)
+                 (first))]
+
+    (with-meta file
+      {:current-page-id (:id page)})))
 
 (defn validate-file!
   ([file] (validate-file! file {}))

common/src/app/common/test_helpers/variants.cljc

@@ -22,4 +22,18 @@
         (thc/make-component component1-label root1-label)
         (thc/update-component component1-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "Value1"}]})
         (thc/make-component component2-label root2-label)
-        (thc/update-component component2-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "Value1"}]}))))
+        (thc/update-component component2-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "Value2"}]}))))
+
+(defn add-variant-two-properties
+  [file variant-label component1-label root1-label component2-label root2-label
+   & {:keys []}]
+  (let [file (ths/add-sample-shape file variant-label :type :frame :is-variant-container true)
+        variant-id (thi/id variant-label)]
+
+    (-> file
+        (ths/add-sample-shape root2-label :type :frame :parent-label variant-label :variant-id variant-id :variant-name "p1v2, p2v2")
+        (ths/add-sample-shape root1-label :type :frame :parent-label variant-label :variant-id variant-id :variant-name "p1v1, p2v1")
+        (thc/make-component component1-label root1-label)
+        (thc/update-component component1-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "p1v1"} {:name "Property2" :value "p2v1"}]})
+        (thc/make-component component2-label root2-label)
+        (thc/update-component component2-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "p1v2"} {:name "Property2" :value "p2v2"}]}))))

common/src/app/common/types/color.cljc

@@ -41,17 +41,18 @@
   [o]
   (and (string? o) (some? (re-matches rgb-color-re o))))
 
-(def ^:private type:rgb-color
-  {:type :string
-   :pred rgb-color-string?
-   :type-properties
-   {:title "rgb-color"
-    :description "RGB Color String"
-    :error/message "expected a valid RGB color"
-    :error/code "errors.invalid-rgb-color"
-    :gen/gen (generate-rgb-color)
-    ::oapi/type "integer"
-    ::oapi/format "int64"}})
+(def schema:rgb-color
+  (sm/register!
+   {:type ::rgb-color
+    :pred rgb-color-string?
+    :type-properties
+    {:title "rgb-color"
+     :description "RGB Color String"
+     :error/message "expected a valid RGB color"
+     :error/code "errors.invalid-rgb-color"
+     :gen/gen (generate-rgb-color)
+     ::oapi/type "integer"
+     ::oapi/format "int64"}}))
 
 (def schema:image-color
   [:map {:title "ImageColor"}
@@ -76,7 +77,7 @@
    [:stops
     [:vector {:min 1 :gen/max 2}
      [:map {:title "GradientStop"}
-      [:color ::rgb-color]
+      [:color schema:rgb-color]
       [:opacity {:optional true} [:maybe ::sm/safe-number]]
       [:offset ::sm/safe-number]]]]])
 
@@ -86,7 +87,7 @@
    [:name {:optional true} :string]
    [:path {:optional true} [:maybe :string]]
    [:value {:optional true} [:maybe :string]]
-   [:color {:optional true} [:maybe ::rgb-color]]
+   [:color {:optional true} [:maybe schema:rgb-color]]
    [:opacity {:optional true} [:maybe ::sm/safe-number]]
    [:modified-at {:optional true} ::sm/inst]
    [:ref-id {:optional true} ::sm/uuid]
@@ -103,12 +104,17 @@
   [:and
    [:map {:title "RecentColor"}
     [:opacity {:optional true} [:maybe ::sm/safe-number]]
-    [:color {:optional true} [:maybe ::rgb-color]]
+    [:color {:optional true} [:maybe schema:rgb-color]]
     [:gradient {:optional true} [:maybe schema:gradient]]
     [:image {:optional true} [:maybe schema:image-color]]]
    [::sm/contains-any {:strict true} [:color :gradient :image]]])
 
-(sm/register! ::rgb-color type:rgb-color)
+;; Same as color but with :id prop required
+(def schema:library-color
+  [:and
+   (sm/required-keys schema:color-attrs [:id])
+   [::sm/contains-any {:strict true} [:color :gradient :image]]])
+
 (sm/register! ::color schema:color)
 (sm/register! ::gradient schema:gradient)
 (sm/register! ::image-color schema:image-color)
@@ -119,10 +125,13 @@
   (sm/lazy-validator schema:color))
 
 (def check-color
-  (sm/check-fn schema:color :hint "expected valid color struct"))
+  (sm/check-fn schema:color :hint "expected valid color"))
+
+(def check-library-color
+  (sm/check-fn schema:library-color :hint "expected valid library color"))
 
 (def check-recent-color
-  (sm/check-fn schema:recent-color))
+  (sm/check-fn schema:recent-color :hint "expected valid recent color"))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; HELPERS

common/src/app/common/types/component.cljc

@@ -10,6 +10,7 @@
    [app.common.schema :as sm]
    [app.common.types.page :as ctp]
    [app.common.types.plugins :as ctpg]
+   [app.common.types.variant :as ctv]
    [cuerdas.core :as str]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -17,17 +18,19 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def schema:component
-  [:map
-   [:id ::sm/uuid]
-   [:name :string]
-   [:path {:optional true} [:maybe :string]]
-   [:modified-at {:optional true} ::sm/inst]
-   [:objects {:gen/max 10 :optional true} ::ctp/objects]
-   [:main-instance-id ::sm/uuid]
-   [:main-instance-page ::sm/uuid]
-   [:plugin-data {:optional true} ::ctpg/plugin-data]])
-
-(sm/register! ::component schema:component)
+  (sm/register!
+   ^{::sm/type ::component}
+   [:merge
+    [:map
+     [:id ::sm/uuid]
+     [:name :string]
+     [:path {:optional true} [:maybe :string]]
+     [:modified-at {:optional true} ::sm/inst]
+     [:objects {:gen/max 10 :optional true} ctp/schema:objects]
+     [:main-instance-id ::sm/uuid]
+     [:main-instance-page ::sm/uuid]
+     [:plugin-data {:optional true} ctpg/schema:plugin-data]]
+    ctv/schema:variant-component]))
 
 (def check-component
   (sm/check-fn schema:component))
@@ -90,8 +93,8 @@
    :constraints-h           :constraints-group
    :constraints-v           :constraints-group
    :fixed-scroll            :constraints-group
-   :bool-type               :bool-group
-   :bool-content            :bool-group
+   :bool-type               :content-group
+   :bool-content            :content-group
    :exports                 :exports-group
    :grids                   :grids-group
 
@@ -179,10 +182,8 @@
        (= (:component-file shape) file-id)))
 
 (defn is-main-of?
-  [shape-main shape-inst components-v2]
-  (or (= (:shape-ref shape-inst) (:id shape-main))
-      (and (= (:shape-ref shape-inst) (:shape-ref shape-main))
-           (not components-v2))))
+  [shape-main shape-inst]
+  (= (:shape-ref shape-inst) (:id shape-main)))
 
 (defn main-instance?
   "Check if this shape is the root of the main instance of some
@@ -286,7 +287,7 @@
 
 (defn get-component-root
   [component]
-  (if (true? (:main-instance-id component))
+  (if (some? (:main-instance-id component))
     (get-in component [:objects (:main-instance-id component)])
     (get-in component [:objects (:id component)])))
 
@@ -333,8 +334,6 @@
   (let [parent (get objects (:parent-id shape))]
     ;; We don't want to change the structure of component copies
     (and (not (in-component-copy-not-head? shape))
-         ;; We don't want to duplicate variants
-         (not (is-variant? shape))
          ;; Non instance, non copy. We allow
          (or (not (instance-head? shape))
              (not (in-component-copy? parent))))))

common/src/app/common/types/components_list.cljc

@@ -34,20 +34,12 @@
   (assoc component :modified-at (dt/now)))
 
 (defn add-component
-  [fdata {:keys [id name path main-instance-id main-instance-page shapes annotation variant-id variant-properties]}]
-  (let [components-v2  (dm/get-in fdata [:options :components-v2])
-        fdata          (update fdata :components assoc id (touch {:id id :name name :path path}))]
-    (if components-v2
-      (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)
-        variant-properties (update-in [:components id] assoc :variant-properties variant-properties))
-
-      (let [wrap-object-fn cfeat/*wrap-with-objects-map-fn*]
-        (assoc-in fdata [:components id :objects]
-                  (->> shapes
-                       (d/index-by :id)
-                       (wrap-object-fn)))))))
+  [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}))]
+    (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)
+      variant-properties (update-in [:components id] assoc :variant-properties variant-properties))))
 
 (defn mod-component
   [file-data {:keys [id name path main-instance-id main-instance-page objects annotation variant-id variant-properties modified-at]}]
@@ -119,7 +111,6 @@
   [file-data component-id f & args]
   (d/update-in-when file-data [:components component-id] #(-> (apply f % args)
                                                               (touch))))
-
 (defn set-component-modified
   [file-data component-id]
   (update-component file-data component-id identity))

common/src/app/common/types/container.cljc

@@ -41,7 +41,7 @@
    [:map-of {:gen/max 10} ::sm/uuid :map]]
   [:plugin-data {:optional true} ::ctpg/plugin-data]])
 
-(def check-container!
+(def check-container
   (sm/check-fn ::container))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -62,9 +62,9 @@
 
 (defn get-container
   [file type id]
-  (dm/assert! (map? file))
-  (dm/assert! (contains? valid-container-types type))
-  (dm/assert! (uuid? id))
+  (assert (map? file))
+  (assert (contains? valid-container-types type))
+  (assert (uuid? id))
 
   (-> (if (= type :page)
         (ctpl/get-page file id)
@@ -74,13 +74,9 @@
 (defn get-shape
   [container shape-id]
 
-  (dm/assert!
-   "expected valid container"
-   (check-container! container))
-
-  (dm/assert!
-   "expected valid uuid for `shape-id`"
-   (uuid? shape-id))
+  (assert (check-container container))
+  (assert (uuid? shape-id)
+          "expected valid uuid for `shape-id`")
 
   (-> container
       (get :objects)
@@ -267,67 +263,8 @@
         new-children       (->> (cfh/get-children objects (:id root))
                                 (map #(dissoc % :component-root)))]
     [(assoc new-root :id new-id)
-     nil
      (into [new-root] new-children)]))
 
-(defn make-component-shape ;; Only used for components v1
-  "Clone the shape and all children. Generate new ids and detach
-  from parent and frame. Update the original shapes to have links
-  to the new ones."
-  [shape objects file-id components-v2]
-  (assert (nil? (:component-id shape)))
-  (assert (nil? (:component-file shape)))
-  (assert (nil? (:shape-ref shape)))
-  (let [frame-ids-map (volatile! {})
-
-        ;; Ensure that the component root is not an instance
-        update-new-shape (fn [new-shape original-shape]
-                           (when (= (:type original-shape) :frame)
-                             (vswap! frame-ids-map assoc (:id original-shape) (:id new-shape)))
-
-                           (cond-> new-shape
-                             true
-                             (dissoc :component-root)
-
-                             (nil? (:parent-id new-shape))
-                             (dissoc :component-id
-                                     :component-file
-                                     :shape-ref)))
-
-        ;; Make the original shape an instance of the new component.
-        ;; If one of the original shape children already was a component
-        ;; instance, maintain this instanceness untouched.
-        update-original-shape (fn [original-shape new-shape]
-                                (cond-> original-shape
-                                  (nil? (:shape-ref original-shape))
-                                  (-> (assoc :shape-ref (:id new-shape))
-                                      (dissoc :touched))
-
-                                  (nil? (:parent-id new-shape))
-                                  (assoc :component-id (:id new-shape)
-                                         :component-file file-id
-                                         :component-root true)
-
-                                  (and (nil? (:parent-id new-shape)) components-v2)
-                                  (assoc :main-instance true)
-
-                                  (some? (:parent-id new-shape))
-                                  (dissoc :component-root)))
-
-        [new-root-shape new-shapes updated-shapes]
-        (ctst/clone-shape shape
-                          nil
-                          objects
-                          :update-new-shape update-new-shape
-                          :update-original-shape update-original-shape)
-
-        ;; If frame-id points to a shape inside the component, remap it to the
-        ;; corresponding new frame shape. If not, set it to nil.
-        remap-frame-id (fn [shape]
-                         (update shape :frame-id #(get @frame-ids-map % nil)))]
-
-    [new-root-shape (map remap-frame-id new-shapes) updated-shapes]))
-
 (defn remove-swap-keep-attrs
   "Remove flex children properties except the fit-content for flex layouts. These are properties
   that we don't have to propagate to copies but will be respected when swapping components"
@@ -352,20 +289,18 @@
   WARNING: This process does not remap media references (on fills, strokes, ...); that is
   delegated to an async process on the backend side that checks unreferenced shapes and
   automatically creates correct references."
-  ([page component library-data position components-v2]
-   (make-component-instance page component library-data position components-v2 {}))
-  ([page component library-data position components-v2
+  ([page component library-data position]
+   (make-component-instance page component library-data position {}))
+  ([page component library-data position
     {:keys [main-instance? force-id force-frame-id keep-ids?]
      :or {main-instance? false force-id nil force-frame-id nil keep-ids? false}}]
-   (let [component-page  (when components-v2
-                           (ctpl/get-page library-data (:main-instance-page component)))
+   (let [component-page  (ctpl/get-page library-data (:main-instance-page component))
+
+         component-shape (-> (get-shape component-page (:main-instance-id component))
+                             (assoc :parent-id nil) ;; On v2 we force parent-id to nil in order to behave like v1
+                             (assoc :frame-id uuid/zero)
+                             (remove-swap-keep-attrs))
 
-         component-shape (if components-v2
-                           (-> (get-shape component-page (:main-instance-id component))
-                               (assoc :parent-id nil) ;; On v2 we force parent-id to nil in order to behave like v1
-                               (assoc :frame-id uuid/zero)
-                               (remove-swap-keep-attrs))
-                           (get-shape component (:id component)))
 
          orig-pos        (gpt/point (:x component-shape) (:y component-shape))
          delta           (gpt/subtract position orig-pos)
@@ -395,8 +330,7 @@
          update-new-shape
          (fn [new-shape original-shape]
            (let [new-name (:name new-shape)
-                 root?    (or (ctk/instance-root? original-shape)   ; If shape is inside a component (not components-v2)
-                              (nil? (:parent-id original-shape)))]  ; we detect it by having no parent)
+                 root?    (ctk/instance-root? original-shape)]
 
              (when root?
                (vswap! unames conj new-name))
@@ -417,10 +351,8 @@
                main-instance?
                (dissoc :shape-ref)
 
-               (and (not main-instance?)
-                    (or components-v2                        ; In v1, shape-ref points to the remote instance
-                        (nil? (:shape-ref original-shape)))) ; in v2, shape-ref points to the near instance
-               (assoc :shape-ref (:id original-shape))
+               (not main-instance?)
+               (assoc :shape-ref (:id original-shape)) ; shape-ref points to the near instance
 
                (nil? (:parent-id original-shape))
                (assoc :component-id (:id component)
@@ -428,14 +360,14 @@
                       :component-root true
                       :name new-name)
 
-               (or (some? (:parent-id original-shape)) ; On v2 we have removed the parent-id for component roots (see above)
+               (or (some? (:parent-id original-shape)) ; On v2 we have removed the parent-id for component roots
                    (some? component-frame))
                (dissoc :component-root))))
 
          [new-shape new-shapes _]
          (ctst/clone-shape component-shape
                            frame-id
-                           (if components-v2 (:objects component-page) (:objects component))
+                           (:objects component-page)
                            :update-new-shape update-new-shape
                            :force-id force-id
                            :keep-ids? keep-ids?
@@ -545,21 +477,39 @@
            no-changes?
            (and (every? #(= parent-id (:parent-id %)) children)
                 (not pasting?))
+
+           ;; When pasting frames, children have the frames and their children
+           ;; We need to check only the top shapes
+           children-ids (set (map :id children))
+           top-children (remove #(contains? children-ids (:parent-id %)) children)
+
+           ;; Are all the top-children a main-instance of a component?
            all-main?
-           (every? ctk/main-instance? children)
+           (every? ctk/main-instance? top-children)
 
            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 variant-container, all the items should be main
-                    (or all-main? (not (ctk/is-variant-container? parent)))
                     ;; If we are moving into a main component, no descendant can be main
-                    (or (nil? any-main-descendant) (not (ctk/main-instance? parent)))))
+                    (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?)))
          [parent-id (get-frame parent-id)]
          (recur (:parent-id parent) objects children pasting? libraries))))))
 
@@ -602,8 +552,7 @@
 
         ;; TODO: the check of :width and :height probably may be
         ;; removed after the check added in
-        ;; data/workspace/modifiers/check-delta function. Better check
-        ;; it and test toroughly when activating components-v2 mode.
+        ;; data/workspace/modifiers/check-delta function.
         in-copy?
         (ctk/in-component-copy? shape)
 

common/src/app/common/types/file.cljc

@@ -83,6 +83,7 @@
   because sometimes we want to validate file without the data."
   [:map {:title "file"}
    [:id ::sm/uuid]
+   [:name :string]
    [:revn {:optional true} :int]
    [:vern {:optional true} :int]
    [:created-at {:optional true} ::sm/inst]
@@ -101,13 +102,15 @@
 (sm/register! ::media schema:media)
 (sm/register! ::colors schema:colors)
 (sm/register! ::typographies schema:typographies)
-
 (sm/register! ::media-object schema:media)
 
-(def check-file-data!
-  (sm/check-fn ::data))
+(def check-file
+  (sm/check-fn schema:file :hint "check error on validating file"))
 
-(def check-media-object!
+(def check-file-data
+  (sm/check-fn schema:data))
+
+(def check-media-object
   (sm/check-fn schema:media))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -127,40 +130,43 @@
                 (ctp/make-empty-page {:id page-id :name "Page 1"}))]
 
      (cond-> (assoc empty-file-data :id file-id)
-       (some? page-id)
+       (some? page)
        (ctpl/add-page page)
 
-       (contains? cfeat/*current* "components/v2")
-       (assoc-in [:options :components-v2] true)))))
+       :always
+       (update :options assoc :components-v2 true)))))
 
 (defn make-file
-  [{:keys [id project-id name revn is-shared features
-           ignore-sync-until modified-at deleted-at
-           create-page page-id]
-    :or {is-shared false revn 0 create-page true}}]
+  [{:keys [id project-id name revn is-shared features migrations
+           ignore-sync-until modified-at deleted-at]
+    :or {is-shared false revn 0}}
+
+   & {:keys [create-page page-id]
+      :or {create-page true}}]
 
   (let [id       (or id (uuid/next))
-
         data     (if create-page
                    (if page-id
                      (make-file-data id page-id)
                      (make-file-data id))
                    (make-file-data id nil))
 
-        file     {:id id
-                  :project-id project-id
-                  :name name
-                  :revn revn
-                  :vern 0
-                  :is-shared is-shared
-                  :version version
-                  :data data
-                  :features features
-                  :ignore-sync-until ignore-sync-until
-                  :modified-at modified-at
-                  :deleted-at deleted-at}]
+        file     (d/without-nils
+                  {:id id
+                   :project-id project-id
+                   :name name
+                   :revn revn
+                   :vern 0
+                   :is-shared is-shared
+                   :version version
+                   :data data
+                   :features features
+                   :migrations migrations
+                   :ignore-sync-until ignore-sync-until
+                   :modified-at modified-at
+                   :deleted-at deleted-at})]
 
-    (d/without-nils file)))
+    (check-file file)))
 
 ;; Helpers
 
@@ -221,48 +227,45 @@
   (ctpl/get-page file-data (:main-instance-page component)))
 
 (defn get-component-container
-  "Retrieve the container that holds the component shapes (the page in components-v2
-   or the component itself in v1 or deleted component)."
+  "Retrieve the container that holds the component shapes (the page
+   or the component itself on deleted component)."
   [file-data component]
-  (let [components-v2 (dm/get-in file-data [:options :components-v2])]
-    (if (and components-v2 (not (:deleted component)))
-      (let [component-page (get-component-page file-data component)]
-        (cfh/make-container component-page :page))
-      (cfh/make-container component :component))))
+  (if (not (:deleted component))
+    (let [component-page (get-component-page file-data component)]
+      (cfh/make-container component-page :page))
+    (cfh/make-container component :component)))
 
 (defn get-component-root
   "Retrieve the root shape of the component."
   [file-data component]
-  (let [components-v2 (dm/get-in file-data [:options :components-v2])]
-    (if (and components-v2 (not (:deleted component)))
-      (-> file-data
-          (get-component-page component)
-          (ctn/get-shape (:main-instance-id component)))
-      (ctk/get-component-root component))))
+  (if (not (:deleted component))
+    (-> file-data
+        (get-component-page component)
+        (ctn/get-shape (:main-instance-id component)))
+    (ctk/get-component-root component)))
 
 (defn get-component-shape
   "Retrieve one shape in the component by id. If with-context? is true, add the
    file and container where the shape resides in its metadata."
   [file-data component shape-id & {:keys [with-context?] :or {with-context? false}}]
-  (let [components-v2 (dm/get-in file-data [:options :components-v2])]
-    (if (and components-v2 (not (:deleted component)))
-      (let [component-page (get-component-page file-data component)]
-        (when component-page
-          (let [child (cfh/get-child (:objects component-page)
-                                     (:main-instance-id component)
-                                     shape-id)]
-            (cond-> child
-              (and child with-context?)
-              (with-meta {:file {:id (:id file-data)
-                                 :data file-data}
-                          :container (ctn/make-container component-page :page)})))))
+  (if (not (:deleted component))
+    (let [component-page (get-component-page file-data component)]
+      (when component-page
+        (let [child (cfh/get-child (:objects component-page)
+                                   (:main-instance-id component)
+                                   shape-id)]
+          (cond-> child
+            (and child with-context?)
+            (with-meta {:file {:id (:id file-data)
+                               :data file-data}
+                        :container (ctn/make-container component-page :page)})))))
 
-      (let [shape (dm/get-in component [:objects shape-id])]
-        (cond-> shape
-          (and shape with-context?)
-          (with-meta {:file {:id (:id file-data)
-                             :data file-data}
-                      :container (ctn/make-container component :component)}))))))
+    (let [shape (dm/get-in component [:objects shape-id])]
+      (cond-> shape
+        (and shape with-context?)
+        (with-meta {:file {:id (:id file-data)
+                           :data file-data}
+                    :container (ctn/make-container component :component)})))))
 
 (defn get-ref-shape
   "Retrieve the shape in the component that is referenced by the instance shape."
@@ -384,12 +387,11 @@
 (defn get-component-shapes
   "Retrieve all shapes of the component"
   [file-data component]
-  (let [components-v2 (dm/get-in file-data [:options :components-v2])]
-    (if (and components-v2
-             (not (:deleted component))) ;; the deleted components have its children in the :objects property
-      (let [instance-page (get-component-page file-data component)]
-        (cfh/get-children-with-self (:objects instance-page) (:main-instance-id component)))
-      (vals (:objects component)))))
+
+  (if (not (:deleted component)) ;; the deleted components have its children in the :objects property
+    (let [instance-page (get-component-page file-data component)]
+      (cfh/get-children-with-self (:objects instance-page) (:main-instance-id component)))
+    (vals (:objects component))))
 
 ;; Return true if the object is a component that exists on the file or its libraries (even a deleted one)
 (defn is-main-of-known-component?
@@ -403,44 +405,52 @@
 
 (defn load-component-objects
   "Add an :objects property to the component, with only the shapes that belong to it"
-  [file-data component]
-  (let [components-v2 (dm/get-in file-data [:options :components-v2])]
-    (if (and components-v2 component (empty? (:objects component))) ;; This operation may be called twice, e.g. in an idempotent change
-      (let [component-page (get-component-page file-data component)
-            page-objects   (:objects component-page)
-            objects        (->> (cons (:main-instance-id component)
-                                      (cfh/get-children-ids page-objects (:main-instance-id component)))
-                                (map #(get page-objects %))
-                                (d/index-by :id))]
-        (assoc component :objects objects))
-      component)))
+  ([file-data component]
+   (load-component-objects file-data component (gpt/point 0 0)))
+  ([file-data component delta]
+   (if (and component (empty? (:objects component))) ;; This operation may be called twice, e.g. in an idempotent change
+     (let [component-page (get-component-page file-data component)
+           page-objects   (:objects component-page)
+           objects        (->> (cons (:main-instance-id component)
+                                     (cfh/get-children-ids page-objects (:main-instance-id component)))
+                               (map #(get page-objects %))
+                               ;; when it is an undo of a cut-paste, we need to undo the movement
+                               ;; of the shapes so we need to move them delta
+                               (map #(gsh/move % delta))
+                               (d/index-by :id))]
+       (assoc component :objects objects))
+     component)))
 
 (defn delete-component
   "Mark a component as deleted and store the main instance shapes iside it, to
   be able to be recovered later."
-  [file-data component-id skip-undelete? main-instance]
-  (let [components-v2 (dm/get-in file-data [:options :components-v2])]
-    (if (or (not components-v2) skip-undelete?)
+  [file-data component-id skip-undelete? delta]
+  (let [delta         (or delta (gpt/point 0 0))]
+    (if skip-undelete?
       (ctkl/delete-component file-data component-id)
-      (let [set-main-instance ;; If there is a saved main-instance, restore it. This happens on the restore-component action
-            #(if main-instance
-               (assoc-in % [:objects (:main-instance-id %)] main-instance)
-               %)]
-        (-> file-data
-            (ctkl/update-component component-id (partial load-component-objects file-data))
-            (ctkl/update-component component-id set-main-instance)
-            (ctkl/mark-component-deleted component-id))))))
+      (-> file-data
+          (ctkl/update-component component-id #(load-component-objects file-data % delta))
+          (ctkl/mark-component-deleted component-id)))))
 
 (defn restore-component
   "Recover a deleted component and all its shapes and put all this again in place."
   [file-data component-id page-id]
-  (let [components-v2 (dm/get-in file-data [:options :components-v2])
-        update-page? (and components-v2 (not (nil? page-id)))]
-    (-> file-data
-        (ctkl/update-component component-id #(dissoc % :objects))
-        (ctkl/mark-component-undeleted component-id)
-        (cond-> update-page?
-          (ctkl/update-component component-id #(assoc % :main-instance-page page-id))))))
+  (let [update-page?       (not (nil? page-id))
+        component          (ctkl/get-component file-data component-id true)
+        main-instance-page (or page-id (:main-instance-page component))
+        main-instance      (dm/get-in file-data [:pages-index main-instance-page
+                                                 :objects (:main-instance-id component)])]
+    (cond-> file-data
+      :always
+      (->
+       (ctkl/update-component component-id #(dissoc % :objects))
+       (ctkl/mark-component-undeleted component-id))
+
+      update-page?
+      (ctkl/update-component component-id #(assoc % :main-instance-page page-id))
+
+      (ctk/is-variant? component)
+      (ctkl/update-component component-id #(assoc % :variant-id (:variant-id main-instance))))))
 
 (defn purge-component
   "Remove permanently a component."
@@ -557,7 +567,6 @@
                                              component
                                              library-data
                                              position
-                                             (dm/get-in file-data [:options :components-v2])
                                              {:main-instance? true
                                               :keep-ids? true})
 
@@ -589,8 +598,7 @@
                                        :name (:name component)
                                        :path (:path component)
                                        :main-instance-id (:id main-instance-shape)
-                                       :main-instance-page page-id
-                                       :shapes (get-component-shapes library-data component)}))
+                                       :main-instance-page page-id}))
 
                 ; Change all existing instances to point to the local file
                 remap-instances

common/src/app/common/types/page.cljc

@@ -70,7 +70,7 @@
 (def valid-guide?
   (sm/lazy-validator schema:guide))
 
-(def check-page!
+(def check-page
   (sm/check-fn schema:page))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -82,8 +82,7 @@
 (def root uuid/zero)
 
 (def empty-page-data
-  {:options {}
-   :objects {root
+  {:objects {root
              (cts/setup-shape {:id root
                                :type :frame
                                :parent-id root
@@ -91,10 +90,12 @@
                                :name "Root Frame"})}})
 
 (defn make-empty-page
-  [{:keys [id name]}]
+  [{:keys [id name background]}]
   (-> empty-page-data
       (assoc :id (or id (uuid/next)))
-      (assoc :name (or name "Page 1"))))
+      (assoc :name (d/nilv name "Page 1"))
+      (cond-> background
+        (assoc :background background))))
 
 (defn get-frame-flow
   [flows frame-id]

common/src/app/common/types/path.cljc

@@ -0,0 +1,215 @@
+;; 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.types.path
+  (:require
+   [app.common.data :as d]
+   [app.common.data.macros :as dm]
+   [app.common.files.helpers :as cpf]
+   [app.common.geom.matrix :as gmt]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.rect :as grc]
+   [app.common.geom.shapes.common :as gco]
+   [app.common.types.path.bool :as bool]
+   [app.common.types.path.helpers :as helpers]
+   [app.common.types.path.impl :as impl]
+   [app.common.types.path.segment :as segment]
+   [app.common.types.path.shape-to-path :as stp]
+   [app.common.types.path.subpath :as subpath]))
+
+#?(:clj (set! *warn-on-reflection* true))
+
+(defn content?
+  [o]
+  (impl/path-data? o))
+
+(defn content
+  "Create path content from plain data or bytes, returns itself if it
+  is already PathData instance"
+  [data]
+  (impl/path-data data))
+
+(defn from-bytes
+  [data]
+  (impl/from-bytes data))
+
+(defn check-path-content
+  [content]
+  (impl/check-content-like content))
+
+(defn get-byte-size
+  "Get byte size of a path content"
+  [content]
+  (impl/-get-byte-size content))
+
+(defn write-to
+  [content buffer offset]
+  (impl/-write-to content buffer offset))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TRANSFORMATIONS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn close-subpaths
+  "Given a content, searches a path for possible subpaths that can
+  create closed loops and merge them; then return the transformed path
+  conten as PathData instance"
+  [content]
+  (-> (subpath/close-subpaths content)
+      (impl/from-plain)))
+
+(defn apply-content-modifiers
+  "Apply delta modifiers over the path content"
+  [content modifiers]
+  (assert (impl/check-content-like content))
+
+  (letfn [(apply-to-index [content [index params]]
+            (if (contains? content index)
+              (cond-> content
+                (and
+                 (or (:c1x params) (:c1y params) (:c2x params) (:c2y params))
+                 (= :line-to (get-in content [index :command])))
+
+                (-> (assoc-in [index :command] :curve-to)
+                    (assoc-in [index :params]
+                              (helpers/make-curve-params
+                               (get-in content [index :params])
+                               (get-in content [(dec index) :params]))))
+
+                (:x params) (update-in [index :params :x] + (:x params))
+                (:y params) (update-in [index :params :y] + (:y params))
+
+                (:c1x params) (update-in [index :params :c1x] + (:c1x params))
+                (:c1y params) (update-in [index :params :c1y] + (:c1y params))
+
+                (:c2x params) (update-in [index :params :c2x] + (:c2x params))
+                (:c2y params) (update-in [index :params :c2y] + (:c2y params)))
+              content))]
+
+    (impl/path-data
+     (reduce apply-to-index (vec content) modifiers))))
+
+(defn transform-content
+  "Applies a transformation matrix over content and returns a new
+  content as PathData instance."
+  [content transform]
+  (segment/transform-content content transform))
+
+(defn move-content
+  [content move-vec]
+  (if (gpt/zero? move-vec)
+    content
+    (segment/move-content content move-vec)))
+
+(defn update-geometry
+  "Update shape with new geometry calculated from provided content"
+  ([shape content]
+   (update-geometry (assoc shape :content content)))
+  ([shape]
+   (let [flip-x
+         (get shape :flip-x)
+
+         flip-y
+         (get shape :flip-y)
+
+         ;; NOTE: we ensure that content is PathData instance
+         content
+         (impl/path-data
+          (get shape :content))
+
+         ;; Ensure plain format once
+         transform
+         (cond-> (:transform shape (gmt/matrix))
+           flip-x (gmt/scale (gpt/point -1 1))
+           flip-y (gmt/scale (gpt/point 1 -1)))
+
+         transform-inverse
+         (cond-> (gmt/matrix)
+           flip-x (gmt/scale (gpt/point -1 1))
+           flip-y (gmt/scale (gpt/point 1 -1))
+           :always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
+
+         center
+         (or (some-> (dm/get-prop shape :selrect) grc/rect->center)
+             (segment/content-center content))
+
+         base-content
+         (segment/transform-content content (gmt/transform-in center transform-inverse))
+
+         ;; Calculates the new selrect with points given the old center
+         points
+         (-> (segment/content->selrect base-content)
+             (grc/rect->points)
+             (gco/transform-points center transform))
+
+         points-center
+         (gco/points->center points)
+
+         ;; Points is now the selrect but the center is different so we can create the selrect
+         ;; through points
+         selrect
+         (-> points
+             (gco/transform-points points-center transform-inverse)
+             (grc/points->rect))]
+
+     (-> shape
+         (assoc :content content)
+         (assoc :points points)
+         (assoc :selrect selrect)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PATH SHAPE HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn get-points
+  "Returns points for the given segment, faster version of
+  the `content->points`."
+  [content]
+  (some-> content segment/get-points))
+
+(defn- calc-bool-content*
+  "Calculate the boolean content from shape and objects. Returns plain
+  vector of segments"
+  [shape objects]
+  (let [extract-content-xf
+        (comp (map (d/getf objects))
+              (remove :hidden)
+              (remove cpf/svg-raw-shape?)
+              (map #(stp/convert-to-path % objects))
+              (map :content))
+
+        contents
+        (sequence extract-content-xf (:shapes shape))]
+
+    (bool/calculate-content (:bool-type shape) contents)))
+
+(defn calc-bool-content
+  "Calculate the boolean content from shape and objects. Returns a
+  packed PathData instance"
+  [shape objects]
+  (-> (calc-bool-content* shape objects)
+      (impl/path-data)))
+
+(defn shape-with-open-path?
+  [shape]
+  (let [svg? (contains? shape :svg-attrs)
+        ;; No close subpaths for svgs imported
+        maybe-close (if svg? identity subpath/close-subpaths)]
+    (and (= :path (:type shape))
+         (not (->> shape
+                   :content
+                   (maybe-close)
+                   (subpath/get-subpaths)
+                   (every? subpath/is-closed?))))))
+
+(defn convert-to-path
+  "Transform a shape to a path shape"
+  ([shape]
+   (convert-to-path shape {}))
+  ([shape objects]
+   (-> (stp/convert-to-path shape objects)
+       (update :content impl/path-data))))
+

common/src/app/common/types/path/bool.cljc

@@ -0,0 +1,438 @@
+;; 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.types.path.bool
+  (:require
+   [app.common.colors :as clr]
+   [app.common.data :as d]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.rect :as grc]
+   [app.common.math :as mth]
+   [app.common.types.path.helpers :as helpers]
+   [app.common.types.path.segment :as segment]
+   [app.common.types.path.subpath :as subpath]))
+
+(def default-fills
+  [{:fill-color clr/black}])
+
+(def style-group-properties
+  [:shadow :blur])
+
+(def style-properties
+  (into style-group-properties
+        [:fill-color
+         :fill-opacity
+         :fill-color-gradient
+         :fill-color-ref-file
+         :fill-color-ref-id
+         :fill-image
+         :fills
+         :stroke-color
+         :stroke-color-ref-file
+         :stroke-color-ref-id
+         :stroke-opacity
+         :stroke-style
+         :stroke-width
+         :stroke-alignment
+         :stroke-cap-start
+         :stroke-cap-end
+         :strokes]))
+
+(defn add-previous
+  ([content]
+   (add-previous content nil))
+  ([content first]
+   (->> (d/with-prev content)
+        (mapv (fn [[cmd prev]]
+                (cond-> cmd
+                  (and (nil? prev) (some? first))
+                  (assoc :prev first)
+
+                  (some? prev)
+                  (assoc :prev (helpers/segment->point prev))))))))
+
+(defn close-paths
+  "Removes the :close-path commands and replace them for line-to so we can calculate
+  the intersections"
+  [content]
+
+  (loop [segments   (seq content)
+         result     []
+         last-move  nil
+         last-point nil]
+    (if-let [segment (first segments)]
+      (let [point
+            (helpers/segment->point segment)
+
+            segment
+            (cond
+              (and (= :close-path (:command segment))
+                   (or (nil? last-point) ;; Ignore consecutive close-paths
+                       (< (gpt/distance last-point last-move) 0.01)))
+              nil
+
+              (= :close-path (:command segment))
+              (helpers/make-line-to last-move)
+
+              :else
+              segment)]
+
+        (recur (rest segments)
+               (cond-> result (some? segment) (conj segment))
+               (if (= :move-to (:command segment))
+                 point
+                 last-move)
+               point))
+      result)))
+
+(defn- split-command
+  [cmd values]
+  (case (:command cmd)
+    :line-to  (helpers/split-line-to-ranges (:prev cmd) cmd values)
+    :curve-to (helpers/split-curve-to-ranges (:prev cmd) cmd values)
+    [cmd]))
+
+(defn- split-ts
+  [seg-1 seg-2]
+  (let [cmd-1 (get seg-1 :command)
+        cmd-2 (get seg-2 :command)]
+    (cond
+      (and (= :line-to cmd-1)
+           (= :line-to cmd-2))
+      (helpers/line-line-intersect (helpers/command->line seg-1)
+                                   (helpers/command->line seg-2))
+
+      (and (= :line-to cmd-1)
+           (= :curve-to cmd-2))
+      (helpers/line-curve-intersect (helpers/command->line seg-1)
+                                    (helpers/command->bezier seg-2))
+
+      (and (= :curve-to cmd-1)
+           (= :line-to cmd-2))
+      (let [[seg-2' seg-1']
+            (helpers/line-curve-intersect (helpers/command->line seg-2)
+                                          (helpers/command->bezier seg-1))]
+        ;; Need to reverse because we send the arguments reversed
+        [seg-1' seg-2'])
+
+      (and (= :curve-to cmd-1)
+           (= :curve-to cmd-2))
+      (helpers/curve-curve-intersect (helpers/command->bezier seg-1)
+                                     (helpers/command->bezier seg-2))
+
+      :else
+      [[] []])))
+
+(defn content-intersect-split
+  [content-a content-b sr-a sr-b]
+
+  (let [command->selrect (memoize helpers/command->selrect)]
+
+    (letfn [(overlap-segment-selrect? [segment selrect]
+              (if (= :move-to (:command segment))
+                false
+                (let [r1 (command->selrect segment)]
+                  (grc/overlaps-rects? r1 selrect))))
+
+            (overlap-segments? [seg-1 seg-2]
+              (if (or (= :move-to (:command seg-1))
+                      (= :move-to (:command seg-2)))
+                false
+                (let [r1 (command->selrect seg-1)
+                      r2 (command->selrect seg-2)]
+                  (grc/overlaps-rects? r1 r2))))
+
+            (split [seg-1 seg-2]
+              (if (not (overlap-segments? seg-1 seg-2))
+                [seg-1]
+                (let [[ts-seg-1 _] (split-ts seg-1 seg-2)]
+                  (-> (split-command seg-1 ts-seg-1)
+                      (add-previous (:prev seg-1))))))
+
+            (split-segment-on-content [segment content content-sr]
+              (if (overlap-segment-selrect? segment content-sr)
+                (->> content
+                     (filter #(overlap-segments? segment %))
+                     (reduce
+                      (fn [result current]
+                        (into [] (mapcat #(split % current)) result))
+                      [segment]))
+                [segment]))
+
+            (split-content [content-a content-b sr-b]
+              (into []
+                    (mapcat #(split-segment-on-content % content-b sr-b))
+                    content-a))]
+
+      [(split-content content-a content-b sr-b)
+       (split-content content-b content-a sr-a)])))
+
+(defn is-segment?
+  [cmd]
+  (and (contains? cmd :prev)
+       (contains? #{:line-to :curve-to} (:command cmd))))
+
+(defn contains-segment?
+  [segment content content-sr content-geom]
+
+  (let [point (case (:command segment)
+                :line-to  (-> (helpers/command->line segment)
+                              (helpers/line-values 0.5))
+
+                :curve-to (-> (helpers/command->bezier segment)
+                              (helpers/curve-values 0.5)))]
+
+    (and (grc/contains-point? content-sr point)
+         (or
+          (helpers/is-point-in-geom-data? point content-geom)
+          (helpers/is-point-in-border? point content)))))
+
+(defn inside-segment?
+  [segment content-sr content-geom]
+  (let [point (case (:command segment)
+                :line-to  (-> (helpers/command->line segment)
+                              (helpers/line-values 0.5))
+
+                :curve-to (-> (helpers/command->bezier segment)
+                              (helpers/curve-values 0.5)))]
+
+    (and (grc/contains-point? content-sr point)
+         (helpers/is-point-in-geom-data? point content-geom))))
+
+(defn overlap-segment?
+  "Finds if the current segment is overlapping against other
+  segment meaning they have the same coordinates"
+  [segment content]
+
+  (let [overlap-single?
+        (fn [other]
+          (when (and (= (:command segment) (:command other))
+                     (contains? #{:line-to :curve-to} (:command segment)))
+
+            (case (:command segment)
+              :line-to (let [[p1 q1] (helpers/command->line segment)
+                             [p2 q2] (helpers/command->line other)]
+
+                         (when (or (and (< (gpt/distance p1 p2) 0.1)
+                                        (< (gpt/distance q1 q2) 0.1))
+                                   (and (< (gpt/distance p1 q2) 0.1)
+                                        (< (gpt/distance q1 p2) 0.1)))
+                           [segment other]))
+
+              :curve-to (let [[p1 q1 h11 h21] (helpers/command->bezier segment)
+                              [p2 q2 h12 h22] (helpers/command->bezier other)]
+
+                          (when (or (and (< (gpt/distance p1 p2) 0.1)
+                                         (< (gpt/distance q1 q2) 0.1)
+                                         (< (gpt/distance h11 h12) 0.1)
+                                         (< (gpt/distance h21 h22) 0.1))
+
+                                    (and (< (gpt/distance p1 q2) 0.1)
+                                         (< (gpt/distance q1 p2) 0.1)
+                                         (< (gpt/distance h11 h22) 0.1)
+                                         (< (gpt/distance h21 h12) 0.1)))
+
+                            [segment other])))))]
+
+    (->> content
+         (d/seek overlap-single?)
+         (some?))))
+
+(defn fix-move-to
+  [content]
+  ;; Remove the field `:prev` and makes the necessaries `move-to`
+  ;; then clean the subpaths
+
+  (loop [current (first content)
+         content (rest content)
+         prev nil
+         result []]
+
+    (if (nil? current)
+      result
+
+      (let [result (if (not= (:prev current) prev)
+                     (conj result (helpers/make-move-to (:prev current)))
+                     result)]
+        (recur (first content)
+               (rest content)
+               (helpers/segment->point current)
+               (conj result (dissoc current :prev)))))))
+
+(defn remove-duplicated-segments
+  "Remove from the content segments"
+  [content]
+  (letfn [;; This is a comparator for float points with a precission
+          ;; used to remove already existing segments
+          (comparator [[fx1 fy1 tx1 ty1 :as v1] [fx2 fy2 tx2 ty2 :as v2]]
+            (if (and (mth/close? tx1 tx2)
+                     (mth/close? ty1 ty2)
+                     (mth/close? fx1 fx2)
+                     (mth/close? fy1 fy2))
+              0 ;; equal
+              (compare v1 v2)))]
+
+    (loop [current (first content)
+           content (rest content)
+           segments (sorted-set-by comparator)
+           result []]
+
+      (if (nil? current)
+        result
+
+        (let [fx (-> current :prev :x)
+              fy (-> current :prev :y)
+              tx (-> current :params :x)
+              ty (-> current :params :y)
+
+              result
+              (cond-> result
+                (and (not (contains? segments [fx fy tx ty]))
+                     (not (contains? segments [tx ty fx fy])))
+                (conj current))
+
+              segments (conj segments [fx fy tx ty])]
+
+          (recur (first content)
+                 (rest content)
+                 segments
+                 result))))))
+
+(defn close-content
+  [content]
+  (into []
+        (mapcat :data)
+        (->> content
+             (subpath/close-subpaths)
+             (subpath/get-subpaths))))
+
+(defn- content->geom-data
+  [content]
+
+  (->> content
+       (close-content)
+       (filter #(not= (= :line-to (:command %))
+                      (= :curve-to (:command %))))
+       (mapv (fn [segment]
+               {:command (:command segment)
+                :segment segment
+                :geom (if (= :line-to (:command segment))
+                        (helpers/command->line segment)
+                        (helpers/command->bezier segment))
+                :selrect (helpers/command->selrect segment)}))))
+
+(defn create-union [content-a content-a-split content-b content-b-split sr-a sr-b]
+  ;; Pick all segments in content-a that are not inside content-b
+  ;; Pick all segments in content-b that are not inside content-a
+  (let [content-a-geom (content->geom-data content-a)
+        content-b-geom (content->geom-data content-b)
+
+        content
+        (concat
+         (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
+         (->> content-b-split (filter #(not (contains-segment? % content-a sr-a content-a-geom)))))
+
+        content-geom (content->geom-data content)
+
+        content-sr (segment/content->selrect (fix-move-to content))
+
+        ;; Overlapping segments should be added when they are part of the border
+        border-content
+        (->> content-b-split
+             (filter #(and (contains-segment? % content-a sr-a content-a-geom)
+                           (overlap-segment? % content-a-split)
+                           (not (inside-segment? % content-sr content-geom)))))]
+
+    ;; Ensure that the output is always a vector
+    (d/concat-vec content border-content)))
+
+(defn create-difference [content-a content-a-split content-b content-b-split sr-a sr-b]
+  ;; Pick all segments in content-a that are not inside content-b
+  ;; Pick all segments in content b that are inside content-a
+  ;;  removing overlapping
+  (let [content-a-geom (content->geom-data content-a)
+        content-b-geom (content->geom-data content-b)]
+    (d/concat-vec
+     (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
+
+     ;; Reverse second content so we can have holes inside other shapes
+     (->> content-b-split
+          (filter #(and (contains-segment? % content-a sr-a content-a-geom)
+                        (not (overlap-segment? % content-a-split))))))))
+
+(defn create-intersection [content-a content-a-split content-b content-b-split sr-a sr-b]
+  ;; Pick all segments in content-a that are inside content-b
+  ;; Pick all segments in content-b that are inside content-a
+  (let [content-a-geom (content->geom-data content-a)
+        content-b-geom (content->geom-data content-b)]
+    (d/concat-vec
+     (->> content-a-split (filter #(contains-segment? % content-b sr-b content-b-geom)))
+     (->> content-b-split (filter #(contains-segment? % content-a sr-a content-a-geom))))))
+
+(defn create-exclusion [content-a content-b]
+  ;; Pick all segments
+  (d/concat-vec content-a content-b))
+
+(defn content-bool-pair
+  [bool-type content-a content-b]
+
+  (let [;; We need to reverse the second path when making a difference/intersection/exclude
+        ;; and both shapes are in the same direction
+        should-reverse?
+        (and (not= :union bool-type)
+             (= (subpath/clockwise? content-b)
+                (subpath/clockwise? content-a)))
+
+        content-a
+        (-> content-a
+            (close-paths)
+            (add-previous))
+
+        content-b
+        (-> content-b
+            (close-paths)
+            (cond-> should-reverse? (subpath/reverse-content))
+            (add-previous))
+
+        sr-a
+        (segment/content->selrect content-a)
+
+        sr-b
+        (segment/content->selrect content-b)
+
+        ;; Split content in new segments in the intersection with the other path
+        [content-a-split content-b-split]
+        (content-intersect-split content-a content-b sr-a sr-b)
+
+        content-a-split
+        (->> content-a-split add-previous (filter is-segment?))
+
+        content-b-split
+        (->> content-b-split add-previous (filter is-segment?))
+
+        content
+        (case bool-type
+          :union        (create-union        content-a content-a-split content-b content-b-split sr-a sr-b)
+          :difference   (create-difference   content-a content-a-split content-b content-b-split sr-a sr-b)
+          :intersection (create-intersection content-a content-a-split content-b content-b-split sr-a sr-b)
+          :exclude      (create-exclusion    content-a-split content-b-split))]
+
+    (-> content
+        remove-duplicated-segments
+        fix-move-to
+        subpath/close-subpaths)))
+
+(defn calculate-content
+  "Create a bool content from a collection of contents and specified
+  type."
+  [bool-type contents]
+  ;; We apply the boolean operation in to each pair and the result to the next
+  ;; element
+  (if (seq contents)
+    (->> contents
+         (reduce (partial content-bool-pair bool-type))
+         (vec))
+    []))

common/src/app/common/types/path/impl.cljc

@@ -0,0 +1,782 @@
+;; 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.types.path.impl
+  "Contains schemas and data type implementation for PathData binary
+  and plain formats"
+  #?(:cljs
+     (:require-macros [app.common.types.path.impl :refer [read-float read-short write-float write-short]]))
+  (:refer-clojure :exclude [-lookup -reduce])
+  (:require
+   #?(:clj [app.common.fressian :as fres])
+   #?(:clj [clojure.data.json :as json])
+   #?(:cljs [app.common.weak-map :as weak-map])
+   [app.common.data.macros :as dm]
+   [app.common.schema :as sm]
+   [app.common.schema.generators :as sg]
+   [app.common.svg.path :as svg.path]
+   [app.common.transit :as t]
+   [app.common.types.path :as-alias path])
+  (:import
+   #?(:cljs [goog.string StringBuffer]
+      :clj  [java.nio ByteBuffer ByteOrder])))
+
+#?(:clj (set! *warn-on-reflection* true))
+
+(def ^:const SEGMENT-BYTE-SIZE 28)
+
+(defprotocol IPathData
+  (-write-to [_ buffer offset] "write the content to the specified buffer")
+  (-get-byte-size [_] "get byte size"))
+
+(defprotocol ITransformable
+  (-transform [_ m] "apply a transform")
+  (-lookup [_ index f])
+  (-walk [_ f initial])
+  (-reduce [_ f initial]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; IMPL HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro read-short
+  [target offset]
+  (if (:ns &env)
+    `(.getInt16 ~target ~offset true)
+    (let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
+      `(.getShort ~target ~offset))))
+
+(defmacro read-float
+  [target offset]
+  (if (:ns &env)
+    `(.getFloat32 ~target ~offset true)
+    (let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
+      `(double (.getFloat ~target ~offset)))))
+
+(defmacro write-float
+  [target offset value]
+  (if (:ns &env)
+    `(.setFloat32 ~target ~offset ~value true)
+    (let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
+      `(.putFloat ~target ~offset ~value))))
+
+(defmacro write-short
+  [target offset value]
+  (if (:ns &env)
+    `(.setInt16 ~target ~offset ~value true)
+    (let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
+      `(.putShort ~target ~offset ~value))))
+
+(defmacro with-cache
+  "A helper macro that facilitates cache handling for content
+  instance, only relevant on CLJS"
+  [target key & expr]
+  (if (:ns &env)
+    (let [cache (gensym "cache-")
+          target (with-meta target {:tag 'js})]
+      `(let [~cache (.-cache ~target)
+             ~'result (.get ~cache ~key)]
+         (if ~'result
+           (do
+             ~'result)
+           (let [~'result (do ~@expr)]
+             (.set ~cache ~key ~'result)
+             ~'result))))
+    `(do ~@expr)))
+
+(defn- allocate
+  [n-segments]
+  #?(:clj (let [buffer (ByteBuffer/allocate (* n-segments SEGMENT-BYTE-SIZE))]
+            (.order buffer ByteOrder/LITTLE_ENDIAN))
+     :cljs (new js/ArrayBuffer (* n-segments SEGMENT-BYTE-SIZE))))
+
+(defn- clone-buffer
+  [buffer]
+  #?(:clj
+     (let [src (.array ^ByteBuffer buffer)
+           len (alength ^bytes src)
+           dst (byte-array len)]
+       (System/arraycopy src 0 dst 0 len)
+       (let [buffer (ByteBuffer/wrap dst)]
+         (.order buffer ByteOrder/LITTLE_ENDIAN)))
+     :cljs
+     (let [src-view (js/Uint32Array. buffer)
+           dst-buff (js/ArrayBuffer. (.-byteLength buffer))
+           dst-view (js/Uint32Array. dst-buff)]
+       (.set dst-view src-view)
+       dst-buff)))
+
+(defn- impl-transform-segment
+  "Apply a transformation to a segment located under specified offset"
+  [buffer offset a b c d e f]
+  (let [t (read-short buffer offset)]
+    (case t
+      (1 2)
+      (let [x (read-float buffer (+ offset 20))
+            y (read-float buffer (+ offset 24))
+            x (+ (* x a) (* y c) e)
+            y (+ (* x b) (* y d) f)]
+        (write-float buffer (+ offset 20) x)
+        (write-float buffer (+ offset 24) y))
+
+      3
+      (let [c1x (read-float buffer (+ offset 4))
+            c1y (read-float buffer (+ offset 8))
+            c2x (read-float buffer (+ offset 12))
+            c2y (read-float buffer (+ offset 16))
+            x   (read-float buffer (+ offset 20))
+            y   (read-float buffer (+ offset 24))
+
+            c1x (+ (* c1x a) (* c1y c) e)
+            c1y (+ (* c1x b) (* c1y d) f)
+            c2x (+ (* c2x a) (* c2y c) e)
+            c2y (+ (* c2x b) (* c2y d) f)
+            x   (+ (* x a) (* y c) e)
+            y   (+ (* x b) (* y d) f)]
+
+        (write-float buffer (+ offset 4) c1x)
+        (write-float buffer (+ offset 8) c1y)
+        (write-float buffer (+ offset 12) c2x)
+        (write-float buffer (+ offset 16) c2y)
+        (write-float buffer (+ offset 20) x)
+        (write-float buffer (+ offset 24) y))
+
+      nil)))
+
+(defn- impl-transform
+  [buffer m size]
+  (let [a (dm/get-prop m :a)
+        b (dm/get-prop m :b)
+        c (dm/get-prop m :c)
+        d (dm/get-prop m :d)
+        e (dm/get-prop m :e)
+        f (dm/get-prop m :f)]
+    (loop [index 0]
+      (when (< index size)
+        (let [offset (* index SEGMENT-BYTE-SIZE)]
+          (impl-transform-segment buffer offset a b c d e f)
+          (recur (inc index)))))))
+
+(defn- impl-walk
+  [buffer f initial size]
+  (loop [index 0
+         result (transient initial)]
+    (if (< index size)
+      (let [offset (* index SEGMENT-BYTE-SIZE)
+            type   (read-short buffer offset)
+            c1x    (read-float buffer (+ offset 4))
+            c1y    (read-float buffer (+ offset 8))
+            c2x    (read-float buffer (+ offset 12))
+            c2y    (read-float buffer (+ offset 16))
+            x      (read-float buffer (+ offset 20))
+            y      (read-float buffer (+ offset 24))
+            type   (case type
+                     1 :line-to
+                     2 :move-to
+                     3 :curve-to
+                     4 :close-path)
+            res    (f type c1x c1y c2x c2y x y)]
+        (recur (inc index)
+               (if (some? res)
+                 (conj! result res)
+                 result)))
+      (persistent! result))))
+
+(defn impl-reduce
+  [buffer f initial size]
+  (loop [index 0
+         result initial]
+    (if (< index size)
+      (let [offset (* index SEGMENT-BYTE-SIZE)
+            type   (read-short buffer offset)
+            c1x    (read-float buffer (+ offset 4))
+            c1y    (read-float buffer (+ offset 8))
+            c2x    (read-float buffer (+ offset 12))
+            c2y    (read-float buffer (+ offset 16))
+            x      (read-float buffer (+ offset 20))
+            y      (read-float buffer (+ offset 24))
+            type   (case type
+                     1 :line-to
+                     2 :move-to
+                     3 :curve-to
+                     4 :close-path)
+            result (f result index type c1x c1y c2x c2y x y)]
+        (if (reduced? result)
+          result
+          (recur (inc index) result)))
+      result)))
+
+(defn impl-lookup
+  [buffer index f]
+  (let [offset (* index SEGMENT-BYTE-SIZE)
+        type   (read-short buffer offset)
+        c1x    (read-float buffer (+ offset 4))
+        c1y    (read-float buffer (+ offset 8))
+        c2x    (read-float buffer (+ offset 12))
+        c2y    (read-float buffer (+ offset 16))
+        x      (read-float buffer (+ offset 20))
+        y      (read-float buffer (+ offset 24))
+        type   (case type
+                 1 :line-to
+                 2 :move-to
+                 3 :curve-to
+                 4 :close-path)]
+    #?(:clj (f type c1x c1y c2x c2y x y)
+       :cljs (^function f type c1x c1y c2x c2y x y))))
+
+(defn- to-string-segment*
+  [buffer offset type ^StringBuilder builder]
+  (case (long type)
+    1 (let [x (read-float buffer (+ offset 20))
+            y (read-float buffer (+ offset 24))]
+        (doto builder
+          (.append "M")
+          (.append x)
+          (.append ",")
+          (.append y)))
+    2 (let [x (read-float buffer (+ offset 20))
+            y (read-float buffer (+ offset 24))]
+        (doto builder
+          (.append "L")
+          (.append x)
+          (.append ",")
+          (.append y)))
+
+    3 (let [c1x (read-float buffer (+ offset 4))
+            c1y (read-float buffer (+ offset 8))
+            c2x (read-float buffer (+ offset 12))
+            c2y (read-float buffer (+ offset 16))
+            x   (read-float buffer (+ offset 20))
+            y   (read-float buffer (+ offset 24))]
+        (doto builder
+          (.append "C")
+          (.append c1x)
+          (.append ",")
+          (.append c1y)
+          (.append ",")
+          (.append c2x)
+          (.append ",")
+          (.append c2y)
+          (.append ",")
+          (.append x)
+          (.append ",")
+          (.append y)))
+    4 (doto builder
+        (.append "Z"))))
+
+(defn- to-string
+  "Format the path data structure to string"
+  [buffer size]
+  (let [builder #?(:clj (java.lang.StringBuilder. (int (* size 4)))
+                   :cljs (StringBuffer.))]
+    (loop [index 0]
+      (when (< index size)
+        (let [offset (* index SEGMENT-BYTE-SIZE)
+              type   (read-short buffer offset)]
+          (to-string-segment* buffer offset type builder)
+          (recur (inc index)))))
+
+    (.toString builder)))
+
+(defn- read-segment
+  "Read segment from binary buffer at specified index"
+  [buffer index]
+  (let [offset (* index SEGMENT-BYTE-SIZE)
+        type   (read-short buffer offset)]
+    (case (long type)
+      1 (let [x (read-float buffer (+ offset 20))
+              y (read-float buffer (+ offset 24))]
+          {:command :move-to
+           :params {:x (double x)
+                    :y (double y)}})
+
+      2 (let [x (read-float buffer (+ offset 20))
+              y (read-float buffer (+ offset 24))]
+          {:command :line-to
+           :params {:x (double x)
+                    :y (double y)}})
+
+      3 (let [c1x (read-float buffer (+ offset 4))
+              c1y (read-float buffer (+ offset 8))
+              c2x (read-float buffer (+ offset 12))
+              c2y (read-float buffer (+ offset 16))
+              x   (read-float buffer (+ offset 20))
+              y   (read-float buffer (+ offset 24))]
+          {:command :curve-to
+           :params {:x (double x)
+                    :y (double y)
+                    :c1x (double c1x)
+                    :c1y (double c1y)
+                    :c2x (double c2x)
+                    :c2y (double c2y)}})
+
+      4 {:command :close-path
+         :params {}})))
+
+(defn- in-range?
+  [size i]
+  (and (< i size) (>= i 0)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TYPE: PATH-DATA
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#?(:clj
+   (deftype PathData [size
+                      ^ByteBuffer buffer
+                      ^:unsynchronized-mutable hash]
+     Object
+     (toString [_]
+       (to-string buffer size))
+
+     (equals [_ other]
+       (if (instance? PathData other)
+         (.equals ^ByteBuffer buffer (.-buffer ^PathData other))
+         false))
+
+     ITransformable
+     (-transform [_ m]
+       (let [buffer (clone-buffer buffer)]
+         (impl-transform buffer m size)
+         (PathData. size buffer nil)))
+
+     (-walk [_ f initial]
+       (impl-walk buffer f initial size))
+
+     (-reduce [_ f initial]
+       (impl-reduce buffer f initial size))
+
+     (-lookup [_ index f]
+       (when (and (<= 0 index)
+                  (< index size))
+         (impl-lookup buffer index f)))
+
+     json/JSONWriter
+     (-write [this writter options]
+       (json/-write (.toString this) writter options))
+
+     clojure.lang.IHashEq
+     (hasheq [this]
+       (when-not hash
+         (set! hash (clojure.lang.Murmur3/hashOrdered (seq this))))
+       hash)
+
+     clojure.lang.Sequential
+     clojure.lang.Seqable
+     (seq [_]
+       (when (pos? size)
+         ((fn next-seq [i]
+            (when (< i size)
+              (cons (read-segment buffer i)
+                    (lazy-seq (next-seq (inc i))))))
+          0)))
+
+     clojure.lang.IReduceInit
+     (reduce [_ f start]
+       (loop [index  0
+              result start]
+         (if (< index size)
+           (let [result (f result (read-segment buffer index))]
+             (if (reduced? result)
+               @result
+               (recur (inc index) result)))
+           result)))
+
+     clojure.lang.Indexed
+     (nth [_ i]
+       (if (in-range? size i)
+         (read-segment buffer i)
+         nil))
+
+     (nth [_ i default]
+       (if (in-range? size i)
+         (read-segment buffer i)
+         default))
+
+     clojure.lang.Counted
+     (count [_] size)
+
+     IPathData
+     (-get-byte-size [_]
+       (* size SEGMENT-BYTE-SIZE))
+
+     (-write-to [_ _ _]
+       (throw (RuntimeException. "not implemented"))))
+
+   :cljs
+   #_:clj-kondo/ignore
+   (deftype PathData [size buffer dview cache ^:mutable __hash]
+     Object
+     (toString [_]
+       (to-string dview size))
+
+     IPathData
+     (-get-byte-size [_]
+       (.-byteLength buffer))
+
+     (-write-to [_ into-buffer offset]
+       ;; NOTE: we still use u8 because until the heap refactor merge
+       ;; we can't guarrantee the alignment of offset on 4 bytes
+       (assert (instance? js/ArrayBuffer into-buffer))
+       (let [size (.-byteLength buffer)
+             mem  (js/Uint8Array. into-buffer offset size)]
+         (.set mem (js/Uint8Array. buffer))))
+
+     ITransformable
+     (-transform [this m]
+       (let [buffer (clone-buffer buffer)
+             dview  (js/DataView. buffer)]
+         (impl-transform dview m size)
+         (PathData. size buffer dview (weak-map/create) nil)))
+
+     (-walk [_ f initial]
+       (impl-walk dview f initial size))
+
+     (-reduce [_ f initial]
+       (impl-reduce dview f initial size))
+
+     (-lookup [_ index f]
+       (when (and (<= 0 index)
+                  (< index size))
+         (impl-lookup dview index f)))
+
+     cljs.core/ISequential
+     cljs.core/IEquiv
+     (-equiv [this other]
+       (if (instance? PathData other)
+         (let [obuffer (.-buffer other)]
+           (if (= (.-byteLength obuffer)
+                  (.-byteLength buffer))
+             (let [cb (js/Uint32Array. buffer)
+                   ob (js/Uint32Array. obuffer)
+                   sz (alength cb)]
+               (loop [i 0]
+                 (if (< i sz)
+                   (if (= (aget ob i)
+                          (aget cb i))
+                     (recur (inc i))
+                     false)
+                   true)))
+             false))
+         false))
+
+     cljs.core/IReduce
+     (-reduce [_ f]
+       (loop [index  1
+              result (if (pos? size)
+                       (read-segment dview 0)
+                       nil)]
+         (if (< index size)
+           (let [result (f result (read-segment dview index))]
+             (if (reduced? result)
+               @result
+               (recur (inc index) result)))
+           result)))
+
+     (-reduce [_ f start]
+       (loop [index  0
+              result start]
+         (if (< index size)
+           (let [result (f result (read-segment dview index))]
+             (if (reduced? result)
+               @result
+               (recur (inc index) result)))
+           result)))
+
+     cljs.core/IHash
+     (-hash [coll]
+       (caching-hash coll hash-ordered-coll __hash))
+
+     cljs.core/ICounted
+     (-count [_] size)
+
+     cljs.core/IIndexed
+     (-nth [_ i]
+       (if (in-range? size i)
+         (read-segment dview i)
+         nil))
+
+     (-nth [_ i default]
+       (if (in-range? i size)
+         (read-segment dview i)
+         default))
+
+     cljs.core/ISeqable
+     (-seq [this]
+       (when (pos? size)
+         ((fn next-seq [i]
+            (when (< i size)
+              (cons (read-segment dview i)
+                    (lazy-seq (next-seq (inc i))))))
+          0)))
+
+     cljs.core/IPrintWithWriter
+     (-pr-writer [this writer _]
+       (cljs.core/-write writer (str "#penpot/path-data \"" (.toString this) "\"")))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SCHEMA
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def schema:safe-number
+  [:schema {:gen/gen (sg/small-int :max 100 :min -100)}
+   ::sm/safe-number])
+
+(def ^:private schema:line-to-segment
+  [:map
+   [:command [:= :line-to]]
+   [:params
+    [:map
+     [:x schema:safe-number]
+     [:y schema:safe-number]]]])
+
+(def ^:private schema:close-path-segment
+  [:map
+   [:command [:= :close-path]]])
+
+(def ^:private schema:move-to-segment
+  [:map
+   [:command [:= :move-to]]
+   [:params
+    [:map
+     [:x schema:safe-number]
+     [:y schema:safe-number]]]])
+
+(def ^:private schema:curve-to-segment
+  [:map
+   [:command [:= :curve-to]]
+   [:params
+    [:map
+     [:x schema:safe-number]
+     [:y schema:safe-number]
+     [:c1x schema:safe-number]
+     [:c1y schema:safe-number]
+     [:c2x schema:safe-number]
+     [:c2y schema:safe-number]]]])
+
+(def ^:private schema:segment
+  [:multi {:title "PathSegment"
+           :dispatch :command
+           :decode/json #(update % :command keyword)}
+   [:line-to schema:line-to-segment]
+   [:close-path schema:close-path-segment]
+   [:move-to schema:move-to-segment]
+   [:curve-to schema:curve-to-segment]])
+
+(def schema:segments
+  [:vector {:gen/gen (->> (sg/generator schema:segment)
+                          (sg/vector)
+                          (sg/filter not-empty)
+                          (sg/filter (fn [[e1]]
+                                       (= (:command e1) :move-to))))}
+   schema:segment])
+
+(def schema:content-like
+  [:sequential schema:segment])
+
+(def check-content-like
+  (sm/check-fn schema:content-like))
+
+(def check-segment
+  (sm/check-fn schema:segment))
+
+(def ^:private check-segments
+  (sm/check-fn schema:segments))
+
+(defn path-data?
+  [o]
+  (instance? PathData o))
+
+(declare from-string)
+(declare from-plain)
+
+;; Mainly used on backend: features/components_v2.clj
+(sm/register! ::path/segment schema:segment)
+(sm/register! ::path/segments schema:segments)
+
+(sm/register!
+ {:type ::path/content
+  :compile
+  (fn [_ _ _]
+    (let [decoder   (delay (sm/decoder schema:segments sm/json-transformer))
+          generator (->> (sg/generator schema:segments)
+                         (sg/filter not-empty)
+                         (sg/fmap from-plain))]
+      {:pred path-data?
+       :type-properties
+       {:gen/gen generator
+        :encode/json identity
+        :decode/json (fn [s]
+                       (cond
+                         (string? s)
+                         (from-string s)
+
+                         (vector? s)
+                         (let [decode-fn (deref decoder)]
+                           (-> (decode-fn s)
+                               (from-plain)))
+
+                         :else
+                         s))}}))})
+
+(def check-path-content
+  (sm/check-fn ::path/content))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; CONSTRUCTORS & PREDICATES
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn from-string
+  [s]
+  (from-plain (svg.path/parse s)))
+
+(defn from-bytes
+  [buffer]
+  #?(:clj
+     (cond
+       (instance? ByteBuffer buffer)
+       (let [size   (.capacity ^ByteBuffer buffer)
+             count  (long (/ size SEGMENT-BYTE-SIZE))
+             buffer (.order ^ByteBuffer buffer ByteOrder/LITTLE_ENDIAN)]
+         (PathData. count buffer nil))
+
+       (bytes? buffer)
+       (let [size   (alength ^bytes buffer)
+             count  (long (/ size SEGMENT-BYTE-SIZE))
+             buffer (ByteBuffer/wrap buffer)]
+         (PathData. count
+                    (.order buffer ByteOrder/LITTLE_ENDIAN)
+                    nil))
+       :else
+       (throw (java.lang.IllegalArgumentException. "invalid data provided")))
+
+     :cljs
+     (cond
+       (instance? js/ArrayBuffer buffer)
+       (let [size  (.-byteLength buffer)
+             count (long (/ size SEGMENT-BYTE-SIZE))]
+         (PathData. count
+                    buffer
+                    (js/DataView. buffer)
+                    (weak-map/create)
+                    nil))
+
+       (instance? js/DataView buffer)
+       (let [dview  buffer
+             buffer (.-buffer dview)
+             size  (.-byteLength buffer)
+             count (long (/ size SEGMENT-BYTE-SIZE))]
+         (PathData. count buffer dview (weak-map/create) nil))
+
+       (instance? js/Uint8Array buffer)
+       (from-bytes (.-buffer buffer))
+
+       (instance? js/Int8Array buffer)
+       (from-bytes (.-buffer buffer))
+
+       :else
+       (throw (js/Error. "invalid data provided")))))
+
+;; FIXME: consider implementing with reduce
+;; FIXME: consider ensure fixed precision for avoid doing it on formatting
+
+(defn from-plain
+  "Create a PathData instance from plain data structures"
+  [segments]
+  (assert (check-segments segments))
+
+  (let [total    (count segments)
+        #?@(:cljs [buffer' (allocate total)
+                   buffer  (new js/DataView buffer')]
+            :clj  [buffer  (allocate total)])]
+    (loop [index 0]
+      (when (< index total)
+        (let [segment (nth segments index)
+              offset  (* index SEGMENT-BYTE-SIZE)]
+          (case (get segment :command)
+            :move-to
+            (let [params (get segment :params)
+                  x      (float (get params :x))
+                  y      (float (get params :y))]
+              (write-short buffer offset 1)
+              (write-float buffer (+ offset 20) x)
+              (write-float buffer (+ offset 24) y))
+
+            :line-to
+            (let [params (get segment :params)
+                  x      (float (get params :x))
+                  y      (float (get params :y))]
+
+              (write-short buffer offset 2)
+              (write-float buffer (+ offset 20) x)
+              (write-float buffer (+ offset 24) y))
+
+            :curve-to
+            (let [params (get segment :params)
+                  x      (float (get params :x))
+                  y      (float (get params :y))
+                  c1x    (float (get params :c1x x))
+                  c1y    (float (get params :c1y y))
+                  c2x    (float (get params :c2x x))
+                  c2y    (float (get params :c2y y))]
+
+              (write-short buffer offset 3)
+              (write-float buffer (+ offset 4)  c1x)
+              (write-float buffer (+ offset 8)  c1y)
+              (write-float buffer (+ offset 12) c2x)
+              (write-float buffer (+ offset 16) c2y)
+              (write-float buffer (+ offset 20) x)
+              (write-float buffer (+ offset 24) y))
+
+            :close-path
+            (write-short buffer offset 4))
+          (recur (inc index)))))
+
+    (from-bytes buffer)))
+
+(defn path-data
+  "Create an instance of PathData, returns itself if it is already
+  PathData instance"
+  [data]
+  (cond
+    (path-data? data)
+    data
+
+    (nil? data)
+    (from-plain [])
+
+    (sequential? data)
+    (from-plain data)
+
+    :else
+    (throw (ex-info "unexpected data" {:data data}))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SERIALIZATION
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(t/add-handlers!
+ {:id "penpot/path-data"
+  :class PathData
+  :wfn (fn [^PathData pdata]
+         (let [buffer (.-buffer pdata)]
+           #?(:cljs (js/Uint8Array. buffer)
+              :clj  (.array ^ByteBuffer buffer))))
+  :rfn from-bytes})
+
+#?(:clj
+   (fres/add-handlers!
+    {:name "penpot/path-data"
+     :class PathData
+     :wfn (fn [n w o]
+            (fres/write-tag! w n 1)
+            (let [buffer (.-buffer ^PathData o)
+                  bytes  (.array ^ByteBuffer buffer)]
+              (fres/write-bytes! w bytes)))
+     :rfn (fn [r]
+            (let [^bytes bytes (fres/read-object! r)]
+              (from-bytes bytes)))}))
+

common/src/app/common/types/path/segment.cljc

@@ -0,0 +1,889 @@
+;; 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.types.path.segment
+  "A collection of helpers for work with plain segment type"
+  (:require
+   [app.common.data :as d]
+   [app.common.data.macros :as dm]
+   [app.common.geom.matrix :as gmt]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.rect :as grc]
+   [app.common.math :as mth]
+   [app.common.types.path.helpers :as helpers]
+   [app.common.types.path.impl :as impl]
+   [clojure.set :as set]))
+
+#?(:clj (set! *warn-on-reflection* true))
+
+(defn update-handler
+  [command prefix point]
+  (let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
+    (-> command
+        (assoc-in [:params cox] (:x point))
+        (assoc-in [:params coy] (:y point)))))
+
+(defn get-handler [{:keys [params] :as command} prefix]
+  (let [cx (d/prefix-keyword prefix :x)
+        cy (d/prefix-keyword prefix :y)]
+    (when (and command
+               (contains? params cx)
+               (contains? params cy))
+      (gpt/point (get params cx)
+                 (get params cy)))))
+
+(defn get-handlers
+  "Retrieve a map where for every point will retrieve a list of
+  the handlers that are associated with that point.
+  point -> [[index, prefix]]"
+  [content]
+  (let [prev-point* (volatile! nil)
+        vec-conj    (fnil conj [])]
+    (impl/-reduce content
+                  (fn [result index type _ _ _ _ x y]
+                    (let [curr-point (gpt/point x y)
+                          prev-point (deref prev-point*)]
+                      (vreset! prev-point* curr-point)
+                      (if (and prev-point (= :curve-to type))
+                        (-> result
+                            (update prev-point vec-conj [index :c1])
+                            (update curr-point vec-conj [index :c2]))
+                        result)))
+                  {})))
+
+(defn point-indices
+  [content point]
+  (->> (d/enumerate content)
+       (filter (fn [[_ segment]] (= point (helpers/segment->point segment))))
+       (mapv (fn [[index _]] index))))
+
+(defn handler-indices
+  "Return an index where the key is the positions and the values the handlers"
+  [content point]
+  (->> (d/with-prev content)
+       (d/enumerate)
+       (mapcat (fn [[index [cur-segment pre-segment]]]
+                 (if (and (some? pre-segment) (= :curve-to (:command cur-segment)))
+                   (let [cur-pos (helpers/segment->point cur-segment)
+                         pre-pos (helpers/segment->point pre-segment)]
+                     (cond-> []
+                       (= pre-pos point) (conj [index :c1])
+                       (= cur-pos point) (conj [index :c2])))
+                   [])))))
+
+(defn opposite-index
+  "Calculates the opposite index given a prefix and an index"
+  [content index prefix]
+
+  (let [point (if (= prefix :c2)
+                (helpers/segment->point (nth content index))
+                (helpers/segment->point (nth content (dec index))))
+
+        point->handlers (get-handlers content)
+
+        handlers (->> point
+                      (point->handlers)
+                      (filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)))))]
+
+    (cond
+      (= (count handlers) 1)
+      (->> handlers first)
+
+      (and (= :c1 prefix) (= (count content) index))
+      [(dec index) :c2]
+
+      :else nil)))
+
+;; FIXME: rename to get-point
+(defn get-handler-point
+  "Given a segment index and prefix, get a handler point"
+  [content index prefix]
+  (when (and (some? index)
+             (some? content))
+    (impl/-lookup content index
+                  (fn [command c1x c1y c2x c2y x y]
+                    (let [prefix (if (= :curve-to command)
+                                   prefix
+                                   nil)]
+                      (case prefix
+                        :c1 (gpt/point c1x c1y)
+                        :c2 (gpt/point c2x c2y)
+                        (gpt/point x y)))))))
+
+;; FIXME: revisit this function
+(defn handler->node
+  [content index prefix]
+  (if (= prefix :c1)
+    (helpers/segment->point (nth content (dec index)))
+    (helpers/segment->point (nth content index))))
+
+(defn calculate-opposite-handler
+  "Given a point and its handler, gives the symmetric handler"
+  [point handler]
+  (let [handler-vector (gpt/to-vec point handler)]
+    (gpt/add point (gpt/negate handler-vector))))
+
+(defn opposite-handler
+  "Calculates the coordinates of the opposite handler"
+  [point handler]
+  (let [phv (gpt/to-vec point handler)]
+    (gpt/add point (gpt/negate phv))))
+
+(defn get-points
+  "Returns points for the given segment, faster version of
+  the `content->points`."
+  [content]
+  (impl/with-cache content "get-points"
+    (impl/-walk content
+                (fn [type _ _ _ _ x y]
+                  (when (not= type :close-path)
+                    (gpt/point x y)))
+                [])))
+
+;; FIXME: incorrect API, don't need full shape
+(defn path->lines
+  "Given a path returns a list of lines that approximate the path"
+  [shape]
+  (loop [command (first (:content shape))
+         pending (rest (:content shape))
+         result []
+         last-start nil
+         prev-point nil]
+
+    (if-let [{:keys [command params]} command]
+      (let [point (if (= :close-path command)
+                    last-start
+                    (gpt/point params))
+
+            result (case command
+                     :line-to  (conj result [prev-point point])
+                     :curve-to (let [h1 (gpt/point (:c1x params) (:c1y params))
+                                     h2 (gpt/point (:c2x params) (:c2y params))]
+                                 (into result (helpers/curve->lines prev-point point h1 h2)))
+                     :move-to  (cond-> result
+                                 last-start (conj [prev-point last-start]))
+                     result)
+            last-start (if (= :move-to command)
+                         point
+                         last-start)]
+        (recur (first pending)
+               (rest pending)
+               result
+               last-start
+               point))
+
+      (conj result [prev-point last-start]))))
+
+(def ^:const path-closest-point-accuracy 0.01)
+
+;; FIXME: move to helpers?, this function need performance review, it
+;; is executed so many times on path edition
+(defn- curve-closest-point
+  [position start end h1 h2]
+  (let [d (memoize (fn [t] (gpt/distance position (helpers/curve-values start end h1 h2 t))))]
+    (loop [t1 0.0
+           t2 1.0]
+      (if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy)
+        (-> (helpers/curve-values start end h1 h2 t1)
+            ;; store the segment info
+            (with-meta {:t t1 :from-p start :to-p end}))
+
+        (let [ht  (+ t1 (/ (- t2 t1) 2))
+              ht1 (+ t1 (/ (- t2 t1) 4))
+              ht2 (+ t1 (/ (* 3 (- t2 t1)) 4))
+
+              [t1 t2] (cond
+                        (< (d ht1) (d ht2))
+                        [t1 ht]
+
+                        (< (d ht2) (d ht1))
+                        [ht t2]
+
+                        (and (< (d ht) (d t1)) (< (d ht) (d t2)))
+                        [ht1 ht2]
+
+                        (< (d t1) (d t2))
+                        [t1 ht]
+
+                        :else
+                        [ht t2])]
+          (recur (double t1)
+                 (double t2)))))))
+
+(defn- line-closest-point
+  "Point on line"
+  [position from-p to-p]
+
+  (let [e1 (gpt/to-vec from-p to-p)
+        e2 (gpt/to-vec from-p position)
+
+        len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1)))
+        t (/ (gpt/dot e1 e2) len2)]
+
+    (if (and (>= t 0) (<= t 1) (not (mth/almost-zero? len2)))
+      (-> (gpt/add from-p (gpt/scale e1 t))
+          (with-meta {:t t
+                      :from-p from-p
+                      :to-p to-p}))
+
+      ;; There is no perpendicular projection in the line so the closest
+      ;; point will be one of the extremes
+      (if (<= (gpt/distance position from-p) (gpt/distance position to-p))
+        from-p
+        to-p))))
+
+;; FIXME: incorrect API, complete shape is not necessary here
+(defn path-closest-point
+  "Given a path and a position"
+  [shape position]
+
+  (let [point+distance
+        (fn [[cur-segment prev-segment]]
+          (let [from-p (helpers/segment->point prev-segment)
+                to-p   (helpers/segment->point cur-segment)
+                h1 (gpt/point (get-in cur-segment [:params :c1x])
+                              (get-in cur-segment [:params :c1y]))
+                h2 (gpt/point (get-in cur-segment [:params :c2x])
+                              (get-in cur-segment [:params :c2y]))
+                point
+                (case (:command cur-segment)
+                  :line-to
+                  (line-closest-point position from-p to-p)
+
+                  :curve-to
+                  (curve-closest-point position from-p to-p h1 h2)
+
+                  nil)]
+            (when point
+              [point (gpt/distance point position)])))
+
+        find-min-point
+        (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
+          (if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
+            [min-p min-dist]
+            [cur-p cur-dist]))]
+
+    (->> (:content shape)
+         (d/with-prev)
+         (map point+distance)
+         (reduce find-min-point)
+         (first))))
+
+
+(defn closest-point
+  "Given a path and a position"
+  [content position]
+
+  (let [point+distance
+        (fn [[cur-segment prev-segment]]
+          (let [from-p (helpers/segment->point prev-segment)
+                to-p   (helpers/segment->point cur-segment)
+                h1 (gpt/point (get-in cur-segment [:params :c1x])
+                              (get-in cur-segment [:params :c1y]))
+                h2 (gpt/point (get-in cur-segment [:params :c2x])
+                              (get-in cur-segment [:params :c2y]))
+                point
+                (case (:command cur-segment)
+                  :line-to
+                  (line-closest-point position from-p to-p)
+
+                  :curve-to
+                  (curve-closest-point position from-p to-p h1 h2)
+
+                  nil)]
+            (when point
+              [point (gpt/distance point position)])))
+
+        find-min-point
+        (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
+          (if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
+            [min-p min-dist]
+            [cur-p cur-dist]))]
+
+    (->> content
+         (d/with-prev)
+         (map point+distance)
+         (reduce find-min-point)
+         (first))))
+
+(defn- remove-line-curves
+  "Remove all curves that have both handlers in the same position that the
+  beginning and end points. This makes them really line-to commands"
+  [content]
+  (let [with-prev (d/enumerate (d/with-prev content))
+        process-command
+        (fn [content [index [command prev]]]
+
+          (let [cur-point (helpers/segment->point command)
+                pre-point (helpers/segment->point prev)
+                handler-c1 (get-handler command :c1)
+                handler-c2 (get-handler command :c2)]
+            (if (and (= :curve-to (:command command))
+                     (= cur-point handler-c2)
+                     (= pre-point handler-c1))
+              (assoc content index {:command :line-to
+                                    :params (into {} cur-point)})
+              content)))]
+
+    (reduce process-command content with-prev)))
+
+(defn make-corner-point
+  "Changes the content to make a point a 'corner'"
+  [content point]
+  (let [handlers (-> (get-handlers content)
+                     (get point))
+        change-content
+        (fn [content [index prefix]]
+          (let [cx (d/prefix-keyword prefix :x)
+                cy (d/prefix-keyword prefix :y)]
+            (-> content
+                (assoc-in [index :params cx] (:x point))
+                (assoc-in [index :params cy] (:y point)))))]
+    (as-> content $
+      (reduce change-content $ handlers)
+      (remove-line-curves $))))
+
+
+(defn- line->curve
+  [from-p segment]
+
+  (let [to-p (helpers/segment->point segment)
+
+        v (gpt/to-vec from-p to-p)
+        d (gpt/distance from-p to-p)
+
+        dv1 (-> (gpt/normal-left v)
+                (gpt/scale (/ d 3)))
+
+        h1 (gpt/add from-p dv1)
+
+        dv2 (-> (gpt/to-vec to-p h1)
+                (gpt/unit)
+                (gpt/scale (/ d 3)))
+
+        h2 (gpt/add to-p dv2)]
+    (-> segment
+        (assoc :command :curve-to)
+        (update :params (fn [params]
+                          ;; ensure plain map
+                          (-> (into {} params)
+                              (assoc :c1x (:x h1))
+                              (assoc :c1y (:y h1))
+                              (assoc :c2x (:x h2))
+                              (assoc :c2y (:y h2))))))))
+
+;; FIXME: optimize
+(defn is-curve?
+  [content point]
+  (let [handlers (-> (get-handlers content)
+                     (get point))
+        handler-points (map #(get-handler-point content (first %) (second %)) handlers)]
+    (some #(not= point %) handler-points)))
+
+(def ^:private xf:mapcat-points
+  (comp
+   (mapcat #(vector (:next-p %) (:prev-p %)))
+   (remove nil?)))
+
+(defn make-curve-point
+  "Changes the content to make the point a 'curve'. The handlers will be positioned
+  in the same vector that results from the previous->next points but with fixed length."
+  [content point]
+
+  (let [indices (point-indices content point)
+        vectors (map (fn [index]
+                       (let [segment (nth content index)
+                             prev-i (dec index)
+                             prev (when (not (= :move-to (:command segment)))
+                                    (get content prev-i))
+                             next-i (inc index)
+                             next (get content next-i)
+
+                             next (when (not (= :move-to (:command next)))
+                                    next)]
+                         {:index index
+                          :prev-i (when (some? prev) prev-i)
+                          :prev-c prev
+                          :prev-p (helpers/segment->point prev)
+                          :next-i (when (some? next) next-i)
+                          :next-c next
+                          :next-p (helpers/segment->point next)
+                          :segment segment}))
+                     indices)
+
+        points (into #{} xf:mapcat-points vectors)]
+
+    (if (= (count points) 2)
+      (let [v1 (gpt/to-vec (first points) point)
+            v2 (gpt/to-vec (first points) (second points))
+            vp (gpt/project v1 v2)
+            vh (gpt/subtract v1 vp)
+
+            add-curve
+            (fn [content {:keys [index prev-p next-p next-i]}]
+              (let [cur-segment (get content index)
+                    next-segment (get content next-i)
+
+                    ;; New handlers for prev-point and next-point
+                    prev-h (when (some? prev-p) (gpt/add prev-p vh))
+                    next-h (when (some? next-p) (gpt/add next-p vh))
+
+                    ;; Correct 1/3 to the point improves the curve
+                    prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
+                    next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
+
+                    prev-h (when (some? prev-h) (gpt/add prev-h prev-correction))
+                    next-h (when (some? next-h) (gpt/add next-h next-correction))]
+                (cond-> content
+                  (and (= :line-to (:command cur-segment)) (some? prev-p))
+                  (update index helpers/update-curve-to prev-p prev-h)
+
+                  (and (= :line-to (:command next-segment)) (some? next-p))
+                  (update next-i helpers/update-curve-to next-h next-p)
+
+                  (and (= :curve-to (:command cur-segment)) (some? prev-p))
+                  (update index update-handler :c2 prev-h)
+
+                  (and (= :curve-to (:command next-segment)) (some? next-p))
+                  (update next-i update-handler :c1 next-h))))]
+
+        (reduce add-curve content vectors))
+
+      (let [add-curve
+            (fn [content {:keys [index segment prev-p next-c next-i]}]
+              (cond-> content
+                (= :line-to (:command segment))
+                (update index #(line->curve prev-p %))
+
+                (= :curve-to (:command segment))
+                (update index #(line->curve prev-p %))
+
+                (= :line-to (:command next-c))
+                (update next-i #(line->curve point %))
+
+                (= :curve-to (:command next-c))
+                (update next-i #(line->curve point %))))]
+        (reduce add-curve content vectors)))))
+
+(defn get-segments-with-points
+  "Given a content and a set of points return all the segments in the path
+  that uses the points"
+  [content points]
+  (let [point-set (set points)]
+    (loop [result      (transient [])
+           prev-point  nil
+           start-point nil
+           index       0
+           content     (seq content)]
+      (if-let [{:keys [command] :as segment} (first content)]
+        (let [close-path? (= command :close-path)
+              move-to?    (= command :move-to)
+
+              cur-point   (if close-path?
+                            start-point
+                            (helpers/segment->point segment))
+
+              ;; If there is a move-to we don't have a segment
+              prev-point  (if move-to?
+                            nil
+                            prev-point)
+
+              ;; We update the start point
+              start-point  (if move-to?
+                             cur-point
+                             start-point)
+
+              result      (cond-> result
+                            (and (some? prev-point)
+                                 (contains? point-set prev-point)
+                                 (contains? point-set cur-point))
+
+                            (conj! (-> segment
+                                       (assoc :start prev-point)
+                                       (assoc :end cur-point)
+                                       (assoc :index index))))]
+          (recur result
+                 cur-point
+                 start-point
+                 (inc index)
+                 (rest content)))
+
+        (persistent! result)))))
+
+(defn split-segments
+  "Given a content creates splits commands between points with new segments"
+  [content points value]
+
+  (let [split-command
+        (fn [{:keys [command start end index] :as segment}]
+          (case command
+            :line-to [index (helpers/split-line-to start segment value)]
+            :curve-to [index (helpers/split-curve-to start segment value)]
+            :close-path [index [(helpers/make-line-to (gpt/lerp start end value)) segment]]
+            nil))
+
+        segment-changes
+        (->> (get-segments-with-points content points)
+             (into {} (keep split-command)))
+
+        process-segments
+        (fn [[index command]]
+          (if (contains? segment-changes index)
+            (get segment-changes index)
+            [command]))]
+
+    (into [] (mapcat process-segments) (d/enumerate content))))
+
+;; FIXME: rename to next-segment
+(defn next-node
+  "Calculates the next-node to be inserted."
+  [content position prev-point prev-handler]
+  (let [position     (select-keys position [:x :y])
+        last-command (-> content last :command)
+        add-line?    (and prev-point (not prev-handler) (not= last-command :close-path))
+        add-curve?   (and prev-point prev-handler (not= last-command :close-path))]
+    (cond
+      add-line?   {:command :line-to
+                   :params position}
+      add-curve?  {:command :curve-to
+                   :params (helpers/make-curve-params position prev-handler)}
+      :else       {:command :move-to
+                   :params position})))
+(defn remove-nodes
+  "Removes from content the points given. Will try to reconstruct the paths
+  to keep everything consistent"
+  [content points]
+
+  (if (empty? points)
+    content
+
+    (let [content (d/with-prev content)]
+
+      (loop [result []
+             last-handler nil
+             [cur-segment prev-segment] (first content)
+             content (rest content)]
+
+        (if (nil? cur-segment)
+          ;; The result with be an array of arrays were every entry is a subpath
+          (->> result
+               ;; remove empty and only 1 node subpaths
+               (filter #(> (count %) 1))
+               ;; flatten array-of-arrays plain array
+               (flatten)
+               (into []))
+
+          (let [move? (= :move-to (:command cur-segment))
+                curve? (= :curve-to (:command cur-segment))
+
+                ;; When the old command was a move we start a subpath
+                result (if move? (conj result []) result)
+
+                subpath (peek result)
+
+                point (helpers/segment->point cur-segment)
+
+                old-prev-point (helpers/segment->point prev-segment)
+                new-prev-point (helpers/segment->point (peek subpath))
+
+                remove? (contains? points point)
+
+
+                ;; We store the first handler for the first curve to be removed to
+                ;; use it for the first handler of the regenerated path
+                cur-handler (cond
+                              (and (not last-handler) remove? curve?)
+                              (select-keys (:params cur-segment) [:c1x :c1y])
+
+                              (not remove?)
+                              nil
+
+                              :else
+                              last-handler)
+
+                cur-segment (cond-> cur-segment
+                              ;; If we're starting a subpath and it's not a move make it a move
+                              (and (not move?) (empty? subpath))
+                              (assoc :command :move-to
+                                     :params (select-keys (:params cur-segment) [:x :y]))
+
+                              ;; If have a curve the first handler will be relative to the previous
+                              ;; point. We change the handler to the new previous point
+                              (and curve? (seq subpath) (not= old-prev-point new-prev-point))
+                              (update :params merge last-handler))
+
+                head-idx (dec (count result))
+
+                result (cond-> result
+                         (not remove?)
+                         (update head-idx conj cur-segment))]
+            (recur result
+                   cur-handler
+                   (first content)
+                   (rest content))))))))
+
+(defn join-nodes
+  "Creates new segments between points that weren't previously"
+  [content points]
+
+  (let [segments-set (into #{}
+                           (map (juxt :start :end))
+                           (get-segments-with-points content points))
+
+        create-line-command (fn [point other]
+                              [(helpers/make-move-to point)
+                               (helpers/make-line-to other)])
+
+        not-segment? (fn [point other] (and (not (contains? segments-set [point other]))
+                                            (not (contains? segments-set [other point]))))
+
+        new-content (->> (d/map-perm create-line-command not-segment? points)
+                         (flatten)
+                         (into []))]
+
+    (into content new-content)))
+
+
+(defn separate-nodes
+  "Removes the segments between the points given"
+  [content points]
+
+  (let [content (d/with-prev content)]
+    (loop [result []
+           [cur-segment prev-segment] (first content)
+           content (rest content)]
+
+      (if (nil? cur-segment)
+        (->> result
+             (filter #(> (count %) 1))
+             (flatten)
+             (into []))
+
+        (let [prev-point (helpers/segment->point prev-segment)
+              cur-point (helpers/segment->point cur-segment)
+
+              cur-segment (cond-> cur-segment
+                            (and (contains? points prev-point)
+                                 (contains? points cur-point))
+
+                            (assoc :command :move-to
+                                   :params (select-keys (:params cur-segment) [:x :y])))
+
+              move? (= :move-to (:command cur-segment))
+
+              result (if move? (conj result []) result)
+              head-idx (dec (count result))
+
+              result (-> result
+                         (update head-idx conj cur-segment))]
+          (recur result
+                 (first content)
+                 (rest content)))))))
+
+
+(defn- add-to-set
+  "Given a list of sets adds the value to the target set"
+  [set-list target value]
+  (->> set-list
+       (mapv (fn [it]
+               (cond-> it
+                 (= it target) (conj value))))))
+
+(defn- join-sets
+  "Given a list of sets join two sets in the list into a new one"
+  [set-list target other]
+  (conj (->> set-list
+             (filterv #(and (not= % target)
+                            (not= % other))))
+        (set/union target other)))
+
+;; FIXME: revisit impl of this fn
+(defn- group-segments [segments]
+  (loop [result []
+         {point-a :start point-b :end :as segment} (first segments)
+         segments (rest segments)]
+
+    (if (nil? segment)
+      result
+
+      (let [set-a (d/seek #(contains? % point-a) result)
+            set-b (d/seek #(contains? % point-b) result)
+
+            result (cond-> result
+                     (and (nil? set-a) (nil? set-b))
+                     (conj #{point-a point-b})
+
+                     (and (some? set-a) (nil? set-b))
+                     (add-to-set set-a point-b)
+
+                     (and (nil? set-a) (some? set-b))
+                     (add-to-set set-b point-a)
+
+                     (and (some? set-a) (some? set-b) (not= set-a set-b))
+                     (join-sets set-a set-b))]
+        (recur result
+               (first segments)
+               (rest segments))))))
+
+(defn- calculate-merge-points [group-segments points]
+  (let [index-merge-point (fn [group] (vector group (gpt/center-points group)))
+        index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments)))
+
+        group->merge-point (into {} (map index-merge-point) group-segments)
+        point->group (into {} (map index-group) points)]
+    (d/mapm #(group->merge-point %2) point->group)))
+
+;; TODO: Improve the replace for curves
+(defn- replace-points
+  "Replaces the points in a path for its merge-point"
+  [content point->merge-point]
+  (let [replace-command
+        (fn [segment]
+          (let [point (helpers/segment->point segment)]
+            (if (contains? point->merge-point point)
+              (let [merge-point (get point->merge-point point)]
+                (-> segment (update :params assoc :x (:x merge-point) :y (:y merge-point))))
+              segment)))]
+    (->> content
+         (mapv replace-command))))
+
+(defn merge-nodes
+  "Reduces the contiguous segments in points to a single point"
+  [content points]
+  (let [segments (get-segments-with-points content points)]
+    (if (seq segments)
+      (let [point->merge-point (-> segments
+                                   (group-segments)
+                                   (calculate-merge-points points))]
+        (-> content
+            (separate-nodes points)
+            (replace-points point->merge-point)))
+      content)))
+
+(defn transform-content
+  "Applies a transformation matrix over content and returns a new
+  content as PathData instance."
+  [content transform]
+  (if (some? transform)
+    (impl/-transform content transform)
+    content))
+
+(defn move-content
+  "Applies a displacement over content and returns a new content as
+  PathData instance. Implemented in function of `transform-content`."
+  [content move-vec]
+  (let [transform (gmt/translate-matrix move-vec)]
+    (transform-content content transform)))
+
+(defn calculate-extremities
+  "Calculate extremities for the provided content"
+  [content]
+  (loop [points  (transient #{})
+         content (not-empty (vec content))
+         from-p  nil
+         move-p  nil]
+    (if content
+      (let [last-p  (peek content)
+            content (if (= :move-to (:command last-p))
+                      (pop content)
+                      content)
+            segment (get content 0)
+            to-p    (helpers/segment->point segment)]
+
+        (if segment
+          (case (:command segment)
+            :move-to
+            (recur (conj! points to-p)
+                   (not-empty (subvec content 1))
+                   to-p
+                   to-p)
+
+            :close-path
+            (recur (conj! points move-p)
+                   (not-empty (subvec content 1))
+                   move-p
+                   move-p)
+
+            :line-to
+            (recur (cond-> points
+                     (and from-p to-p)
+                     (-> (conj! move-p)
+                         (conj! to-p)))
+                   (not-empty (subvec content 1))
+                   to-p
+                   move-p)
+
+            :curve-to
+            (let [c1 (helpers/segment->point segment :c1)
+                  c2 (helpers/segment->point segment :c2)]
+              (recur (if (and from-p to-p c1 c2)
+                       (reduce conj!
+                               (-> points (conj! from-p) (conj! to-p))
+                               (helpers/calculate-curve-extremities from-p to-p c1 c2))
+                       points)
+
+                     (not-empty (subvec content 1))
+                     to-p
+                     move-p)))
+          (persistent! points)))
+      (persistent! points))))
+
+(defn content->selrect
+  [content]
+  (let [extremities (calculate-extremities content)
+        ;; We haven't found any extremes so we turn the commands to points
+        extremities
+        (if (empty? extremities)
+          (->> content (keep helpers/segment->point))
+          extremities)]
+
+    ;; If no points are returned we return an empty rect.
+    (if (d/not-empty? extremities)
+      (grc/points->rect extremities)
+      (grc/make-rect))))
+
+(defn content-center
+  [content]
+  (-> content
+      content->selrect
+      grc/rect->center))
+
+(defn append-segment
+  [content segment]
+  (let [content (cond
+                  (impl/path-data? content)
+                  (vec content)
+
+                  (nil? content)
+                  []
+
+                  :else
+                  content)]
+    (conj content (impl/check-segment segment))))
+
+(defn points->content
+  "Given a vector of points generate a path content.
+
+  Mainly used for generate a path content from user drawing points
+  using curve drawing tool."
+  [points & {:keys [close]}]
+  (let [initial (first points)
+        point->params
+        (fn [point]
+          {:x (dm/get-prop point :x)
+           :y (dm/get-prop point :y)})]
+    (loop [points (rest points)
+           result [{:command :move-to
+                    :params (point->params initial)}]]
+      (if-let [point (first points)]
+        (recur (rest points)
+               (conj result {:command :line-to
+                             :params (point->params point)}))
+
+        (let [result (if close
+                       (conj result {:command :close-path})
+                       result)]
+          (impl/from-plain result))))))

common/src/app/common/types/path/shape_to_path.cljc

@@ -4,58 +4,34 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.svg.path.shapes-to-path
+(ns app.common.types.path.shape-to-path
   (:require
-   [app.common.colors :as clr]
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
+   [app.common.files.helpers :as cfh]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.common :as gco]
    [app.common.geom.shapes.corners :as gso]
-   [app.common.geom.shapes.path :as gsp]
-   [app.common.svg.path.bool :as pb]
-   [app.common.svg.path.command :as pc]
+   [app.common.types.path.bool :as bool]
+   [app.common.types.path.helpers :as helpers]
+   [app.common.types.path.impl :as path.impl]
+   [app.common.types.path.segment :as segm]
    [app.common.types.shape.radius :as ctsr]))
 
-(def ^:const bezier-circle-c 0.551915024494)
+(def ^:const ^:private bezier-circle-c
+  0.551915024494)
 
-(def dissoc-attrs
+(def ^:private dissoc-attrs
   [:x :y :width :height
    :rx :ry :r1 :r2 :r3 :r4
    :metadata])
 
-(def allowed-transform-types
-  #{:rect
-    :circle
-    :image})
+(defn without-position-attrs
+  [shape]
+  (d/without-keys shape dissoc-attrs))
 
-(def style-group-properties
-  [:shadow
-   :blur])
-
-(def style-properties
-  (into style-group-properties
-        [:fill-color
-         :fill-opacity
-         :fill-color-gradient
-         :fill-color-ref-file
-         :fill-color-ref-id
-         :fill-image
-         :fills
-         :stroke-color
-         :stroke-color-ref-file
-         :stroke-color-ref-id
-         :stroke-opacity
-         :stroke-style
-         :stroke-width
-         :stroke-alignment
-         :stroke-cap-start
-         :stroke-cap-end
-         :strokes]))
-
-(def default-bool-fills [{:fill-color clr/black}])
-
-(defn make-corner-arc
+(defn- make-corner-arc
   "Creates a curvle corner for border radius"
   [from to corner radius]
   (let [x (case corner
@@ -91,9 +67,9 @@
              :bottom-right (assoc to :x c2x)
              :bottom-left  (assoc to :y c2y))]
 
-    (pc/make-curve-to to h1 h2)))
+    (helpers/make-curve-to to h1 h2)))
 
-(defn circle->path
+(defn- circle->path
   "Creates the bezier curves to approximate a circle shape"
   [{:keys [x y width height]}]
   (let [mx (+ x (/ width 2))
@@ -112,13 +88,13 @@
         c1y (+ y (* (/ height 2) (- 1 c)))
         c2y (+ y (* (/ height 2) (+ 1 c)))]
 
-    [(pc/make-move-to p1)
-     (pc/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
-     (pc/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
-     (pc/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
-     (pc/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
+    [(helpers/make-move-to p1)
+     (helpers/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
+     (helpers/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
+     (helpers/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
+     (helpers/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
 
-(defn draw-rounded-rect-path
+(defn- draw-rounded-rect-path
   ([x y width height r]
    (draw-rounded-rect-path x y width height r r r r))
 
@@ -135,21 +111,21 @@
          p7 (gpt/point (+ x r4) (+ height y))
          p8 (gpt/point x (+ height y (- r4)))]
      (-> []
-         (conj (pc/make-move-to p1))
+         (conj (helpers/make-move-to p1))
          (cond-> (not= p1 p2)
            (conj (make-corner-arc p1 p2 :top-left r1)))
-         (conj (pc/make-line-to p3))
+         (conj (helpers/make-line-to p3))
          (cond-> (not= p3 p4)
            (conj (make-corner-arc p3 p4 :top-right r2)))
-         (conj (pc/make-line-to p5))
+         (conj (helpers/make-line-to p5))
          (cond-> (not= p5 p6)
            (conj (make-corner-arc p5 p6 :bottom-right r3)))
-         (conj (pc/make-line-to p7))
+         (conj (helpers/make-line-to p7))
          (cond-> (not= p7 p8)
            (conj (make-corner-arc p7 p8 :bottom-left r4)))
-         (conj (pc/make-line-to p1))))))
+         (conj (helpers/make-line-to p1))))))
 
-(defn rect->path
+(defn- rect->path
   "Creates a bezier curve that approximates a rounded corner rectangle"
   [{:keys [x y width height] :as shape}]
   (case (ctsr/radius-mode shape)
@@ -165,7 +141,10 @@
 
 (declare convert-to-path)
 
-(defn fix-first-relative
+;; FIXME: this looks unnecesary because penpot already normalizes all
+;; path content to be absolute. There are no relative segments on
+;; penpot.
+(defn- fix-first-relative
   "Fix an issue with the simplify commands not changing the first relative"
   [content]
   (let [head (first content)]
@@ -173,17 +152,19 @@
       (and head (:relative head))
       (update 0 assoc :relative false))))
 
-(defn group-to-path
+(defn- group-to-path
   [group objects]
-  (let [xform (comp (map #(get objects %))
-                    (map #(-> (convert-to-path % objects))))
+  (let [xform (comp (map (d/getf objects))
+                    (map #(convert-to-path % objects)))
 
         child-as-paths (into [] xform (:shapes group))
-        head (last child-as-paths)
-        head-data (select-keys head style-properties)
+        head (peek child-as-paths)
+        head-data (select-keys head bool/style-properties)
         content (into []
-                      (comp (filter #(= :path (:type %)))
-                            (mapcat #(fix-first-relative (:content %))))
+                      (comp (filter cfh/path-shape?)
+                            (map :content)
+                            (map vec)
+                            (mapcat fix-first-relative))
                       child-as-paths)]
     (-> group
         (assoc :type :path)
@@ -191,54 +172,68 @@
         (merge head-data)
         (d/without-keys dissoc-attrs))))
 
-(defn bool-to-path
+(defn- bool-to-path
   [shape objects]
 
-  (let [children (->> (:shapes shape)
-                      (map #(get objects %))
-                      (map #(convert-to-path % objects)))
-        bool-type (:bool-type shape)
-        content (pb/content-bool bool-type (mapv :content children))]
+  (let [children
+        (->> (:shapes shape)
+             (map (d/getf objects))
+             (map #(convert-to-path % objects)))
+
+        bool-type
+        (:bool-type shape)
+
+        content
+        (bool/calculate-content bool-type (map :content children))]
+
     (-> shape
         (assoc :type :path)
         (assoc :content content)
+        (dissoc :bool-type)
         (d/without-keys dissoc-attrs))))
 
 (defn convert-to-path
-  "Transforms the given shape to a path"
-  ([shape]
-   (convert-to-path shape {}))
-  ([{:keys [type metadata] :as shape} objects]
-   (assert (map? objects))
-   (case type
-     (:group :frame)
-     (group-to-path shape objects)
+  "Transforms the given shape to a path shape"
+  [shape objects]
+  (assert (map? objects))
+  ;; FIXME: add check-objects-like
+  ;; FIXME: add check-shape ?
 
-     :bool
-     (bool-to-path shape objects)
+  (let [type (dm/get-prop shape :type)]
 
-     (:rect :circle :image :text)
-     (let [new-content
-           (case type
-             :circle (circle->path shape)
-             #_:else (rect->path shape))
+    (case type
+      (:group :frame)
+      (group-to-path shape objects)
 
-           ;; Apply the transforms that had the shape
-           transform
-           (cond-> (:transform shape (gmt/matrix))
-             (:flip-x shape) (gmt/scale (gpt/point -1 1))
-             (:flip-y shape) (gmt/scale (gpt/point 1 -1)))
+      :bool
+      (bool-to-path shape objects)
 
-           new-content (cond-> new-content
-                         (some? transform)
-                         (gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
+      (:rect :circle :image :text)
+      (let [content
+            (if (= type :circle)
+              (circle->path shape)
+              (rect->path shape))
 
-       (-> shape
-           (assoc :type :path)
-           (assoc :content new-content)
-           (cond-> (= :image type)
-             (assoc :fill-image metadata))
-           (d/without-keys dissoc-attrs)))
+            content
+            (path.impl/from-plain content)
 
-     ;; For the rest return the plain shape
-     shape)))
+            ;; Apply the transforms that had the shape
+            transform
+            (cond-> (:transform shape (gmt/matrix))
+              (:flip-x shape) (gmt/scale (gpt/point -1 1))
+              (:flip-y shape) (gmt/scale (gpt/point 1 -1)))
+
+            content
+            (cond-> content
+              (some? transform)
+              (segm/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
+
+        (-> shape
+            (assoc :type :path)
+            (assoc :content content)
+            (cond-> (= :image type)
+              (assoc :fill-image (get shape :metadata)))
+            (d/without-keys dissoc-attrs)))
+
+      ;; For the rest return the plain shape
+      shape)))

common/src/app/common/types/path/subpath.cljc

@@ -4,11 +4,11 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.svg.path.subpath
+(ns app.common.types.path.subpath
   (:require
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
-   [app.common.svg.path.command :as upc]))
+   [app.common.types.path.helpers :as helpers]))
 
 (defn pt=
   "Check if two points are close"
@@ -18,7 +18,7 @@
 (defn make-subpath
   "Creates a subpath either from a single command or with all the data"
   ([command]
-   (let [p (upc/command->point command)]
+   (let [p (helpers/segment->point command)]
      (make-subpath p p [command])))
   ([from to data]
    {:from from
@@ -29,9 +29,9 @@
   "Adds a command to the subpath"
   [subpath command]
   (let [command (if (= :close-path (:command command))
-                  (upc/make-line-to (:from subpath))
+                  (helpers/make-line-to (:from subpath))
                   command)
-        p (upc/command->point command)]
+        p (helpers/segment->point command)]
     (-> subpath
         (assoc :to p)
         (update :data conj command))))
@@ -62,7 +62,7 @@
             result))
 
         new-data (->> subpath :data d/with-prev reverse
-                      (reduce reverse-commands [(upc/make-move-to (:to subpath))]))]
+                      (reduce reverse-commands [(helpers/make-move-to (:to subpath))]))]
 
     (make-subpath (:to subpath) (:from subpath) new-data)))
 
@@ -125,8 +125,11 @@
 (defn is-closed? [subpath]
   (pt= (:from subpath) (:to subpath)))
 
+(def ^:private xf-mapcat-data
+  (mapcat :data))
+
 (defn close-subpaths
-  "Searches a path for possible supaths that can create closed loops and merge them"
+  "Searches a path for possible subpaths that can create closed loops and merge them"
   [content]
   (let [subpaths (get-subpaths content)
         closed-subpaths
@@ -153,20 +156,17 @@
                        new-subpaths)))
             result))]
 
-    (->> closed-subpaths
-         (mapcat :data)
-         (into []))))
 
+    (into [] xf-mapcat-data closed-subpaths)))
+
+;; FIXME: revisit this fn impl for perfromance
 (defn reverse-content
   "Given a content reverse the order of the commands"
   [content]
-
-  (->> content
-       (get-subpaths)
+  (->> (get-subpaths content)
        (mapv reverse-subpath)
        (reverse)
-       (mapcat :data)
-       (into [])))
+       (into [] xf-mapcat-data)))
 
 ;; https://mathworld.wolfram.com/PolygonArea.html
 (defn clockwise?
@@ -181,10 +181,10 @@
       (if (nil? current)
         (> signed-area 0)
 
-        (let [{x1 :x y1 :y :as p} (upc/command->point current)
+        (let [{x1 :x y1 :y :as p} (helpers/segment->point current)
               last? (nil? (first subpath))
               first-point (if (nil? first-point) p first-point)
-              {x2 :x y2 :y} (if last? first-point (upc/command->point (first subpath)))
+              {x2 :x y2 :y} (if last? first-point (helpers/segment->point (first subpath)))
               signed-area (+ signed-area (- (* x1 y2) (* x2 y1)))]
 
           (recur (first subpath)

common/src/app/common/types/plugins.cljc

@@ -22,14 +22,13 @@
    :keyword])
 
 (def schema:plugin-data
-  [:map-of {:gen/max 5}
-   schema:keyword
+  (sm/register!
+   ^{::sm/type ::plugin-data}
    [:map-of {:gen/max 5}
-    schema:string
-    schema:string]])
-
-(sm/register! ::plugin-data schema:plugin-data)
-
+    schema:keyword
+    [:map-of {:gen/max 5}
+     schema:string
+     schema:string]]))
 
 (def ^:private schema:registry-entry
   [:map

common/src/app/common/types/shape.cljc

@@ -22,16 +22,18 @@
    [app.common.transit :as t]
    [app.common.types.color :as ctc]
    [app.common.types.grid :as ctg]
+   [app.common.types.path :as path]
+   [app.common.types.path.segment :as path.segment]
    [app.common.types.plugins :as ctpg]
    [app.common.types.shape.attrs :refer [default-color]]
    [app.common.types.shape.blur :as ctsb]
    [app.common.types.shape.export :as ctse]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.layout :as ctsl]
-   [app.common.types.shape.path :as ctsp]
    [app.common.types.shape.shadow :as ctss]
    [app.common.types.shape.text :as ctsx]
    [app.common.types.token :as cto]
+   [app.common.types.variant :as ctv]
    [app.common.uuid :as uuid]
    [clojure.set :as set]))
 
@@ -118,35 +120,35 @@
   [:vector {:gen/max 4 :gen/min 4} ::gpt/point])
 
 (def schema:fill
-  [:map {:title "Fill"}
-   [:fill-color {:optional true} ::ctc/rgb-color]
-   [:fill-opacity {:optional true} ::sm/safe-number]
-   [:fill-color-gradient {:optional true} [:maybe ::ctc/gradient]]
-   [:fill-color-ref-file {:optional true} [:maybe ::sm/uuid]]
-   [:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]]
-   [:fill-image {:optional true} ::ctc/image-color]])
+  (sm/register!
+   ^{::sm/type ::fill}
+   [:map {:title "Fill"}
+    [:fill-color {:optional true} ::ctc/rgb-color]
+    [:fill-opacity {:optional true} ::sm/safe-number]
+    [:fill-color-gradient {:optional true} [:maybe ::ctc/gradient]]
+    [:fill-color-ref-file {:optional true} [:maybe ::sm/uuid]]
+    [:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]]
+    [:fill-image {:optional true} ::ctc/image-color]]))
 
-(sm/register! ::fill schema:fill)
-
-(def ^:private schema:stroke
-  [:map {:title "Stroke"}
-   [:stroke-color {:optional true} :string]
-   [:stroke-color-ref-file {:optional true} ::sm/uuid]
-   [:stroke-color-ref-id {:optional true} ::sm/uuid]
-   [:stroke-opacity {:optional true} ::sm/safe-number]
-   [:stroke-style {:optional true}
-    [::sm/one-of #{:solid :dotted :dashed :mixed :none :svg}]]
-   [:stroke-width {:optional true} ::sm/safe-number]
-   [:stroke-alignment {:optional true}
-    [::sm/one-of #{:center :inner :outer}]]
-   [:stroke-cap-start {:optional true}
-    [::sm/one-of stroke-caps]]
-   [:stroke-cap-end {:optional true}
-    [::sm/one-of stroke-caps]]
-   [:stroke-color-gradient {:optional true} ::ctc/gradient]
-   [:stroke-image {:optional true} ::ctc/image-color]])
-
-(sm/register! ::stroke schema:stroke)
+(def schema:stroke
+  (sm/register!
+   ^{::sm/type ::stroke}
+   [:map {:title "Stroke"}
+    [:stroke-color {:optional true} :string]
+    [:stroke-color-ref-file {:optional true} ::sm/uuid]
+    [:stroke-color-ref-id {:optional true} ::sm/uuid]
+    [:stroke-opacity {:optional true} ::sm/safe-number]
+    [:stroke-style {:optional true}
+     [::sm/one-of #{:solid :dotted :dashed :mixed :none :svg}]]
+    [:stroke-width {:optional true} ::sm/safe-number]
+    [:stroke-alignment {:optional true}
+     [::sm/one-of #{:center :inner :outer}]]
+    [:stroke-cap-start {:optional true}
+     [::sm/one-of stroke-caps]]
+    [:stroke-cap-end {:optional true}
+     [::sm/one-of stroke-caps]]
+    [:stroke-color-gradient {:optional true} ::ctc/gradient]
+    [:stroke-image {:optional true} ::ctc/image-color]]))
 
 (def check-stroke
   (sm/check-fn schema:stroke))
@@ -170,8 +172,7 @@
    [:width ::sm/safe-number]
    [:height ::sm/safe-number]])
 
-;; FIXME: rename to shape-generic-attrs
-(def schema:shape-attrs
+(def schema:shape-generic-attrs
   [:map {:title "ShapeAttrs"}
    [:page-id {:optional true} ::sm/uuid]
    [:component-id {:optional true}  ::sm/uuid]
@@ -233,7 +234,7 @@
   [:map {:title "BoolAttrs"}
    [:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
    [:bool-type [::sm/one-of bool-types]]
-   [:bool-content ::ctsp/content]])
+   [:content ::path/content]])
 
 (def ^:private schema:rect-attrs
   [:map {:title "RectAttrs"}])
@@ -258,7 +259,7 @@
 
 (def ^:private schema:path-attrs
   [:map {:title "PathAttrs"}
-   [:content ::ctsp/content]])
+   [:content ::path/content]])
 
 (def ^:private schema:text-attrs
   [:map {:title "TextAttrs"}
@@ -275,7 +276,7 @@
   []
   (->> (sg/generator schema:shape-base-attrs)
        (sg/mcat (fn [{:keys [type] :as shape}]
-                  (sg/let [attrs1 (sg/generator schema:shape-attrs)
+                  (sg/let [attrs1 (sg/generator schema:shape-generic-attrs)
                            attrs2 (sg/generator schema:shape-geom-attrs)
                            attrs3 (case type
                                     :text    (sg/generator schema:text-attrs)
@@ -293,92 +294,100 @@
                       (merge attrs1 shape attrs2 attrs3)))))
        (sg/fmap create-shape)))
 
+(def schema:shape-attrs
+  [:multi {:dispatch :type
+           :decode/json (fn [shape]
+                          (update shape :type keyword))
+           :title "Shape"}
+   [:group
+    [:merge {:title "GroupShape"}
+     ctsl/schema:layout-attrs
+     schema:group-attrs
+     schema:shape-generic-attrs
+     schema:shape-geom-attrs
+     schema:shape-base-attrs]]
+
+   [:frame
+    [:merge {:title "FrameShape"}
+     ctsl/schema:layout-attrs
+     ::ctsl/layout-attrs
+     schema:frame-attrs
+     schema:shape-generic-attrs
+     schema:shape-geom-attrs
+     schema:shape-base-attrs
+     ::ctv/variant-shape
+     ::ctv/variant-container]]
+
+   [:bool
+    [:merge {:title "BoolShape"}
+     ctsl/schema:layout-attrs
+     schema:bool-attrs
+     schema:shape-generic-attrs
+     schema:shape-base-attrs]]
+
+   [:rect
+    [:merge {:title "RectShape"}
+     ctsl/schema:layout-attrs
+     schema:rect-attrs
+     schema:shape-generic-attrs
+     schema:shape-geom-attrs
+     schema:shape-base-attrs]]
+
+   [:circle
+    [:merge {:title "CircleShape"}
+     ctsl/schema:layout-attrs
+     schema:circle-attrs
+     schema:shape-generic-attrs
+     schema:shape-geom-attrs
+     schema:shape-base-attrs]]
+
+   [:image
+    [:merge {:title "ImageShape"}
+     ctsl/schema:layout-attrs
+     schema:image-attrs
+     schema:shape-generic-attrs
+     schema:shape-geom-attrs
+     schema:shape-base-attrs]]
+
+   [:svg-raw
+    [:merge {:title "SvgRawShape"}
+     ctsl/schema:layout-attrs
+     schema:svg-raw-attrs
+     schema:shape-generic-attrs
+     schema:shape-geom-attrs
+     schema:shape-base-attrs]]
+
+   [:path
+    [:merge {:title "PathShape"}
+     ctsl/schema:layout-attrs
+     schema:path-attrs
+     schema:shape-generic-attrs
+     schema:shape-base-attrs]]
+
+   [:text
+    [:merge {:title "TextShape"}
+     ctsl/schema:layout-attrs
+     schema:text-attrs
+     schema:shape-generic-attrs
+     schema:shape-geom-attrs
+     schema:shape-base-attrs]]])
+
 (def schema:shape
-  [:and {:title "Shape"
-         :gen/gen (shape-generator)
-         :decode/json {:leave decode-shape}}
-   [:fn shape?]
-   [:multi {:dispatch :type
-            :decode/json (fn [shape]
-                           (update shape :type keyword))
-            :title "Shape"}
-    [:group
-     [:merge {:title "GroupShape"}
-      ::ctsl/layout-child-attrs
-      schema:group-attrs
-      schema:shape-attrs
-      schema:shape-geom-attrs
-      schema:shape-base-attrs]]
+  (sm/register!
+   ^{::sm/type ::shape}
+   [:and {:title "Shape"
+          :gen/gen (shape-generator)
+          :decode/json {:leave decode-shape}}
+    [:fn shape?]
+    schema:shape-attrs]))
 
-    [:frame
-     [:merge {:title "FrameShape"}
-      ::ctsl/layout-child-attrs
-      ::ctsl/layout-attrs
-      schema:frame-attrs
-      schema:shape-attrs
-      schema:shape-geom-attrs
-      schema:shape-base-attrs]]
+(def check-shape-generic-attrs
+  (sm/check-fn schema:shape-generic-attrs))
 
-    [:bool
-     [:merge {:title "BoolShape"}
-      ::ctsl/layout-child-attrs
-      schema:bool-attrs
-      schema:shape-attrs
-      schema:shape-base-attrs]]
-
-    [:rect
-     [:merge {:title "RectShape"}
-      ::ctsl/layout-child-attrs
-      schema:rect-attrs
-      schema:shape-attrs
-      schema:shape-geom-attrs
-      schema:shape-base-attrs]]
-
-    [:circle
-     [:merge {:title "CircleShape"}
-      ::ctsl/layout-child-attrs
-      schema:circle-attrs
-      schema:shape-attrs
-      schema:shape-geom-attrs
-      schema:shape-base-attrs]]
-
-    [:image
-     [:merge {:title "ImageShape"}
-      ::ctsl/layout-child-attrs
-      schema:image-attrs
-      schema:shape-attrs
-      schema:shape-geom-attrs
-      schema:shape-base-attrs]]
-
-    [:svg-raw
-     [:merge {:title "SvgRawShape"}
-      ::ctsl/layout-child-attrs
-      schema:svg-raw-attrs
-      schema:shape-attrs
-      schema:shape-geom-attrs
-      schema:shape-base-attrs]]
-
-    [:path
-     [:merge {:title "PathShape"}
-      ::ctsl/layout-child-attrs
-      schema:path-attrs
-      schema:shape-attrs
-      schema:shape-base-attrs]]
-
-    [:text
-     [:merge {:title "TextShape"}
-      ::ctsl/layout-child-attrs
-      schema:text-attrs
-      schema:shape-attrs
-      schema:shape-geom-attrs
-      schema:shape-base-attrs]]]])
-
-(sm/register! ::shape schema:shape)
-
-(def check-shape-attrs!
+(def check-shape-attrs
   (sm/check-fn schema:shape-attrs))
 
-(def check-shape!
+(def check-shape
   (sm/check-fn schema:shape
                :hint "expected valid shape"))
 
@@ -393,6 +402,50 @@
   (or (some :fill-image fills)
       (some :stroke-image strokes)))
 
+;; Valid attributes
+
+(def ^:private allowed-shape-attrs #{:page-id :component-id :component-file :component-root :main-instance
+                                     :remote-synced :shape-ref :touched :blocked :collapsed :locked
+                                     :hidden :masked-group :fills :proportion :proportion-lock :constraints-h
+                                     :constraints-v :fixed-scroll :r1 :r2 :r3 :r4 :opacity :grids :exports
+                                     :strokes :blend-mode :interactions :shadow :blur :grow-type :applied-tokens
+                                     :plugin-data})
+(def ^:private allowed-shape-geom-attrs #{:x :y :width :height})
+(def ^:private allowed-shape-base-attrs #{:id :name :type :selrect :points :transform :transform-inverse :parent-id :frame-id})
+(def ^:private allowed-bool-attrs #{:shapes :bool-type :content})
+(def ^:private allowed-group-attrs #{:shapes})
+(def ^:private allowed-frame-attrs #{:shapes :hide-fill-on-export :show-content :hide-in-viewer})
+(def ^:private allowed-image-attrs #{:metadata})
+(def ^:private allowed-svg-attrs #{:content})
+(def ^:private allowed-path-attrs #{:content})
+(def ^:private allowed-text-attrs #{:content})
+(def ^:private allowed-generic-attrs (set/union allowed-shape-attrs allowed-shape-geom-attrs allowed-shape-base-attrs))
+
+(defn is-allowed-attr?
+  [attr type]
+  (case type
+    :group   (or (contains? allowed-group-attrs attr)
+                 (contains? allowed-generic-attrs attr))
+    :frame   (or (contains? allowed-frame-attrs attr)
+                 (contains? allowed-generic-attrs attr))
+    :bool    (or (contains? allowed-bool-attrs attr)
+                 (contains? allowed-shape-attrs attr)
+                 (contains? allowed-shape-base-attrs attr))
+    :rect    (contains? allowed-generic-attrs attr)
+    :circle  (contains? allowed-generic-attrs attr)
+    :image   (or (contains? allowed-image-attrs attr)
+                 (contains? allowed-generic-attrs attr))
+    :svg-raw (or (contains? allowed-svg-attrs attr)
+                 (contains? allowed-generic-attrs attr))
+    :path    (or (contains? allowed-path-attrs attr)
+                 (contains? allowed-shape-attrs attr)
+                 (contains? allowed-shape-base-attrs attr))
+    :text    (or (contains? allowed-text-attrs attr)
+                 (contains? allowed-generic-attrs attr))))
+
+
+
+
 ;; --- Initialization
 
 (def ^:private minimal-rect-attrs
@@ -522,7 +575,7 @@
 (defn setup-path
   [{:keys [content selrect points] :as shape}]
   (let [selrect (or selrect
-                    (gsh/content->selrect content)
+                    (path.segment/content->selrect content)
                     (grc/make-rect))
         points  (or points  (grc/rect->points selrect))]
     (-> shape

common/src/app/common/types/shape/layout.cljc

@@ -168,25 +168,24 @@
 (def item-align-self-types
   #{:start :end :center :stretch})
 
-(sm/register!
- ^{::sm/type ::layout-child-attrs}
- [:map {:title "LayoutChildAttrs"}
-  [:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
-  [:layout-item-margin {:optional true}
-   [:map
-    [:m1 {:optional true} ::sm/safe-number]
-    [:m2 {:optional true} ::sm/safe-number]
-    [:m3 {:optional true} ::sm/safe-number]
-    [:m4 {:optional true} ::sm/safe-number]]]
-  [:layout-item-max-h {:optional true} ::sm/safe-number]
-  [:layout-item-min-h {:optional true} ::sm/safe-number]
-  [:layout-item-max-w {:optional true} ::sm/safe-number]
-  [:layout-item-min-w {:optional true} ::sm/safe-number]
-  [:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]]
-  [:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]]
-  [:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]]
-  [:layout-item-absolute {:optional true} :boolean]
-  [:layout-item-z-index {:optional true} ::sm/safe-number]])
+(def schema:layout-attrs
+  [:map {:title "LayoutChildAttrs"}
+   [:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
+   [:layout-item-margin {:optional true}
+    [:map
+     [:m1 {:optional true} ::sm/safe-number]
+     [:m2 {:optional true} ::sm/safe-number]
+     [:m3 {:optional true} ::sm/safe-number]
+     [:m4 {:optional true} ::sm/safe-number]]]
+   [:layout-item-max-h {:optional true} ::sm/safe-number]
+   [:layout-item-min-h {:optional true} ::sm/safe-number]
+   [:layout-item-max-w {:optional true} ::sm/safe-number]
+   [:layout-item-min-w {:optional true} ::sm/safe-number]
+   [:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]]
+   [:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]]
+   [:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]]
+   [:layout-item-absolute {:optional true} :boolean]
+   [:layout-item-z-index {:optional true} ::sm/safe-number]])
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SCHEMAS

common/src/app/common/types/shape/path.cljc

@@ -1,56 +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 app.common.types.shape.path
-  (:require
-   [app.common.schema :as sm]))
-
-(def schema:line-to-segment
-  [:map
-   [:command [:= :line-to]]
-   [:params
-    [:map
-     [:x ::sm/safe-number]
-     [:y ::sm/safe-number]]]])
-
-(def schema:close-path-segment
-  [:map
-   [:command [:= :close-path]]])
-
-(def schema:move-to-segment
-  [:map
-   [:command [:= :move-to]]
-   [:params
-    [:map
-     [:x ::sm/safe-number]
-     [:y ::sm/safe-number]]]])
-
-(def schema:curve-to-segment
-  [:map
-   [:command [:= :curve-to]]
-   [:params
-    [:map
-     [:x ::sm/safe-number]
-     [:y ::sm/safe-number]
-     [:c1x ::sm/safe-number]
-     [:c1y ::sm/safe-number]
-     [:c2x ::sm/safe-number]
-     [:c2y ::sm/safe-number]]]])
-
-(def schema:path-segment
-  [:multi {:title "PathSegment"
-           :dispatch :command
-           :decode/json #(update % :command keyword)}
-   [:line-to schema:line-to-segment]
-   [:close-path schema:close-path-segment]
-   [:move-to schema:move-to-segment]
-   [:curve-to schema:curve-to-segment]])
-
-(def schema:path-content
-  [:vector schema:path-segment])
-
-(sm/register! ::segment schema:path-segment)
-(sm/register! ::content schema:path-content)

common/src/app/common/types/shape_tree.cljc

@@ -16,6 +16,8 @@
    [app.common.types.shape.layout :as ctl]
    [app.common.uuid :as uuid]))
 
+
+;; FIXME: the order of arguments seems arbitrary, container should be a first artgument
 (defn add-shape
   "Insert a shape in the tree, at the given index below the given parent or frame.
   Update the parent as needed."

common/src/app/common/types/token.cljc

@@ -66,16 +66,6 @@
   [n]
   (string? n))
 
-;; TODO Move this to tokens-lib
-(sm/register!
- ^{::sm/type ::token}
- [:map {:title "Token"}
-  [:name token-name-ref]
-  [:type [::sm/one-of token-types]]
-  [:value :any]
-  [:description {:optional true} [:maybe :string]]
-  [:modified-at {:optional true} ::sm/inst]])
-
 (sm/register!
  ^{::sm/type ::color}
  [:map

common/src/app/common/types/token_theme.cljc

@@ -1,28 +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 app.common.types.token-theme
-  (:require
-   [app.common.schema :as sm]))
-
-(sm/register!
- ^{::sm/type ::token-theme}
- [:map {:title "TokenTheme"}
-  [:name :string]
-  [:group :string]
-  [:description [:maybe :string]]
-  [:is-source :boolean]
-  [:id :string]
-  [:modified-at {:optional true} ::sm/inst]
-  [:sets :any]])
-
-(sm/register!
- ^{::sm/type ::token-set}
- [:map {:title "TokenSet"}
-  [:name :string]
-  [:description {:optional true} [:maybe :string]]
-  [:modified-at {:optional true} ::sm/inst]
-  [:tokens {:optional true} :any]])

common/src/app/common/types/tokens_lib.cljc

@@ -9,7 +9,9 @@
    #?(:clj [app.common.fressian :as fres])
    [app.common.data :as d]
    [app.common.data.macros :as dm]
+   [app.common.files.helpers :as cfh]
    [app.common.schema :as sm]
+   [app.common.schema.generators :as sg]
    [app.common.time :as dt]
    [app.common.transit :as t]
    [app.common.types.token :as cto]
@@ -117,12 +119,15 @@
    [:name cto/token-name-ref]
    [:type [::sm/one-of cto/token-types]]
    [:value :any]
-   [:description [:maybe :string]]
-   [:modified-at ::sm/inst]])
+   [:description {:optional true} :string]
+   [:modified-at {:optional true} ::sm/inst]])
+
+(declare make-token)
 
 (def schema:token
-  [:and
-   schema:token-attrs
+  [:and {:gen/gen (->> (sg/generator schema:token-attrs)
+                       (sg/fmap #(make-token %)))}
+   (sm/required-keys schema:token-attrs)
    [:fn token?]])
 
 (def check-token
@@ -321,6 +326,7 @@
            (assoc-in [:ids temp-id] token))))
    {:tokens-tree {} :ids {}} tokens))
 
+
 (defprotocol ITokenSet
   (update-name [_ set-name] "change a token set name while keeping the path")
   (add-token [_ token] "add a token at the end of the list")
@@ -380,15 +386,32 @@
 (def schema:token-set-attrs
   [:map {:title "TokenSet"}
    [:name :string]
-   [:description [:maybe :string]]
-   [:modified-at ::sm/inst]
-   [:tokens [:and
-             [:map-of {:gen/max 5} :string schema:token]
-             [:fn d/ordered-map?]]]])
+   [:description {:optional true} :string]
+   [:modified-at {:optional true} ::sm/inst]
+   [:tokens {:optional true
+             :gen/gen (->> (sg/generator [:map-of ::sm/text schema:token])
+                           (sg/fmap #(into (d/ordered-map) %)))}
+    [:and
+     [:map-of {:gen/max 5
+               :decode/json (fn [v]
+                              (cond
+                                (d/ordered-map? v)
+                                v
+
+                                (map? v)
+                                (into (d/ordered-map) v)
+
+                                :else
+                                v))}
+      :string schema:token]
+     [:fn d/ordered-map?]]]])
+
+(declare make-token-set)
 
 (def schema:token-set
-  [:and
-   schema:token-set-attrs
+  [:and {:gen/gen (->> (sg/generator schema:token-set-attrs)
+                       (sg/fmap #(make-token-set %)))}
+   (sm/required-keys schema:token-set-attrs)
    [:fn token-set?]])
 
 (sm/register! ::token-set schema:token-set)
@@ -552,16 +575,16 @@
 (def schema:token-theme-attrs
   [:map {:title "TokenTheme"}
    [:name :string]
-   [:group :string]
-   [:description [:maybe :string]]
-   [:is-source [:maybe :boolean]]
-   [:id :string]
-   [:modified-at ::sm/inst]
-   [:sets [:set {:gen/max 5} :string]]])
+   [:group {:optional true} :string]
+   [:description {:optional true} :string]
+   [:is-source {:optional true} :boolean]
+   [:id {:optional true} :string]
+   [:modified-at {:optional true} ::sm/inst]
+   [:sets {:optional true} [:set {:gen/max 5} :string]]])
 
 (def schema:token-theme
   [:and
-   schema:token-theme-attrs
+   (sm/required-keys schema:token-theme-attrs)
    [:fn token-theme?]])
 
 (sm/register! ::token-theme schema:token-theme)
@@ -803,7 +826,7 @@
          (map-indexed (fn [index item]
                         (assoc item :index index))))))
 
-(defn- flatten-nested-tokens-json
+(defn flatten-nested-tokens-json
   "Recursively flatten the dtcg token structure, joining keys with '.'."
   [tokens token-path]
   (reduce-kv
@@ -830,7 +853,7 @@
 
 (declare make-tokens-lib)
 
-(defn- legacy-nodes->dtcg-nodes [sets-data]
+(defn legacy-nodes->dtcg-nodes [sets-data]
   (walk/postwalk
    (fn [node]
      (cond-> node
@@ -866,8 +889,6 @@ Will return a value that matches this schema:
   (get-active-themes-set-tokens [_] "set of set names that are active in the the active themes")
   (encode-dtcg [_] "Encodes library to a dtcg compatible json string")
   (decode-dtcg-json [_ parsed-json] "Decodes parsed json containing tokens and converts to library")
-  (decode-single-set-json [_ set-name tokens] "Decodes parsed json containing single token set and converts to library")
-  (decode-single-set-legacy-json [_ set-name tokens] "Decodes parsed legacy json containing single token set and converts to library")
   (decode-legacy-json [_ parsed-json] "Decodes parsed legacy json containing tokens and converts to library")
   (get-all-tokens [_] "all tokens in the lib")
   (validate [_]))
@@ -922,6 +943,7 @@ Will return a value that matches this schema:
         this)))
 
 
+
   (delete-set [_ set-name]
     (let [prefixed-path (set-name->prefixed-full-path set-name)]
       (TokensLib. (d/dissoc-in sets prefixed-path)
@@ -1311,17 +1333,6 @@ Will return a value that matches this schema:
           (assoc-in ["$metadata" "activeThemes"] active-themes-clear)
           (assoc-in ["$metadata" "activeSets"] active-sets))))
 
-  (decode-single-set-json [this set-name tokens]
-    (assert (map? tokens) "expected a map data structure for `data`")
-
-    (add-set this (make-token-set :name (normalize-set-name set-name)
-                                  :tokens (flatten-nested-tokens-json tokens ""))))
-
-
-  (decode-single-set-legacy-json [this set-name tokens]
-    (assert (map? tokens) "expected a map data structure for `data`")
-    (decode-single-set-json this set-name (legacy-nodes->dtcg-nodes tokens)))
-
   (decode-dtcg-json [_ data]
     (assert (map? data) "expected a map data structure for `data`")
 
@@ -1481,6 +1492,14 @@ Will return a value that matches this schema:
    {:encode/json encode-dtcg
     :decode/json decode-dtcg}})
 
+(defn duplicate-set [set-name lib & {:keys [suffix]}]
+  (let [sets (get-sets lib)
+        unames (map :name sets)
+        copy-name (cfh/generate-unique-name set-name unames :suffix suffix)]
+    (some-> (get-set lib set-name)
+            (assoc :name copy-name)
+            (assoc :modified-at (dt/now)))))
+
 (sm/register! type:tokens-lib)
 
 ;; === Serialization handlers for RPC API (transit) and database (fressian)

common/src/app/common/types/typography.cljc

@@ -17,25 +17,25 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def schema:typography
-  [:map {:title "Typography"}
-   [:id ::sm/uuid]
-   [:name :string]
-   [:font-id :string]
-   [:font-family :string]
-   [:font-variant-id :string]
-   [:font-size :string]
-   [:font-weight :string]
-   [:font-style :string]
-   [:line-height :string]
-   [:letter-spacing :string]
-   [:text-transform :string]
-   [:modified-at {:optional true} ::sm/inst]
-   [:path {:optional true} [:maybe :string]]
-   [:plugin-data {:optional true} ::ctpg/plugin-data]])
+  (sm/register!
+   ^{::sm/type ::typography}
+   [:map {:title "Typography"}
+    [:id ::sm/uuid]
+    [:name :string]
+    [:font-id :string]
+    [:font-family :string]
+    [:font-variant-id :string]
+    [:font-size :string]
+    [:font-weight :string]
+    [:font-style :string]
+    [:line-height :string]
+    [:letter-spacing :string]
+    [:text-transform :string]
+    [:modified-at {:optional true} ::sm/inst]
+    [:path {:optional true} [:maybe :string]]
+    [:plugin-data {:optional true} ::ctpg/plugin-data]]))
 
-(sm/register! ::typography schema:typography)
-
-(def check-typography!
+(def check-typography
   (sm/check-fn ::typography))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

common/src/app/common/types/variant.cljc

@@ -0,0 +1,282 @@
+;; 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.types.variant
+  (:require
+   [app.common.data :as d]
+   [app.common.files.helpers :as cfh]
+   [app.common.math :as math]
+   [app.common.schema :as sm]
+   [cuerdas.core :as str]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SCHEMA
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def schema:variant-property
+  [:map
+   [:name :string]
+   [:value :string]])
+
+(def schema:variant-component
+  ;; A component that is part of a variant set.
+  (sm/register!
+   ^{::sm/type ::variant-component}
+   [:map
+    [:variant-id {:optional true} ::sm/uuid]
+    [:variant-properties {:optional true} [:vector schema:variant-property]]]))
+
+(def schema:variant-shape
+  ;; The root shape of the main instance of a variant component.
+  [:map
+   [:variant-id {:optional true} ::sm/uuid]
+   [:variant-name {:optional true} :string]])
+
+(def schema:variant-container
+  ;; is a board that contains all variant components of a variant set,
+  ;; for grouping them visually in the workspace.
+  [:map
+   [:is-variant-container {:optional true} :boolean]])
+
+(sm/register! ::variant-property schema:variant-property)
+(sm/register! ::variant-shape schema:variant-shape)
+(sm/register! ::variant-container schema:variant-container)
+
+(def valid-variant-component?
+  (sm/check-fn schema:variant-component))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def property-prefix "Property")
+(def property-regex (re-pattern (str property-prefix "(\\d+)")))
+(def value-prefix "Value ")
+
+
+(defn properties-to-name
+  "Transform the properties into a name, with the values separated by comma"
+  [properties]
+  (->> properties
+       (map :value)
+       (remove str/empty?)
+       (str/join ", ")))
+
+
+(defn next-property-number
+  "Returns the next property number, to avoid duplicates on the property names"
+  [properties]
+  (let [numbers (keep
+                 #(some->> (:name %) (re-find property-regex) second d/parse-integer)
+                 properties)
+        max-num (if (seq numbers)
+                  (apply max numbers)
+                  0)]
+    (inc (max max-num (count properties)))))
+
+(defn add-new-prop
+  "Adds a new property with generated name and provided value to the existing props list."
+  [props value]
+  (conj props {:name (str property-prefix (next-property-number props))
+               :value value}))
+
+(defn add-new-props
+  "Adds new properties with generated names and provided values to the existing props list."
+  [props values]
+  (let [next-prop-num (next-property-number props)
+        xf (map-indexed (fn [i v]
+                          {:name (str property-prefix (+ next-prop-num i))
+                           :value v}))]
+    (into props xf values)))
+
+(defn path-to-properties
+  "From a list of properties and a name with path, assign each token of the
+   path as value of a different property"
+  ([path properties]
+   (path-to-properties path properties 0))
+  ([path properties min-props]
+   (let [cpath          (cfh/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
+         cpath          (take total-props (concat cpath (repeat "")))
+         remaining      (drop (count properties) cpath)]
+     (add-new-props assigned remaining))))
+
+
+(defn properties-map-to-string
+  "Transforms a map of properties to a string of properties omitting the empty ones"
+  [properties]
+  (->> properties
+       (keep (fn [{:keys [name value]}]
+               (when (not (str/blank? value))
+                 (str name "=" value))))
+       (str/join ", ")))
+
+
+(defn properties-string-to-map
+  "Transforms a string of properties to a map of properties"
+  [s]
+  (->> (str/split s ",")
+       (mapv #(str/split % "="))
+       (mapv (fn [[k v]]
+               {:name (str/trim k)
+                :value (str/trim v)}))))
+
+
+(defn valid-properties-string?
+  "Checks if a string of properties has a processable format or not"
+  [s]
+  (let [pattern #"^([a-zA-Z0-9\s]+=[a-zA-Z0-9\s]+)(,\s*[a-zA-Z0-9\s]+=[a-zA-Z0-9\s]+)*$"]
+    (not (nil? (re-matches pattern s)))))
+
+
+(defn find-properties-to-remove
+  "Compares two property maps to find which properties should be removed"
+  [prev-props upd-props]
+  (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 find-index-for-property-name
+  "Finds the index of a name in a property map"
+  [props name]
+  (some (fn [[idx prop]]
+          (when (= (:name prop) name)
+            idx))
+        (map-indexed vector props)))
+
+(defn remove-prefix
+  "Removes the given prefix (with or without a trailing ' / ') from the beginning of the name"
+  [name prefix]
+  (let [long-name (str prefix " / ")]
+    (cond
+      (str/starts-with? name long-name)
+      (subs name (count long-name))
+
+      (str/starts-with? name prefix)
+      (subs name (count prefix))
+
+      :else
+      name)))
+
+(def ^:private xf:map-name
+  (map :name))
+
+(defn- matching-indices
+  [props1 props2]
+  (let [names-in-p2 (into #{} xf:map-name props2)
+        xform (comp
+               (map-indexed (fn [index {:keys [name]}]
+                              (when (contains? names-in-p2 name)
+                                index)))
+               (filter some?))]
+    (into #{} xform props1)))
+
+(defn- find-index-by-name
+  "Returns the index of the first item in props with the given name, or nil if not found."
+  [name props]
+  (some (fn [[idx item]]
+          (when (= (:name item) name)
+            idx))
+        (map-indexed vector props)))
+
+(defn- next-valid-position
+  "Returns the first non-negative integer not present in the used-pos set."
+  [used-pos]
+  (loop [p 0]
+    (if (contains? used-pos p)
+      (recur (inc p))
+      p)))
+
+(defn- find-position
+  "Returns the index of the property with the given name in `props`,
+  or the next available index not in `used-pos` if not found."
+  [name props used-pos]
+  (or (find-index-by-name name props)
+      (next-valid-position used-pos)))
+
+(defn merge-properties
+  "Merges props2 into props1 with the following rules:
+    - For each property p2 in props2:
+      - Skip it if its value is empty.
+      - If props1 contains a property with the same name, update its value with that of p2.
+      - Otherwise, assign p2's value to the first unused property in props1. A property is considered used if:
+        - Its name exists in both props1 and props2, or
+        - Its value has already been updated during the merge.
+      - If no unused properties are available in props1, append a new property with a default name and p2's value."
+  [props1 props2]
+  (let [props2 (remove #(str/empty? (:value %)) props2)]
+    (-> (reduce
+         (fn [{:keys [props used-pos]} prop]
+           (let [pos (find-position (:name prop) props used-pos)
+                 used-pos (conj used-pos pos)]
+             (if (< pos (count props))
+               {:props (assoc-in (vec props) [pos :value] (:value prop)) :used-pos used-pos}
+               {:props (add-new-prop props (:value prop)) :used-pos used-pos})))
+         {:props (vec props1) :used-pos (matching-indices props1 props2)}
+         props2)
+        :props)))
+
+(defn compare-properties
+  "Compares vectors of properties keeping the value if it is the same for all
+   or setting a custom value where their values do not coincide"
+  ([props-list]
+   (compare-properties props-list nil))
+
+  ([props-list distinct-mark]
+   (let [grouped (group-by :name (apply concat props-list))
+         check-values (fn [values]
+                        (let [vals (map :value values)]
+                          (if (apply = vals)
+                            (first vals)
+                            distinct-mark)))]
+     (mapv (fn [[name values]]
+             {:name name :value (check-values values)})
+           grouped))))
+
+(defn same-variant?
+  "Determines if all elements belong to the same variant"
+  [components]
+  (let [variant-ids (distinct (map :variant-id components))
+        not-blank?  (complement str/blank?)]
+    (and
+     (= 1 (count variant-ids))
+     (not-blank? (first variant-ids)))))
+
+(defn distance
+  "Computes a weighted distance between two property lists `props1` and `props2`.
+   Latter properties weight less that previous ones"
+  [props1 props2]
+  (let [total-num-props (count props1)
+        xform           (map-indexed
+                         (fn [idx [p1 p2]]
+                           (if (not= p1 p2)
+                             (math/pow 2 (- total-num-props idx))
+                             0)))]
+    (transduce
+     xform
+     +
+     (map vector props1 props2))))
+
+(defn variant-name-to-name
+  "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) #", " " / ")))

common/src/app/common/weak_map.cljs

@@ -0,0 +1,29 @@
+;; 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.weak-map
+  "A value based weak-map implementation (CLJS/JS)")
+
+(deftype ValueWeakMap [^js/Map data ^js/FinalizationRegistry registry]
+  Object
+  (clear [_]
+    (.clear data))
+  (delete [_ key]
+    (.delete data key))
+  (get [_ key]
+    (if-let [ref (.get data key)]
+      (.deref ^WeakRef ref)
+      nil))
+  (set [_ key val]
+    (.set data key (js/WeakRef. val))
+    (.register registry val key)
+    nil))
+
+(defn create
+  []
+  (let [data (js/Map.)
+        registry (js/FinalizationRegistry. #(.delete data %))]
+    (ValueWeakMap. data registry)))

common/test/common_tests/files/tokens_test.cljc

@@ -4,36 +4,36 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns frontend-tests.tokens.token-test
+(ns common-tests.files.tokens-test
   (:require
-   [app.main.ui.workspace.tokens.token :as wtt]
-   [cljs.test :as t :include-macros true]))
+   [app.common.files.tokens :as cft]
+   [clojure.test :as t]))
 
 (t/deftest test-parse-token-value
   (t/testing "parses double from a token value"
-    (t/is (= {:value 100.1 :unit nil} (wtt/parse-token-value "100.1")))
-    (t/is (= {:value -9 :unit nil} (wtt/parse-token-value "-9"))))
+    (t/is (= {:value 100.1 :unit nil} (cft/parse-token-value "100.1")))
+    (t/is (= {:value -9.0 :unit nil} (cft/parse-token-value "-9"))))
   (t/testing "trims white-space"
-    (t/is (= {:value -1.3 :unit nil} (wtt/parse-token-value "     -1.3   "))))
+    (t/is (= {:value -1.3 :unit nil} (cft/parse-token-value "     -1.3   "))))
   (t/testing "parses unit: px"
-    (t/is (= {:value 70.3 :unit "px"} (wtt/parse-token-value "     70.3px   "))))
+    (t/is (= {:value 70.3 :unit "px"} (cft/parse-token-value "     70.3px   "))))
   (t/testing "parses unit: %"
-    (t/is (= {:value -10 :unit "%"} (wtt/parse-token-value "-10%"))))
+    (t/is (= {:value -10.0 :unit "%"} (cft/parse-token-value "-10%"))))
   (t/testing "parses unit: px")
   (t/testing "returns nil for any invalid characters"
-    (t/is (nil? (wtt/parse-token-value "     -1.3a   "))))
+    (t/is (nil? (cft/parse-token-value "     -1.3a   "))))
   (t/testing "doesnt accept invalid double"
-    (t/is (nil? (wtt/parse-token-value ".3")))))
+    (t/is (nil? (cft/parse-token-value ".3")))))
 
 (t/deftest token-applied-test
   (t/testing "matches passed token with `:token-attributes`"
-    (t/is (true? (wtt/token-applied? {:name "a"} {:applied-tokens {:x "a"}} #{:x}))))
+    (t/is (true? (cft/token-applied? {:name "a"} {:applied-tokens {:x "a"}} #{:x}))))
   (t/testing "doesn't match empty token"
-    (t/is (nil? (wtt/token-applied? {} {:applied-tokens {:x "a"}} #{:x}))))
+    (t/is (nil? (cft/token-applied? {} {:applied-tokens {:x "a"}} #{:x}))))
   (t/testing "does't match passed token `:id`"
-    (t/is (nil? (wtt/token-applied? {:name "b"} {:applied-tokens {:x "a"}} #{:x}))))
+    (t/is (nil? (cft/token-applied? {:name "b"} {:applied-tokens {:x "a"}} #{:x}))))
   (t/testing "doesn't match passed `:token-attributes`"
-    (t/is (nil? (wtt/token-applied? {:name "a"} {:applied-tokens {:x "a"}} #{:y})))))
+    (t/is (nil? (cft/token-applied? {:name "a"} {:applied-tokens {:x "a"}} #{:y})))))
 
 (t/deftest shapes-ids-by-applied-attributes
   (t/testing "Returns set of matched attributes that fit the applied token"
@@ -54,7 +54,7 @@
                   shape-applied-x-y
                   shape-applied-all
                   shape-applied-none]
-          expected (wtt/shapes-ids-by-applied-attributes {:name "1"} shapes attributes)]
+          expected (cft/shapes-ids-by-applied-attributes {:name "1"} shapes attributes)]
       (t/is (= (:x expected) (shape-ids shape-applied-x
                                         shape-applied-x-y
                                         shape-applied-all)))
@@ -62,34 +62,34 @@
                                         shape-applied-x-y
                                         shape-applied-all)))
       (t/is (= (:z expected) (shape-ids shape-applied-all)))
-      (t/is (true? (wtt/shapes-applied-all? expected (shape-ids shape-applied-all) attributes)))
-      (t/is (false? (wtt/shapes-applied-all? expected (apply shape-ids shapes) attributes)))
+      (t/is (true? (cft/shapes-applied-all? expected (shape-ids shape-applied-all) attributes)))
+      (t/is (false? (cft/shapes-applied-all? expected (apply shape-ids shapes) attributes)))
       (shape-ids shape-applied-x
                  shape-applied-x-y
                  shape-applied-all))))
 
 (t/deftest tokens-applied-test
   (t/testing "is true when single shape matches the token and attributes"
-    (t/is (true? (wtt/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "a"}}
+    (t/is (true? (cft/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "a"}}
                                                          {:applied-tokens {:x "b"}}]
                                             #{:x}))))
   (t/testing "is false when no shape matches the token or attributes"
-    (t/is (nil? (wtt/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "b"}}
+    (t/is (nil? (cft/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "b"}}
                                                         {:applied-tokens {:x "b"}}]
                                            #{:x})))
-    (t/is (nil? (wtt/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "a"}}
+    (t/is (nil? (cft/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "a"}}
                                                         {:applied-tokens {:x "a"}}]
                                            #{:y})))))
 
 (t/deftest name->path-test
-  (t/is (= ["foo" "bar" "baz"] (wtt/token-name->path "foo.bar.baz")))
-  (t/is (= ["foo" "bar" "baz"] (wtt/token-name->path "foo..bar.baz")))
-  (t/is (= ["foo" "bar" "baz"] (wtt/token-name->path "foo..bar.baz...."))))
+  (t/is (= ["foo" "bar" "baz"] (cft/token-name->path "foo.bar.baz")))
+  (t/is (= ["foo" "bar" "baz"] (cft/token-name->path "foo..bar.baz")))
+  (t/is (= ["foo" "bar" "baz"] (cft/token-name->path "foo..bar.baz...."))))
 
 (t/deftest token-name-path-exists?-test
-  (t/is (true? (wtt/token-name-path-exists? "border-radius" {"border-radius" {"sm" {:name "sm"}}})))
-  (t/is (true? (wtt/token-name-path-exists? "border-radius" {"border-radius" {:name "sm"}})))
-  (t/is (true? (wtt/token-name-path-exists? "border-radius.sm" {"border-radius" {:name "sm"}})))
-  (t/is (true? (wtt/token-name-path-exists? "border-radius.sm.x" {"border-radius" {:name "sm"}})))
-  (t/is (false? (wtt/token-name-path-exists? "other" {"border-radius" {:name "sm"}})))
-  (t/is (false? (wtt/token-name-path-exists? "dark.border-radius.md" {"dark" {"border-radius" {"sm" {:name "sm"}}}}))))
+  (t/is (true? (cft/token-name-path-exists? "border-radius" {"border-radius" {"sm" {:name "sm"}}})))
+  (t/is (true? (cft/token-name-path-exists? "border-radius" {"border-radius" {:name "sm"}})))
+  (t/is (true? (cft/token-name-path-exists? "border-radius.sm" {"border-radius" {:name "sm"}})))
+  (t/is (true? (cft/token-name-path-exists? "border-radius.sm.x" {"border-radius" {:name "sm"}})))
+  (t/is (false? (cft/token-name-path-exists? "other" {"border-radius" {:name "sm"}})))
+  (t/is (false? (cft/token-name-path-exists? "dark.border-radius.md" {"dark" {"border-radius" {"sm" {:name "sm"}}}}))))

common/test/common_tests/geom_shapes_test.cljc

@@ -14,6 +14,7 @@
    [app.common.geom.shapes.transforms :as gsht]
    [app.common.math :as mth :refer [close?]]
    [app.common.types.modifiers :as ctm]
+   [app.common.types.path :as path]
    [app.common.types.shape :as cts]
    [clojure.test :as t]))
 
@@ -30,7 +31,7 @@
    (if (= type :path)
      (cts/setup-shape
       (into {:type :path
-             :content (:content params default-path)}
+             :content (path/content (:content params default-path))}
             params))
      (cts/setup-shape
       (into {:type type

common/test/common_tests/logic/comp_creation_test.cljc

@@ -40,8 +40,6 @@
                                     (:objects page)
                                     (:id page)
                                     (:id file)
-                                    true
-                                    nil
                                     nil)
 
         file' (thf/apply-changes file changes)
@@ -74,8 +72,6 @@
                                     (:objects page)
                                     (:id page)
                                     (:id file)
-                                    true
-                                    nil
                                     cfsh/prepare-create-artboard-from-selection)
 
         file' (thf/apply-changes file changes)
@@ -111,8 +107,6 @@
                                     (:objects page)
                                     (:id page)
                                     (:id file)
-                                    true
-                                    nil
                                     cfsh/prepare-create-artboard-from-selection)
 
         file' (thf/apply-changes file changes)
@@ -151,8 +145,6 @@
                                     (:objects page)
                                     (:id page)
                                     (:id file)
-                                    true
-                                    nil
                                     cfsh/prepare-create-artboard-from-selection)
 
         file' (thf/apply-changes file changes)
@@ -191,8 +183,6 @@
                                     (:objects page)
                                     (:id page)
                                     (:id file)
-                                    true
-                                    nil
                                     nil)
 
         file' (thf/apply-changes file changes)
@@ -232,8 +222,6 @@
                                     (:objects page)
                                     (:id page)
                                     (:id file)
-                                    true
-                                    nil
                                     cfsh/prepare-create-artboard-from-selection)
 
         file' (thf/apply-changes file changes)
@@ -265,8 +253,7 @@
         changes   (cll/generate-rename-component (pcb/empty-changes)
                                                  (:id component)
                                                  "Test component after"
-                                                 (:data file)
-                                                 true)
+                                                 (:data file))
 
         file' (thf/apply-changes file changes)
 
@@ -445,8 +432,8 @@
     (t/is (some? copy1-child'))
     (t/is (ctk/instance-root? copy1-root'))
     (t/is (ctk/instance-of? copy1-root' (:id file') (:id component')))
-    (t/is (ctk/is-main-of? main1-root' copy1-root' true))
-    (t/is (ctk/is-main-of? main1-child' copy1-child' true))
+    (t/is (ctk/is-main-of? main1-root' copy1-root'))
+    (t/is (ctk/is-main-of? main1-child' copy1-child'))
     (t/is (ctst/parent-of? copy1-root' copy1-child'))))
 
 (t/deftest test-instantiate-component-from-lib
@@ -489,8 +476,8 @@
     (t/is (some? copy1-child'))
     (t/is (ctk/instance-root? copy1-root'))
     (t/is (ctk/instance-of? copy1-root' (:id library) (:id component')))
-    (t/is (ctk/is-main-of? main1-root' copy1-root' true))
-    (t/is (ctk/is-main-of? main1-child' copy1-child' true))
+    (t/is (ctk/is-main-of? main1-root' copy1-root'))
+    (t/is (ctk/is-main-of? main1-child' copy1-child'))
     (t/is (ctst/parent-of? copy1-root' copy1-child'))))
 
 (t/deftest test-instantiate-nested-component
@@ -533,8 +520,8 @@
     (t/is (some? copy1-child'))
     (t/is (ctk/instance-root? copy1-root'))
     (t/is (ctk/instance-of? copy1-root' (:id file') (:id component')))
-    (t/is (ctk/is-main-of? main1-root' copy1-root' true))
-    (t/is (ctk/is-main-of? main1-child' copy1-child' true))
+    (t/is (ctk/is-main-of? main1-root' copy1-root'))
+    (t/is (ctk/is-main-of? main1-child' copy1-child'))
     (t/is (ctst/parent-of? copy1-root' copy1-child'))))
 
 (t/deftest test-instantiate-nested-component-from-lib
@@ -580,8 +567,8 @@
     (t/is (some? copy1-child'))
     (t/is (ctk/instance-root? copy1-root'))
     (t/is (ctk/instance-of? copy1-root' (:id library) (:id component')))
-    (t/is (ctk/is-main-of? main1-root' copy1-root' true))
-    (t/is (ctk/is-main-of? main1-child' copy1-child' true))
+    (t/is (ctk/is-main-of? main1-root' copy1-root'))
+    (t/is (ctk/is-main-of? main1-child' copy1-child'))
     (t/is (ctst/parent-of? copy1-root' copy1-child'))))
 
 (t/deftest test-detach-copy

common/test/common_tests/logic/comp_reset_test.cljc

@@ -47,8 +47,7 @@
                                                 file-mdf
                                                 {(:id file-mdf) file-mdf}
                                                 page-mdf
-                                                (:id copy-root)
-                                                true)
+                                                (:id copy-root))
 
         file'     (thf/apply-changes file changes)
 
@@ -99,8 +98,7 @@
                                                 {(:id file-mdf) file-mdf
                                                  (:id library) library}
                                                 page-mdf
-                                                (:id copy-root)
-                                                true)
+                                                (:id copy-root))
 
         file'     (thf/apply-changes file changes)
 
@@ -151,8 +149,7 @@
                                                 file-mdf
                                                 {(:id file-mdf) file-mdf}
                                                 page-mdf
-                                                (:id copy-root)
-                                                true)
+                                                (:id copy-root))
 
         file'   (thf/apply-changes file changes)
 
@@ -198,8 +195,7 @@
                                                 file-mdf
                                                 {(:id file-mdf) file-mdf}
                                                 page-mdf
-                                                (:id copy-root)
-                                                true)
+                                                (:id copy-root))
 
         file'   (thf/apply-changes file changes)
 
@@ -246,8 +242,7 @@
                                                 file-mdf
                                                 {(:id file-mdf) file-mdf}
                                                 page-mdf
-                                                (:id copy-root)
-                                                true)
+                                                (:id copy-root))
 
         file'   (thf/apply-changes file changes)
 
@@ -291,8 +286,7 @@
                                                 file-mdf
                                                 {(:id file-mdf) file-mdf}
                                                 page-mdf
-                                                (:id copy2-root)
-                                                true)
+                                                (:id copy2-root))
 
         file'     (thf/apply-changes file changes)
 
@@ -338,8 +332,7 @@
                                                 file-mdf
                                                 {(:id file-mdf) file-mdf}
                                                 page-mdf
-                                                (:id copy2-root)
-                                                true)
+                                                (:id copy2-root))
 
         file'     (thf/apply-changes file changes)
 

common/test/common_tests/logic/comp_sync_test.cljc

@@ -227,7 +227,7 @@
     (t/is (= (:touched copy-root') nil))
     (t/is (= (:touched copy-new-child') nil))
     (t/is (ctst/parent-of? copy-root' copy-new-child'))
-    (t/is (ctk/is-main-of? main-free-shape' copy-new-child' true))))
+    (t/is (ctk/is-main-of? main-free-shape' copy-new-child'))))
 
 (t/deftest test-sync-when-deleting-shape
   (let [;; ==== Setup

common/test/common_tests/logic/token_test.cljc

@@ -1,3 +1,9 @@
+;; 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.logic.token-test
   (:require
    [app.common.files.changes-builder :as pcb]

common/test/common_tests/logic/variants_test.cljc

@@ -7,7 +7,10 @@
 (ns common-tests.logic.variants-test
   (:require
    [app.common.files.changes-builder :as pcb]
-   [app.common.logic.variants :as clv]
+   [app.common.geom.point :as gpt]
+   [app.common.logic.libraries :as cll]
+   [app.common.logic.shapes :as cls]
+   [app.common.logic.variant-properties :as clvp]
    [app.common.test-helpers.components :as thc]
    [app.common.test-helpers.files :as thf]
    [app.common.test-helpers.ids-map :as thi]
@@ -20,7 +23,7 @@
 (t/deftest test-update-property-name
   (let [;; ==== Setup
         file    (-> (thf/sample-file :file1)
-                    (thv/add-variant :v01 :c01 :m01 :c02 :m02))
+                    (thv/add-variant-two-properties :v01 :c01 :m01 :c02 :m02))
         v-id    (-> (ths/get-shape file :v01) :id)
         page    (thf/current-page file)
 
@@ -29,8 +32,8 @@
                     (pcb/with-page-id (:id page))
                     (pcb/with-library-data (:data file))
                     (pcb/with-objects (:objects page))
-                    (clv/generate-update-property-name v-id 0 "NewName1")
-                    (clv/generate-update-property-name v-id 1 "NewName2"))
+                    (clvp/generate-update-property-name v-id 0 "NewName1")
+                    (clvp/generate-update-property-name v-id 1 "NewName2"))
 
 
         file'   (thf/apply-changes file changes)
@@ -65,7 +68,7 @@
                     (pcb/with-page-id (:id page))
                     (pcb/with-library-data (:data file))
                     (pcb/with-objects (:objects page))
-                    (clv/generate-add-new-property v-id))
+                    (clvp/generate-add-new-property v-id))
 
 
         file'   (thf/apply-changes file changes)
@@ -101,7 +104,7 @@
                     (pcb/with-page-id (:id page))
                     (pcb/with-library-data (:data file))
                     (pcb/with-objects (:objects page))
-                    (clv/generate-add-new-property v-id {:fill-values? true}))
+                    (clvp/generate-add-new-property v-id {:fill-values? true}))
 
 
         file'   (thf/apply-changes file changes)
@@ -117,7 +120,7 @@
     (t/is (= (count (:variant-properties comp01')) 2))
     (t/is (= (count (:variant-properties comp02)) 1))
     (t/is (= (count (:variant-properties comp02')) 2))
-    (t/is (= (-> comp01' :variant-properties last :value) "Value1"))))
+    (t/is (= (-> comp01' :variant-properties last :value) "Value 1"))))
 
 
 
@@ -132,7 +135,7 @@
                     (pcb/with-page-id (:id page))
                     (pcb/with-library-data (:data file))
                     (pcb/with-objects (:objects page))
-                    (clv/generate-add-new-property v-id))
+                    (clvp/generate-add-new-property v-id))
 
 
         file    (thf/apply-changes file changes)
@@ -147,7 +150,7 @@
                     (pcb/with-page-id (:id page))
                     (pcb/with-library-data (:data file))
                     (pcb/with-objects (:objects page))
-                    (clv/generate-remove-property v-id 0))
+                    (clvp/generate-remove-property v-id 0))
 
 
         file'   (thf/apply-changes file changes)
@@ -180,8 +183,8 @@
                     (pcb/with-page-id (:id page))
                     (pcb/with-library-data (:data file))
                     (pcb/with-objects (:objects page))
-                    (clv/generate-update-property-value (:id comp01) 0 "NewValue1")
-                    (clv/generate-update-property-value (:id comp02) 0 "NewValue2"))
+                    (clvp/generate-update-property-value (:id comp01) 0 "NewValue1")
+                    (clvp/generate-update-property-value (:id comp02) 0 "NewValue2"))
 
         file'   (thf/apply-changes file changes)
 
@@ -192,3 +195,73 @@
     ;; ==== Check
     (t/is (= (-> comp01' :variant-properties first :value) "NewValue1"))
     (t/is (= (-> comp02' :variant-properties first :value) "NewValue2"))))
+
+
+(t/deftest test-duplicate-variant-container
+  (let [;; ==== Setup
+        file    (-> (thf/sample-file :file1)
+                    (thv/add-variant :v01 :c01 :m01 :c02 :m02))
+        data    (:data file)
+        page    (thf/current-page file)
+        objects (:objects page)
+
+        variant-container (ths/get-shape file :v01)
+
+
+
+
+        ;; ==== Action
+        changes (-> (pcb/empty-changes nil)
+                    (pcb/with-page-id (:id page))
+                    (pcb/with-library-data (:data file))
+                    (pcb/with-objects (:objects page))
+                    (cll/generate-duplicate-changes objects                    ;; objects
+                                                    page                       ;; page
+                                                    #{(:id variant-container)} ;; ids
+                                                    (gpt/point 0 0)            ;; delta
+                                                    {(:id  file) file}         ;; libraries
+                                                    (:data file)               ;; library-data
+                                                    (:id file)))               ;; file-id
+
+        ;; ==== Get
+        file'   (thf/apply-changes file changes)
+        data'   (:data file')
+        page'   (thf/current-page file')
+        objects' (:objects page')]
+
+     ;; ==== Check
+    (thf/validate-file! file')
+    (t/is (= (count (:components data)) 2))
+    (t/is (= (count (:components data')) 4))
+    (t/is (= (count objects) 4))
+    (t/is (= (count objects') 7))))
+
+
+(t/deftest test-delete-variant
+  ;; When a variant container becomes empty, it id automatically deleted
+  (let [;; ==== Setup
+        file      (-> (thf/sample-file :file1)
+                      (thv/add-variant-two-properties :v01 :c01 :m01 :c02 :m02))
+        container (ths/get-shape file :v01)
+        m01-id    (-> (ths/get-shape file :m01) :id)
+        m02-id    (-> (ths/get-shape file :m02) :id)
+
+        page    (thf/current-page file)
+
+        ;; ==== Action
+        changes (-> (pcb/empty-changes nil)
+                    (pcb/with-page-id (:id page))
+                    (pcb/with-library-data (:data file))
+                    (pcb/with-objects (:objects page))
+                    (#(second (cls/generate-delete-shapes % #{m01-id m02-id} {}))))
+
+        file'   (thf/apply-changes file changes)
+
+        ;; ==== Get
+        container' (ths/get-shape file' :v01)]
+
+    ;; ==== Check
+    ;; The variant containew was not nil before the deletion
+    (t/is (not (nil? container)))
+    ;; The variant containew is nil after the deletion
+    (t/is (nil? container'))))

common/test/common_tests/runner.cljc

@@ -39,6 +39,7 @@
    [common-tests.types.absorb-assets-test]
    [common-tests.types.components-test]
    [common-tests.types.modifiers-test]
+   [common-tests.types.path-data-test]
    [common-tests.types.shape-decode-encode-test]
    [common-tests.types.shape-interactions-test]
    [common-tests.types.tokens-lib-test]
@@ -90,4 +91,5 @@
    'common-tests.types.tokens-lib-test
    'common-tests.types.components-test
    'common-tests.types.absorb-assets-test
+   'common-tests.types.path-data-test
    'common-tests.uuid-test))

common/test/common_tests/svg_path_test.cljc

@@ -547,4 +547,3 @@
 
 ;; FOR POSSIBLE FUTURE TEST CASES
 ;; (str "M259.958 89.134c-6.88-.354-10.484-1.241-12.44-3.064-1.871-1.743-6.937-3.098-15.793-4.226-7.171-.913-17.179-2.279-22.24-3.034-5.06-.755-15.252-2.016-22.648-2.8-18.685-1.985-35.63-4.223-38.572-5.096-3.655-1.084-3.016-3.548.708-2.726 1.751.387 13.376 1.701 25.833 2.922 12.456 1.22 29.018 3.114 36.803 4.208 29.94 4.206 29.433 4.204 34.267.136 3.787-3.186 5.669-3.669 14.303-3.669 14.338 0 17.18 1.681 12.182 7.205-2.053 2.268-1.994 2.719.707 5.42 3.828 3.827 3.74 5.846-.238 5.5-1.752-.153-7.544-.502-12.872-.776zm7.563-3.194c0-.778-1.751-1.352-3.892-1.274l-3.893.141 3.539 1.133c1.946.624 3.698 1.197 3.893 1.275.194.077.354-.496.354-1.275zm-15.899-8.493c1.43-2.29 1.414-2.83-.084-2.83-2.05 0-5.25 2.76-5.25 4.529 0 2.226 3.599 1.08 5.334-1.699zm8.114 0c2.486-2.746 2.473-2.83-.438-2.83-1.65 0-3.683 1.273-4.516 2.83-1.175 2.196-1.077 2.831.438 2.831 1.075 0 3.107-1.274 4.516-2.83zm7.814.674c2.858-3.444.476-4.085-3.033-.816-2.451 2.284-2.677 2.973-.975 2.973 1.22 0 3.023-.97 4.008-2.157zm-49.571-4.509c-1.168-.43-3.294-1.802-4.725-3.051-2.112-1.843-9.304-2.595-38.219-3.994-46.474-2.25-63-4.077-60.27-6.665.324-.308 9.507.261 20.406 1.264 10.9 1.003 31.16 2.258 45.024 2.789l25.207.964 4.625-3.527c4.313-3.29 5.41-3.474 16.24-2.732 6.389.438 11.981 1.388 12.428 2.111.447.723-.517 2.73-2.141 4.46l-2.954 3.144c1.607 1.697 3.308 3.289 5.049 4.845 3.248 2.189-5.438 1.289-8.678 1.284-5.428-.061-10.825-.463-11.992-.892zm12.74-3.242c-1.123-.694-2.36-.943-2.75-.554-.389.39.21 1.275 1.334 1.97 1.122.693 2.36.942 2.749.553.389-.39-.21-1.275-1.334-1.97zm-5.663 0a1.42 1.42 0 00-1.415-1.416 1.42 1.42 0 00-1.416 1.416 1.42 1.42 0 001.416 1.415 1.42 1.42 0 001.415-1.415zm-8.464-6.404c.984-1.187 1.35-2.598.813-3.135-1.181-1.18-5.408 1.297-6.184 3.624-.806 2.42 3.265 2.048 5.37-.49zm6.863.258c.867-1.045 1.163-2.313.658-2.819-1.063-1.062-4.719 1.631-4.719 3.476 0 1.864 2.274 1.496 4.061-.657zm8.792-.36c1.637-1.972 1.448-2.197-1.486-1.77-1.848.27-3.622 1.287-3.943 2.26-.838 2.547 3.212 2.181 5.429-.49zm32.443-4.11c-6.156-2.228-67.1-6.138-119.124-7.642-39.208-1.134-72.072-.928-94.618.593-6.617.446-19.681 1.16-29.03 1.587-15.798.72-17.183.573-19.588-2.085-4.498-4.97-2.544-7.857 6.39-9.44 4.394-.778 9.164-2.436 10.6-3.685 5.44-4.729 20.332-14.06 31.14-19.509C65.717 11.88 78.955 7.79 103.837 3.08 121.686-.3 125.552-.642 129.318.82c2.44.948 12.4 1.948 22.132 2.221 15.37.432 20.004 1.18 35.294 5.698 22.36 6.606 39.732 15.1 56.55 27.653 7.307 5.452 14.086 9.913 15.066 9.913.98 0 2.148.956 2.596 2.124.55 1.432 2.798 2.123 6.914 2.123 6.213 0 12.4 3.046 12.38 6.096-.012 1.75-6.502 5.353-9.118 5.063-.818-.09-3.717-.972-6.442-1.958zm-16.986-7.436c0-1.575-33.326-18.118-43.173-21.43-23.008-7.739-54.084-12.922-77.136-12.866-16.863.041-37.877 3.628-52.465 8.956-18.062 6.596-26.563 10.384-29.181 13.002-1.205 1.205-5.306 3.769-9.112 5.698-7.754 3.929-8.841 5.482-3.029 4.325 13.494-2.685 66.794-3.773 110.913-2.264 38.005 1.3 96.812 4.435 102.122 5.443.584.111 1.061-.277 1.061-.864zm-236.39-3.18c0-.78-1.592-1.416-3.539-1.416-1.946 0-3.538.637-3.538 1.415 0 .779 1.592 1.416 3.538 1.416 1.947 0 3.54-.637 3.54-1.416zm7.078-1.416c0-.779-.956-1.416-2.124-1.416-1.167 0-2.123.637-2.123 1.416 0 .778.956 1.415 2.123 1.415 1.168 0 2.124-.637 2.124-1.415zm11.734-4.437c3.278-1.661 6.278-3.483 6.667-4.048 1.366-1.98 20.645-11.231 32.557-15.622 11.862-4.372 36.546-9.865 44.327-9.865 3.485 0 3.867-.404 3.012-3.185-.538-1.752-1.177-3.41-1.42-3.685-.907-1.026-36.72 7.16-45.065 10.302-17.226 6.484-47.566 24.27-47.566 27.886 0 1.786.845 1.585 7.488-1.783zm206.254-5.577c-12.298-10.518-53.842-27.166-70.896-28.41-5.526-.404-6.3-.097-6.695 2.655-.33 2.307.402 3.275 2.831 3.742 32.436 6.237 52.205 12.315 66.975 20.594 11.904 6.673 14.477 7.141 7.785 1.419zM150.1 11.04c-1.949-3.64-7.568-4.078-6.886-.538.256 1.329 2.054 2.817 3.997 3.309 4.498 1.137 4.816.832 2.888-2.771zm6.756.94c-.248-1.752-1.026-3.185-1.727-3.185-.7 0-1.493 1.433-1.76 3.185-.328 2.152.232 3.185 1.727 3.185 1.485 0 2.064-1.047 1.76-3.185zm-30.178-2.458c0-2.303-.908-3.694-2.627-4.025-3.6-.694-5.23 1.301-4.22 5.166 1.216 4.647 6.847 3.709 6.847-1.14zm12.544 2.104c-.448-1.168-1.224-2.132-1.725-2.142-.5-.013-2.343-.404-4.095-.873-2.569-.689-3.185-.274-3.185 2.142 0 2.476.854 2.996 4.91 2.996 3.783 0 4.723-.487 4.095-2.123z")
-

common/test/common_tests/types/absorb_assets_test.cljc

@@ -54,7 +54,7 @@
     (t/is (= (count components') 1))
 
     (t/is (ctk/instance-of? copy-root' (:id file') (:id component')))
-    (t/is (ctk/is-main-of? main-root' copy-root' true))
+    (t/is (ctk/is-main-of? main-root' copy-root'))
     (t/is (ctk/main-instance-of? (:id main-root') (:id (second pages')) component'))))
 
 (t/deftest absorb-colors