0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-10 14:51:37 -05:00

♻️ Reorganize workspace persistence related namespace

This commit is contained in:
Andrey Antukh 2022-04-21 13:28:47 +02:00 committed by Andrés Moya
parent 3ab3ea68b4
commit c01e4e52f8
21 changed files with 503 additions and 536 deletions

View file

@ -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?)

View file

@ -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
;; Check that a file obtained with the file javascript API is valid.
(defn validate-file ;; 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))))

View file

@ -36,13 +36,13 @@
[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]
@ -1606,6 +1606,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 +1615,8 @@
(watch [_ state _]
(let [position (deref ms/mouse-position)
file-id (:current-file-id state)]
(->> (dwp/parse-svg ["svg" text])
(rx/map #(svg/svg-uploaded % file-id position)))))))
(->> (dwm/svg->clj ["svg" text])
(rx/map #(dwm/svg-uploaded % file-id position)))))))
(defn- paste-image
[image]
@ -1626,7 +1627,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 +1709,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)

View file

@ -482,22 +482,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))))))

View file

@ -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
@ -290,7 +292,7 @@
(-> component
(assoc :path path)
(assoc :name name)
(update :objects
(update :objects
;; Give the same name to the root shape
#(assoc-in % [id :name] name)))))
@ -673,3 +675,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))))))

View file

@ -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)))))))))

View file

@ -6,37 +6,28 @@
(ns app.main.data.workspace.persistence
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.pages :as cp]
[app.common.pages.helpers :as cph]
[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 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.refs :as refs]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.http :as http]
[app.util.i18n :as i18n :refer [tr]]
[app.util.time :as dt]
[app.util.uri :as uu]
[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]))
[clojure.set :as set]
[potok.core :as ptk]))
(declare persist-changes)
(declare persist-synchronous-changes)
@ -274,271 +265,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 +275,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"
[]

View file

@ -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

View file

@ -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

View file

@ -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 []

View file

@ -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,28 +18,28 @@
(defn has-image? [shape]
(= (:type shape) :image))
(mf/defc image-panel [{:keys [shapes]}]
(let [shapes (->> shapes (filter has-image?))]
(for [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))}]]]
(mf/defc image-panel
[{:keys [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 (cf/resolve-file-media (-> shape :metadata))}]]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.width")]
[:div.attributes-value (-> shape :metadata :width) "px"]
[:& copy-button {:data (cg/generate-css-props shape :width)}]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.width")]
[:div.attributes-value (-> shape :metadata :width) "px"]
[:& copy-button {:data (cg/generate-css-props shape :width)}]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.height")]
[:div.attributes-value (-> shape :metadata :height) "px"]
[:& copy-button {:data (cg/generate-css-props shape :height)}]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.height")]
[:div.attributes-value (-> shape :metadata :height) "px"]
[:& copy-button {:data (cg/generate-css-props shape :height)}]]
(let [mtype (-> shape :metadata :mtype)
name (:name shape)
extension (dom/mtype->extension mtype)]
[:a.download-button {:target "_blank"
:download (cond-> name extension (str/concat extension))
:href (cfg/resolve-file-media (-> shape :metadata))}
(tr "handoff.attributes.image.download")])])))
(let [mtype (-> shape :metadata :mtype)
name (:name shape)
extension (cm/mtype->extension mtype)]
[:a.download-button {:target "_blank"
:download (cond-> name extension (str/concat extension))
:href (cf/resolve-file-media (-> shape :metadata))}
(tr "handoff.attributes.image.download")])]))

View file

@ -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

View file

@ -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))

View file

@ -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

View file

@ -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]
@ -629,7 +630,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"})))))

View file

@ -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,82 +424,77 @@
(dnd/has-type? e "text/asset-id"))
(dom/prevent-default e)))))
(defn on-image-uploaded []
(mf/use-callback
(fn [image position]
(st/emit! (dw/image-uploaded image position)))))
(defn on-drop
[file viewport-ref zoom]
(mf/use-fn
(mf/deps zoom)
(fn [event]
(dom/prevent-default event)
(let [point (gpt/point (.-clientX event) (.-clientY event))
viewport (mf/ref-val viewport-ref)
viewport-coord (utils/translate-point-to-viewport viewport zoom point)
asset-id (-> (dnd/get-data event "text/asset-id") uuid/uuid)
asset-name (dnd/get-data event "text/asset-name")
asset-type (dnd/get-data event "text/asset-type")]
(cond
(dnd/has-type? event "penpot/shape")
(let [shape (dnd/get-data event "penpot/shape")
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dw/add-shape (-> shape
(assoc :id (uuid/next))
(assoc :x final-x)
(assoc :y final-y)))))
(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)
(let [point (gpt/point (.-clientX event) (.-clientY event))
viewport (mf/ref-val viewport-ref)
viewport-coord (utils/translate-point-to-viewport viewport zoom point)
asset-id (-> (dnd/get-data event "text/asset-id") uuid/uuid)
asset-name (dnd/get-data event "text/asset-name")
asset-type (dnd/get-data event "text/asset-type")]
(cond
(dnd/has-type? event "penpot/shape")
(let [shape (dnd/get-data event "penpot/shape")
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dw/add-shape (-> shape
(assoc :id (uuid/next))
(assoc :x final-x)
(assoc :y final-y)))))
(dnd/has-type? event "penpot/component")
(let [{:keys [component file-id]} (dnd/get-data event "penpot/component")
shape (get-in component [:objects (:id component)])
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dwl/instantiate-component file-id
(:id component)
(gpt/point final-x final-y))))
(dnd/has-type? event "penpot/component")
(let [{:keys [component file-id]} (dnd/get-data event "penpot/component")
shape (get-in component [:objects (:id component)])
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dwl/instantiate-component file-id
(:id component)
(gpt/point final-x final-y))))
;; Will trigger when the user drags an image from a browser to the viewport
(dnd/has-type? event "text/uri-list")
(let [data (dnd/get-data event "text/uri-list")
lines (str/lines data)
uris (filter #(and (not (str/blank? %))
(not (str/starts-with? % "#")))
lines)
params {:file-id (:id file)
:position viewport-coord
:uris uris}]
(st/emit! (dwm/upload-media-workspace params)))
;; Will trigger when the user drags an image from a browser to the viewport
(dnd/has-type? event "text/uri-list")
(let [data (dnd/get-data event "text/uri-list")
lines (str/lines data)
uris (filter #(and (not (str/blank? %))
(not (str/starts-with? % "#")))
lines)
params {:file-id (:id file)
:position viewport-coord
:uris uris}]
(st/emit! (dw/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"))
(let [path (cfg/resolve-file-media {:id asset-id})
params {:file-id (:id file)
:position viewport-coord
:uris [path]
:name asset-name
:mtype asset-type}]
(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"))
(let [path (cfg/resolve-file-media {:id asset-id})
params {:file-id (:id file)
:position viewport-coord
:uris [path]
:name asset-name
:mtype asset-type}]
(st/emit! (dw/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! (dwm/clone-media-object
(with-meta params
{:on-success #(st/emit! (dwm/image-uploaded % viewport-coord))}))))
;; 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
(with-meta params
{:on-success #(on-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
;; Or the user uploads an image using the image tool
:else
(let [files (dnd/get-files event)
params {:file-id (:id file)
:position viewport-coord
:blobs (seq files)}]
(st/emit! (dw/upload-media-workspace params)))))))))
;; Will trigger when the user drags a file from their file explorer into the viewport
;; Or the user pastes an image
;; Or the user uploads an image using the image tool
:else
(let [files (dnd/get-files event)
params {:file-id (:id file)
:position viewport-coord
:blobs (seq files)}]
(st/emit! (dwm/upload-media-workspace params))))))))
(defn on-paste [disable-paste in-viewport?]
(mf/use-callback

View file

@ -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]))
@ -319,28 +321,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))
@ -432,21 +417,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)))
@ -497,7 +467,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)]
@ -510,14 +480,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)]}}]}]

View file

@ -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})))

View file

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

View file

@ -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

View file

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