3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-04 15:45:53 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Refactor exportation process, make it considerably faster

Browse source
This commit is contained in:
Andrey Antukh 2022-03-29 12:34:11 +02:00 • committed by Andrés Moya
parent d6abd2202c
commit 9140fc71b9
33 changed files with 1096 additions and 1090 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

180
backend/src/app/rpc/queries/files.clj
View file

@ -205,107 +205,27 @@
(-> (retrieve-file cfg id)
(assoc :permissions perms))))
(declare trim-file-data)
(s/def ::page-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::trimmed-file
(s/keys :req-un [::profile-id ::id ::object-id ::page-id]))
(sv/defmethod ::trimmed-file
"Retrieve a file by its ID and trims all unnecesary content from
it. It is mainly used for rendering a concrete object, so we don't
need force download all shapes when only a small subset is
necesseary."
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(let [perms (get-permissions pool profile-id id)]
(check-read-permissions! perms)
(-> (retrieve-file cfg id)
(trim-file-data params)
(assoc :permissions perms))))
(defn- trim-file-data
[file {:keys [page-id object-id]}]
(let [page (get-in file [:data :pages-index page-id])
objects (->> (cph/get-children-with-self (:objects page) object-id)
(map #(dissoc % :thumbnail))
(d/index-by :id))
page (assoc page :objects objects)]
(-> file
(update :data assoc :pages-index {page-id page})
(update :data assoc :pages [page-id]))))
;; --- FILE THUMBNAIL
(declare strip-frames-with-thumbnails)
(declare extract-file-thumbnail)
(declare get-first-page-data)
(declare get-thumbnail-data)
(defn- trim-objects
"Given the page data and the object-id returns the page data with all
other not needed objects removed from the `:objects` data
structure."
[{:keys [objects] :as page} object-id]
(let [objects (cph/get-children-with-self objects object-id)]
(assoc page :objects (d/index-by :id objects))))
(s/def ::strip-frames-with-thumbnails ::us/boolean)
(defn- prune-thumbnails
"Given the page data, removes the `:thumbnail` prop from all
shapes."
[page]
(update page :objects (fn [objects]
(d/mapm #(dissoc %2 :thumbnail) objects))))
(s/def ::page
(s/keys :req-un [::profile-id ::file-id]
:opt-un [::strip-frames-with-thumbnails]))
(sv/defmethod ::page
"Retrieves the first page of the file. Used mainly for render
thumbnails on dashboard.
DEPRECATED: still here for backward compatibility."
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as props}]
(check-read-permissions! pool profile-id file-id)
(let [file (retrieve-file cfg file-id)
data (get-first-page-data file props)]
data))
(s/def ::file-data-for-thumbnail
(s/keys :req-un [::profile-id ::file-id]
:opt-un [::strip-frames-with-thumbnails]))
(sv/defmethod ::file-data-for-thumbnail
"Retrieves the data for generate the thumbnail of the file. Used mainly for render
thumbnails on dashboard."
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as props}]
(check-read-permissions! pool profile-id file-id)
(let [file (retrieve-file cfg file-id)]
{:data (get-thumbnail-data file props)
:file-id file-id
:revn (:revn file)}))
(defn get-thumbnail-data
[{:keys [data] :as file} props]
(if-let [[page frame] (first
(for [page (-> data :pages-index vals)
frame (-> page :objects cph/get-frames)
:when (:file-thumbnail frame)]
[page frame]))]
(let [objects (->> (cph/get-children-with-self (:objects page) (:id frame))
(d/index-by :id))]
(cond-> (assoc page :objects objects)
(:strip-frames-with-thumbnails props)
(strip-frames-with-thumbnails)
:always
(assoc :thumbnail-frame frame)))
(let [page-id (-> data :pages first)]
(cond-> (get-in data [:pages-index page-id])
(:strip-frames-with-thumbnails props)
(strip-frames-with-thumbnails)))))
(defn get-first-page-data
[file props]
(let [page-id (get-in file [:data :pages 0])
data (cond-> (get-in file [:data :pages-index page-id])
(true? (:strip-frames-with-thumbnails props))
(strip-frames-with-thumbnails))]
data))
(defn strip-frames-with-thumbnails
"Remove unnecesary shapes from frames that have thumbnail."
[data]
(defn- prune-frames-with-thumbnails
"Remove unnecesary shapes from frames that have thumbnail from page
data."
[page]
(let [filter-shape?
(fn [objects [id shape]]
(let [frame-id (:frame-id shape)]
@ -328,7 +248,71 @@
(filter (partial filter-shape? objects)))
objects))]
(update data :objects update-objects)))
(update page :objects update-objects)))
(defn- get-thumbnail-data
[{:keys [data] :as file}]
(if-let [[page frame] (first
(for [page (-> data :pages-index vals)
frame (-> page :objects cph/get-frames)
:when (:file-thumbnail frame)]
[page frame]))]
(let [objects (->> (cph/get-children-with-self (:objects page) (:id frame))
(d/index-by :id))]
(-> (assoc page :objects objects)
(assoc :thumbnail-frame frame)))
(let [page-id (-> data :pages first)]
(-> (get-in data [:pages-index page-id])
(prune-frames-with-thumbnails)))))
(s/def ::page-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::prune-frames-with-thumbnails ::us/boolean)
(s/def ::prune-thumbnails ::us/boolean)
(s/def ::page
(s/keys :req-un [::profile-id ::file-id]
:opt-un [::page-id
::object-id
::prune-frames-with-thumbnails
::prune-thumbnails]))
(sv/defmethod ::page
"Retrieves the page data from file and returns it. If no page-id is
specified, the first page will be returned. If object-id is
specified, only that object and its children will be returned in the
page objects data structure.
Mainly used for rendering purposes."
[{:keys [pool] :as cfg} {:keys [profile-id file-id page-id object-id] :as props}]
(check-read-permissions! pool profile-id file-id)
(let [file (retrieve-file cfg file-id)
page-id (or page-id (-> file :data :pages first))
page (get-in file [:data :pages-index page-id])]
(cond-> page
(:prune-frames-with-thumbnails props)
(prune-frames-with-thumbnails)
(:prune-thumbnails props)
(prune-thumbnails)
(uuid? object-id)
(trim-objects object-id))))
(s/def ::file-data-for-thumbnail
(s/keys :req-un [::profile-id ::file-id]))
(sv/defmethod ::file-data-for-thumbnail
"Retrieves the data for generate the thumbnail of the file. Used mainly for render
thumbnails on dashboard. Returns the page data."
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as props}]
(check-read-permissions! pool profile-id file-id)
(let [file (retrieve-file cfg file-id)]
{:page (get-thumbnail-data file)
:file-id file-id
:revn (:revn file)}))
;; --- Query: Shared Library Files

2
common/deps.edn
View file

@ -22,7 +22,7 @@
java-http-clj/java-http-clj {:mvn/version "0.4.3"}
funcool/promesa {:mvn/version "8.0.450"}
funcool/cuerdas {:mvn/version "2022.01.14-391"}
funcool/cuerdas {:mvn/version "2022.03.27-397"}
lambdaisland/uri {:mvn/version "1.13.95"
:exclusions [org.clojure/data.json]}

89
common/src/app/common/data/macros.cljc
View file

@ -13,6 +13,7 @@
#?(:clj [clojure.core :as c]
:cljs [cljs.core :as c])
[app.common.data :as d]
[cuerdas.core :as str]
[cljs.analyzer.api :as aapi]))
(defmacro select-keys
@ -36,61 +37,9 @@
`(let [v# (-> ~target ~@(map (fn [key] (list `c/get key)) keys))]
(if (some? v#) v# ~default))))
;; => benchmarking: clojure.core/str
;; --> WARM: 100000
;; --> BENCH: 500000
;; --> TOTAL: 197.82ms
;; --> MEAN: 395.64ns
;; => benchmarking: app.commons.data.macros/str
;; --> WARM: 100000
;; --> BENCH: 500000
;; --> TOTAL: 20.31ms
;; --> MEAN: 40.63ns
(defmacro str
"CLJS only macro variant of `str` function that performs string concat much faster."
([a]
(if (:ns &env)
(list 'js* "\"\"+~{}" a)
(list `c/str a)))
([a b]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}" a b)
(list `c/str a b)))
([a b c]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}" a b c)
(list `c/str a b c)))
([a b c d]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}+~{}" a b c d)
(list `c/str a b c d)))
([a b c d e]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}+~{}+~{}" a b c d e)
(list `c/str a b c d e)))
([a b c d e f]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}+~{}+~{}+~{}" a b c d e f)
(list `c/str a b c d e f)))
([a b c d e f g]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}+~{}+~{}+~{}+~{}" a b c d e f g)
(list `c/str a b c d e f g)))
([a b c d e f g h]
(if (:ns &env)
(list 'js* "\"\"+~{}+~{}+~{}+~{}+~{}+~{}+~{}+~{}" a b c d e f g h)
(list `c/str a b c d e f g h)))
([a b c d e f g h & rest]
(let [all (into [a b c d e f g h] rest)]
(if (:ns &env)
(let [xf (map (fn [items] `(str ~@items)))
pall (partition-all 8 all)]
(if (<= (count all) 64)
`(str ~@(sequence xf pall))
`(c/str ~@(sequence xf pall))))
`(c/str ~@all)))))
[& params]
`(str/concat ~@params))
(defmacro export
"A helper macro that allows reexport a var in a current namespace."
@ -129,36 +78,6 @@
;; (.setMacro (var ~n)))
~vr))))
(defn- interpolate
[s params]
(loop [items (->> (re-seq #"([^\%]+)*(\%(\d+)?)?" s)
(remove (fn [[full seg]] (and (nil? seg) (not full)))))
result []
index 0]
(if-let [[_ segment var? sidx] (first items)]
(cond
(and var? sidx)
(let [cidx (dec (d/read-string sidx))]
(recur (rest items)
(-> result
(conj segment)
(conj (nth params cidx)))
(inc index)))
var?
(recur (rest items)
(-> result
(conj segment)
(conj (nth params index)))
(inc index))
:else
(recur (rest items)
(conj result segment)
(inc index)))
(remove nil? result))))
(defmacro fmt
"String interpolation helper. Can only be used with strings known at
compile time. Can be used with indexed params access or sequential.
@ -169,7 +88,7 @@
(dm/fmt \"url(%1)\" my-url) ; indexed
"
[s & params]
(cons 'app.common.data.macros/str (interpolate s (vec params))))
`(str/ffmt ~s ~@params))

1
common/src/app/common/logging.cljc
View file

@ -9,7 +9,6 @@
[app.common.exceptions :as ex]
[app.common.uuid :as uuid]
[app.common.spec :as us]
[clojure.pprint :refer [pprint]]
[cuerdas.core :as str]
[clojure.spec.alpha :as s]
[fipp.edn :as fpp]

27
common/src/app/common/pprint.cljc Normal file
View file

@ -0,0 +1,27 @@
;; 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.common.pprint
(:refer-clojure :exclude [prn])
(:require
[cuerdas.core :as str]
[fipp.edn :as fpp]))
(defn pprint-str
[expr]
(binding [*print-level* 8
*print-length* 25]
(with-out-str
(fpp/pprint expr {:width 110}))))
(defn pprint
([expr]
(println (pprint-str expr)))
([label expr]
(println (str/concat "============ " label "============"))
(pprint expr)))

7
exporter/src/app/browser.cljs
View file

@ -56,11 +56,12 @@
(defn screenshot
([frame] (screenshot frame {}))
([frame {:keys [full-page? omit-background? type quality]
([frame {:keys [full-page? omit-background? type quality path]
:or {type "png" full-page? false omit-background? false quality 95}}]
(let [options (-> (obj/new)
(obj/set! "type" (name type))
(obj/set! "omitBackground" omit-background?)
(cond-> path (obj/set! "path" path))
(cond-> (= "jpeg" type) (obj/set! "quality" quality))
(cond-> full-page? (-> (obj/set! "fullPage" true)
(obj/set! "clip" nil))))]
@ -73,10 +74,10 @@
(defn pdf
([page] (pdf page {}))
([page {:keys [scale save-path page-ranges]
([page {:keys [scale path page-ranges]
:or {page-ranges "1"
scale 1}}]
(.pdf ^js page #js {:path save-path
(.pdf ^js page #js {:path path
:scale scale
:pageRanges page-ranges
:printBackground true

14
exporter/src/app/handlers.cljs
View file

@ -6,7 +6,7 @@
(ns app.handlers
(:require
[app.common.data.macros :as dm]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.spec :as us]
@ -32,6 +32,7 @@
(let [explain (us/pretty-explain data)
data (-> data
(assoc :explain explain)
(assoc :type :validation)
(dissoc ::s/problems ::s/value ::s/spec))]
(-> exchange
(assoc :response/status 400)
@ -46,19 +47,24 @@
(and (= :internal type)
(= :browser-not-ready code))
(let [data {:type :server-error
:code :internal
:hint (ex-message error)
:data data}]
(-> exchange
(assoc :response/status 503)
(assoc :response/body (t/encode data))
(assoc :response/headers {"content-type" "application/transit+json"}))
(assoc :response/headers {"content-type" "application/transit+json"})))
:else
(let [data {:type :server-error
:code type
:hint (ex-message error)
:data data}]
(l/error :hint "unexpected internal error" :cause error)
(-> exchange
(assoc :response/status 500)
(assoc :response/body (t/encode data))
(assoc :response/body (t/encode (d/without-nils data)))
(assoc :response/headers {"content-type" "application/transit+json"}))))))
(defmulti command-spec :cmd)
@ -98,4 +104,4 @@
:export-frames (export-frames/handler exchange params)
(ex/raise :type :internal
:code :method-not-implemented
:hint (dm/fmt "method % not implemented" cmd)))))
:hint (str/istr "method ~{cmd} not implemented")))))

135
exporter/src/app/handlers/export_frames.cljs
View file

@ -7,12 +7,14 @@
(ns app.handlers.export-frames
(:require
["path" :as path]
[app.common.data.macros :as dm]
[app.common.exceptions :as exc :include-macros true]
[app.common.logging :as l]
[app.common.exceptions :as exc]
[app.common.spec :as us]
[app.common.pprint :as pp]
[app.handlers.resources :as rsc]
[app.handlers.export-shapes :refer [prepare-exports]]
[app.redis :as redis]
[app.renderer.pdf :as rp]
[app.renderer :as rd]
[app.util.shell :as sh]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
@ -20,19 +22,17 @@
(declare ^:private handle-export)
(declare ^:private create-pdf)
(declare ^:private export-frame)
(declare ^:private join-pdf)
(declare ^:private move-file)
(declare ^:private clean-tmp)
(s/def ::name ::us/string)
(s/def ::file-id ::us/uuid)
(s/def ::page-id ::us/uuid)
(s/def ::frame-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::uri ::us/uri)
(s/def ::export
(s/keys :req-un [::file-id ::page-id ::frame-id ::name]))
(s/keys :req-un [::file-id ::page-id ::object-id ::name]))
(s/def ::exports
(s/every ::export :kind vector? :min-count 1))
@ -42,42 +42,53 @@
:opt-un [::uri ::name]))
(defn handler
[{:keys [:request/auth-token] :as exchange} {:keys [exports uri] :as params}]
(let [xform (map #(assoc % :token auth-token :uri uri))
exports (sequence xform exports)]
[{:keys [:request/auth-token] :as exchange} {:keys [exports uri profile-id] :as params}]
;; NOTE: we need to have the `:type` prop because the exports
;; datastructure preparation uses it for creating the groups.
(let [exports (-> (map #(assoc % :type :pdf :scale 1 :suffix "") exports)
(prepare-exports auth-token uri))]
(handle-export exchange (assoc params :exports exports))))
(defn handle-export
[exchange {:keys [exports wait uri name] :as params}]
(let [topic (-> exports first :file-id str)
[exchange {:keys [exports wait uri name profile-id] :as params}]
(let [total (count exports)
topic (str profile-id)
resource (rsc/create :pdf (or name (-> exports first :name)))
on-progress (fn [progress]
on-progress (fn [{:keys [done]}]
(when-not wait
(let [data {:type :export-update
:resource-id (:id resource)
:name (:name resource)
:filename (:filename resource)
:status "running"
:progress progress}]
(redis/pub! topic data)))
:total total
:done done}]
(redis/pub! topic data))))
on-complete (fn [resource]
on-complete (fn []
(when-not wait
(let [data {:type :export-update
:resource-id (:id resource)
:name (:name resource)
:size (:size resource)
:filename (:filename resource)
:status "ended"}]
(redis/pub! topic data)))
(redis/pub! topic data))))
on-error (fn [cause]
(l/error :hint "unexpected error on frames exportation" :cause cause)
(if wait
(p/rejected cause)
(let [data {:type :export-update
:resource-id (:id resource)
:name (:name resource)
:filename (:filename resource)
:status "error"
:cause (ex-message cause)}]
(redis/pub! topic data)))
(redis/pub! topic data))))
proc (create-pdf :resource resource
:items exports
:exports exports
:on-progress on-progress
:on-complete on-complete
:on-error on-error)]
@ -86,70 +97,46 @@
(assoc exchange :response/body (dissoc resource :path)))))
(defn create-pdf
[& {:keys [resource items on-progress on-complete on-error]
:or {on-progress identity
on-complete identity
on-error identity}}]
(p/let [progress (atom 0)
tmpdir (sh/create-tmpdir! "pdfexport")
file-id (-> items first :file-id)
items (into [] (map #(partial export-frame tmpdir %)) items)
xform (map (fn [export-fn]
#(p/finally
(export-fn)
(fn [result _]
(on-progress {:total (count items)
:done (swap! progress inc)
:name (:name result)})))))]
(-> (reduce (fn [res export-fn]
(p/let [res res
out (export-fn)]
(cons (:path out) res)))
(p/resolved nil)
(into '() xform items))
(p/then (partial join-pdf tmpdir file-id))
[& {:keys [resource exports on-progress on-complete on-error]
:or {on-progress (constantly nil)
on-complete (constantly nil)
on-error p/rejected}}]
(let [file-id (-> exports first :file-id)
result (atom [])
on-object
(fn [{:keys [path] :as object}]
(let [res (swap! result conj path)]
(on-progress {:done (count res)})))]
(-> (p/loop [exports (seq exports)]
(when-let [export (first exports)]
(p/let [proc (rd/render export on-object)]
(p/recur (rest exports)))))
(p/then (fn [_] (deref result)))
(p/then (partial join-pdf file-id))
(p/then (partial move-file resource))
(p/then (partial clean-tmp tmpdir))
(p/then (constantly resource))
(p/then (fn [resource]
(-> (sh/stat (:path resource))
(p/then #(merge resource %)))))
(p/catch on-error)
(p/finally (fn [result cause]
(if cause
(on-error cause)
(on-complete result)))))))
(defn- export-frame
[tmpdir {:keys [file-id page-id frame-id token uri] :as params}]
(let [file-name (dm/fmt "%.pdf" frame-id)
save-path (path/join tmpdir file-name)]
(-> (rp/render {:name (dm/str frame-id)
:uri uri
:suffix ""
:token token
:file-id file-id
:page-id page-id
:object-id frame-id
:scale 1
:save-path save-path})
(p/then (fn [_]
{:name file-name
:path save-path})))))
(when-not cause
(on-complete)))))))
(defn- join-pdf
[tmpdir file-id paths]
(let [output-path (path/join tmpdir (str file-id ".pdf"))
paths-str (str/join " " paths)]
(-> (sh/run-cmd! (str "pdfunite " paths-str " " output-path))
(p/then (constantly output-path)))))
[file-id paths]
(p/let [tmpdir (sh/mktmpdir! "join-pdf")
path (path/join tmpdir (str/concat file-id ".pdf"))]
(sh/run-cmd! (str "pdfunite " (str/join " " paths) " " path))
path))
(defn- move-file
[{:keys [path] :as resource} output-path]
(p/do
(sh/move! output-path path)
(sh/rmdir! (path/dirname output-path))
resource))
(defn- clean-tmp
[tdpath data]
(p/do!
(sh/rmdir! tdpath)
data))

192
exporter/src/app/handlers/export_shapes.cljs
View file

@ -6,34 +6,35 @@
(ns app.handlers.export-shapes
(:require
[app.common.exceptions :as exc :include-macros true]
["path" :as path]
[app.common.data :as d]
[app.common.exceptions :as exc]
[app.common.logging :as l]
[app.common.spec :as us]
[app.redis :as redis]
[app.handlers.resources :as rsc]
[app.renderer.bitmap :as rb]
[app.renderer.pdf :as rp]
[app.renderer.svg :as rs]
[app.redis :as redis]
[app.renderer :as rd]
[app.util.mime :as mime]
[app.util.shell :as sh]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[promesa.core :as p]))
(declare ^:private handle-exports)
(declare ^:private handle-single-export)
(declare ^:private handle-multiple-export)
(declare ^:private run-export)
(declare ^:private assign-file-name)
(declare ^:private assoc-file-name)
(declare prepare-exports)
(s/def ::name ::us/string)
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::filename ::us/string)
(s/def ::name ::us/string)
(s/def ::object-id ::us/uuid)
(s/def ::page-id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::suffix ::us/string)
(s/def ::type ::us/keyword)
(s/def ::suffix string?)
(s/def ::scale number?)
(s/def ::uri ::us/uri)
(s/def ::profile-id ::us/uuid)
(s/def ::wait ::us/boolean)
(s/def ::export
@ -47,13 +48,13 @@
:opt-un [::uri ::wait ::name]))
(defn handler
[{:keys [:request/auth-token] :as exchange} {:keys [exports] :as params}]
(let [xform (comp
(map #(assoc % :token auth-token))
(assign-file-name))
exports (into [] xform exports)]
(if (= 1 (count exports))
(handle-single-export exchange (assoc params :export (first exports)))
[{:keys [:request/auth-token] :as exchange} {:keys [exports uri] :as params}]
(let [exports (prepare-exports exports auth-token uri)]
(if (and (= 1 (count exports))
(= 1 (count (-> exports first :objects))))
(handle-single-export exchange (-> params
(assoc :export (first exports))
(dissoc :exports)))
(handle-multiple-export exchange (assoc params :exports exports)))))
(defn- handle-single-export
@ -61,87 +62,102 @@
(let [topic (str profile-id)
resource (rsc/create (:type export) (or name (:name export)))
on-progress (fn [progress]
(let [data {:type :export-update
on-progress (fn [{:keys [path] :as object}]
(p/do
;; Move the generated path to the resource
;; path destination.
(sh/move! path (:path resource))
(when-not wait
(redis/pub! topic {:type :export-update
:resource-id (:id resource)
:status "running"
:progress progress}]
(redis/pub! topic data)))
on-complete (fn [resource]
(let [data {:type :export-update
:total 1
:done 1})
(redis/pub! topic {:type :export-update
:resource-id (:id resource)
:size (:size resource)
:filename (:filename resource)
:name (:name resource)
:status "ended"}]
(redis/pub! topic data)))
:status "ended"}))))
on-error (fn [cause]
(let [data {:type :export-update
(l/error :hint "unexpected error happened on export multiple process"
:cause cause)
(if wait
(p/rejected cause)
(redis/pub! topic {:type :export-update
:resource-id (:id resource)
:name (:name resource)
:status "error"
:cause (ex-message cause)}]
(redis/pub! topic data)))
:cause (ex-message cause)})))
proc (-> (rd/render export on-progress)
(p/then (constantly resource))
(p/catch on-error))]
proc (rsc/create-simple :task #(run-export export)
:resource resource
:on-progress on-progress
:on-error on-error
:on-complete on-complete)]
(if wait
(p/then proc #(assoc exchange :response/body (dissoc % :path)))
(assoc exchange :response/body (dissoc resource :path)))))
(defn- handle-multiple-export
[exchange {:keys [exports wait uri profile-id name] :as params}]
(let [tasks (map #(fn [] (run-export %)) exports)
(let [resource (rsc/create :zip (or name (-> exports first :name)))
total (count exports)
topic (str profile-id)
resource (rsc/create :zip (or name (-> exports first :name)))
on-progress (fn [progress]
to-delete (atom #{})
on-progress (fn [{:keys [done]}]
(when-not wait
(let [data {:type :export-update
:resource-id (:id resource)
:name (:name resource)
:status "running"
:progress progress}]
(redis/pub! topic data)))
:total total
:done done}]
(redis/pub! topic data))))
on-complete (fn [resource]
on-complete (fn []
(when-not wait
(let [data {:type :export-update
:resource-id (:id resource)
:name (:name resource)
:size (:size resource)
:filename (:filename resource)
:resource-id (:id resource)
:status "ended"}]
(redis/pub! topic data)))
(redis/pub! topic data))))
on-error (fn [cause]
(let [data {:type :export-update
(l/error :hint "unexpected error on multiple exportation" :cause cause)
(if wait
(p/rejected cause)
(redis/pub! topic {:type :export-update
:resource-id (:id resource)
:name (:name resource)
:status "error"
:cause (ex-message cause)}]
(redis/pub! topic data)))
:cause (ex-message cause)})))
proc (rsc/create-zip :resource resource
:tasks tasks
:on-progress on-progress
zip (rsc/create-zip :resource resource
:on-complete on-complete
:on-error on-error)]
:on-error on-error
:on-progress on-progress)
append (fn [{:keys [filename path] :as object}]
(swap! to-delete conj path)
(rsc/add-to-zip! zip path filename))
proc (-> (p/do
(p/loop [exports (seq exports)]
(when-let [export (first exports)]
(p/let [proc (rd/render export append)]
(p/recur (rest exports)))))
(.finalize zip))
(p/then (fn [_] (p/run! #(sh/rmdir! (path/dirname %)) @to-delete)))
(p/then (constantly resource))
(p/catch on-error))
]
(if wait
(p/then proc #(assoc exchange :response/body (dissoc % :path)))
(assoc exchange :response/body (dissoc resource :path)))))
(defn- run-export
[{:keys [type] :as params}]
(p/let [res (case type
:png (rb/render params)
:jpeg (rb/render params)
:svg (rs/render params)
:pdf (rp/render params))]
(assoc res :type type)))
(defn- assign-file-name
(defn- assoc-file-name
"A transducer that assocs a candidate filename and avoid duplicates."
[]
(letfn [(find-candidate [params used]
@ -149,12 +165,8 @@
(let [candidate (str (:name params)
(:suffix params "")
(when (pos? index)
(str "-" (inc index)))
(case (:type params)
:png ".png"
:jpeg ".jpg"
:svg ".svg"
:pdf ".pdf"))]
(str/concat "-" (inc index)))
(mime/get-extension (:type params)))]
(if (contains? used candidate)
(recur (inc index))
candidate))))]
@ -168,3 +180,37 @@
params (assoc params :filename candidate)]
(vswap! used conj candidate)
(rf result params))))))))
(def ^:const ^:private
default-partition-size 50)
(defn prepare-exports
[exports token uri]
(letfn [(process-group [group]
(sequence (comp (partition-all default-partition-size)
(map process-partition))
group))
(process-partition [[part1 :as part]]
{:file-id (:file-id part1)
:page-id (:page-id part1)
:name (:name part1)
:token token
:uri uri
:type (:type part1)
:scale (:scale part1)
:objects (mapv part-entry->object part)})
(part-entry->object [entry]
{:id (:object-id entry)
:filename (:filename entry)
:name (:name entry)
:suffix (:suffix entry)})]
(let [xform (comp
(map #(assoc % :token token))
(assoc-file-name))]
(->> (sequence xform exports)
(d/group-by (juxt :scale :type))
(map second)
(into [] (mapcat process-group))))))

105
exporter/src/app/handlers/resources.cljs
View file

@ -12,104 +12,33 @@
["os" :as os]
["path" :as path]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.uuid :as uuid]
[app.util.shell :as sh]
[app.util.mime :as mime]
[cljs.core :as c]
[cuerdas.core :as str]
[promesa.core :as p]))
(defn- get-path
[type id]
(path/join (os/tmpdir) (dm/str "exporter." (d/name type) "." id)))
(defn- get-mtype
[type]
(case (d/name type)
"zip" "application/zip"
"pdf" "application/pdf"
"svg" "image/svg+xml"
"jpeg" "image/jpeg"
"png" "image/png"))
(path/join (os/tmpdir) (str/concat "exporter-resource." (c/name type) "." id)))
(defn create
"Generates ephimeral resource object."
[type name]
(let [task-id (uuid/next)]
{:path (get-path type task-id)
:mtype (get-mtype type)
:mtype (mime/get type)
:name name
:id (dm/str (c/name type) "." task-id)}))
(defn- write-as-zip!
[{:keys [id path]} items on-progress]
(let [^js zip (arc/create "zip")
^js out (fs/createWriteStream path)
append! (fn [{:keys [data name] :as result}]
(.append zip data #js {:name name}))
progress (atom 0)]
(p/create
(fn [resolve reject]
(.on zip "error" #(reject %))
(.on zip "end" resolve)
(.on zip "entry" (fn [data]
(let [name (unchecked-get data "name")
num (swap! progress inc)]
;; Sample code used for testing failing exports
#_(when (= 2 num)
(.abort ^js zip)
(reject (js/Error. "unable to create zip file")))
(on-progress
{:total (count items)
:done num}))))
(.pipe zip out)
(-> (reduce (fn [res export-fn]
(p/then res (fn [_] (-> (export-fn) (p/then append!)))))
(p/resolved 1)
items)
(p/then #(.finalize zip))
(p/catch reject))))))
(defn create-simple
[& {:keys [task resource on-progress on-complete on-error]
:or {on-progress identity
on-complete identity
on-error identity}
:as params}]
(let [path (:path resource)]
(-> (task)
(p/then (fn [{:keys [data name]}]
(on-progress {:total 1 :done 1 :name name})
(.writeFile fs/promises path data)))
(p/then #(sh/stat path))
(p/then #(merge resource %))
(p/finally (fn [result cause]
(if cause
(on-error cause)
(on-complete result)))))))
(defn create-zip
"Creates a resource with multiple files merget into a single zip file."
[& {:keys [resource tasks on-error on-progress on-complete]
:or {on-error identity
on-progress identity
on-complete identity}}]
(let [{:keys [path id] :as resource} resource]
(-> (write-as-zip! resource tasks on-progress)
(p/then #(sh/stat path))
(p/then #(merge resource %))
(p/finally (fn [result cause]
(if cause
(on-error cause)
(on-complete result)))))))
:filename (str/concat name (mime/get-extension type))
:id (str/concat (c/name type) "." task-id)}))
(defn- lookup
[id]
(p/let [[type task-id] (str/split id "." 2)
path (get-path type task-id)
mtype (get-mtype type)
mtype (mime/get (keyword type))
stat (sh/stat path)]
(when-not stat
@ -131,3 +60,25 @@
(assoc :response/status 200)
(assoc :response/body stream)
(assoc :response/headers headers))))))
(defn create-zip
[& {:keys [resource on-complete on-progress on-error]}]
(let [^js zip (arc/create "zip")
^js out (fs/createWriteStream (:path resource))
progress (atom 0)]
(.on zip "error" on-error)
(.on zip "end" on-complete)
(.on zip "entry" (fn [data]
(let [name (unchecked-get data "name")
num (swap! progress inc)]
(on-progress {:done num :filename name}))))
(.pipe zip out)
zip))
(defn add-to-zip!
[zip path name]
(.file ^js zip path #js {:name name}))
(defn close-zip!
[zip]
(.finalize ^js zip))

45
exporter/src/app/renderer.cljs Normal file
View file

@ -0,0 +1,45 @@
;; 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.renderer
"Common renderer interface."
(:require
[app.common.spec :as us]
[app.renderer.bitmap :as rb]
[app.renderer.pdf :as rp]
[app.renderer.svg :as rs]
[cljs.spec.alpha :as s]))
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
(s/def ::type #{:jpeg :png :pdf :svg})
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::uri ::us/uri)
(s/def ::filename ::us/string)
(s/def ::object
(s/keys :req-un [::id ::name ::suffix ::filename]))
(s/def ::objects
(s/coll-of ::object :min-count 1))
(s/def ::render-params
(s/keys :req-un [::file-id ::page-id ::scale ::token ::type ::objects]
:opt-un [::uri]))
(defn- render
[{:keys [type] :as params} on-object]
(us/verify ::render-params params)
(us/verify fn? on-object)
(case type
:png (rb/render params on-object)
:jpeg (rb/render params on-object)
:pdf (rp/render params on-object)
:svg (rs/render params on-object)))

84
exporter/src/app/renderer/bitmap.cljs
View file

@ -7,29 +7,25 @@
(ns app.renderer.bitmap
"A bitmap renderer."
(:require
["path" :as path]
[app.browser :as bw]
[app.common.data :as d]
[app.common.exceptions :as ex :include-macros true]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.uri :as u]
[app.config :as cf]
[app.util.mime :as mime]
[app.util.shell :as sh]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[promesa.core :as p]))
(defn screenshot-object
[{:keys [file-id page-id object-id token scale type uri]}]
(p/let [params {:file-id file-id
:page-id page-id
:object-id object-id
:route "render-object"}
uri (-> (or uri (cf/get :public-uri))
(assoc :path "/render.html")
(assoc :query (u/map->query-string params)))]
(bw/exec!
(defn render
[{:keys [file-id page-id token scale type uri objects] :as params} on-object]
(letfn [(prepare-options [uri]
#js {:screen #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:viewport #js {:width bw/default-viewport-width
@ -37,45 +33,35 @@
:locale "en-US"
:storageState #js {:cookies (bw/create-cookies uri {:token token})}
:deviceScaleFactor scale
:userAgent bw/default-user-agent}
(fn [page]
(l/info :uri uri)
(p/do!
(bw/nav! page (str uri))
(p/let [node (bw/select page "#screenshot")]
:userAgent bw/default-user-agent})
(render-object [page {:keys [id] :as object}]
(p/let [tmpdir (sh/mktmpdir! "bitmap-render")
path (path/join tmpdir (str/concat id (mime/get-extension type)))
node (bw/select page (str/concat "#screenshot-" id))]
(bw/wait-for node)
(bw/eval! page (js* "() => document.body.style.background = 'transparent'"))
(bw/sleep page 2000) ; the good old fix with sleep
(case type
:png (bw/screenshot node {:omit-background? true :type type})
:jpeg (bw/screenshot node {:omit-background? false :type type}))))))))
:png (bw/screenshot node {:omit-background? true :type type :path path})
:jpeg (bw/screenshot node {:omit-background? false :type type :path path}))
(on-object (assoc object :path path))))
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
(s/def ::type #{:jpeg :png})
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::uri ::us/uri)
(render [uri page]
(l/info :uri uri)
(p/do
;; navigate to the page and perform basic setup
(bw/nav! page (str uri))
(bw/sleep page 1000) ; the good old fix with sleep
(bw/eval! page (js* "() => document.body.style.background = 'transparent'"))
(s/def ::params
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::scale ::token ::file-id]
:opt-un [::uri]))
(defn render
[params]
(us/verify ::params params)
(p/let [content (screenshot-object params)]
{:data content
:name (str (:name params)
(:suffix params "")
(case (:type params)
:png ".png"
:jpeg ".jpg"))
:size (alength content)
:mtype (case (:type params)
:png "image/png"
:jpeg "image/jpeg")}))
;; take the screnshot of requested objects, one by one
(p/run! (partial render-object page) objects)
nil))]
(p/let [params {:file-id file-id
:page-id page-id
:object-id (mapv :id objects)
:route "objects"}
uri (-> (or uri (cf/get :public-uri))
(assoc :path "/render.html")
(assoc :query (u/map->query-string params)))]
(bw/exec! (prepare-options uri) (partial render uri)))))

78
exporter/src/app/renderer/pdf.cljs
View file

@ -7,26 +7,23 @@
(ns app.renderer.pdf
"A pdf renderer."
(:require
["path" :as path]
[app.browser :as bw]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex :include-macros true]
[app.common.logging :as l]
[app.common.spec :as us]
[app.common.uri :as u]
[app.config :as cf]
[app.util.mime :as mime]
[app.util.shell :as sh]
[cuerdas.core :as str]
[cljs.spec.alpha :as s]
[promesa.core :as p]))
(defn pdf-from-object
[{:keys [file-id page-id object-id token scale type save-path uri] :as params}]
(p/let [params {:file-id file-id
:page-id page-id
:object-id object-id
:route "render-object"}
uri (-> (or uri (cf/get :public-uri))
(assoc :path "/render.html")
(assoc :query (u/map->query-string params)))]
(bw/exec!
(defn render
[{:keys [file-id page-id token scale type uri objects] :as params} on-object]
(letfn [(prepare-options [uri]
#js {:screen #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:viewport #js {:width bw/default-viewport-width
@ -34,41 +31,38 @@
:locale "en-US"
:storageState #js {:cookies (bw/create-cookies uri {:token token})}
:deviceScaleFactor scale
:userAgent bw/default-user-agent}
(fn [page]
:userAgent bw/default-user-agent})
(prepare-uri [base-uri object-id]
(let [params {:file-id file-id
:page-id page-id
:object-id object-id
:route "objects"}]
(-> base-uri
(assoc :path "/render.html")
(assoc :query (u/map->query-string params)))))
(render-object [page base-uri {:keys [id] :as object}]
(p/let [uri (prepare-uri base-uri id)
tmp (sh/mktmpdir! "pdf-render")
path (path/join tmp (str/concat id (mime/get-extension type)))]
(l/info :uri uri)
(p/do!
(bw/nav! page uri)
(p/let [dom (bw/select page "#screenshot")]
(p/let [dom (bw/select page (dm/str "#screenshot-" id))]
(bw/wait-for dom)
(bw/screenshot dom {:full-page? true})
(bw/sleep page 2000) ; the good old fix with sleep
(if save-path
(bw/pdf page {:save-path save-path})
(bw/pdf page))))))))
(bw/pdf page {:path path})
path)))
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::save-path ::us/string)
(s/def ::uri ::us/uri)
(s/def ::render-params
(s/keys :req-un [::name ::suffix ::object-id ::page-id ::scale ::token ::file-id]
:opt-un [::save-path ::uri]))
(defn render
[params]
(us/assert ::render-params params)
(p/let [content (pdf-from-object params)]
{:data content
:name (str (:name params)
(:suffix params "")
".pdf")
:size (alength content)
:mtype "application/pdf"}))
(render [base-uri page]
(p/loop [objects (seq objects)]
(when-let [object (first objects)]
(p/let [uri (prepare-uri base-uri (:id object))
path (render-object page base-uri object)]
(on-object (assoc object :path path))
(p/recur (rest objects))))))]
(let [base-uri (or uri (cf/get :public-uri))]
(bw/exec! (prepare-options base-uri)
(partial render base-uri)))))

125
exporter/src/app/renderer/svg.cljs
View file

@ -10,12 +10,14 @@
["xml-js" :as xml]
[app.browser :as bw]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex :include-macros true]
[app.common.logging :as l]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.uri :as u]
[app.config :as cf]
[app.util.mime :as mime]
[app.util.shell :as sh]
[cljs.spec.alpha :as s]
[clojure.walk :as walk]
@ -111,9 +113,8 @@
{:width width
:height height}))
(defn- render-object
[{:keys [page-id file-id object-id token scale suffix type uri]}]
(defn render
[{:keys [page-id file-id objects token scale suffix type uri]} on-object]
(letfn [(convert-to-ppm [pngpath]
(l/trace :fn :convert-to-ppm)
(let [basepath (path/dirname pngpath)
@ -246,7 +247,7 @@
(trace-node [{:keys [data] :as node}]
(l/trace :fn :trace-node)
(p/let [tdpath (sh/create-tmpdir! "svgexport-")
(p/let [tdpath (sh/mktmpdir! "svgexport")
pngpath (path/join tdpath "origin.png")
_ (sh/write-file! pngpath data)
ppmpath (convert-to-ppm pngpath)
@ -293,48 +294,25 @@
(sh/rmdir! tempdir)
(dissoc node :tempdir)))
(process-text-node [page item]
(extract-txt-node [page item]
(-> (p/resolved item)
(p/then (partial resolve-text-node page))
(p/then extract-single-node)
(p/then trace-node)
(p/then clean-temp-data)))
(process-text-nodes [page]
(extract-txt-nodes [page {:keys [id] :as objects}]
(l/trace :fn :process-text-nodes)
(-> (bw/select-all page "#screenshot foreignObject")
(p/then (fn [nodes] (p/all (map (partial process-text-node page) nodes))))))
(-> (bw/select-all page (str/concat "#screenshot-" id " foreignObject"))
(p/then (fn [nodes] (p/all (map (partial extract-txt-node page) nodes))))
(p/then (fn [nodes] (d/index-by :id nodes)))))
(extract [page]
(p/let [dom (bw/select page "#screenshot")
xmldata (bw/eval! dom (fn [elem] (.-outerHTML ^js elem)))
nodes (process-text-nodes page)
nodes (d/index-by :id nodes)
result (replace-text-nodes xmldata nodes)
(extract-svg [page {:keys [id] :as object}]
(let [node (bw/select page (str/concat "#screenshot-" id))]
(bw/wait-for node)
(bw/eval! node (fn [elem] (.-outerHTML ^js elem)))))
;; SVG standard don't allow the entity nbsp. &#160; is equivalent but
;; compatible with SVG
result (str/replace result "&nbsp;" "&#160;")]
;; (println "------- ORIGIN:")
;; (cljs.pprint/pprint (xml->clj xmldata))
;; (println "------- RESULT:")
;; (cljs.pprint/pprint (xml->clj result))
;; (println "-------")
result))
]
(p/let [params {:file-id file-id
:page-id page-id
:object-id object-id
:render-texts true
:embed true
:route "render-object"}
uri (-> (or uri (cf/get :public-uri))
(assoc :path "/render.html")
(assoc :query (u/map->query-string params)))]
(bw/exec!
(prepare-options [uri]
#js {:screen #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:viewport #js {:width bw/default-viewport-width
@ -342,39 +320,48 @@
:locale "en-US"
:storageState #js {:cookies (bw/create-cookies uri {:token token})}
:deviceScaleFactor scale
:userAgent bw/default-user-agent}
(fn [page]
:userAgent bw/default-user-agent})
(render-object [page {:keys [id] :as object}]
(p/let [tmpdir (sh/mktmpdir! "svg-render")
path (path/join tmpdir (str/concat id (mime/get-extension type)))
node (bw/select page (str/concat "#screenshot-" id))]
(bw/wait-for node)
(p/let [xmldata (extract-svg page object)
txtdata (extract-txt-nodes page object)
result (replace-text-nodes xmldata txtdata)
result (str/replace result "&nbsp;" "&#160;")]
;; (println "------- ORIGIN:")
;; (cljs.pprint/pprint (xml->clj xmldata))
;; (println "------- RESULT:")
;; (cljs.pprint/pprint (xml->clj result))
;; (println "-------")
(sh/write-file! path result)
(on-object (assoc object :path path))
path)))
(render [uri page]
(l/info :uri uri)
(p/do!
(bw/nav! page uri)
(p/let [dom (bw/select page "#screenshot")]
(bw/wait-for dom)
(bw/sleep page 2000))
(p/do
;; navigate to the page and perform basic setup
(bw/nav! page (str uri))
(bw/sleep page 1000) ; the good old fix with sleep
(extract page)))))))
;; take the screnshot of requested objects, one by one
(p/run! (partial render-object page) objects)
nil))]
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
(s/def ::type #{:svg})
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::uri ::us/uri)
(s/def ::params
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::file-id ::scale ::token]
:opt-un [::uri]))
(defn render
[params]
(us/assert ::params params)
(p/let [content (render-object params)]
{:data content
:name (str (:name params)
(:suffix params "")
".svg")
:size (alength content)
:mtype "image/svg+xml"}))
(p/let [params {:file-id file-id
:page-id page-id
:render-texts true
:render-embed true
:object-id (mapv :id objects)
:route "objects"}
uri (-> (or uri (cf/get :public-uri))
(assoc :path "/render.html")
(assoc :query (u/map->query-string params)))]
(bw/exec! (prepare-options uri)
(partial render uri)))))

32
exporter/src/app/util/mime.cljs Normal file
View file

@ -0,0 +1,32 @@
;; 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.mime
"Mimetype and file extension helpers."
(:refer-clojure :exclude [get])
(:require
[app.common.data :as d]
[cljs.core :as c]))
(defn get-extension
[type]
(case type
:png ".png"
:jpeg ".jpg"
:svg ".svg"
:pdf ".pdf"
:zip ".zip"))
(defn- get
[type]
(case type
:zip "application/zip"
:pdf "application/pdf"
:svg "image/svg+xml"
:jpeg "image/jpeg"
:png "image/png"))

7
exporter/src/app/util/shell.cljs
View file

@ -16,12 +16,9 @@
(l/set-level! :trace)
(defn create-tmpdir!
(defn mktmpdir!
[prefix]
(-> (.mkdtemp fs/promises prefix)
(p/then (fn [result]
(path/join (os/tmpdir) result)))))
(.mkdtemp fs/promises (path/join (os/tmpdir) prefix)))
(defn move!
[origin-path dest-path]

4
frontend/deps.edn
View file

@ -10,10 +10,12 @@
funcool/beicon {:mvn/version "2021.07.05-1"}
funcool/okulary {:mvn/version "2020.04.14-0"}
funcool/potok {:mvn/version "2021.09.20-0"}
funcool/rumext {:mvn/version "2022.01.20.128"}
funcool/rumext {:mvn/version "2022.03.28-131"}
funcool/tubax {:mvn/version "2021.05.20-0"}
instaparse/instaparse {:mvn/version "1.4.10"}
garden/garden {:mvn/version "1.3.10"}
}
:aliases

70
frontend/src/app/main/data/exports.cljs
View file

@ -6,7 +6,6 @@
(ns app.main.data.exports
(:require
[app.common.data.macros :as dm]
[app.common.uuid :as uuid]
[app.main.data.modal :as modal]
[app.main.data.workspace.persistence :as dwp]
@ -47,6 +46,7 @@
state
(dissoc state :export))))))
(defn show-workspace-export-dialog
([] (show-workspace-export-dialog nil))
([{:keys [selected]}]
@ -55,8 +55,6 @@
(watch [_ state _]
(let [file-id (:current-file-id state)
page-id (:current-page-id state)
filename (-> (wsh/lookup-page state page-id) :name)
selected (or selected (wsh/lookup-selected state page-id {}))
shapes (if (seq selected)
@ -74,11 +72,10 @@
(assoc :name (:name shape))))]
(rx/of (modal/show :export-shapes
{:exports (vec exports)
:filename filename})))))))
{:exports (vec exports)})))))))
(defn show-viewer-export-dialog
[{:keys [shapes filename page-id file-id exports]}]
[{:keys [shapes page-id file-id exports]}]
(ptk/reify ::show-viewer-export-dialog
ptk/WatchEvent
(watch [_ _ _]
@ -91,51 +88,44 @@
(assoc :object-id (:id shape))
(assoc :shape (dissoc shape :exports))
(assoc :name (:name shape))))]
(rx/of (modal/show :export-shapes {:exports (vec exports)
:filename filename}))))))
(rx/of (modal/show :export-shapes {:exports (vec exports)}))))))
(defn show-workspace-export-frames-dialog
([frames]
[frames]
(ptk/reify ::show-workspace-export-frames-dialog
ptk/WatchEvent
(watch [_ state _]
(let [file-id (:current-file-id state)
page-id (:current-page-id state)
filename (-> (wsh/lookup-page state page-id)
:name
(dm/str ".pdf"))
exports (for [frame frames]
{:enabled true
:page-id page-id
:file-id file-id
:frame-id (:id frame)
:object-id (:id frame)
:shape frame
:name (:name frame)})]
(rx/of (modal/show :export-frames
{:exports (vec exports)
:filename filename})))))))
{:exports (vec exports)}))))))
(defn- initialize-export-status
[exports filename resource-id query-name]
[exports cmd resource]
(ptk/reify ::initialize-export-status
ptk/UpdateEvent
(update [_ state]
(assoc state :export {:in-progress true
:resource-id resource-id
:resource-id (:id resource)
:healthy? true
:error false
:progress 0
:widget-visible true
:detail-visible true
:exports exports
:filename filename
:last-update (dt/now)
:query-name query-name}))))
:cmd cmd}))))
(defn- update-export-status
[{:keys [progress status resource-id name] :as data}]
[{:keys [done status resource-id filename] :as data}]
(ptk/reify ::update-export-status
ptk/UpdateEvent
(update [_ state]
@ -144,7 +134,7 @@
healthy? (< time-diff (dt/duration {:seconds 6}))]
(cond-> state
(= status "running")
(update :export assoc :progress (:done progress) :last-update (dt/now) :healthy? healthy?)
(update :export assoc :progress done :last-update (dt/now) :healthy? healthy?)
(= status "error")
(update :export assoc :error (:cause data) :last-update (dt/now) :healthy? healthy?)
@ -155,12 +145,12 @@
ptk/WatchEvent
(watch [_ _ _]
(when (= status "ended")
(->> (rp/query! :download-export-resource resource-id)
(->> (rp/query! :exporter {:cmd :get-resource :blob? true :id resource-id})
(rx/delay 500)
(rx/map #(dom/trigger-download name %)))))))
(rx/map #(dom/trigger-download filename %)))))))
(defn request-simple-export
[{:keys [export filename]}]
[{:keys [export]}]
(ptk/reify ::request-simple-export
ptk/UpdateEvent
(update [_ state]
@ -170,22 +160,26 @@
(watch [_ state _]
(let [profile-id (:profile-id state)
params {:exports [export]
:profile-id profile-id}]
:profile-id profile-id
:cmd :export-shapes
:wait true}]
(rx/concat
(rx/of ::dwp/force-persist)
(->> (rp/query! :export-shapes-simple params)
(->> (rp/query! :export-shapes params)
(rx/mapcat (fn [{:keys [id filename]}]
(->> (rp/query! :exporter {:cmd :get-resource :blob? true :id id})
(rx/map (fn [data]
(dom/trigger-download filename data)
(clear-export-state uuid/zero)))
(clear-export-state uuid/zero))))))
(rx/catch (fn [cause]
(prn "KKKK" cause)
(rx/concat
(rx/of (clear-export-state uuid/zero))
(rx/throw cause))))))))))
(defn request-multiple-export
[{:keys [filename exports query-name]
:or {query-name :export-shapes-multiple}
[{:keys [exports cmd]
:or {cmd :export-shapes}
:as params}]
(ptk/reify ::request-multiple-export
ptk/WatchEvent
@ -194,7 +188,7 @@
profile-id (:profile-id state)
ws-conn (:ws-conn state)
params {:exports exports
:name filename
:cmd cmd
:profile-id profile-id
:wait false}
@ -219,11 +213,10 @@
;; Launch the exportation process and stores the resource id
;; locally.
(->> (rp/query! query-name params)
(rx/tap (fn [{:keys [id]}]
(vreset! resource-id id)))
(rx/map (fn [{:keys [id]}]
(initialize-export-status exports filename id query-name))))
(->> (rp/query! :exporter params)
(rx/map (fn [{:keys [id] :as resource}]
(vreset! resource-id id)
(initialize-export-status exports cmd resource))))
;; We proceed to update the export state with incoming
;; progress updates. We delay the stoper for give some time
@ -246,13 +239,12 @@
(rx/map #(clear-export-state @resource-id))
(rx/take-until (rx/delay 6000 stoper))))))))
(defn retry-last-export
[]
(ptk/reify ::retry-last-export
ptk/WatchEvent
(watch [_ state _]
(let [params (select-keys (:export state) [:filename :exports :query-name])]
(let [params (select-keys (:export state) [:exports :cmd])]
(when (seq params)
(rx/of (request-multiple-export params)))))))

2
frontend/src/app/main/errors.cljs
View file

@ -17,7 +17,6 @@
[app.util.i18n :refer [tr]]
[app.util.router :as rt]
[app.util.timers :as ts]
[expound.alpha :as expound]
[fipp.edn :as fpp]
[potok.core :as ptk]))
@ -119,7 +118,6 @@
;; Print to the console some debugging info
(js/console.group message)
(js/console.info context)
(js/console.error (with-out-str (expound/printer error)))
(js/console.groupEnd message)))
;; That are special case server-errors that should be treated

229
frontend/src/app/main/render.cljs
View file

@ -14,7 +14,8 @@
(:require
["react-dom/server" :as rds]
[app.common.colors :as clr]
[app.common.geom.align :as gal]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
@ -22,10 +23,12 @@
[app.common.pages.helpers :as cph]
[app.config :as cfg]
[app.main.fonts :as fonts]
[app.main.ui.context :as muc]
[app.main.ui.shapes.bool :as bool]
[app.main.ui.shapes.circle :as circle]
[app.main.ui.shapes.embed :as embed]
[app.main.ui.shapes.export :as export]
[app.main.ui.shapes.filters :as filters]
[app.main.ui.shapes.frame :as frame]
[app.main.ui.shapes.group :as group]
[app.main.ui.shapes.image :as image]
@ -57,11 +60,9 @@
:fill color}])
(defn- calculate-dimensions
[{:keys [objects] :as data} vport]
[objects]
(let [shapes (cph/get-immediate-children objects)
rect (cond->> (gsh/selection-rect shapes)
(some? vport)
(gal/adjust-to-viewport vport))]
rect (gsh/selection-rect shapes)]
(-> rect
(update :x mth/finite 0)
(update :y mth/finite 0)
@ -156,24 +157,63 @@
(->> [x y width height]
(map #(ust/format-precision % viewbox-decimal-precision)))))
(defn adapt-root-frame
[objects object]
(let [shapes (cph/get-immediate-children objects)
srect (gsh/selection-rect shapes)
object (merge object (select-keys srect [:x :y :width :height]))
object (gsh/transform-shape object)]
(assoc object :fill-color "#f0f0f0")))
(defn adapt-objects-for-shape
[objects object-id]
(let [object (get objects object-id)
object (cond->> object
(cph/root-frame? object)
(adapt-root-frame objects))
;; Replace the previous object with the new one
objects (assoc objects object-id object)
modifier (-> (gpt/point (:x object) (:y object))
(gpt/negate)
(gmt/translate-matrix))
mod-ids (cons object-id (cph/get-children-ids objects object-id))
updt-fn #(-> %1
(assoc-in [%2 :modifiers :displacement] modifier)
(update %2 gsh/transform-shape))]
(reduce updt-fn objects mod-ids)))
(defn get-object-bounds
[objects object-id]
(let [object (get objects object-id)
padding (filters/calculate-padding object)
bounds (-> (filters/get-filters-bounds object)
(update :x - (:horizontal padding))
(update :y - (:vertical padding))
(update :width + (* 2 (:horizontal padding)))
(update :height + (* 2 (:vertical padding))))]
(if (cph/group-shape? object)
(if (:masked-group? object)
(get-object-bounds objects (-> object :shapes first))
(->> (:shapes object)
(into [bounds] (map (partial get-object-bounds objects)))
(gsh/join-rects)))
bounds)))
(mf/defc page-svg
{::mf/wrap [mf/memo]}
[{:keys [data width height thumbnails? embed? include-metadata?] :as props
:or {embed? false include-metadata? false}}]
[{:keys [data thumbnails? render-embed? include-metadata?] :as props
:or {render-embed? false include-metadata? false}}]
(let [objects (:objects data)
shapes (cph/get-immediate-children objects)
root-children
(->> shapes
(remove cph/frame-shape?)
(mapcat #(cph/get-children-with-self objects (:id %))))
vport (when (and (some? width) (some? height))
{:width width :height height})
dim (calculate-dimensions data vport)
dim (calculate-dimensions objects)
vbox (format-viewbox dim)
background-color (get-in data [:options :background] default-color)
bgcolor (dm/get-in data [:options :background] default-color)
frame-wrapper
(mf/use-memo
@ -185,7 +225,7 @@
(mf/deps objects)
#(shape-wrapper-factory objects))]
[:& (mf/provider embed/context) {:value embed?}
[:& (mf/provider embed/context) {:value render-embed?}
[:& (mf/provider export/include-metadata-ctx) {:value include-metadata?}
[:svg {:view-box vbox
:version "1.1"
@ -194,12 +234,17 @@
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:style {:width "100%"
:height "100%"
:background background-color}}
:background bgcolor}}
(when include-metadata?
[:& export/export-page {:options (:options data)}])
[:& ff/fontfaces-style {:shapes root-children}]
(let [shapes (->> shapes
(remove cph/frame-shape?)
(mapcat #(cph/get-children-with-self objects (:id %))))]
[:& ff/fontfaces-style {:shapes shapes}])
(for [item shapes]
(let [frame? (= (:type item) :frame)]
(cond
@ -214,6 +259,10 @@
[:& shape-wrapper {:shape item
:key (:id item)}])))]]]))
;; Component that serves for render frame thumbnails, mainly used in
;; the viewer and handoff
(mf/defc frame-svg
{::mf/wrap [mf/memo]}
[{:keys [objects frame zoom show-thumbnails?] :or {zoom 1} :as props}]
@ -260,6 +309,10 @@
[:> shape-container {:shape frame}
[:& frame/frame-thumbnail {:shape frame}]]))]))
;; Component for rendering a thumbnail of a single componenent. Mainly
;; used to render thumbnails on assets panel.
(mf/defc component-svg
{::mf/wrap [mf/memo #(mf/deferred % ts/idle-then-raf)]}
[{:keys [objects group zoom] :or {zoom 1} :as props}]
@ -304,81 +357,122 @@
[:> shape-container {:shape group}
[:& group-wrapper {:shape group :view-box vbox}]]]))
(mf/defc object-svg
{::mf/wrap [mf/memo]}
[{:keys [objects object zoom render-texts? render-embed?]
:or {zoom 1 render-embed? false}
:as props}]
(let [object (cond-> object
(:hide-fill-on-export object)
(assoc :fills []))
obj-id (:id object)
x (* (:x object) zoom)
y (* (:y object) zoom)
width (* (:width object) zoom)
height (* (:height object) zoom)
vbox (dm/str x " " y " " width " " height)
frame-wrapper
(mf/with-memo [objects]
(frame-wrapper-factory objects))
group-wrapper
(mf/with-memo [objects]
(group-wrapper-factory objects))
shape-wrapper
(mf/with-memo [objects]
(shape-wrapper-factory objects))
text-shapes (sequence (filter cph/text-shape?) (vals objects))
render-texts? (and render-texts? (d/seek (comp nil? :position-data) text-shapes))]
[:& (mf/provider embed/context) {:value render-embed?}
[:svg {:id (dm/str "screenshot-" obj-id)
:view-box vbox
:width width
:height height
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
;; Fix Chromium bug about color of html texts
;; https://bugs.chromium.org/p/chromium/issues/detail?id=1244560#c5
:style {:-webkit-print-color-adjust :exact}}
(let [shapes (cph/get-children objects obj-id)]
[:& ff/fontfaces-style {:shapes shapes}])
(case (:type object)
:frame [:& frame-wrapper {:shape object :view-box vbox}]
:group [:> shape-container {:shape object}
[:& group-wrapper {:shape object}]]
[:& shape-wrapper {:shape object}])]
;; Auxiliary SVG for rendering text-shapes
(when render-texts?
(for [object text-shapes]
[:& (mf/provider muc/text-plain-colors-ctx) {:value true}
[:svg
{:id (dm/str "screenshot-text-" (:id object))
:view-box (dm/str "0 0 " (:width object) " " (:height object))
:width (:width object)
:height (:height object)
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"}
[:& shape-wrapper {:shape (assoc object :x 0 :y 0)}]]]))]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SPRITES (DEBUG)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(mf/defc component-symbol
{::mf/wrap-props false}
[props]
(let [id (obj/get props "id")
data (obj/get props "data")
name (:name data)
path (:path data)
objects (:objects data)
root (get objects id)
selrect (:selrect root)
[{:keys [id data] :as props}]
(let [name (:name data)
objects (-> (:objects data)
(adapt-objects-for-shape id))
object (get objects id)
selrect (:selrect object)
vbox
(format-viewbox
{:width (:width selrect)
:height (:height selrect)})
modifier
(mf/use-memo
(mf/deps (:x root) (:y root))
(fn []
(-> (gpt/point (:x root) (:y root))
(gpt/negate)
(gmt/translate-matrix))))
objects
(mf/use-memo
(mf/deps modifier id objects)
(fn []
(let [modifier-ids (cons id (cph/get-children-ids objects id))
update-fn #(assoc-in %1 [%2 :modifiers :displacement] modifier)]
(reduce update-fn objects modifier-ids))))
root
(mf/use-memo
(mf/deps modifier root)
(fn [] (assoc-in root [:modifiers :displacement] modifier)))
group-wrapper
(mf/use-memo
(mf/deps objects)
(fn [] (group-wrapper-factory objects)))]
[:> "symbol" #js {:id (str id)
:viewBox vbox
"penpot:path" path}
[:> "symbol" #js {:id (str id) :viewBox vbox}
[:title name]
[:> shape-container {:shape root}
[:& group-wrapper {:shape root :view-box vbox}]]]))
[:> shape-container {:shape object}
[:& group-wrapper {:shape object :view-box vbox}]]]))
(mf/defc components-sprite-svg
{::mf/wrap-props false}
[props]
(let [data (obj/get props "data")
children (obj/get props "children")
embed? (obj/get props "embed?")
render-embed? (obj/get props "render-embed?")
include-metadata? (obj/get props "include-metadata?")]
[:& (mf/provider embed/context) {:value embed?}
[:& (mf/provider embed/context) {:value render-embed?}
[:& (mf/provider export/include-metadata-ctx) {:value include-metadata?}
[:svg {:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:style {:width "100vw"
:height "100vh"
:display (when-not (some? children) "none")}}
:style {:display (when-not (some? children) "none")}}
[:defs
(for [[component-id component-data] (:components data)]
[:& component-symbol {:id component-id
:key (str component-id)
:data component-data}])]
(for [[id data] (:components data)]
[:& component-symbol {:id id :key (dm/str id) :data data}])]
children]]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; RENDERING
;; RENDER FOR DOWNLOAD (wrongly called exportation)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- get-image-data [shape]
@ -426,7 +520,7 @@
(->> (rx/of data)
(rx/map
(fn [data]
(let [elem (mf/element page-svg #js {:data data :embed? true :include-metadata? true})]
(let [elem (mf/element page-svg #js {:data data :render-embed? true :include-metadata? true})]
(rds/renderToStaticMarkup elem)))))))
(defn render-components
@ -445,5 +539,6 @@
(->> (rx/of data)
(rx/map
(fn [data]
(let [elem (mf/element components-sprite-svg #js {:data data :embed? true :include-metadata? true})]
(let [elem (mf/element components-sprite-svg
#js {:data data :render-embed? true :include-metadata? true})]
(rds/renderToStaticMarkup elem))))))))

28
frontend/src/app/main/repo.cljs
View file

@ -105,34 +105,22 @@
(rx/map http/conditional-decode-transit)
(rx/mapcat handle-response)))
(defn- send-export-command
[& {:keys [cmd params blob?]}]
(defn- send-export
[{:keys [blob?] :as params}]
(->> (http/send! {:method :post
:uri (u/join base-uri "api/export")
:body (http/transit-data (assoc params :cmd cmd))
:body (http/transit-data (dissoc params :blob?))
:credentials "include"
:response-type (if blob? :blob :text)})
(rx/map http/conditional-decode-transit)
(rx/mapcat handle-response)))
(defmethod query :export-shapes-simple
(defmethod query :exporter
[_ params]
(let [params (merge {:wait true} params)]
(->> (rx/of params)
(rx/mapcat #(send-export-command :cmd :export-shapes :params % :blob? false))
(rx/mapcat #(send-export-command :cmd :get-resource :params % :blob? true)))))
(defmethod query :export-shapes-multiple
[_ params]
(send-export-command :cmd :export-shapes :params params :blob? false))
(defmethod query :export-frames-multiple
[_ params]
(send-export-command :cmd :export-frames :params (assoc params :uri (str base-uri)) :blob? false))
(defmethod query :download-export-resource
[_ id]
(send-export-command :cmd :get-resource :params {:id id} :blob? true))
(let [default {:wait false
:blob? false
:uri (str base-uri)}]
(send-export (merge default params))))
(derive :upload-file-media-object ::multipart-upload)
(derive :update-profile-photo ::multipart-upload)

10
frontend/src/app/main/ui.cljs
View file

@ -19,7 +19,6 @@
[app.main.ui.onboarding]
[app.main.ui.onboarding.questions]
[app.main.ui.releases]
[app.main.ui.render :as render]
[app.main.ui.settings :as settings]
[app.main.ui.static :as static]
[app.main.ui.viewer :as viewer]
@ -110,15 +109,6 @@
:index index
:share-id share-id}]))
;; TODO: maybe move to `app.render` entrypoint (handled by render.html)
:render-sprite
(do
(let [file-id (uuid (get-in route [:path-params :file-id]))
component-id (get-in route [:query-params :component-id])
component-id (when (some? component-id) (uuid component-id))]
[:& render/render-sprite {:file-id file-id
:component-id component-id}]))
:workspace
(let [project-id (some-> params :path :project-id uuid)
file-id (some-> params :path :file-id uuid)

22
frontend/src/app/main/ui/export.cljs
View file

@ -23,7 +23,7 @@
[rumext.alpha :as mf]))
(mf/defc export-multiple-dialog
[{:keys [exports filename title query-name no-selection]}]
[{:keys [exports title cmd no-selection]}]
(let [lstate (mf/deref refs/export)
in-progress? (:in-progress lstate)
@ -33,7 +33,10 @@
all-checked? (every? :enabled all-exports)
all-unchecked? (every? (complement :enabled) all-exports)
enabled-exports (into [] (filter :enabled) all-exports)
enabled-exports (into []
(comp (filter :enabled)
(map #(dissoc % :shape :enabled)))
all-exports)
cancel-fn
(fn [event]
@ -45,9 +48,8 @@
(dom/prevent-default event)
(st/emit! (modal/hide)
(de/request-multiple-export
{:filename filename
:exports enabled-exports
:query-name query-name})))
{:exports enabled-exports
:cmd cmd})))
on-toggle-enabled
(fn [index]
@ -145,25 +147,23 @@
(mf/defc export-shapes-dialog
{::mf/register modal/components
::mf/register-as :export-shapes}
[{:keys [exports filename]}]
[{:keys [exports]}]
(let [title (tr "dashboard.export-shapes.title")]
[:& export-multiple-dialog
{:exports exports
:filename filename
:title title
:query-name :export-shapes-multiple
:cmd :export-shapes
:no-selection shapes-no-selection}]))
(mf/defc export-frames
{::mf/register modal/components
::mf/register-as :export-frames}
[{:keys [exports filename]}]
[{:keys [exports]}]
(let [title (tr "dashboard.export-frames.title")]
[:& export-multiple-dialog
{:exports exports
:filename filename
:title title
:query-name :export-frames-multiple}]))
:cmd :export-frames}]))
(mf/defc export-progress-widget
{::mf/wrap [mf/memo]}

203
frontend/src/app/main/ui/render.cljs
View file

@ -1,203 +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.main.ui.render
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
[app.common.uuid :as uuid]
[app.main.data.fonts :as df]
[app.main.render :as render]
[app.main.repo :as repo]
[app.main.store :as st]
[app.main.ui.context :as muc]
[app.main.ui.shapes.embed :as embed]
[app.main.ui.shapes.filters :as filters]
[app.main.ui.shapes.shape :refer [shape-container]]
[app.main.ui.shapes.text.fontfaces :as ff]
[app.util.dom :as dom]
[beicon.core :as rx]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
(defn calc-bounds
[object objects]
(let [xf-get-bounds (comp (map #(get objects %)) (map #(calc-bounds % objects)))
padding (filters/calculate-padding object)
obj-bounds (-> (filters/get-filters-bounds object)
(update :x - (:horizontal padding))
(update :y - (:vertical padding))
(update :width + (* 2 (:horizontal padding)))
(update :height + (* 2 (:vertical padding))))]
(cond
(and (= :group (:type object))
(:masked-group? object))
(calc-bounds (get objects (first (:shapes object))) objects)
(= :group (:type object))
(->> (:shapes object)
(into [obj-bounds] xf-get-bounds)
(gsh/join-rects))
:else
obj-bounds)))
(mf/defc object-svg
{::mf/wrap [mf/memo]}
[{:keys [objects object-id zoom render-texts? embed?]
:or {zoom 1 embed? false}
:as props}]
(let [object (get objects object-id)
frame-id (if (= :frame (:type object))
(:id object)
(:frame-id object))
modifier (-> (gpt/point (:x object) (:y object))
(gpt/negate)
(gmt/translate-matrix))
mod-ids (cons frame-id (cph/get-children-ids objects frame-id))
updt-fn #(-> %1
(assoc-in [%2 :modifiers :displacement] modifier)
(update %2 gsh/transform-shape))
objects (reduce updt-fn objects mod-ids)
object (get objects object-id)
object (cond-> object
(:hide-fill-on-export object)
(assoc :fills []))
all-children (cph/get-children objects object-id)
{:keys [x y width height] :as bs} (calc-bounds object objects)
[_ _ width height :as coords] (->> [x y width height] (map #(* % zoom)))
vbox (str/join " " coords)
frame-wrapper
(mf/with-memo [objects]
(render/frame-wrapper-factory objects))
group-wrapper
(mf/with-memo [objects]
(render/group-wrapper-factory objects))
shape-wrapper
(mf/with-memo [objects]
(render/shape-wrapper-factory objects))
is-text? (fn [shape] (= :text (:type shape)))
text-shapes (sequence (comp (map second) (filter is-text?)) objects)
render-texts? (and render-texts? (d/seek (comp nil? :position-data) text-shapes))]
(mf/with-effect [width height]
(dom/set-page-style!
{:size (dm/str (mth/ceil width) "px "
(mth/ceil height) "px")}))
[:& (mf/provider embed/context) {:value embed?}
[:svg {:id "screenshot"
:view-box vbox
:width width
:height height
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
;; Fix Chromium bug about color of html texts
;; https://bugs.chromium.org/p/chromium/issues/detail?id=1244560#c5
:style {:-webkit-print-color-adjust :exact}}
[:& ff/fontfaces-style {:shapes all-children}]
(case (:type object)
:frame [:& frame-wrapper {:shape object :view-box vbox}]
:group [:> shape-container {:shape object}
[:& group-wrapper {:shape object}]]
[:& shape-wrapper {:shape object}])]
;; Auxiliary SVG for rendering text-shapes
(when render-texts?
(for [object text-shapes]
[:& (mf/provider muc/text-plain-colors-ctx) {:value true}
[:svg {:id (str "screenshot-text-" (:id object))
:view-box (str "0 0 " (:width object) " " (:height object))
:width (:width object)
:height (:height object)
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"}
[:& shape-wrapper {:shape (assoc object :x 0 :y 0)}]]]))]))
(defn- adapt-root-frame
[objects object-id]
(if (uuid/zero? object-id)
(let [object (get objects object-id)
shapes (cph/get-immediate-children objects)
srect (gsh/selection-rect shapes)
object (merge object (select-keys srect [:x :y :width :height]))
object (gsh/transform-shape object)
object (assoc object :fill-color "#f0f0f0")]
(assoc objects (:id object) object))
objects))
(mf/defc render-object
[{:keys [file-id page-id object-id render-texts? embed?] :as props}]
(let [objects (mf/use-state nil)]
(mf/with-effect [file-id page-id object-id]
(->> (rx/zip
(repo/query! :font-variants {:file-id file-id})
(repo/query! :trimmed-file {:id file-id :page-id page-id :object-id object-id}))
(rx/subs
(fn [[fonts {:keys [data]}]]
(when (seq fonts)
(st/emit! (df/fonts-fetched fonts)))
(let [objs (get-in data [:pages-index page-id :objects])
objs (adapt-root-frame objs object-id)]
(reset! objects objs)))))
(constantly nil))
(when @objects
[:& object-svg {:objects @objects
:object-id object-id
:embed? embed?
:render-texts? render-texts?
:zoom 1}])))
(mf/defc render-sprite
[{:keys [file-id component-id] :as props}]
(let [file (mf/use-state nil)]
(mf/with-effect [file-id]
(->> (repo/query! :file {:id file-id})
(rx/subs
(fn [result]
(reset! file result))))
(constantly nil))
(when @file
[:*
[:& render/components-sprite-svg {:data (:data @file) :embed true}
(when (some? component-id)
[:use {:x 0 :y 0
:xlinkHref (str "#" component-id)}])]
(when-not (some? component-id)
[:ul
(for [[id data] (get-in @file [:data :components])]
(let [url (str "#/render-sprite/" (:id @file) "?component-id=" id)]
[:li [:a {:href url} (:name data)]]))])])))

1
frontend/src/app/main/ui/routes.cljs
View file

@ -61,7 +61,6 @@
["/debug/icons-preview" :debug-icons-preview])
;; Used for export
["/render-object/:file-id/:page-id/:object-id" :render-object]
["/render-sprite/:file-id" :render-sprite]
["/dashboard/team/:team-id"

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

@ -11,6 +11,7 @@
[app.util.code-gen :as cg]
[app.util.dom :as dom]
[app.util.i18n :refer [tr]]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
(defn has-image? [shape]
@ -38,8 +39,6 @@
name (:name shape)
extension (dom/mtype->extension mtype)]
[:a.download-button {:target "_blank"
:download (if extension
(str name "." extension)
name)
:download (cond-> name extension (str/concat extension))
:href (cfg/resolve-file-media (-> shape :metadata))}
(tr "handoff.attributes.image.download")])])))

31
frontend/src/app/main/ui/viewer/shapes.cljs
View file

@ -390,34 +390,3 @@
:bool [:> bool-container {:shape shape :frame frame :objects objects}]
:svg-raw [:> svg-raw-container {:shape shape :frame frame :objects objects}])))))))
(mf/defc frame-svg
{::mf/wrap [mf/memo]}
[{:keys [objects frame zoom] :or {zoom 1} :as props}]
(let [modifier (-> (gpt/point (:x frame) (:y frame))
(gpt/negate)
(gmt/translate-matrix))
update-fn #(assoc-in %1 [%2 :modifiers :displacement] modifier)
frame-id (:id frame)
modifier-ids (into [frame-id] (cph/get-children-ids objects frame-id))
objects (reduce update-fn objects modifier-ids)
frame (assoc-in frame [:modifiers :displacement] modifier)
width (* (:width frame) zoom)
height (* (:height frame) zoom)
vbox (str "0 0 " (:width frame 0)
" " (:height frame 0))
wrapper (mf/use-memo
(mf/deps objects)
#(frame-container-factory objects))]
[:svg {:view-box vbox
:width width
:height height
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"}
[:& wrapper {:shape frame
:view-box vbox}]]))

8
frontend/src/app/main/ui/workspace/sidebar/options/menus/exports.cljs
View file

@ -30,7 +30,7 @@
state (mf/deref refs/export)
in-progress? (:in-progress state)
filename (when (seqable? exports)
sname (when (seqable? exports)
(let [shapes (wsh/lookup-shapes @st/state ids)
sname (-> shapes first :name)
suffix (-> exports first :suffix)]
@ -56,13 +56,13 @@
;; separatelly by the export-modal.
(let [defaults {:page-id page-id
:file-id file-id
:name filename
:name sname
:object-id (first ids)}
exports (mapv #(merge % defaults) exports)]
(if (= 1 (count exports))
(let [export (first exports)]
(st/emit! (de/request-simple-export {:export export :filename (:name export)})))
(st/emit! (de/request-multiple-export {:exports exports :filename filename})))))))
(st/emit! (de/request-simple-export {:export export})))
(st/emit! (de/request-multiple-export {:exports exports})))))))
;; TODO: maybe move to specific events for avoid to have this logic here?
add-export

248
frontend/src/app/render.cljs
View file

@ -7,25 +7,36 @@
(ns app.render
"The main entry point for UI part needed by the exporter."
(:require
[app.common.logging :as log]
[app.common.logging :as l]
[app.common.math :as mth]
[app.common.spec :as us]
[app.common.uri :as u]
[app.config :as cf]
[app.main.ui.render :as render]
[app.main.data.fonts :as df]
[app.main.render :as render]
[app.main.repo :as repo]
[app.main.store :as st]
[app.util.dom :as dom]
[app.util.globals :as glob]
[beicon.core :as rx]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[garden.core :refer [css]]
[rumext.alpha :as mf]))
(log/initialize!)
(log/set-level! :root :warn)
(log/set-level! :app :info)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SETUP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare reinit)
(l/initialize!)
(l/set-level! :root :warn)
(l/set-level! :app :info)
(declare ^:private render-object)
(declare ^:private render-single-object)
(declare ^:private render-components)
(declare ^:private render-objects)
(log/info :hint "Welcome to penpot (Export)"
(l/info :hint "Welcome to penpot (Export)"
:version (:full @cf/version)
:public-uri (str cf/public-uri))
@ -38,7 +49,8 @@
[]
(when-let [params (parse-params glob/location)]
(when-let [component (case (:route params)
"render-object" (render-object params)
"objects" (render-objects params)
"components" (render-components params)
nil)]
(mf/mount component (dom/get-element "app")))))
@ -55,23 +67,225 @@
[]
(reinit))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPONENTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ---- SINGLE OBJECT
(defn use-resource
"A general purpose hook for retrieve or subscribe to remote changes
using the reactive-streams mechanism mechanism.
It receives a function to execute for retrieve the stream that will
be used for creating the subscription. The function should be
stable, so is the responsability of the user of this hook to
properly memoize it.
TODO: this should be placed in some generic hooks namespace but his
right now is pending of refactor and it will be done later."
[f]
(let [[state ^js update-state!] (mf/useState {:loaded? false})]
(mf/with-effect [f]
(update-state! (fn [prev] (assoc prev :refreshing? true)))
(let [on-value (fn [data]
(update-state! #(-> %
(assoc :refreshing? false)
(assoc :loaded? true)
(merge data))))
subs (rx/subscribe (f) on-value)]
#(rx/dispose! subs)))
state))
(mf/defc object-svg
[{:keys [page-id file-id object-id render-embed? render-texts?]}]
(let [fetch-state (mf/use-fn
(mf/deps file-id page-id object-id)
(fn []
(->> (rx/zip
(repo/query! :font-variants {:file-id file-id})
(repo/query! :page {:file-id file-id
:page-id page-id
:object-id object-id
:prune-thumbnails true}))
(rx/tap (fn [[fonts]]
(when (seq fonts)
(st/emit! (df/fonts-fetched fonts)))))
(rx/map (comp :objects second))
(rx/map (fn [objects]
(let [objects (render/adapt-objects-for-shape objects object-id)
bounds (render/get-object-bounds objects object-id)
object (get objects object-id)]
{:objects objects
:object (merge object bounds)}))))))
{:keys [objects object]} (use-resource fetch-state)]
;; Set the globa CSS to assign the page size, needed for PDF
;; exportation process.
(mf/with-effect [object]
(when object
(dom/set-page-style!
{:size (str/concat
(mth/ceil (:width object)) "px "
(mth/ceil (:height object)) "px")})))
(when objects
[:& render/object-svg
{:objects objects
:object object
:render-embed? render-embed?
:render-texts? render-texts?
:zoom 1}])))
(mf/defc objects-svg
[{:keys [page-id file-id object-ids render-embed? render-texts?]}]
(let [fetch-state (mf/use-fn
(mf/deps file-id page-id)
(fn []
(->> (rx/zip
(repo/query! :font-variants {:file-id file-id})
(repo/query! :page {:file-id file-id
:page-id page-id
:prune-thumbnails true}))
(rx/tap (fn [[fonts]]
(when (seq fonts)
(st/emit! (df/fonts-fetched fonts)))))
(rx/map (comp :objects second)))))
objects (use-resource fetch-state)]
(when objects
(for [object-id object-ids]
(let [objects (render/adapt-objects-for-shape objects object-id)
bounds (render/get-object-bounds objects object-id)
object (merge (get objects object-id) bounds)]
[:& render/object-svg
{:objects objects
:key (str object-id)
:object object
:render-embed? render-embed?
:render-texts? render-texts?
:zoom 1}])))))
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::object-id
(s/or :single ::us/uuid
:multiple (s/coll-of ::us/uuid)))
(s/def ::render-text ::us/boolean)
(s/def ::embed ::us/boolean)
(s/def ::render-object-params
(s/def ::render-objects
(s/keys :req-un [::file-id ::page-id ::object-id]
:opt-un [::render-text ::embed]))
:opt-un [::render-text ::render-embed]))
(defn- render-object
(defn- render-objects
[params]
(let [{:keys [page-id file-id object-id render-texts embed]} (us/conform ::render-object-params params)]
(let [{:keys [file-id
page-id
render-embed
render-texts]
:as params}
(us/conform ::render-objects params)
[type object-id] (:object-id params)]
(case type
:single
(mf/html
[:& render/render-object
[:& object-svg
{:file-id file-id
:page-id page-id
:object-id object-id
:embed? embed
:render-texts? render-texts}])))
:render-embed? render-embed
:render-texts? render-texts}])
:multiple
(mf/html
[:& objects-svg
{:file-id file-id
:page-id page-id
:object-ids (into #{} object-id)
:render-embed? render-embed
:render-texts? render-texts}]))))
;; ---- COMPONENTS SPRITE
(mf/defc components-sprite-svg
[{:keys [file-id embed] :as props}]
(let [fetch (mf/use-fn
(mf/deps file-id)
(fn [] (repo/query! :file {:id file-id})))
file (use-resource fetch)
state (mf/use-state nil)]
(when file
[:*
[:style
(css [[:body
{:margin 0
:overflow "hidden"
:width "100vw"
:height "100vh"}]
[:main
{:overflow "auto"
:display "flex"
:justify-content "center"
:align-items "center"
:height "calc(100vh - 200px)"}
[:svg {:width "50%"
:height "50%"}]]
[:.nav
{:display "flex"
:margin 0
:padding "10px"
:flex-direction "column"
:flex-wrap "wrap"
:height "200px"
:list-style "none"
:overflow-x "scroll"
:border-bottom "1px dotted #e6e6e6"}
[:a {:cursor :pointer
:text-overflow "ellipsis"
:white-space "nowrap"
:overflow "hidden"
:text-decoration "underline"}]
[:li {:display "flex"
:width "150px"
:padding "5px"
:border "0px solid black"}]]])]
[:ul.nav
(for [[id data] (get-in file [:data :components])]
(let [on-click (fn [event]
(dom/prevent-default event)
(swap! state assoc :component-id id))]
[:li {:key (str id)}
[:a {:on-click on-click} (:name data)]]))]
[:main
[:& render/components-sprite-svg
{:data (:data file)
:embed embed}
(when-let [component-id (:component-id @state)]
[:use {:x 0 :y 0 :xlinkHref (str "#" component-id)}])]]
])))
(s/def ::component-id ::us/uuid)
(s/def ::render-components
(s/keys :req-un [::file-id]
:opt-un [::embed ::component-id]))
(defn render-components
[params]
(let [{:keys [file-id component-id embed]} (us/conform ::render-components params)]
(mf/html
[:& components-sprite-svg
{:file-id file-id
:component-id component-id
:embed embed}])))

24
frontend/src/app/util/dom.cljs
View file

@ -403,16 +403,16 @@
(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"
"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]
@ -466,8 +466,8 @@
[filename mtype uri]
(let [link (create-element "a")
extension (mtype->extension mtype)
filename (if extension
(str filename "." extension)
filename (if (and extension (not (str/ends-with? filename extension)))
(str/concat filename "." extension)
filename)]
(obj/set! link "href" uri)
(obj/set! link "download" filename)

2
frontend/src/app/worker/export.cljs
View file

@ -135,7 +135,7 @@
(rx/map #(assoc % :file-id file-id))
(rx/flat-map
(fn [media]
(let [file-path (str file-id "/media/" (:id media) "." (dom/mtype->extension (:mtype media)))]
(let [file-path (str/concat file-id "/media/" (:id media) (dom/mtype->extension (:mtype media)))]
(->> (http/send!
{:uri (cfg/resolve-file-media media)
:response-type :blob

2
frontend/src/app/worker/import.cljs
View file

@ -48,7 +48,7 @@
:typographies (str file-id "/typographies.json")
:media-list (str file-id "/media.json")
:media (let [ext (dom/mtype->extension (:mtype media))]
(str file-id "/media/" id "." ext))
(str/concat file-id "/media/" id ext))
:components (str file-id "/components.svg"))
parse-svg? (and (not= type :media) (str/ends-with? path "svg"))

10
frontend/src/app/worker/thumbnails.cljs
View file

@ -56,15 +56,16 @@
:uri (u/join (cfg/get-public-uri) path)
:credentials "include"
:query params}]
(->> (http/send! request)
(rx/map http/conditional-decode-transit)
(rx/mapcat handle-response))))
(defn- render-thumbnail
[{:keys [data file-id revn] :as params}]
(let [elem (if-let [frame (:thumbnail-frame data)]
(mf/element render/frame-svg #js {:objects (:objects data) :frame frame})
(mf/element render/page-svg #js {:data data :width "290" :height "150" :thumbnails? true}))]
[{:keys [page file-id revn] :as params}]
(let [elem (if-let [frame (:thumbnail-frame page)]
(mf/element render/frame-svg #js {:objects (:objects page) :frame frame})
(mf/element render/page-svg #js {:data page :thumbnails? true}))]
{:data (rds/renderToStaticMarkup elem)
:fonts @fonts/loaded
:file-id file-id
@ -81,6 +82,7 @@
:uri (u/join (cfg/get-public-uri) path)
:credentials "include"
:body (http/transit-data params)}]
(->> (http/send! request)
(rx/map http/conditional-decode-transit)
(rx/mapcat handle-response)