Merge remote-tracking branch 'origin/staging' into develop

CHANGES.md

@@ -52,6 +52,7 @@
 
 - Round the size values on handoff to two decimals [Taiga #3227](https://tree.taiga.io/project/penpot/issue/3227)
 - Fix internal error when hoverin over shape [Taiga #3237](https://tree.taiga.io/project/penpot/issue/3237)
+- Fix mouse leave in handoff close overlay animation breaks [Taiga #3173](https://tree.taiga.io/project/penpot/issue/3173)
 - Fix different behaviour during image drag [Taiga #2279](https://tree.taiga.io/project/penpot/issue/2279)
 - Fix hidden file name on import [Taiga #3172](https://tree.taiga.io/project/penpot/issue/3172)
 - Fix unneccessary scrollbars at the color list [Taiga #3211](https://tree.taiga.io/project/penpot/issue/3211)
@@ -95,6 +96,7 @@
 - Fix component name in sidebar widget [Taiga #3144](https://tree.taiga.io/project/penpot/issue/3144)
 - Fix resize rotated shape with top&down constraints [Taiga #3167](https://tree.taiga.io/project/penpot/issue/3167)
 - Fix multi user not working [Taiga #3195](https://tree.taiga.io/project/penpot/issue/3195)
+- Fix guides are not duplicated with the artboard [Taiga #3072](https://tree.taiga.io/project/penpot/issue/3072)
 
 ### :arrow_up: Deps updates
 ### :heart: Community contributions by (Thank you!)

common/src/app/common/media.cljc

@@ -44,6 +44,21 @@
     "image/svg+xml" :svg
     nil))
 
+(defn mtype->extension [mtype]
+  ;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types
+  (case mtype
+    "image/apng"         ".apng"
+    "image/avif"         ".avif"
+    "image/gif"          ".gif"
+    "image/jpeg"         ".jpg"
+    "image/png"          ".png"
+    "image/svg+xml"      ".svg"
+    "image/webp"         ".webp"
+    "application/zip"    ".zip"
+    "application/penpot" ".penpot"
+    "application/pdf"    ".pdf"
+    nil))
+
 (def max-file-size (* 5 1024 1024))
 
 (s/def ::id uuid?)

common/src/app/common/pages/changes_builder.cljc

@@ -286,9 +286,10 @@
          update-shape
          (fn [changes id]
            (let [old-obj (get objects id)
-                 new-obj (update-fn old-obj)
+                 new-obj (update-fn old-obj)]
-
+             (if (= old-obj new-obj)
-                 attrs (or attrs (d/concat-set (keys old-obj) (keys new-obj)))
+               changes
+               (let [attrs (or attrs (d/concat-set (keys old-obj) (keys new-obj)))
 
                      {rops :rops uops :uops}
                      (reduce #(generate-operation %1 %2 old-obj new-obj ignore-geometry?)
@@ -313,7 +314,7 @@
                    (update :redo-changes conj (assoc change :operations rops))
 
                    (seq uops)
-               (update :undo-changes d/preconj (assoc change :operations uops)))))]
+                   (update :undo-changes d/preconj (assoc change :operations uops)))))))]
 
              (-> (reduce update-shape changes ids)
                  (apply-changes-local)))))

common/src/app/common/pages/helpers.cljc

@@ -502,3 +502,20 @@
           (reduce process-shape (transient {}))
           (persistent!))
      persistent!)))
+
+(defn selected-subtree
+  "Given a set of shapes, returns an objects subtree with the parents
+  of the selected items up to the root. Useful to calculate a partial z-index"
+  [objects selected]
+
+  (let [selected+parents
+        (into selected
+              (mapcat #(get-parent-ids objects %))
+              selected)
+
+        remove-children
+        (fn [shape]
+          (update shape :shapes #(filterv selected+parents %)))]
+
+    (-> (select-keys objects selected+parents)
+        (d/update-vals remove-children))))

common/src/app/common/spec/color.cljc

@@ -6,7 +6,9 @@
 
 (ns app.common.spec.color
   (:require
+    [app.common.data :as d]
     [app.common.spec :as us]
+    [app.common.text :as txt]
     [clojure.spec.alpha :as s]))
 
 ;; TODO: waiting clojure 1.11 to rename this all :internal.stuff to a
@@ -46,7 +48,7 @@
                    :internal.gradient/width
                    :internal.gradient/stops]))
 
-;;; --- COLORS
+;; --- COLORS
 
 (s/def :internal.color/name string?)
 (s/def :internal.color/path (s/nilable string?))
@@ -54,6 +56,15 @@
 (s/def :internal.color/color (s/nilable string?))
 (s/def :internal.color/opacity (s/nilable ::us/safe-number))
 (s/def :internal.color/gradient (s/nilable ::gradient))
+(s/def :internal.color/ref-id uuid?)
+(s/def :internal.color/ref-file uuid?)
+
+(s/def ::shape-color
+  (s/keys :req-un [:us/color
+                   :internal.color/opacity]
+          :opt-un [:internal.color/gradient
+                   :internal.color/ref-id
+                   :internal.color/ref-file]))
 
 (s/def ::color
   (s/keys :opt-un [::id
@@ -70,6 +81,197 @@
                    :internal.color/opacity
                    :internal.color/gradient]))
 
+;; --- Helpers for color in different parts of a shape
 
+;; fill
 
+(defn fill->shape-color
+  [fill]
+  (d/without-nils {:color (:fill-color fill)
+                   :opacity (:fill-opacity fill)
+                   :gradient (:fill-color-gradient fill)
+                   :ref-id (:fill-color-ref-id fill)
+                   :ref-file (:fill-color-ref-file fill)}))
 
+(defn set-fill-color
+  [shape position color opacity gradient]
+  (update-in shape [:fills position]
+             (fn [fill]
+               (d/without-nils (assoc fill
+                                      :fill-color color
+                                      :fill-opacity opacity
+                                      :fill-color-gradient gradient)))))
+
+(defn detach-fill-color
+  [shape position]
+  (-> shape
+      (d/dissoc-in [:fills position :fill-color-ref-id])
+      (d/dissoc-in [:fills position :fill-color-ref-file])))
+
+;; stroke
+
+(defn stroke->shape-color
+  [stroke]
+  (d/without-nils {:color (:stroke-color stroke)
+                   :opacity (:stroke-opacity stroke)
+                   :gradient (:stroke-color-gradient stroke)
+                   :ref-id (:stroke-color-ref-id stroke)
+                   :ref-file (:stroke-color-ref-file stroke)}))
+
+(defn set-stroke-color
+  [shape position color opacity gradient]
+  (update-in shape [:strokes position]
+             (fn [stroke]
+               (d/without-nils (assoc stroke
+                                      :stroke-color color
+                                      :stroke-opacity opacity
+                                      :stroke-color-gradient gradient)))))
+
+(defn detach-stroke-color
+  [shape position]
+  (-> shape
+      (d/dissoc-in [:strokes position :stroke-color-ref-id])
+      (d/dissoc-in [:strokes position :stroke-color-ref-file])))
+
+;; shadow
+
+(defn shadow->shape-color
+  [shadow]
+  (d/without-nils {:color (-> shadow :color :color)
+                   :opacity (-> shadow :color :opacity)
+                   :gradient (-> shadow :color :gradient)
+                   :ref-id (-> shadow :color :id)
+                   :ref-file (-> shadow :color :file-id)}))
+
+(defn set-shadow-color
+  [shape position color opacity gradient]
+  (update-in shape [:shadow position :color]
+             (fn [shadow-color]
+               (d/without-nils (assoc shadow-color 
+                                      :color color
+                                      :opacity opacity
+                                      :gradient gradient)))))
+
+(defn detach-shadow-color
+  [shape position]
+  (-> shape
+      (d/dissoc-in [:shadow position :color :id])
+      (d/dissoc-in [:shadow position :color :file-id])))
+
+;; grid
+
+(defn grid->shape-color
+  [grid]
+  (d/without-nils {:color (-> grid :params :color :color)
+                   :opacity (-> grid :params :color :opacity)
+                   :gradient (-> grid :params :color :gradient)
+                   :ref-id (-> grid :params :color :id)
+                   :ref-file (-> grid :params :color :file-id)}))
+
+(defn set-grid-color
+  [shape position color opacity gradient]
+  (update-in shape [:grids position :params :color]
+             (fn [grid-color]
+               (d/without-nils (assoc grid-color 
+                                      :color color
+                                      :opacity opacity
+                                      :gradient gradient)))))
+
+(defn detach-grid-color
+  [shape position]
+  (-> shape
+      (d/dissoc-in [:grids position :params :color :id])
+      (d/dissoc-in [:grids position :params :color :file-id])))
+
+;; --- Helpers for all colors in a shape
+
+(defn get-text-node-colors
+  "Get all colors used by a node of a text shape"
+  [node]
+  (concat (map fill->shape-color (:fills node))
+          (map stroke->shape-color (:strokes node))))
+
+(defn get-all-colors
+  "Get all colors used by a shape, in any section."
+  [shape]
+  (concat (map fill->shape-color (:fills shape))
+          (map stroke->shape-color (:strokes shape))
+          (map shadow->shape-color (:shadow shape))
+          (when (= (:type shape) :frame)
+            (map grid->shape-color (:grids shape)))
+          (when (= (:type shape) :text)
+            (reduce (fn [colors node]
+                      (concat colors (get-text-node-colors node)))
+                    ()
+                    (txt/node-seq (:content shape))))))
+
+(defn uses-library-colors?
+  "Check if the shape uses any color in the given library."
+  [shape library-id]
+  (let [all-colors (get-all-colors shape)]
+    (some #(and (some? (:ref-id %))
+                (= (:ref-file %) library-id))
+          all-colors)))
+
+(defn sync-shape-colors
+  "Look for usage of any color of the given library inside the shape,
+  and, in this case, copy the library color into the shape."
+  [shape library-id library-colors]
+  (let [sync-color (fn [shape position shape-color set-fn detach-fn]
+                     (if (= (:ref-file shape-color) library-id)
+                       (let [library-color (get library-colors (:ref-id shape-color))]
+                         (if (some? library-color)
+                           (set-fn shape
+                                   position
+                                   (:color library-color)
+                                   (:opacity library-color)
+                                   (:gradient library-color))
+                           (detach-fn shape position)))
+                       shape))
+
+        sync-fill (fn [shape [position fill]]
+                    (sync-color shape
+                                position
+                                (fill->shape-color fill)
+                                set-fill-color
+                                detach-fill-color))
+
+        sync-stroke (fn [shape [position stroke]]
+                      (sync-color shape
+                                  position
+                                  (stroke->shape-color stroke)
+                                  set-stroke-color
+                                  detach-stroke-color))
+
+        sync-shadow (fn [shape [position shadow]]
+                      (sync-color shape
+                                  position
+                                  (shadow->shape-color shadow)
+                                  set-shadow-color
+                                  detach-shadow-color))
+
+        sync-grid (fn [shape [position grid]]
+                    (sync-color shape
+                                position
+                                (grid->shape-color grid)
+                                set-grid-color
+                                detach-grid-color))
+
+        sync-text-node (fn [node]
+                         (as-> node $
+                           (reduce sync-fill $ (d/enumerate (:fills $)))
+                           (reduce sync-stroke $ (d/enumerate (:strokes $)))))
+
+        sync-text (fn [shape]
+                    (let [content     (:content shape)
+                          new-content (txt/transform-nodes sync-text-node content)]
+                      (if (not= content new-content)
+                        (assoc shape :content new-content)
+                        shape)))]
+
+    (as-> shape $
+       (reduce sync-fill $ (d/enumerate (:fills $)))
+       (reduce sync-stroke $ (d/enumerate (:strokes $)))
+       (reduce sync-shadow $ (d/enumerate (:shadow $)))
+       (reduce sync-grid $ (d/enumerate (:grids $)))
+       (sync-text $))))

common/src/app/common/spec/shape.cljc

@@ -166,11 +166,11 @@
                    ::blocked
                    ::collapsed
                    ::fills
-                   ::fill-color
+                   ::fill-color            ;; TODO: remove these attributes
-                   ::fill-opacity
+                   ::fill-opacity          ;;       when backward compatibility
-                   ::fill-color-gradient
+                   ::fill-color-gradient   ;;       is no longer needed
-                   ::fill-color-ref-file
+                   ::fill-color-ref-file   ;;
-                   ::fill-color-ref-id
+                   ::fill-color-ref-id     ;;
                    ::hide-fill-on-export
                    ::font-family
                    ::font-size
@@ -196,10 +196,10 @@
                    ::exports
                    ::shapes
                    ::strokes
-                   ::stroke-color
+                   ::stroke-color           ;; TODO: same thing
-                   ::stroke-color-ref-file
+                   ::stroke-color-ref-file  ;;
-                   ::stroke-color-ref-id
+                   ::stroke-color-ref-i     ;;
-                   ::stroke-opacity
+                   ::stroke-opacity         ;;
                    ::stroke-style
                    ::stroke-width
                    ::stroke-alignment

frontend/src/app/main/data/media.cljs

@@ -17,15 +17,14 @@
 
 ;; --- Predicates
 
-(defn ^boolean file?
+(defn file?
   [o]
   (instance? js/File o))
 
-(defn ^boolean blob?
+(defn blob?
   [o]
   (instance? js/Blob o))
 
-
 ;; --- Specs
 
 (s/def ::blob blob?)
@@ -36,8 +35,7 @@
 
 ;; --- Utility functions
 
-(defn validate-file
+(defn validate-file  ;; Check that a file obtained with the file javascript API is valid.
-  ;; Check that a file obtained with the file javascript API is valid.
   [file]
   (when (> (.-size file) cm/max-file-size)
     (ex/raise :type :validation
@@ -74,4 +72,3 @@
               :else
               (tr "errors.unexpected-error"))]
     (rx/of (dm/error msg))))
-

frontend/src/app/main/data/workspace.cljs

@@ -36,20 +36,19 @@
    [app.main.data.workspace.layers :as dwly]
    [app.main.data.workspace.layout :as layout]
    [app.main.data.workspace.libraries :as dwl]
+   [app.main.data.workspace.media :as dwm]
    [app.main.data.workspace.notifications :as dwn]
    [app.main.data.workspace.path :as dwdp]
    [app.main.data.workspace.path.shapes-to-path :as dwps]
    [app.main.data.workspace.persistence :as dwp]
    [app.main.data.workspace.selection :as dws]
    [app.main.data.workspace.state-helpers :as wsh]
-   [app.main.data.workspace.svg-upload :as svg]
    [app.main.data.workspace.thumbnails :as dwth]
    [app.main.data.workspace.transforms :as dwt]
    [app.main.data.workspace.undo :as dwu]
    [app.main.data.workspace.zoom :as dwz]
    [app.main.repo :as rp]
    [app.main.streams :as ms]
-   [app.main.worker :as uw]
    [app.util.dom :as dom]
    [app.util.globals :as ug]
    [app.util.http :as http]
@@ -163,7 +162,7 @@
 
 (defn finalize-file
   [_project-id file-id]
-  (ptk/reify ::finalize
+  (ptk/reify ::finalize-file
     ptk/UpdateEvent
     (update [_ state]
       (dissoc state
@@ -1193,28 +1192,14 @@
 
 (defn copy-selected
   []
-  (letfn [;; Sort objects so they have the same relative ordering
+  (letfn [(sort-selected [state data]
-          ;; when pasted later.
-          (sort-selected-async [state data]
             (let [selected (wsh/lookup-selected state)
                   objects (wsh/lookup-page-objects state)
-                  page-id  (:current-page-id state)]
-              (->> (uw/ask! {:cmd :selection/query-z-index
-                             :page-id page-id
-                             :objects objects
-                             :ids selected})
-                   (rx/map (fn [z-indexes]
-                             (assoc data :selected
-                                    (->> (d/zip selected z-indexes)
-                                         (sort-by second)
-                                         (map first)
-                                         (into (d/ordered-set)))))))))
 
-          ;; We cannot call to a remote procedure in Safari (for the copy) so we need
+                  ;; Narrow the objects map so it contains only relevant data for
-          ;; to calculate it here instead of on the worker
+                  ;; selected and its parents
-          (sort-selected-sync [state data]
+                  objects (cph/selected-subtree objects selected)
-            (let [selected (wsh/lookup-selected state)
+
-                  objects (wsh/lookup-page-objects state)
                   z-index (cp/calculate-z-index objects)
                   z-values (->> selected
                                 (map #(vector %
@@ -1289,18 +1274,13 @@
                         :file-id (:current-file-id state)
                         :selected selected
                         :objects {}
-                        :images #{}}
+                        :images #{}}]
+
 
-              sort-results
-              (fn [obs]
-                ;; Safari doesn't allow asynchronous sorting on the copy
-                (if (cfg/check-browser? :safari)
-                  (rx/map (partial sort-selected-sync state) obs)
-                  (rx/mapcat (partial sort-selected-async state) obs)))]
           (->> (rx/from (seq (vals pdata)))
                (rx/merge-map (partial prepare-object objects selected))
                (rx/reduce collect-data initial)
-               (sort-results)
+               (rx/map (partial sort-selected state))
                (rx/map t/encode-str)
                (rx/map wapi/write-to-clipboard)
                (rx/catch on-copy-error)
@@ -1606,6 +1586,7 @@
                (dwc/add-shape shape)
                (dwu/commit-undo-transaction))))))
 
+;; TODO: why not implement it in terms of upload-media-workspace?
 (defn- paste-svg
   [text]
   (us/assert string? text)
@@ -1614,8 +1595,8 @@
     (watch [_ state _]
       (let [position (deref ms/mouse-position)
             file-id  (:current-file-id state)]
-        (->> (dwp/parse-svg ["svg" text])
+        (->> (dwm/svg->clj ["svg" text])
-             (rx/map #(svg/svg-uploaded % file-id position)))))))
+             (rx/map #(dwm/svg-uploaded % file-id position)))))))
 
 (defn- paste-image
   [image]
@@ -1626,7 +1607,7 @@
             params  {:file-id file-id
                      :blobs [image]
                      :position @ms/mouse-position}]
-        (rx/of (dwp/upload-media-workspace params))))))
+        (rx/of (dwm/upload-media-workspace params))))))
 
 (defn toggle-distances-display [value]
   (ptk/reify ::toggle-distances-display
@@ -1708,17 +1689,6 @@
 (dm/export dwt/flip-vertical-selected)
 (dm/export dwly/set-opacity)
 
-;; Persistence
-
-(dm/export dwp/set-file-shared)
-(dm/export dwp/fetch-shared-files)
-(dm/export dwp/link-file-to-library)
-(dm/export dwp/unlink-file-from-library)
-(dm/export dwp/upload-media-asset)
-(dm/export dwp/upload-media-workspace)
-(dm/export dwp/clone-media-object)
-(dm/export dwc/image-uploaded)
-
 ;; Common
 (dm/export dwc/add-shape)
 (dm/export dwc/clear-edition-mode)

frontend/src/app/main/data/workspace/changes.cljs

@@ -6,11 +6,13 @@
 
 (ns app.main.data.workspace.changes
   (:require
+   [app.common.data :as d]
    [app.common.logging :as log]
    [app.common.pages :as cp]
    [app.common.pages.changes-builder :as pcb]
    [app.common.spec :as us]
    [app.common.spec.change :as spec.change]
+   [app.common.uuid :as uuid]
    [app.main.data.workspace.state-helpers :as wsh]
    [app.main.data.workspace.undo :as dwu]
    [app.main.store :as st]
@@ -59,14 +61,52 @@
            (let [changes  (cond-> changes reg-objects? (pcb/resize-parents ids))]
              (rx/of (commit-changes changes)))))))))
 
-(defn update-indices
+(defn send-update-indices
-  [page-id changes]
+  []
-  (ptk/reify ::update-indices
+  (ptk/reify ::send-update-indices
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (->> (rx/of
+            (fn [state]
+              (-> state
+                  (dissoc ::update-indices-debounce)
+                  (dissoc ::update-changes))))
+           (rx/observe-on :async)))
+
     ptk/EffectEvent
-    (effect [_ _ _]
+    (effect [_ state _]
+      (doseq [[page-id changes] (::update-changes state)]
         (uw/ask! {:cmd :update-page-indices
                   :page-id page-id
-                :changes changes}))))
+                  :changes changes})))))
+
+;; Update indices will debounce operations so we don't have to update
+;; the index several times (which is an expensive operation)
+(defn update-indices
+  [page-id changes]
+
+  (let [start (uuid/next)]
+    (ptk/reify ::update-indices
+      ptk/UpdateEvent
+      (update [_ state]
+        (if (nil? (::update-indices-debounce state))
+          (assoc state ::update-indices-debounce start)
+          (update-in state [::update-changes page-id] (fnil d/concat-vec []) changes)))
+
+      ptk/WatchEvent
+      (watch [_ state stream]
+        (if (= (::update-indices-debounce state) start)
+          (let [stopper (->> stream (rx/filter (ptk/type? :app.main.data.workspace/finalize)))]
+            (rx/merge
+             (->> stream
+                  (rx/filter (ptk/type? ::update-indices))
+                  (rx/debounce 50)
+                  (rx/take 1)
+                  (rx/map #(send-update-indices))
+                  (rx/take-until stopper))
+             (rx/of (update-indices page-id changes))))
+          (rx/empty))))))
+
 
 (defn commit-changes
   [{:keys [redo-changes undo-changes

frontend/src/app/main/data/workspace/common.cljs

@@ -393,6 +393,11 @@
                               interactions)))
                     (vals objects))
 
+            ;; If any of the deleted shapes is a frame with guides
+            guides (into {} (map (juxt :id identity) (->> (get-in page [:options :guides])
+                                                          (vals)
+                                                          (filter #(not (contains? ids (:frame-id %)))))))
+
             starting-flows
             (filter (fn [flow]
                       ;; If any of the deleted is a frame that starts a flow,
@@ -432,6 +437,7 @@
             changes (-> (pcb/empty-changes it page-id)
                         (pcb/with-page page)
                         (pcb/with-objects objects)
+                        (pcb/set-page-option :guides guides)
                         (pcb/remove-objects all-children)
                         (pcb/remove-objects ids)
                         (pcb/remove-objects empty-parents)
@@ -482,22 +488,3 @@
                       (assoc :frame-id frame-id)
                       (cp/setup-rect-selrect))]
         (rx/of (add-shape shape))))))
-
-(defn image-uploaded
-  [image {:keys [x y]}]
-  (ptk/reify ::image-uploaded
-    ptk/WatchEvent
-    (watch [_ _ _]
-      (let [{:keys [name width height id mtype]} image
-            shape {:name name
-                   :width width
-                   :height height
-                   :x (- x (/ width 2))
-                   :y (- y (/ height 2))
-                   :metadata {:width width
-                              :height height
-                              :mtype mtype
-                              :id id}}]
-        (rx/of (create-and-add-shape :image x y shape))))))
-
-

frontend/src/app/main/data/workspace/libraries.cljs

@@ -18,6 +18,7 @@
    [app.common.spec.file :as spec.file]
    [app.common.spec.typography :as spec.typography]
    [app.common.uuid :as uuid]
+   [app.main.data.events :as ev]
    [app.main.data.messages :as dm]
    [app.main.data.workspace.changes :as dch]
    [app.main.data.workspace.common :as dwc]
@@ -31,6 +32,7 @@
    [app.util.router :as rt]
    [app.util.time :as dt]
    [beicon.core :as rx]
+   [cljs.spec.alpha :as s]
    [potok.core :as ptk]))
 
 ;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
@@ -710,3 +712,70 @@
                   :callback do-dismiss}]
                 :sync-dialog))))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Backend interactions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn set-file-shared
+  [id is-shared]
+  {:pre [(uuid? id) (boolean? is-shared)]}
+  (ptk/reify ::set-file-shared
+    IDeref
+    (-deref [_]
+      {::ev/origin "workspace" :id id :shared is-shared})
+
+    ptk/UpdateEvent
+    (update [_ state]
+      (assoc-in state [:workspace-file :is-shared] is-shared))
+
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (let [params {:id id :is-shared is-shared}]
+        (->> (rp/mutation :set-file-shared params)
+             (rx/ignore))))))
+
+(defn- shared-files-fetched
+  [files]
+  (us/verify (s/every ::file) files)
+  (ptk/reify ::shared-files-fetched
+    ptk/UpdateEvent
+    (update [_ state]
+      (let [state (dissoc state :files)]
+        (assoc state :workspace-shared-files files)))))
+
+(defn fetch-shared-files
+  [{:keys [team-id] :as params}]
+  (us/assert ::us/uuid team-id)
+  (ptk/reify ::fetch-shared-files
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (->> (rp/query :team-shared-files {:team-id team-id})
+           (rx/map shared-files-fetched)))))
+
+;; --- Link and unlink Files
+
+(defn link-file-to-library
+  [file-id library-id]
+  (ptk/reify ::attach-library
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (let [fetched #(assoc-in %2 [:workspace-libraries (:id %1)] %1)
+            params  {:file-id file-id
+                     :library-id library-id}]
+        (->> (rp/mutation :link-file-to-library params)
+             (rx/mapcat #(rp/query :file {:id library-id}))
+             (rx/map #(partial fetched %)))))))
+
+(defn unlink-file-from-library
+  [file-id library-id]
+  (ptk/reify ::detach-library
+    ptk/UpdateEvent
+    (update [_ state]
+      (d/dissoc-in state [:workspace-libraries library-id]))
+
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (let [params {:file-id file-id
+                    :library-id library-id}]
+        (->> (rp/mutation :unlink-file-from-library params)
+             (rx/ignore))))))

frontend/src/app/main/data/workspace/libraries_helpers.cljs

@@ -14,6 +14,7 @@
    [app.common.pages.changes-builder :as pcb]
    [app.common.pages.helpers :as cph]
    [app.common.spec :as us]
+   [app.common.spec.color :as color]
    [app.common.text :as txt]
    [app.main.data.workspace.common :as dwc]
    [app.main.data.workspace.groups :as dwg]
@@ -24,18 +25,10 @@
 ;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
 (log/set-level! :warn)
 
-(defonce color-sync-attrs
-  [[:fill-color-ref-id   :fill-color-ref-file   :color    :fill-color]
-   [:fill-color-ref-id   :fill-color-ref-file   :gradient :fill-color-gradient]
-   [:fill-color-ref-id   :fill-color-ref-file   :opacity  :fill-opacity]
-
-   [:stroke-color-ref-id :stroke-color-ref-file :color    :stroke-color]
-   [:stroke-color-ref-id :stroke-color-ref-file :gradient :stroke-color-gradient]
-   [:stroke-color-ref-id :stroke-color-ref-file :opacity  :stroke-opacity]])
-
 (declare generate-sync-container)
 (declare generate-sync-shape)
-(declare has-asset-reference-fn)
+(declare generate-sync-text-shape)
+(declare uses-assets?)
 
 (declare get-assets)
 (declare generate-sync-shape-direct)
@@ -60,7 +53,7 @@
     "<local>"
     (str "<" (get-in state [:workspace-libraries file-id :name]) ">")))
 
-;; ---- Create a new component ----
+;; ---- Components and instances creation ----
 
 (defn make-component-shape
   "Clone the shape and all children. Generate new ids and detach
@@ -278,9 +271,8 @@
     (log/debug :msg "Sync page in local file" :page-id (:id container))
     (log/debug :msg "Sync component in local library" :component-id (:id container)))
 
-  (let [has-asset-reference? (has-asset-reference-fn asset-type library-id (cph/page? container))
+  (let [linked-shapes        (->> (vals (:objects container))
-        linked-shapes        (->> (vals (:objects container))
+                                  (filter #(uses-assets? asset-type % library-id (cph/page? container))))]
-                                  (filter has-asset-reference?))]
     (loop [shapes (seq linked-shapes)
            changes (-> (pcb/empty-changes it)
                        (pcb/with-container container)
@@ -295,49 +287,34 @@
                                     shape))
         changes))))
 
-(defn- has-asset-reference-fn
+(defmulti uses-assets?
-  "Gets a function that checks if a shape uses some asset of the given type
+  "Checks if a shape uses some asset of the given type in the given library."
-  in the given library."
+  (fn [asset-type _ _ _] asset-type))
-  [asset-type library-id page?]
-  (case asset-type
-    :components
-    (fn [shape] (and (:component-id shape)
-                     (or (:component-root? shape) (not page?))
-                     (= (:component-file shape) library-id)))
 
-    :colors
+(defmethod uses-assets? :components
-    (fn [shape]
+  [_ shape library-id page?]
-      (if (= (:type shape) :text)
+  (and (some? (:component-id shape))
-        (->> shape
+       (= (:component-file shape) library-id)
-             :content
+       (or (:component-root? shape) (not page?)))) ; avoid nested components inside pages
-             ;; Check if any node in the content has a reference for the library
-             (txt/node-seq
-              #(or (and (some? (:stroke-color-ref-id %))
-                        (= library-id (:stroke-color-ref-file %)))
-                   (and (some? (:fill-color-ref-id %))
-                        (= library-id (:fill-color-ref-file %))))))
-        (some
-          #(let [attr (name %)
-                 attr-ref-id (keyword (str attr "-ref-id"))
-                 attr-ref-file (keyword (str attr "-ref-file"))]
-             (and (get shape attr-ref-id)
-                  (= library-id (get shape attr-ref-file))))
-          (map #(nth % 3) color-sync-attrs))))
 
-    :typographies
+(defmethod uses-assets? :colors
-    (fn [shape]
+  [_ shape library-id _]
+  (color/uses-library-colors? shape library-id))
+
+(defmethod uses-assets? :typographies
+  [_ shape library-id _]
   (and (= (:type shape) :text)
        (->> shape
             :content
             ;; Check if any node in the content has a reference for the library
             (txt/node-seq
               #(and (some? (:typography-ref-id %))
-                       (= library-id (:typography-ref-file %)))))))))
+                    (= (:typography-ref-file %) library-id))))))
 
 (defmulti generate-sync-shape
-  "Generate changes to synchronize one shape with all assets of the given type
+  "Generate changes to synchronize one shape from all assets of the given type
   that is using, in the given library."
-  (fn [type _changes _library-id _state _container _shape] type))
+  (fn [asset-type _changes _library-id _state _container _shape] asset-type))
 
 (defmethod generate-sync-shape :components
   [_ changes _library-id state container shape]
@@ -345,6 +322,37 @@
         libraries (wsh/get-libraries state)]
     (generate-sync-shape-direct changes libraries container shape-id false)))
 
+(defmethod generate-sync-shape :colors
+  [_ changes library-id state _ shape]
+  (log/debug :msg "Sync colors of shape" :shape (:name shape))
+
+  ;; Synchronize a shape that uses some colors of the library. The value of the
+  ;; color in the library is copied to the shape.
+  (let [library-colors (get-assets library-id :colors state)]
+    (pcb/update-shapes changes
+                       [(:id shape)]
+                       #(color/sync-shape-colors % library-id library-colors))))
+
+(defmethod generate-sync-shape :typographies
+  [_ changes library-id state container shape]
+  (log/debug :msg "Sync typographies of shape" :shape (:name shape))
+
+  ;; Synchronize a shape that uses some typographies of the library. The attributes
+  ;; of the typography are copied to the shape."
+  (let [typographies (get-assets library-id :typographies state)
+        update-node (fn [node]
+                      (if-let [typography (get typographies (:typography-ref-id node))]
+                        (merge node (dissoc typography :name :id))
+                        (dissoc node :typography-ref-id
+                                     :typography-ref-file)))]
+    (generate-sync-text-shape changes shape container update-node)))
+
+(defn- get-assets
+  [library-id asset-type state]
+  (if (= library-id (:current-file-id state))
+    (get-in state [:workspace-data asset-type])
+    (get-in state [:workspace-libraries library-id :data asset-type])))
+
 (defn- generate-sync-text-shape
   [changes shape container update-node]
   (let [old-content (:content shape)
@@ -368,99 +376,6 @@
       changes
       changes')))
 
-(defmethod generate-sync-shape :colors
-  [_ changes library-id state container shape]
-  (log/debug :msg "Sync colors of shape" :shape (:name shape))
-
-  ;; Synchronize a shape that uses some colors of the library. The value of the
-  ;; color in the library is copied to the shape.
-  (let [colors (get-assets library-id :colors state)]
-    (if (= :text (:type shape))
-      (let [update-node (fn [node]
-                          (if-let [color (get colors (:fill-color-ref-id node))]
-                            (assoc node
-                                   :fill-color (:color color)
-                                   :fill-opacity (:opacity color)
-                                   :fill-color-gradient (:gradient color))
-                            (assoc node
-                                   :fill-color-ref-id nil
-                                   :fill-color-ref-file nil)))]
-        (generate-sync-text-shape changes shape container update-node))
-      (loop [attrs   (seq color-sync-attrs)
-             roperations []
-             uoperations []]
-        (let [[attr-ref-id attr-ref-file color-attr attr] (first attrs)]
-          (if (nil? attr)
-            (if (empty? roperations)
-              changes
-              (-> changes
-                  (update :redo-changes (make-change
-                                          container
-                                          {:type :mod-obj
-                                           :id (:id shape)
-                                           :operations roperations}))
-                  (update :undo-changes (make-change
-                                          container
-                                          {:type :mod-obj
-                                           :id (:id shape)
-                                           :operations uoperations}))))
-            (if-not (contains? shape attr-ref-id)
-              (recur (next attrs)
-                     roperations
-                     uoperations)
-              (let [color (get colors (get shape attr-ref-id))
-                    roperations' (if color
-                                   [{:type :set
-                                     :attr attr
-                                     :val (color-attr color)
-                                     :ignore-touched true}]
-                                   ;; If the referenced color does no longer exist in the library,
-                                   ;; we must unlink the color in the shape
-                                   [{:type :set
-                                     :attr attr-ref-id
-                                     :val nil
-                                     :ignore-touched true}
-                                    {:type :set
-                                     :attr attr-ref-file
-                                     :val nil
-                                     :ignore-touched true}])
-                    uoperations' (if color
-                                   [{:type :set
-                                     :attr attr
-                                     :val (get shape attr)
-                                     :ignore-touched true}]
-                                   [{:type :set
-                                     :attr attr-ref-id
-                                     :val (get shape attr-ref-id)
-                                     :ignore-touched true}
-                                    {:type :set
-                                     :attr attr-ref-file
-                                     :val (get shape attr-ref-file)
-                                     :ignore-touched true}])]
-                (recur (next attrs)
-                       (into roperations roperations')
-                       (into uoperations uoperations'))))))))))
-
-(defmethod generate-sync-shape :typographies
-  [_ changes library-id state container shape]
-  (log/debug :msg "Sync typographies of shape" :shape (:name shape))
-
-  ;; Synchronize a shape that uses some typographies of the library. The attributes
-  ;; of the typography are copied to the shape."
-  (let [typographies (get-assets library-id :typographies state)
-        update-node (fn [node]
-                      (if-let [typography (get typographies (:typography-ref-id node))]
-                        (merge node (dissoc typography :name :id))
-                        (dissoc node :typography-ref-id
-                                     :typography-ref-file)))]
-    (generate-sync-text-shape changes shape container update-node)))
-
-(defn- get-assets
-  [library-id asset-type state]
-  (if (= library-id (:current-file-id state))
-    (get-in state [:workspace-data asset-type])
-    (get-in state [:workspace-libraries library-id :data asset-type])))
-
 
 ;; ---- Component synchronization helpers ----
 

frontend/src/app/main/data/workspace/media.cljs

@@ -0,0 +1,286 @@
+;; 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) UXBOX Labs SL
+
+(ns app.main.data.workspace.media
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.main.data.media :as dmm]
+   [app.main.data.messages :as dm]
+   [app.main.data.workspace.common :as dwc]
+   [app.main.data.workspace.libraries :as dwl]
+   [app.main.data.workspace.svg-upload :as svg]
+   [app.main.repo :as rp]
+   [app.main.store :as st]
+   [app.util.http :as http]
+   [app.util.i18n :refer [tr]]
+   [app.util.svg :as usvg]
+   [app.util.webapi :as wapi]
+   [beicon.core :as rx]
+   [cljs.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [potok.core :as ptk]
+   [promesa.core :as p]
+   [tubax.core :as tubax]))
+
+(defn svg->clj
+  [[name text]]
+  (try
+    (->> (rx/of (-> (tubax/xml->clj text)
+                    (assoc :name name))))
+
+    (catch :default _err
+      (rx/throw {:type :svg-parser}))))
+
+(defn extract-name [url]
+  (let [query-idx (str/last-index-of url "?")
+        url (if (> query-idx 0) (subs url 0 query-idx) url)
+        filename (->> (str/split url "/") (last))
+        ext-idx (str/last-index-of filename ".")]
+    (if (> ext-idx 0) (subs filename 0 ext-idx) filename)))
+
+(defn data-uri->blob
+  [data-uri]
+  (let [[mtype b64-data] (str/split data-uri ";base64,")
+        mtype   (subs mtype (inc (str/index-of mtype ":")))
+        decoded (.atob js/window b64-data)
+        size    (.-length ^js decoded)
+        content (js/Uint8Array. size)]
+
+    (doseq [i (range 0 size)]
+      (aset content i (.charCodeAt decoded i)))
+
+    (wapi/create-blob content mtype)))
+
+
+;; TODO: rename to bitmap-image-uploaded
+(defn image-uploaded
+  [image {:keys [x y]}]
+  (ptk/reify ::image-uploaded
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (let [{:keys [name width height id mtype]} image
+            shape {:name name
+                   :width width
+                   :height height
+                   :x (- x (/ width 2))
+                   :y (- y (/ height 2))
+                   :metadata {:width width
+                              :height height
+                              :mtype mtype
+                              :id id}}]
+        (rx/of (dwc/create-and-add-shape :image x y shape))))))
+
+(defn svg-uploaded
+  [svg-data file-id position]
+  (ptk/reify ::svg-uploaded
+    ptk/WatchEvent
+    (watch [_ _ _]
+      ;; Once the SVG is uploaded, we need to extract all the bitmap
+      ;; images and upload them separately, then proceed to create
+      ;; all shapes.
+      (->> (rx/from (usvg/collect-images svg-data))
+           (rx/map (fn [uri]
+                     (merge
+                      {:file-id file-id
+                       :is-local true}
+                      (if (str/starts-with? uri "data:")
+                        {:name "image"
+                         :content (data-uri->blob uri)}
+                        {:name (extract-name uri)
+                         :url uri}))))
+           (rx/mapcat (fn [uri-data]
+                        (->> (rp/mutation! (if (contains? uri-data :content)
+                                             :upload-file-media-object
+                                             :create-file-media-object-from-url) uri-data)
+                             ;; When the image uploaded fail we skip the shape
+                             ;; returning `nil` will afterward not create the shape.
+                             (rx/catch #(rx/of nil))
+                             (rx/map #(vector (:url uri-data) %)))))
+           (rx/reduce (fn [acc [url image]] (assoc acc url image)) {})
+           (rx/map #(svg/create-svg-shapes (assoc svg-data :image-data %) position))))))
+
+(defn- process-uris
+  [{:keys [file-id local? name uris mtype on-image on-svg]}]
+  (letfn [(svg-url? [url]
+            (or (and mtype (= mtype "image/svg+xml"))
+                (str/ends-with? url ".svg")))
+
+          (prepare [uri]
+            {:file-id file-id
+             :is-local local?
+             :name (or name (extract-name uri))
+             :url uri})
+
+          (fetch-svg [name uri]
+            (->> (http/send! {:method :get :uri uri :mode :no-cors})
+                 (rx/map #(vector
+                           (or name (extract-name uri))
+                           (:body %)))))]
+
+    (rx/merge
+     (->> (rx/from uris)
+          (rx/filter (comp not svg-url?))
+          (rx/map prepare)
+          (rx/mapcat #(rp/mutation! :create-file-media-object-from-url %))
+          (rx/do on-image))
+
+     (->> (rx/from uris)
+          (rx/filter svg-url?)
+          (rx/merge-map (partial fetch-svg name))
+          (rx/merge-map svg->clj)
+          (rx/do on-svg)))))
+
+(defn- process-blobs
+  [{:keys [file-id local? name blobs force-media on-image on-svg]}]
+  (letfn [(svg-blob? [blob]
+            (and (not force-media)
+                 (= (.-type blob) "image/svg+xml")))
+
+          (prepare-blob [blob]
+            (let [name (or name (if (dmm/file? blob) (.-name blob) "blob"))]
+              {:file-id file-id
+               :name name
+               :is-local local?
+               :content blob}))
+
+          (extract-content [blob]
+            (let [name (or name (.-name blob))]
+              (-> (.text ^js blob)
+                  (p/then #(vector name %)))))]
+
+    (rx/merge
+     (->> (rx/from blobs)
+          (rx/map dmm/validate-file)
+          (rx/filter (comp not svg-blob?))
+          (rx/map prepare-blob)
+          (rx/mapcat #(rp/mutation! :upload-file-media-object %))
+          (rx/do on-image))
+
+     (->> (rx/from blobs)
+          (rx/map dmm/validate-file)
+          (rx/filter svg-blob?)
+          (rx/merge-map extract-content)
+          (rx/merge-map svg->clj)
+          (rx/do on-svg)))))
+
+(s/def ::local? ::us/boolean)
+(s/def ::blobs ::dmm/blobs)
+(s/def ::name ::us/string)
+(s/def ::uris (s/coll-of ::us/string))
+(s/def ::mtype ::us/string)
+
+(s/def ::process-media-objects
+  (s/and
+   (s/keys :req-un [::file-id ::local?]
+           :opt-un [::name ::data ::uris ::mtype])
+   (fn [props]
+     (or (contains? props :blobs)
+         (contains? props :uris)))))
+
+(defn- process-media-objects
+  [{:keys [uris on-error] :as params}]
+  (us/assert ::process-media-objects params)
+  (letfn [(handle-error [error]
+            (if (ex/ex-info? error)
+              (handle-error (ex-data error))
+              (cond
+                (= (:code error) :invalid-svg-file)
+                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
+
+                (= (:code error) :media-type-not-allowed)
+                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
+
+                (= (:code error) :unable-to-access-to-url)
+                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
+
+                (= (:code error) :invalid-image)
+                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
+
+                (= (:code error) :media-too-large)
+                (rx/of (dm/error (tr "errors.media-too-large")))
+
+                (= (:code error) :media-type-mismatch)
+                (rx/of (dm/error (tr "errors.media-type-mismatch")))
+
+                (= (:code error) :unable-to-optimize)
+                (rx/of (dm/error (:hint error)))
+
+                (fn? on-error)
+                (on-error error)
+
+                :else
+                (rx/throw error))))]
+
+    (ptk/reify ::process-media-objects
+      ptk/WatchEvent
+      (watch [_ _ _]
+        (rx/concat
+         (rx/of (dm/show {:content (tr "media.loading")
+                          :type :info
+                          :timeout nil
+                          :tag :media-loading}))
+         (->> (if (seq uris)
+                ;; Media objects is a list of URL's pointing to the path
+                (process-uris params)
+                ;; Media objects are blob of data to be upload
+                (process-blobs params))
+
+              ;; Every stream has its own sideeffect. We need to ignore the result
+              (rx/ignore)
+              (rx/catch handle-error)
+              (rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))
+
+(defn upload-media-asset
+  [params]
+  (let [params (assoc params
+                      :force-media true
+                      :local? false
+                      :on-image #(st/emit! (dwl/add-media %)))]
+    (process-media-objects params)))
+
+
+;; TODO: it is really need handle SVG here, looks like it already
+;; handled separatelly
+(defn upload-media-workspace
+  [{:keys [position file-id] :as params}]
+  (let [params (assoc params
+                      :local? true
+                      :on-image #(st/emit! (image-uploaded % position))
+                      :on-svg   #(st/emit! (svg-uploaded % file-id position)))]
+    (process-media-objects params)))
+
+
+;; --- Upload File Media objects
+
+(s/def ::object-id ::us/uuid)
+
+(s/def ::clone-media-objects-params
+  (s/keys :req-un [::file-id ::object-id]))
+
+(defn clone-media-object
+  [{:keys [file-id object-id] :as params}]
+  (us/assert ::clone-media-objects-params params)
+  (ptk/reify ::clone-media-objects
+    ptk/WatchEvent
+    (watch [_ _ _]
+      (let [{:keys [on-success on-error]
+             :or {on-success identity
+                  on-error identity}} (meta params)
+            params {:is-local true
+                    :file-id file-id
+                    :id object-id}]
+
+        (rx/concat
+         (rx/of (dm/show {:content (tr "media.loading")
+                          :type :info
+                          :timeout nil
+                          :tag :media-loading}))
+         (->> (rp/mutation! :clone-file-media-object params)
+              (rx/do on-success)
+              (rx/catch on-error)
+              (rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))
+

frontend/src/app/main/data/workspace/persistence.cljs

@@ -6,37 +6,28 @@
 
 (ns app.main.data.workspace.persistence
   (:require
-   [app.common.data :as d]
+   [app.common.logging :as log]
-   [app.common.exceptions :as ex]
    [app.common.pages :as cp]
    [app.common.spec :as us]
    [app.common.spec.change :as spec.change]
    [app.common.spec.file :as spec.file]
    [app.common.uuid :as uuid]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.main.data.dashboard :as dd]
-   [app.main.data.events :as ev]
    [app.main.data.fonts :as df]
-   [app.main.data.media :as di]
-   [app.main.data.messages :as dm]
    [app.main.data.workspace.changes :as dch]
-   [app.main.data.workspace.common :as dwc]
-   [app.main.data.workspace.libraries :as dwl]
-   [app.main.data.workspace.selection :as dws]
    [app.main.data.workspace.state-helpers :as wsh]
-   [app.main.data.workspace.svg-upload :as svg]
    [app.main.repo :as rp]
    [app.main.store :as st]
    [app.util.http :as http]
-   [app.util.i18n :as i18n :refer [tr]]
+   [app.util.router :as rt]
    [app.util.time :as dt]
-   [app.util.uri :as uu]
    [beicon.core :as rx]
    [cljs.spec.alpha :as s]
-   [cuerdas.core :as str]
+   [okulary.core :as l]
-   [potok.core :as ptk]
+   [potok.core :as ptk]))
-   [promesa.core :as p]
+
-   [tubax.core :as tubax]))
+(log/set-level! :info)
 
 (declare persist-changes)
 (declare persist-synchronous-changes)
@@ -48,18 +39,17 @@
 (defn initialize-file-persistence
   [file-id]
   (ptk/reify ::initialize-persistence
-    ptk/EffectEvent
+    ptk/WatchEvent
-    (effect [_ _ stream]
+    (watch [_ _ stream]
+      (log/debug :hint "initialize persistence")
       (let [stoper   (rx/filter #(= ::finalize %) stream)
-            forcer   (rx/filter #(= ::force-persist %) stream)
+            commits  (l/atom [])
-            notifier (->> stream
+
-                          (rx/filter dch/commit-changes?)
-                          (rx/debounce 2000)
-                          (rx/merge stoper forcer))
             local-file?
             #(as-> (:file-id %) event-file-id
                (or (nil? event-file-id)
                    (= event-file-id file-id)))
+
             library-file?
             #(as-> (:file-id %) event-file-id
                (and (some? event-file-id)
@@ -80,93 +70,89 @@
               ;; Disable reload stoper
               (swap! st/ongoing-tasks disj :workspace-change)
               (st/emit! (update-persistence-status {:status :saved})))]
-        (->> (rx/merge
+
+        (rx/merge
          (->> stream
               (rx/filter dch/commit-changes?)
               (rx/map deref)
               (rx/filter local-file?)
               (rx/tap on-dirty)
-                   (rx/buffer-until notifier)
               (rx/filter (complement empty?))
-                   (rx/map (fn [buf]
+              (rx/map (fn [commit]
-                             (->> (into [] (comp (map #(assoc % :id (uuid/next)))
+                        (-> commit
-                                                 (map #(assoc % :file-id file-id)))
+                            (assoc :id (uuid/next))
-                                        buf)
+                            (assoc :file-id file-id))))
-                                  (persist-changes file-id))))
+              (rx/observe-on :async)
+              (rx/tap #(swap! commits conj %))
+              (rx/take-until (rx/delay 100 stoper))
+              (rx/finalize (fn []
+                             (log/debug :hint "finalize persistence: changes watcher"))))
+
+         (->> (rx/from-atom commits)
+              (rx/filter (complement empty?))
+              (rx/sample-when (rx/merge
+                               (rx/interval 5000)
+                               (rx/filter #(= ::force-persist %) stream)
+                               (->> (rx/from-atom commits)
+                                    (rx/filter (complement empty?))
+                                    (rx/debounce 2000))))
+              (rx/tap #(reset! commits []))
               (rx/tap on-saving)
-                   (rx/take-until (rx/delay 100 stoper)))
+              (rx/mapcat (fn [changes]
+                           ;; NOTE: this is needed for don't start the
+                           ;; next persistence before this one is
+                           ;; finished.
+                           (rx/merge
+                            (rx/of (persist-changes file-id changes))
+                            (->> stream
+                                 (rx/filter (ptk/type? ::changes-persisted))
+                                 (rx/take 1)
+                                 (rx/tap on-saved)
+                                 (rx/ignore)))))
+              (rx/take-until (rx/delay 100 stoper))
+              (rx/finalize (fn []
+                             (log/debug :hint "finalize persistence: save loop"))))
+
+         ;; Synchronous changes
          (->> stream
               (rx/filter dch/commit-changes?)
               (rx/map deref)
               (rx/filter library-file?)
               (rx/filter (complement #(empty? (:changes %))))
               (rx/map persist-synchronous-changes)
-                   (rx/take-until (rx/delay 100 stoper)))
+              (rx/take-until (rx/delay 100 stoper))
-              (->> stream
+              (rx/finalize (fn []
-                   (rx/filter (ptk/type? ::changes-persisted))
+                             (log/debug :hint "finalize persistence: synchronous save loop"))))
-                   (rx/tap on-saved)
+         )))))
-                   (rx/ignore)
-                   (rx/take-until stoper)))
-             (rx/subs #(st/emit! %)
-                      (constantly nil)
-                      (fn []
-                        (on-saved))))))))
 
 (defn persist-changes
   [file-id changes]
+  (log/debug :hint "persist changes" :changes (count changes))
   (us/verify ::us/uuid file-id)
   (ptk/reify ::persist-changes
-    ptk/UpdateEvent
-    (update [_ state]
-      (let [into* (fnil into [])]
-        (update-in state [:workspace-persistence :queue] into* changes)))
-
     ptk/WatchEvent
     (watch [_ state _]
       (let [sid     (:session-id state)
             file    (get state :workspace-file)
-            queue   (get-in state [:workspace-persistence :queue] [])
-
             params  {:id (:id file)
                      :revn (:revn file)
                      :session-id sid
-                     :changes-with-metadata (into [] queue)}
+                     :changes-with-metadata (into [] changes)}]
-
+        (when (= file-id (:id params))
-            ids     (into #{} (map :id) queue)
+          (->> (rp/mutation :update-file params)
-
+               (rx/mapcat (fn [lagged]
-            update-persistence-queue
+                            (log/debug :hint "changes persisted" :lagged (count lagged))
-            (fn [state]
-              (update-in state [:workspace-persistence :queue]
-                         (fn [items] (into [] (remove #(ids (:id %))) items))))
-
-            handle-response
-            (fn [lagged]
                             (let [lagged (cond->> lagged
                                            (= #{sid} (into #{} (map :session-id) lagged))
                                            (map #(assoc % :changes [])))]
-                (rx/concat
-                 (rx/of update-persistence-queue)
                               (->> (rx/of lagged)
                                    (rx/mapcat seq)
                                    (rx/map #(shapes-changes-persisted file-id %))))))
-
+               (rx/catch (fn [cause]
-            on-error
-            (fn [{:keys [type] :as error}]
-              (if (or (= :bad-gateway type)
-                      (= :service-unavailable type))
-                (rx/of (update-persistence-status {:status :error :reason type}))
                            (rx/concat
-                 (rx/of update-persistence-queue)
+                            (rx/of (rt/assign-exception cause))
-                 (rx/of (update-persistence-status {:status :error :reason type}))
+                            (rx/throw cause))))))))))
-                 (rx/of (dws/deselect-all))
-                 (->> (rx/of nil)
-                      (rx/delay 200)
-                      (rx/mapcat #(rx/throw error))))))]
 
-        (when (= file-id (:id params))
-          (->> (rp/mutation :update-file params)
-               (rx/mapcat handle-response)
-               (rx/catch on-error)))))))
 
 (defn persist-synchronous-changes
   [{:keys [file-id changes]}]
@@ -274,271 +260,6 @@
                         (rx/of (ptk/data-event ::bundle-fetched bundle)
                                (df/load-team-fonts (:team-id project)))))))))
 
-;; --- Set File shared
-
-(defn set-file-shared
-  [id is-shared]
-  {:pre [(uuid? id) (boolean? is-shared)]}
-  (ptk/reify ::set-file-shared
-    IDeref
-    (-deref [_]
-      {::ev/origin "workspace" :id id :shared is-shared})
-
-    ptk/UpdateEvent
-    (update [_ state]
-      (assoc-in state [:workspace-file :is-shared] is-shared))
-
-    ptk/WatchEvent
-    (watch [_ _ _]
-      (let [params {:id id :is-shared is-shared}]
-        (->> (rp/mutation :set-file-shared params)
-             (rx/ignore))))))
-
-
-;; --- Fetch Shared Files
-
-(declare shared-files-fetched)
-
-(defn fetch-shared-files
-  [{:keys [team-id] :as params}]
-  (us/assert ::us/uuid team-id)
-  (ptk/reify ::fetch-shared-files
-    ptk/WatchEvent
-    (watch [_ _ _]
-      (->> (rp/query :team-shared-files {:team-id team-id})
-           (rx/map shared-files-fetched)))))
-
-(defn shared-files-fetched
-  [files]
-  (us/verify (s/every ::file) files)
-  (ptk/reify ::shared-files-fetched
-    ptk/UpdateEvent
-    (update [_ state]
-      (let [state (dissoc state :files)]
-        (assoc state :workspace-shared-files files)))))
-
-
-;; --- Link and unlink Files
-
-(defn link-file-to-library
-  [file-id library-id]
-  (ptk/reify ::attach-library
-    ptk/WatchEvent
-    (watch [_ _ _]
-      (let [fetched #(assoc-in %2 [:workspace-libraries (:id %1)] %1)
-            params  {:file-id file-id
-                     :library-id library-id}]
-        (->> (rp/mutation :link-file-to-library params)
-             (rx/mapcat #(rp/query :file {:id library-id}))
-             (rx/map #(partial fetched %)))))))
-
-(defn unlink-file-from-library
-  [file-id library-id]
-  (ptk/reify ::detach-library
-    ptk/UpdateEvent
-    (update [_ state]
-      (d/dissoc-in state [:workspace-libraries library-id]))
-
-    ptk/WatchEvent
-    (watch [_ _ _]
-      (let [params {:file-id file-id
-                    :library-id library-id}]
-        (->> (rp/mutation :unlink-file-from-library params)
-             (rx/ignore))))))
-
-
-;; --- Upload File Media objects
-
-(defn parse-svg
-  [[name text]]
-  (try
-    (->> (rx/of (-> (tubax/xml->clj text)
-                    (assoc :name name))))
-
-    (catch :default _err
-      (rx/throw {:type :svg-parser}))))
-
-(defn fetch-svg [name uri]
-  (->> (http/send! {:method :get :uri uri :mode :no-cors})
-       (rx/map #(vector
-                 (or name (uu/uri-name uri))
-                 (:body %)))))
-
-(defn- handle-upload-error
-  "Generic error handler for all upload methods."
-  [on-error stream]
-  (letfn [(on-error* [error]
-            (if (ex/ex-info? error)
-              (on-error* (ex-data error))
-              (cond
-                (= (:code error) :invalid-svg-file)
-                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
-
-                (= (:code error) :media-type-not-allowed)
-                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
-
-                (= (:code error) :unable-to-access-to-url)
-                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
-
-                (= (:code error) :invalid-image)
-                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
-
-                (= (:code error) :media-too-large)
-                (rx/of (dm/error (tr "errors.media-too-large")))
-
-                (= (:code error) :media-type-mismatch)
-                (rx/of (dm/error (tr "errors.media-type-mismatch")))
-
-                (= (:code error) :unable-to-optimize)
-                (rx/of (dm/error (:hint error)))
-
-                (fn? on-error)
-                (on-error error)
-
-                :else
-                (rx/throw error))))]
-    (rx/catch on-error* stream)))
-
-(defn- process-uris
-  [{:keys [file-id local? name uris mtype on-image on-svg]}]
-  (letfn [(svg-url? [url]
-            (or (and mtype (= mtype "image/svg+xml"))
-                (str/ends-with? url ".svg")))
-
-          (prepare [uri]
-            {:file-id file-id
-             :is-local local?
-             :name (or name (uu/uri-name uri))
-             :url uri})]
-    (rx/merge
-     (->> (rx/from uris)
-          (rx/filter (comp not svg-url?))
-          (rx/map prepare)
-          (rx/mapcat #(rp/mutation! :create-file-media-object-from-url %))
-          (rx/do on-image))
-
-     (->> (rx/from uris)
-          (rx/filter svg-url?)
-          (rx/merge-map (partial fetch-svg name))
-          (rx/merge-map parse-svg)
-          (rx/do on-svg)))))
-
-(defn- process-blobs
-  [{:keys [file-id local? name blobs force-media on-image on-svg]}]
-  (letfn [(svg-blob? [blob]
-            (and (not force-media)
-                 (= (.-type blob) "image/svg+xml")))
-
-          (prepare-blob [blob]
-            (let [name (or name (if (di/file? blob) (.-name blob) "blob"))]
-              {:file-id file-id
-               :name name
-               :is-local local?
-               :content blob}))
-
-          (extract-content [blob]
-            (let [name (or name (.-name blob))]
-              (-> (.text ^js blob)
-                  (p/then #(vector name %)))))]
-
-    (rx/merge
-     (->> (rx/from blobs)
-          (rx/map di/validate-file)
-          (rx/filter (comp not svg-blob?))
-          (rx/map prepare-blob)
-          (rx/mapcat #(rp/mutation! :upload-file-media-object %))
-          (rx/do on-image))
-
-     (->> (rx/from blobs)
-          (rx/map di/validate-file)
-          (rx/filter svg-blob?)
-          (rx/merge-map extract-content)
-          (rx/merge-map parse-svg)
-          (rx/do on-svg)))))
-
-(s/def ::local? ::us/boolean)
-(s/def ::blobs ::di/blobs)
-(s/def ::name ::us/string)
-(s/def ::uris (s/coll-of ::us/string))
-(s/def ::mtype ::us/string)
-
-(s/def ::process-media-objects
-  (s/and
-   (s/keys :req-un [::file-id ::local?]
-           :opt-un [::name ::data ::uris ::mtype])
-   (fn [props]
-     (or (contains? props :blobs)
-         (contains? props :uris)))))
-
-(defn- process-media-objects
-  [{:keys [uris on-error] :as params}]
-  (us/assert ::process-media-objects params)
-  (ptk/reify ::process-media-objects
-    ptk/WatchEvent
-    (watch [_ _ _]
-      (rx/concat
-       (rx/of (dm/show {:content (tr "media.loading")
-                        :type :info
-                        :timeout nil
-                        :tag :media-loading}))
-       (->> (if (seq uris)
-              ;; Media objects is a list of URL's pointing to the path
-              (process-uris params)
-              ;; Media objects are blob of data to be upload
-              (process-blobs params))
-
-            ;; Every stream has its own sideeffect. We need to ignore the result
-            (rx/ignore)
-            (handle-upload-error on-error)
-            (rx/finalize (st/emitf (dm/hide-tag :media-loading))))))))
-
-(defn upload-media-asset
-  [params]
-  (let [params (assoc params
-                      :force-media true
-                      :local? false
-                      :on-image #(st/emit! (dwl/add-media %)))]
-    (process-media-objects params)))
-
-(defn upload-media-workspace
-  [{:keys [position file-id] :as params}]
-  (let [params (assoc params
-                      :local? true
-                      :on-image #(st/emit! (dwc/image-uploaded % position))
-                      :on-svg   #(st/emit! (svg/svg-uploaded % file-id position)))]
-
-    (process-media-objects params)))
-
-
-;; --- Upload File Media objects
-
-(s/def ::object-id ::us/uuid)
-
-(s/def ::clone-media-objects-params
-  (s/keys :req-un [::file-id ::object-id]))
-
-(defn clone-media-object
-  [{:keys [file-id object-id] :as params}]
-  (us/assert ::clone-media-objects-params params)
-  (ptk/reify ::clone-media-objects
-    ptk/WatchEvent
-    (watch [_ _ _]
-      (let [{:keys [on-success on-error]
-             :or {on-success identity
-                  on-error identity}} (meta params)
-            params {:is-local true
-                    :file-id file-id
-                    :id object-id}]
-
-        (rx/concat
-         (rx/of (dm/show {:content (tr "media.loading")
-                          :type :info
-                          :timeout nil
-                          :tag :media-loading}))
-         (->> (rp/mutation! :clone-file-media-object params)
-              (rx/do on-success)
-              (rx/catch on-error)
-              (rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))
 
 ;; --- Helpers
 
@@ -549,7 +270,6 @@
       (update-in [:workspace-file :pages] #(filterv (partial not= id) %))
       (update :workspace-pages dissoc id)))
 
-
 (defn preload-data-uris
   "Preloads the image data so it's ready when necesary"
   []
@@ -560,10 +280,10 @@
             (fn [{:keys [metadata fill-image]}]
               (cond
                 (some? metadata)
-                [(cfg/resolve-file-media metadata)]
+                [(cf/resolve-file-media metadata)]
 
                 (some? fill-image)
-                [(cfg/resolve-file-media fill-image)]))
+                [(cf/resolve-file-media fill-image)]))
 
             uris (into #{}
                        (comp (mapcat extract-urls)

frontend/src/app/main/data/workspace/selection.cljs

@@ -274,6 +274,7 @@
 (declare prepare-duplicate-frame-change)
 (declare prepare-duplicate-shape-change)
 (declare prepare-duplicate-flows)
+(declare prepare-duplicate-guides)
 
 (defn prepare-duplicate-changes
   "Prepare objects to duplicate: generate new id, give them unique names,
@@ -302,7 +303,9 @@
                                                 delta)
                      init-changes))]
 
-    (prepare-duplicate-flows changes shapes page ids-map)))
+    (-> changes
+        (prepare-duplicate-flows shapes page ids-map)
+        (prepare-duplicate-guides shapes page ids-map delta))))
 
 (defn- prepare-duplicate-change
   [changes objects page unames update-unames! ids-map shape delta]
@@ -399,6 +402,32 @@
         (pcb/update-page-option changes :flows update-flows))
       changes)))
 
+(defn- prepare-duplicate-guides
+  [changes shapes page ids-map delta]
+  (let [guides (get-in page [:options :guides])
+        frames (->> shapes
+                    (filter #(= (:type %) :frame)))
+        new-guides (reduce
+                    (fn [g frame]
+                      (let [new-id     (ids-map (:id frame))
+                            new-frame  (-> frame
+                                           (geom/move delta))
+                            new-guides (->> guides
+                                            (vals)
+                                            (filter #(= (:frame-id %) (:id frame)))
+                                            (map #(-> %
+                                                      (assoc :id (uuid/next))
+                                                      (assoc :frame-id new-id)
+                                                      (assoc :position (if (= (:axis %) :x)
+                                                                         (+ (:position %) (- (:x new-frame) (:x frame)))
+                                                                         (+ (:position %) (- (:y new-frame) (:y frame))))))))]
+                        (conj g
+                              (into {} (map (juxt :id identity) new-guides)))))
+                    guides
+                    frames)]
+    (-> (pcb/with-page changes page)
+        (pcb/set-page-option :guides new-guides))))
+
 (defn duplicate-changes-update-indices
   "Updates the changes to correctly set the indexes of the duplicated objects,
   depending on the index of the original object respect their parent."

frontend/src/app/main/data/workspace/svg_upload.cljs

@@ -19,11 +19,9 @@
    [app.main.data.workspace.changes :as dch]
    [app.main.data.workspace.common :as dwc]
    [app.main.data.workspace.state-helpers :as wsh]
-   [app.main.repo :as rp]
    [app.util.color :as uc]
    [app.util.path.parser :as upp]
    [app.util.svg :as usvg]
-   [app.util.uri :as uu]
    [beicon.core :as rx]
    [cuerdas.core :as str]
    [potok.core :as ptk]))
@@ -429,37 +427,6 @@
 
       [unames changes])))
 
-(declare create-svg-shapes)
-
-(defn svg-uploaded
-  [svg-data file-id position]
-  (ptk/reify ::svg-uploaded
-    ptk/WatchEvent
-    (watch [_ _ _]
-      ;; Once the SVG is uploaded, we need to extract all the bitmap
-      ;; images and upload them separately, then proceed to create
-      ;; all shapes.
-      (->> (rx/from (usvg/collect-images svg-data))
-           (rx/map (fn [uri]
-                     (merge
-                      {:file-id file-id
-                       :is-local true}
-                      (if (str/starts-with? uri "data:")
-                        {:name "image"
-                         :content (uu/data-uri->blob uri)}
-                        {:name (uu/uri-name uri)
-                         :url uri}))))
-           (rx/mapcat (fn [uri-data]
-                        (->> (rp/mutation! (if (contains? uri-data :content)
-                                             :upload-file-media-object
-                                             :create-file-media-object-from-url) uri-data)
-                             ;; When the image uploaded fail we skip the shape
-                             ;; returning `nil` will afterward not create the shape.
-                             (rx/catch #(rx/of nil))
-                             (rx/map #(vector (:url uri-data) %)))))
-           (rx/reduce (fn [acc [url image]] (assoc acc url image)) {})
-           (rx/map #(create-svg-shapes (assoc svg-data :image-data %) position))))))
-
 (defn create-svg-shapes
   [svg-data {:keys [x y] :as position}]
   (ptk/reify ::create-svg-shapes

frontend/src/app/main/data/workspace/texts.cljs

@@ -13,6 +13,7 @@
    [app.common.math :as mth]
    [app.common.pages.helpers :as cph]
    [app.common.text :as txt]
+   [app.common.uuid :as uuid]
    [app.main.data.workspace.changes :as dch]
    [app.main.data.workspace.common :as dwc]
    [app.main.data.workspace.selection :as dws]
@@ -379,3 +380,44 @@
     ptk/UpdateEvent
     (update [_ state]
       (d/dissoc-in state [:workspace-text-modifier id]))))
+
+(defn commit-position-data
+  []
+  (ptk/reify ::commit-position-data
+    ptk/WatchEvent
+    (watch [_ state _]
+      (let [position-data (::update-position-data state)]
+        (rx/concat
+         (rx/of (dch/update-shapes
+                 (keys position-data)
+                 (fn [shape]
+                   (-> shape
+                       (assoc :position-data (get position-data (:id shape)))))
+                 {:save-undo? false :reg-objects? false}))
+         (rx/of (fn [state]
+                  (dissoc state ::update-position-data-debounce ::update-position-data))))))))
+
+(defn update-position-data
+  [id position-data]
+
+  (let [start (uuid/next)]
+    (ptk/reify ::update-position-data
+      ptk/UpdateEvent
+      (update [_ state]
+        (if (nil? (::update-position-data-debounce state))
+          (assoc state ::update-position-data-debounce start)
+          (assoc-in state [::update-position-data id] position-data)))
+
+      ptk/WatchEvent
+      (watch [_ state stream]
+        (if (= (::update-position-data-debounce state) start)
+          (let [stopper (->> stream (rx/filter (ptk/type? :app.main.data.workspace/finalize)))]
+            (rx/merge
+             (->> stream
+                  (rx/filter (ptk/type? ::update-position-data))
+                  (rx/debounce 50)
+                  (rx/take 1)
+                  (rx/map #(commit-position-data))
+                  (rx/take-until stopper))
+             (rx/of (update-position-data id position-data))))
+          (rx/empty))))))

frontend/src/app/main/render.cljs

@@ -402,7 +402,7 @@
             :style {:-webkit-print-color-adjust :exact}
             :fill "none"}
 
-      (let [fonts (ff/frame->fonts object-id objects)]
+      (let [fonts (ff/frame->fonts object objects)]
         [:& ff/fontfaces-style {:fonts fonts}])
 
       (case (:type object)

frontend/src/app/main/ui/dashboard/import.cljs

@@ -17,6 +17,7 @@
    [app.util.dom :as dom]
    [app.util.i18n :as i18n :refer [tr]]
    [app.util.keyboard :as kbd]
+   [app.util.webapi :as wapi]
    [beicon.core :as rx]
    [potok.core :as ptk]
    [rumext.alpha :as mf]))
@@ -35,7 +36,7 @@
                         (mapv
                          (fn [file]
                            {:name (.-name file)
-                            :uri  (dom/create-uri file)})))]
+                            :uri  (wapi/create-uri file)})))]
          (st/emit! (modal/show
                     {:type :import
                      :project-id project-id
@@ -310,7 +311,7 @@
      (fn []
        ;; dispose uris when the component is umount
        #(doseq [file files]
-          (dom/revoke-uri (:uri file)))))
+          (wapi/revoke-uri (:uri file)))))
 
     [:div.modal-overlay
      [:div.modal-container.import-dialog

frontend/src/app/main/ui/onboarding/templates.cljs

@@ -12,9 +12,9 @@
    [app.main.refs :as refs]
    [app.main.store :as st]
    [app.main.ui.icons :as i]
-   [app.util.dom :as dom]
    [app.util.http :as http]
    [app.util.i18n :as i18n :refer [tr]]
+   [app.util.webapi :as wapi]
    [beicon.core :as rx]
    [rumext.alpha :as mf]))
 
@@ -39,7 +39,7 @@
           (reset! downloading? true)
           (->> (http/send! {:method :get :uri link :response-type :blob :mode :no-cors})
                (rx/subs (fn [{:keys [body] :as response}]
-                          (open-import-modal {:name name :uri (dom/create-uri body)}))
+                          (open-import-modal {:name name :uri (wapi/create-uri body)}))
                         (fn [error]
                           (js/console.log "error" error))
                         (fn []

frontend/src/app/main/ui/viewer/handoff/attributes/image.cljs

@@ -6,10 +6,11 @@
 
 (ns app.main.ui.viewer.handoff.attributes.image
   (:require
-   [app.config :as cfg]
+   [app.common.media :as cm]
+   [app.common.pages.helpers :as cph]
+   [app.config :as cf]
    [app.main.ui.components.copy-button :refer [copy-button]]
    [app.util.code-gen :as cg]
-   [app.util.dom :as dom]
    [app.util.i18n :refer [tr]]
    [cuerdas.core :as str]
    [rumext.alpha :as mf]))
@@ -17,13 +18,13 @@
 (defn has-image? [shape]
   (= (:type shape) :image))
 
-(mf/defc image-panel [{:keys [shapes]}]
+(mf/defc image-panel
-  (let [shapes (->> shapes (filter has-image?))]
+  [{:keys [shapes]}]
-    (for [shape shapes]
+  (for [shape (filter cph/image-shape? shapes)]
     [:div.attributes-block {:key (str "image-" (:id shape))}
      [:div.attributes-image-row
       [:div.attributes-image
-         [:img {:src (cfg/resolve-file-media (-> shape :metadata))}]]]
+       [:img {:src (cf/resolve-file-media (-> shape :metadata))}]]]
 
      [:div.attributes-unit-row
       [:div.attributes-label (tr "handoff.attributes.image.width")]
@@ -37,8 +38,8 @@
 
      (let [mtype     (-> shape :metadata :mtype)
            name      (:name shape)
-             extension (dom/mtype->extension mtype)]
+           extension (cm/mtype->extension mtype)]
        [:a.download-button {:target "_blank"
                             :download (cond-> name extension (str/concat extension))
-                              :href (cfg/resolve-file-media (-> shape :metadata))}
+                            :href (cf/resolve-file-media (-> shape :metadata))}
-          (tr "handoff.attributes.image.download")])])))
+        (tr "handoff.attributes.image.download")])]))

frontend/src/app/main/ui/viewer/interactions.cljs

@@ -406,6 +406,7 @@
 (defn animate-open-overlay
   [animation overlay-viewport
    wrapper-size overlay-size overlay-position]
+  (when (some? overlay-viewport)
     (case (:animation-type animation)
 
       :dissolve
@@ -449,11 +450,12 @@
                        #js {:top (str (:y overlay-position) "px")}]
                       #js {:duration (:duration animation)
                            :easing (name (:easing animation))}
-                    #(st/emit! (dv/complete-animation))))))
+                      #(st/emit! (dv/complete-animation)))))))
 
 (defn animate-close-overlay
   [animation overlay-viewport
    wrapper-size overlay-size overlay-position overlay-id]
+  (when (some? overlay-viewport)
     (case (:animation-type animation)
 
       :dissolve
@@ -502,5 +504,5 @@
                       #js {:duration (:duration animation)
                            :easing (name (:easing animation))}
                       #(st/emit! (dv/complete-animation)
-                               (dv/close-overlay overlay-id))))))
+                                 (dv/close-overlay overlay-id)))))))
 

frontend/src/app/main/ui/workspace/header.cljs

@@ -12,6 +12,7 @@
    [app.main.data.exports :as de]
    [app.main.data.modal :as modal]
    [app.main.data.workspace :as dw]
+   [app.main.data.workspace.libraries :as dwl]
    [app.main.data.workspace.shortcuts :as sc]
    [app.main.refs :as refs]
    [app.main.repo :as rp]
@@ -111,10 +112,10 @@
         frames         (mf/deref refs/workspace-frames)
 
         add-shared-fn
-        (st/emitf (dw/set-file-shared (:id file) true))
+        (st/emitf (dwl/set-file-shared (:id file) true))
 
         del-shared-fn
-        (st/emitf (dw/set-file-shared (:id file) false))
+        (st/emitf (dwl/set-file-shared (:id file) false))
 
         on-add-shared
         (mf/use-fn

frontend/src/app/main/ui/workspace/left_toolbar.cljs

@@ -10,6 +10,7 @@
    [app.common.media :as cm]
    [app.main.data.events :as ev]
    [app.main.data.workspace :as dw]
+   [app.main.data.workspace.media :as dwm]
    [app.main.data.workspace.shortcuts :as sc]
    [app.main.refs :as refs]
    [app.main.store :as st]
@@ -44,7 +45,7 @@
                  params {:file-id (:id file)
                          :blobs (seq blobs)
                          :position (gpt/point x y)}]
-             (st/emit! (dw/upload-media-workspace params)))))]
+             (st/emit! (dwm/upload-media-workspace params)))))]
 
     [:li.tooltip.tooltip-right
      {:alt (tr "workspace.toolbar.image" (sc/get-tooltip :insert-image))

frontend/src/app/main/ui/workspace/libraries.cljs

@@ -8,7 +8,6 @@
   (:require
    [app.common.data :as d]
    [app.main.data.modal :as modal]
-   [app.main.data.workspace :as dw]
    [app.main.data.workspace.libraries :as dwl]
    [app.main.refs :as refs]
    [app.main.store :as st]
@@ -72,13 +71,13 @@
            (reset! search-term "")))
 
         link-library
-        (mf/use-callback (mf/deps file) #(st/emit! (dw/link-file-to-library (:id file) %)))
+        (mf/use-callback (mf/deps file) #(st/emit! (dwl/link-file-to-library (:id file) %)))
 
         unlink-library
         (mf/use-callback
           (mf/deps file)
           (fn [library-id]
-            (st/emit! (dw/unlink-file-from-library (:id file) library-id)
+            (st/emit! (dwl/unlink-file-from-library (:id file) library-id)
                       (dwl/sync-file (:id file) library-id))))]
     [:*
      [:div.section
@@ -164,7 +163,7 @@
      (mf/deps project)
      (fn []
        (when (:team-id project)
-         (st/emit! (dw/fetch-shared-files {:team-id (:team-id project)})))))
+         (st/emit! (dwl/fetch-shared-files {:team-id (:team-id project)})))))
 
     [:div.modal-overlay
      [:div.modal.libraries-dialog

frontend/src/app/main/ui/workspace/shapes/text/viewport_texts.cljs

@@ -12,7 +12,6 @@
    [app.common.math :as mth]
    [app.common.pages.helpers :as cph]
    [app.common.text :as txt]
-   [app.main.data.workspace.changes :as dch]
    [app.main.data.workspace.texts :as dwt]
    [app.main.fonts :as fonts]
    [app.main.refs :as refs]
@@ -54,12 +53,7 @@
 
   ;; Update the position-data of every text fragment
   (let [position-data (utp/calc-position-data node)]
-    (st/emit! (dch/update-shapes
+    (st/emit! (dwt/update-position-data id position-data))))
-               [id]
-               (fn [shape]
-                 (-> shape
-                     (assoc :position-data position-data)))
-               {:save-undo? false}))))
 
 (defn- update-text-modifier
   [{:keys [grow-type id]} node]

frontend/src/app/main/ui/workspace/sidebar/assets.cljs

@@ -18,6 +18,7 @@
    [app.main.data.workspace :as dw]
    [app.main.data.workspace.colors :as dc]
    [app.main.data.workspace.libraries :as dwl]
+   [app.main.data.workspace.media :as dwm]
    [app.main.data.workspace.state-helpers :as wsh]
    [app.main.data.workspace.texts :as dwt]
    [app.main.data.workspace.undo :as dwu]
@@ -912,7 +913,7 @@
          (fn [blobs]
            (let [params {:file-id file-id
                          :blobs (seq blobs)}]
-             (st/emit! (dw/upload-media-asset params)
+             (st/emit! (dwm/upload-media-asset params)
                        (ptk/event ::ev/event {::ev/name "add-asset-to-library"
                                               :asset-type "graphics"})))))
 

frontend/src/app/main/ui/workspace/viewport/actions.cljs

@@ -13,6 +13,7 @@
    [app.main.data.workspace :as dw]
    [app.main.data.workspace.drawing :as dd]
    [app.main.data.workspace.libraries :as dwl]
+   [app.main.data.workspace.media :as dwm]
    [app.main.data.workspace.path :as dwdp]
    [app.main.store :as st]
    [app.main.streams :as ms]
@@ -423,14 +424,9 @@
                (dnd/has-type? e "text/asset-id"))
        (dom/prevent-default e)))))
 
-(defn on-image-uploaded []
+(defn on-drop
-  (mf/use-callback
+  [file viewport-ref zoom]
-   (fn [image position]
+  (mf/use-fn
-     (st/emit! (dw/image-uploaded image position)))))
-
-(defn on-drop [file viewport-ref zoom]
-  (let [on-image-uploaded (on-image-uploaded)]
-    (mf/use-callback
    (mf/deps zoom)
    (fn [event]
      (dom/prevent-default event)
@@ -469,7 +465,7 @@
                params {:file-id (:id file)
                        :position viewport-coord
                        :uris uris}]
-             (st/emit! (dw/upload-media-workspace params)))
+           (st/emit! (dwm/upload-media-workspace params)))
 
          ;; Will trigger when the user drags an SVG asset from the assets panel
          (and (dnd/has-type? event "text/asset-id") (= asset-type "image/svg+xml"))
@@ -479,16 +475,16 @@
                        :uris [path]
                        :name asset-name
                        :mtype asset-type}]
-             (st/emit! (dw/upload-media-workspace params)))
+           (st/emit! (dwm/upload-media-workspace params)))
 
          ;; Will trigger when the user drags an image from the assets SVG
          (dnd/has-type? event "text/asset-id")
          (let [params {:file-id (:id file)
                        :object-id asset-id
                        :name asset-name}]
-             (st/emit! (dw/clone-media-object
+           (st/emit! (dwm/clone-media-object
                       (with-meta params
-                          {:on-success #(on-image-uploaded % viewport-coord)}))))
+                        {:on-success #(st/emit! (dwm/image-uploaded % viewport-coord))}))))
 
          ;; Will trigger when the user drags a file from their file explorer into the viewport
          ;; Or the user pastes an image
@@ -498,7 +494,7 @@
                params {:file-id (:id file)
                        :position viewport-coord
                        :blobs (seq files)}]
-             (st/emit! (dw/upload-media-workspace params)))))))))
+           (st/emit! (dwm/upload-media-workspace params))))))))
 
 (defn on-paste [disable-paste in-viewport?]
   (mf/use-callback

frontend/src/app/util/dom.cljs

@@ -10,8 +10,10 @@
    [app.common.data.macros :as dm]
    [app.common.geom.point :as gpt]
    [app.common.logging :as log]
+   [app.common.media :as cm]
    [app.util.globals :as globals]
    [app.util.object :as obj]
+   [app.util.webapi :as wapi]
    [cuerdas.core :as str]
    [goog.dom :as dom]
    [promesa.core :as p]))
@@ -329,28 +331,11 @@
       (log/error :msg "Seems like the current browser does not support fullscreen api.")
       false)))
 
-(defn ^boolean blob?
+(defn blob?
   [^js v]
   (when (some? v)
     (instance? js/Blob v)))
 
-(defn create-blob
-  "Create a blob from content."
-  ([content]
-   (create-blob content "application/octet-stream"))
-  ([content mimetype]
-   (js/Blob. #js [content] #js {:type mimetype})))
-
-(defn revoke-uri
-  [url]
-  (js/URL.revokeObjectURL url))
-
-(defn create-uri
-  "Create a url from blob."
-  [b]
-  {:pre [(blob? b)]}
-  (js/URL.createObjectURL b))
-
 (defn make-node
   ([namespace name]
    (.createElementNS globals/document namespace name))
@@ -442,21 +427,6 @@
   (when (some? node)
     (.getAttribute node (str "data-" attr))))
 
-(defn mtype->extension [mtype]
-  ;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types
-  (case mtype
-    "image/apng"         ".apng"
-    "image/avif"         ".avif"
-    "image/gif"          ".gif"
-    "image/jpeg"         ".jpg"
-    "image/png"          ".png"
-    "image/svg+xml"      ".svg"
-    "image/webp"         ".webp"
-    "application/zip"    ".zip"
-    "application/penpot" ".penpot"
-    "application/pdf"    ".pdf"
-    nil))
-
 (defn set-attribute! [^js node ^string attr value]
   (when (some? node)
     (.setAttribute node attr value)))
@@ -507,7 +477,7 @@
 (defn trigger-download-uri
   [filename mtype uri]
   (let [link      (create-element "a")
-        extension (mtype->extension mtype)
+        extension (cm/mtype->extension mtype)
         filename  (if (and extension (not (str/ends-with? filename extension)))
                     (str/concat filename extension)
                     filename)]
@@ -520,14 +490,14 @@
 
 (defn trigger-download
   [filename blob]
-  (trigger-download-uri filename (.-type ^js blob) (create-uri blob)))
+  (trigger-download-uri filename (.-type ^js blob) (wapi/create-uri blob)))
 
 (defn save-as
   [uri filename mtype description]
 
   ;; Only chrome supports the save dialog
   (if (obj/contains? globals/window "showSaveFilePicker")
-    (let [extension (mtype->extension mtype)
+    (let [extension (cm/mtype->extension mtype)
           opts {:suggestedName (str filename "." extension)
                 :types [{:description description
                          :accept { mtype [(str "." extension)]}}]}]

frontend/src/app/util/uri.cljs

@@ -1,34 +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) UXBOX Labs SL
-
-(ns app.util.uri
-  (:require
-   [app.util.object :as obj]
-   [cuerdas.core :as str]))
-
-(defn uri-name [url]
-  (let [query-idx (str/last-index-of url "?")
-        url (if (> query-idx 0) (subs url 0 query-idx) url)
-        filename (->> (str/split url "/") (last))
-        ext-idx (str/last-index-of filename ".")]
-    (if (> ext-idx 0) (subs filename 0 ext-idx) filename)))
-
-(defn data-uri->blob
-  [data-uri]
-
-  (let [[mtype b64-data] (str/split data-uri ";base64,")
-
-        mtype (subs mtype (inc (str/index-of mtype ":")))
-
-        decoded (.atob js/window b64-data)
-        size (.-length decoded)
-
-        content (js/Uint8Array. size)]
-
-    (doseq [i (range 0 size)]
-      (obj/set! content i (.charCodeAt decoded i)))
-
-    (js/Blob. #js [content] #js {"type" mtype})))

frontend/src/app/util/webapi.cljs

@@ -37,7 +37,7 @@
   [file]
   (file-reader #(.readAsDataURL ^js %1 file)))
 
-(defn ^boolean blob?
+(defn blob?
   [v]
   (instance? js/Blob v))
 

frontend/src/app/worker/export.cljs

@@ -7,13 +7,14 @@
 (ns app.worker.export
   (:require
    [app.common.data :as d]
+   [app.common.media :as cm]
    [app.common.text :as ct]
    [app.config :as cfg]
    [app.main.render :as r]
    [app.main.repo :as rp]
-   [app.util.dom :as dom]
    [app.util.http :as http]
    [app.util.json :as json]
+   [app.util.webapi :as wapi]
    [app.util.zip :as uz]
    [app.worker.impl :as impl]
    [beicon.core :as rx]
@@ -135,7 +136,7 @@
         (rx/map #(assoc % :file-id file-id))
         (rx/flat-map
          (fn [media]
-           (let [file-path (str/concat file-id "/media/" (:id media) (dom/mtype->extension (:mtype media)))]
+           (let [file-path (str/concat file-id "/media/" (:id media) (cm/mtype->extension (:mtype media)))]
              (->> (http/send!
                    {:uri (cfg/resolve-file-media media)
                     :response-type :blob
@@ -466,7 +467,7 @@
                        :filename (:name file)
                        :mtype "application/penpot"
                        :description "Penpot export (*.penpot)"
-                       :uri (dom/create-uri export-blob)}))))
+                       :uri (wapi/create-uri export-blob)}))))
                (rx/catch
                    (fn [err]
                      (rx/of {:type :error

frontend/src/app/worker/import.cljs

@@ -12,11 +12,11 @@
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.path :as gpa]
    [app.common.logging :as log]
+   [app.common.media :as cm]
    [app.common.pages :as cp]
    [app.common.text :as ct]
    [app.common.uuid :as uuid]
    [app.main.repo :as rp]
-   [app.util.dom :as dom]
    [app.util.http :as http]
    [app.util.import.parser :as cip]
    [app.util.json :as json]
@@ -49,7 +49,7 @@
                 :colors       (str file-id "/colors.json")
                 :typographies (str file-id "/typographies.json")
                 :media-list   (str file-id "/media.json")
-                :media        (let [ext (dom/mtype->extension (:mtype media))]
+                :media        (let [ext (cm/mtype->extension (:mtype media))]
                                 (str/concat file-id "/media/" id ext))
                 :components   (str file-id "/components.svg"))