3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-26 06:46:13 +02:00
Code Issues Projects Releases Packages Wiki Activity

Merge pull request #6419 from penpot/niwinz-refactor-library

Browse source 
♻️ Refactor penpot library
This commit is contained in:
Alejandro Alonso 2025-05-12 11:47:00 +02:00 • committed by GitHub
commit 0828994840
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
43 changed files with 1305 additions and 3993 deletions
Download patch file Download diff file Expand all files Collapse all files

281
frontend/src/app/libs/file_builder.cljs
View file

@ -1,281 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.libs.file-builder
(:require
[app.common.data :as d]
[app.common.features :as cfeat]
[app.common.files.builder :as fb]
[app.common.media :as cm]
[app.common.types.components-list :as ctkl]
[app.common.uuid :as uuid]
[app.util.json :as json]
[app.util.webapi :as wapi]
[app.util.zip :as uz]
[app.worker.export :as e]
[beicon.v2.core :as rx]
[cuerdas.core :as str]
[promesa.core :as p]))
(defn parse-data [data]
(as-> data $
(js->clj $ :keywordize-keys true)
;; Transforms camelCase to kebab-case
(d/deep-mapm
(fn [[key value]]
(let [value (if (= (type value) js/Symbol)
(keyword (js/Symbol.keyFor value))
value)
key (-> key d/name str/kebab keyword)]
[key value])) $)))
(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)))
(defn parse-library-media
[[file-id media]]
(rx/merge
(let [markup
(->> (vals media)
(reduce e/collect-media {})
(json/encode))]
(rx/of (vector (str file-id "/media.json") markup)))
(->> (rx/from (vals media))
(rx/map #(assoc % :file-id file-id))
(rx/merge-map
(fn [media]
(let [file-path (str/concat file-id "/media/" (:id media) (cm/mtype->extension (:mtype media)))
blob (data-uri->blob (:uri media))]
(rx/of (vector file-path blob))))))))
(defn export-file
[file]
(let [file (assoc file
:name (:name file)
:file-name (:name file)
:is-shared false)
files-stream (->> (rx/of {(:id file) file})
(rx/share))
manifest-stream
(->> files-stream
(rx/map #(e/create-manifest (uuid/next) (:id file) :all % cfeat/default-features))
(rx/map (fn [a]
(vector "manifest.json" a))))
render-stream
(->> files-stream
(rx/merge-map vals)
(rx/merge-map e/process-pages)
(rx/observe-on :async)
(rx/merge-map e/get-page-data)
(rx/share))
colors-stream
(->> files-stream
(rx/merge-map vals)
(rx/map #(vector (:id %) (get-in % [:data :colors])))
(rx/filter #(d/not-empty? (second %)))
(rx/map e/parse-library-color))
typographies-stream
(->> files-stream
(rx/merge-map vals)
(rx/map #(vector (:id %) (get-in % [:data :typographies])))
(rx/filter #(d/not-empty? (second %)))
(rx/map e/parse-library-typographies))
media-stream
(->> files-stream
(rx/merge-map vals)
(rx/map #(vector (:id %) (get-in % [:data :media])))
(rx/filter #(d/not-empty? (second %)))
(rx/merge-map parse-library-media))
components-stream
(->> files-stream
(rx/merge-map vals)
(rx/filter #(d/not-empty? (ctkl/components-seq (:data %))))
(rx/merge-map e/parse-library-components))
pages-stream
(->> render-stream
(rx/map e/collect-page))]
(rx/merge
(->> render-stream
(rx/map #(hash-map
:type :progress
:file (:id file)
:data (str "Render " (:file-name %) " - " (:name %)))))
(->> (rx/merge
manifest-stream
pages-stream
components-stream
media-stream
colors-stream
typographies-stream)
(rx/reduce conj [])
(rx/with-latest-from files-stream)
(rx/merge-map (fn [[data _]]
(->> (uz/compress-files data)
(rx/map #(vector file %)))))))))
(deftype File [^:mutable file]
Object
(addPage [_ name]
(set! file (fb/add-page file {:name name}))
(str (:current-page-id file)))
(addPage [_ name options]
(set! file (fb/add-page file {:name name :options (parse-data options)}))
(str (:current-page-id file)))
(closePage [_]
(set! file (fb/close-page file)))
(addArtboard [_ data]
(set! file (fb/add-artboard file (parse-data data)))
(str (:last-id file)))
(closeArtboard [_]
(set! file (fb/close-artboard file)))
(addGroup [_ data]
(set! file (fb/add-group file (parse-data data)))
(str (:last-id file)))
(closeGroup [_]
(set! file (fb/close-group file)))
(addBool [_ data]
(set! file (fb/add-bool file (parse-data data)))
(str (:last-id file)))
(closeBool [_]
(set! file (fb/close-bool file)))
(createRect [_ data]
(set! file (fb/create-rect file (parse-data data)))
(str (:last-id file)))
(createCircle [_ data]
(set! file (fb/create-circle file (parse-data data)))
(str (:last-id file)))
(createPath [_ data]
(set! file (fb/create-path file (parse-data data)))
(str (:last-id file)))
(createText [_ data]
(set! file (fb/create-text file (parse-data data)))
(str (:last-id file)))
(createImage [_ data]
(set! file (fb/create-image file (parse-data data)))
(str (:last-id file)))
(createSVG [_ data]
(set! file (fb/create-svg-raw file (parse-data data)))
(str (:last-id file)))
(closeSVG [_]
(set! file (fb/close-svg-raw file)))
(addLibraryColor [_ data]
(set! file (fb/add-library-color file (parse-data data)))
(str (:last-id file)))
(updateLibraryColor [_ data]
(set! file (fb/update-library-color file (parse-data data)))
(str (:last-id file)))
(deleteLibraryColor [_ data]
(set! file (fb/delete-library-color file (parse-data data)))
(str (:last-id file)))
(addLibraryMedia [_ data]
(set! file (fb/add-library-media file (parse-data data)))
(str (:last-id file)))
(deleteLibraryMedia [_ data]
(set! file (fb/delete-library-media file (parse-data data)))
(str (:last-id file)))
(addLibraryTypography [_ data]
(set! file (fb/add-library-typography file (parse-data data)))
(str (:last-id file)))
(deleteLibraryTypography [_ data]
(set! file (fb/delete-library-typography file (parse-data data)))
(str (:last-id file)))
(startComponent [_ data]
(set! file (fb/start-component file (parse-data data)))
(str (:current-component-id file)))
(finishComponent [_]
(set! file (fb/finish-component file)))
(createComponentInstance [_ data]
(set! file (fb/create-component-instance file (parse-data data)))
(str (:last-id file)))
(lookupShape [_ shape-id]
(clj->js (fb/lookup-shape file (uuid/parse shape-id))))
(updateObject [_ id new-obj]
(let [old-obj (fb/lookup-shape file (uuid/parse id))
new-obj (d/deep-merge old-obj (parse-data new-obj))]
(set! file (fb/update-object file old-obj new-obj))))
(deleteObject [_ id]
(set! file (fb/delete-object file (uuid/parse id))))
(getId [_]
(:id file))
(getCurrentPageId [_]
(:current-page-id file))
(asMap [_]
(clj->js file))
(newId [_]
(uuid/next))
(export [_]
(p/create
(fn [resolve reject]
(->> (export-file file)
(rx/filter #(not= (:type %) :progress))
(rx/take 1)
(rx/subs!
(fn [value]
(let [[_ export-blob] value]
(resolve export-blob)))
reject))))))
(defn create-file-export [^string name]
(binding [cfeat/*current* cfeat/default-features]
(File. (fb/create-file name))))
(defn exports []
#js {:createFile create-file-export})

28
frontend/src/app/libs/render.cljs
View file

@ -1,28 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.libs.render
(:require
[app.common.uuid :as uuid]
[app.main.render :as r]
[beicon.v2.core :as rx]
[promesa.core :as p]))
(defn render-page-export
[file ^string page-id]
;; Better to expose the api as a promise to be consumed from JS
(let [page-id (uuid/parse page-id)
file-data (.-file file)
data (get-in file-data [:data :pages-index page-id])]
(p/create
(fn [resolve reject]
(->> (r/render-page data)
(rx/take 1)
(rx/subs! resolve reject))))))
(defn exports []
#js {:renderPage render-page-export})

21
frontend/src/app/main/data/workspace.cljs
View file

@ -771,17 +771,16 @@
;; --- Update Shape Attrs
;; FIXME: rename to update-shape-generic-attrs because on the end we
;; only allow here to update generic attrs
(defn update-shape
[id attrs]
(dm/assert!
"expected valid parameters"
(and (cts/check-shape-attrs! attrs)
(uuid? id)))
(ptk/reify ::update-shape
ptk/WatchEvent
(watch [_ _ _]
(rx/of (dwsh/update-shapes [id] #(merge % attrs))))))
(assert (uuid? id) "expected valid uuid for `id`")
(let [attrs (cts/check-shape-generic-attrs attrs)]
(ptk/reify ::update-shape
ptk/WatchEvent
(watch [_ _ _]
(rx/of (dwsh/update-shapes [id] #(merge % attrs)))))))
(defn start-rename-shape
"Start shape renaming process"
@ -832,10 +831,6 @@
(defn update-selected-shapes
[attrs]
(dm/assert!
"expected valid shape attrs"
(cts/check-shape-attrs! attrs))
(ptk/reify ::update-selected-shapes
ptk/WatchEvent
(watch [_ state _]

19
frontend/src/app/main/data/workspace/bool.cljs
View file

@ -12,7 +12,6 @@
[app.common.geom.shapes :as gsh]
[app.common.types.component :as ctc]
[app.common.types.container :as ctn]
[app.common.types.path :as path]
[app.common.types.path.bool :as bool]
[app.common.types.shape :as cts]
[app.common.types.shape.layout :as ctl]
@ -30,9 +29,6 @@
(let [shape-id
(or id (uuid/next))
shapes
(mapv #(path/convert-to-path % objects) shapes)
head
(if (= type :difference) (first shapes) (last shapes))
@ -48,13 +44,13 @@
:frame-id (:frame-id head)
:parent-id (:parent-id head)
:name name
:shapes (mapv :id shapes)}
:shapes (vec shapes)}
shape
(-> shape
(merge (select-keys head bool/style-properties))
(cts/setup-shape)
(gsh/update-bool shapes objects))]
(gsh/update-bool objects))]
[shape (cph/get-position-on-parent objects (:id head))]))
@ -108,19 +104,16 @@
(defn group->bool
[type group objects]
(let [shapes (->> (:shapes group)
(map #(get objects %))
(mapv #(path/convert-to-path % objects)))
(map (d/getf objects)))
head (if (= type :difference) (first shapes) (last shapes))
head (cond-> head
(and (contains? head :svg-attrs) (empty? (:fills head)))
(assoc :fills bool/default-fills))
head-data (select-keys head bool/style-properties)]
(assoc :fills bool/default-fills))]
(-> group
(assoc :type :bool)
(assoc :bool-type type)
(merge head-data)
(gsh/update-bool shapes objects))))
(merge (select-keys head bool/style-properties))
(gsh/update-bool objects))))
(defn group-to-bool
[shape-id type]

51
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -254,20 +254,17 @@
(defn add-media
[media]
(dm/assert!
"expected valid media object"
(ctf/check-media-object! media))
(let [media (ctf/check-media-object media)]
(ptk/reify ::add-media
ev/Event
(-data [_] media)
(ptk/reify ::add-media
ev/Event
(-data [_] media)
ptk/WatchEvent
(watch [it _ _]
(let [obj (select-keys media [:id :name :width :height :mtype])
changes (-> (pcb/empty-changes it)
(pcb/add-media obj))]
(rx/of (dch/commit-changes changes))))))
ptk/WatchEvent
(watch [it _ _]
(let [obj (select-keys media [:id :name :width :height :mtype])
changes (-> (pcb/empty-changes it)
(pcb/add-media obj))]
(rx/of (dch/commit-changes changes)))))))
(defn rename-media
[id new-name]
@ -297,10 +294,7 @@
(defn delete-media
[{:keys [id]}]
(dm/assert!
"expected valid uuid for `id`"
(uuid? id))
(assert (uuid? id) "expected valid uuid for `id`")
(ptk/reify ::delete-media
ev/Event
(-data [_] {:id id})
@ -316,11 +310,8 @@
(defn add-typography
([typography] (add-typography typography true))
([typography edit?]
(let [typography (update typography :id #(or % (uuid/next)))]
(dm/assert!
"expected valid typography"
(ctt/check-typography! typography))
(let [typography (-> (update typography :id #(or % (uuid/next)))
(ctt/check-typography))]
(ptk/reify ::add-typography
ev/Event
(-data [_] typography)
@ -349,16 +340,12 @@
(defn update-typography
[typography file-id]
(dm/assert!
"expected valid typography and file-id"
(and (ctt/check-typography! typography)
(uuid? file-id)))
(ptk/reify ::update-typography
ptk/WatchEvent
(watch [it state _]
(do-update-tipography it state typography file-id))))
(assert (uuid? file-id) "expected valid uuid for `file-id`")
(let [typography (ctt/check-typography typography)]
(ptk/reify ::update-typography
ptk/WatchEvent
(watch [it state _]
(do-update-tipography it state typography file-id)))))
(defn rename-typography
[file-id id new-name]

46
frontend/src/app/main/data/workspace/shapes.cljs
View file

@ -110,9 +110,7 @@
(add-shape shape {}))
([shape {:keys [no-select? no-update-layout?]}]
(dm/assert!
"expected valid shape"
(cts/check-shape! shape))
(cts/check-shape shape)
(ptk/reify ::add-shape
ptk/WatchEvent
@ -293,30 +291,28 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn update-shape-flags
[ids {:keys [blocked hidden undo-group] :as flags}]
(dm/assert!
"expected valid coll of uuids"
(every? uuid? ids))
[ids flags]
(assert (every? uuid? ids)
"expected valid coll of uuids")
(dm/assert!
"expected valid shape-attrs value for `flags`"
(cts/check-shape-attrs! flags))
(let [{:keys [blocked hidden undo-group]}
(cts/check-shape-generic-attrs flags)]
(ptk/reify ::update-shape-flags
ptk/WatchEvent
(watch [_ state _]
(let [update-fn
(fn [obj]
(cond-> obj
(boolean? blocked) (assoc :blocked blocked)
(boolean? hidden) (assoc :hidden hidden)))
objects (dsh/lookup-page-objects state)
;; We have change only the hidden behaviour, to hide only the
;; selected shape, block behaviour remains the same.
ids (if (boolean? blocked)
(into ids (->> ids (mapcat #(cfh/get-children-ids objects %))))
ids)]
(rx/of (update-shapes ids update-fn {:attrs #{:blocked :hidden} :undo-group undo-group}))))))
(ptk/reify ::update-shape-flags
ptk/WatchEvent
(watch [_ state _]
(let [update-fn
(fn [obj]
(cond-> obj
(boolean? blocked) (assoc :blocked blocked)
(boolean? hidden) (assoc :hidden hidden)))
objects (dsh/lookup-page-objects state)
;; We have change only the hidden behaviour, to hide only the
;; selected shape, block behaviour remains the same.
ids (if (boolean? blocked)
(into ids (->> ids (mapcat #(cfh/get-children-ids objects %))))
ids)]
(rx/of (update-shapes ids update-fn {:attrs #{:blocked :hidden} :undo-group undo-group})))))))
(defn toggle-visibility-selected
[]

14
frontend/src/app/main/data/workspace/tokens/library_edit.cljs
View file

@ -51,15 +51,13 @@
;; TODO HYMA: Copied over from workspace.cljs
(defn update-shape
[id attrs]
(dm/assert!
"expected valid parameters"
(and (cts/check-shape-attrs! attrs)
(uuid? id)))
(assert (uuid? id) "expected valid uuid for `id`")
(ptk/reify ::update-shape
ptk/WatchEvent
(watch [_ _ _]
(rx/of (dwsh/update-shapes [id] #(merge % attrs))))))
(let [attrs (cts/check-shape-attrs attrs)]
(ptk/reify ::update-shape
ptk/WatchEvent
(watch [_ _ _]
(rx/of (dwsh/update-shapes [id] #(merge % attrs)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TOKENS Actions

6
frontend/src/app/main/fonts.cljs
View file

@ -214,15 +214,15 @@
(nil? font)
(p/resolved font-id)
;; Font already loaded, we just continue
;; Font already loaded, we just continue
(contains? @loaded font-id)
(p/resolved font-id)
;; Font is currently downloading. We attach the caller to the promise
;; Font is currently downloading. We attach the caller to the promise
(contains? @loading font-id)
(get @loading font-id)
;; First caller, we create the promise and then wait
;; First caller, we create the promise and then wait
:else
(let [on-load (fn [resolve]
(swap! loaded conj font-id)

47
frontend/src/app/util/object.cljc
View file

@ -6,7 +6,7 @@
(ns app.util.object
"A collection of helpers for work with javascript objects."
(:refer-clojure :exclude [set! new get merge clone contains? array? into-array reify])
(:refer-clojure :exclude [set! new get merge clone contains? array? into-array reify class])
#?(:cljs (:require-macros [app.util.object]))
(:require
[clojure.core :as c]))
@ -93,6 +93,51 @@
(when (some? obj)
(js* "Object.entries(~{}).reduce((a, [k,v]) => (v == null ? a : (a[k]=v, a)), {}) " obj))))
#?(:cljs
(defn plain-object?
^boolean
[o]
(and (some? o)
(identical? (.getPrototypeOf js/Object o)
(.-prototype js/Object)))))
;; EXPERIMENTAL: unsafe, does not checks and not validates the input,
;; should be improved over time, for now it works for define a class
;; extending js/Error that is more than enought for a first, quick and
;; dirty macro impl for generating classes.
(defmacro class
"Create a class instance"
[& {:keys [name extends constructor]}]
(let [params
(if (and constructor (= 'fn (first constructor)))
(into [] (drop 1) (second constructor))
[])
constructor-sym
(symbol name)
constructor
(if constructor
constructor
`(fn ~name [~'this]
(.call ~extends ~'this)))]
`(let [konstructor# ~constructor
extends# ~extends
~constructor-sym
(fn ~constructor-sym ~params
(cljs.core/this-as ~'this
(konstructor# ~'this ~@params)))]
(set! (.-prototype ~constructor-sym)
(js/Object.create (.-prototype extends#)))
(set! (.-constructor (.-prototype ~constructor-sym))
konstructor#)
~constructor-sym)))
(defmacro add-properties!
"Adds properties to an object using `.defineProperty`"
[rsym & properties]

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

@ -8,16 +8,10 @@
(:refer-clojure :exclude [resolve])
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.files.builder :as fb]
[app.common.geom.point :as gpt]
[app.common.json :as json]
[app.common.logging :as log]
[app.common.media :as cm]
[app.common.schema :as sm]
[app.common.text :as ct]
[app.common.time :as tm]
[app.common.types.path :as path]
[app.common.uuid :as uuid]
[app.main.repo :as rp]
[app.util.http :as http]
@ -25,10 +19,8 @@
[app.util.sse :as sse]
[app.util.zip :as uz]
[app.worker.impl :as impl]
[app.worker.import.parser :as parser]
[beicon.v2.core :as rx]
[cuerdas.core :as str]
[tubax.core :as tubax]))
[cuerdas.core :as str]))
(log/set-level! :warn)
@ -37,185 +29,12 @@
(def conjv (fnil conj []))
(def ^:private iso-date-rx
"Incomplete ISO regex for detect datetime-like values on strings"
#"^\d{4}-[01]\d-[0-3]\dT[0-2]\d:[0-5]\d:[0-5]\d.*")
(defn read-json-key
[m]
(or (uuid/parse m)
(json/read-kebab-key m)))
(defn read-json-val
[m]
(cond
(and (string? m)
(re-matches uuid/regex m))
(uuid/uuid m)
(and (string? m)
(re-matches iso-date-rx m))
(or (ex/ignoring (tm/parse-instant m)) m)
:else
m))
(defn get-file
"Resolves the file inside the context given its id and the
data. LEGACY"
([context type]
(get-file context type nil nil))
([context type id]
(get-file context type id nil))
([context type id media]
(let [file-id (:file-id context)
path (case type
:manifest "manifest.json"
:page (str file-id "/" id ".svg")
:colors-list (str file-id "/colors.json")
:colors (let [ext (cm/mtype->extension (:mtype media))]
(str/concat file-id "/colors/" id ext))
:typographies (str file-id "/typographies.json")
:media-list (str file-id "/media.json")
:media (let [ext (cm/mtype->extension (:mtype media))]
(str/concat file-id "/media/" id ext))
:components (str file-id "/components.svg")
:deleted-components (str file-id "/deleted-components.svg"))
parse-svg? (and (not= type :media) (str/ends-with? path "svg"))
parse-json? (and (not= type :media) (str/ends-with? path "json"))
file-type (if (or parse-svg? parse-json?) "text" "blob")]
(log/debug :action "parsing" :path path)
(let [stream (->> (uz/get-file (:zip context) path file-type)
(rx/map :content))]
(cond
parse-svg?
(rx/map tubax/xml->clj stream)
parse-json?
(rx/map #(json/decode % :key-fn read-json-key :val-fn read-json-val) stream)
:else
stream)))))
(defn- read-zip-manifest
[zipfile]
(->> (uz/get-file zipfile "manifest.json")
(rx/map :content)
(rx/map json/decode)))
(defn progress!
([context type]
(assert (keyword? type))
(progress! context type nil nil nil))
([context type file]
(assert (keyword? type))
(assert (string? file))
(progress! context type file nil nil))
([context type current total]
(assert (keyword? type))
(assert (number? current))
(assert (number? total))
(progress! context type nil current total))
([context type file current total]
(when (and context (contains? context :progress))
(let [progress {:type type
:file file
:current current
:total total}]
(log/debug :status :progress :progress progress)
(rx/push! (:progress context) {:file-id (:file-id context)
:status :progress
:progress progress})))))
(defn resolve-factory
"Creates a wrapper around the atom to remap ids to new ids and keep
their relationship so they ids are coherent."
[]
(let [id-mapping-atom (atom {})
resolve
(fn [id-mapping id]
(assert (uuid? id) (str id))
(get id-mapping id))
set-id
(fn [id-mapping id]
(assert (uuid? id) (str id))
(cond-> id-mapping
(nil? (resolve id-mapping id))
(assoc id (uuid/next))))]
(fn [id]
(when (some? id)
(swap! id-mapping-atom set-id id)
(resolve @id-mapping-atom id)))))
(defn create-file
"Create a new file on the back-end"
[context features]
(let [resolve-fn (:resolve context)
file-id (resolve-fn (:file-id context))]
(rp/cmd! :create-temp-file
{:id file-id
:name (:name context)
:is-shared (:is-shared context)
:project-id (:project-id context)
:create-page false
;; If the features object exists send that. Otherwise we remove the components/v2 because
;; if the features attribute doesn't exist is a version < 2.0. The other features will
;; be kept so the shapes are created full featured
:features (d/nilv (:features context) (disj features "components/v2"))})))
(defn link-file-libraries
"Create a new file on the back-end"
[context]
(let [resolve (:resolve context)
file-id (resolve (:file-id context))
libraries (->> context :libraries (mapv resolve))]
(->> (rx/from libraries)
(rx/map #(hash-map :file-id file-id :library-id %))
(rx/merge-map (partial rp/cmd! :link-file-to-library)))))
(defn send-changes
"Creates batches of changes to be sent to the backend"
[context file]
(let [file-id (:id file)
session-id (uuid/next)
changes (fb/generate-changes file)
batches (->> changes
(partition change-batch-size change-batch-size nil)
(mapv vec))
processed (atom 0)
total (count batches)]
(rx/concat
(->> (rx/from (d/enumerate batches))
(rx/merge-map
(fn [[i change-batch]]
(->> (rp/cmd! :update-temp-file
{:id file-id
:session-id session-id
:revn i
:changes change-batch})
(rx/tap #(do (swap! processed inc)
(progress! context :upload-data @processed total))))))
(rx/map first)
(rx/ignore))
(->> (rp/cmd! :persist-temp-file {:id file-id})
;; We use merge to keep some information not stored in back-end
(rx/map #(merge file %))))))
(defn slurp-uri
([uri] (slurp-uri uri :text))
([uri response-type]
@ -225,26 +44,6 @@
:method :get})
(rx/map :body))))
(defn upload-media-files
"Upload a image to the backend and returns its id"
[context file-id name data-uri]
(log/debug :action "Uploading" :file-id file-id :name name)
(->> (http/send!
{:uri data-uri
:response-type :blob
:method :get})
(rx/map :body)
(rx/map
(fn [blob]
{:name name
:file-id file-id
:content blob
:is-local true}))
(rx/tap #(progress! context :upload-media name))
(rx/merge-map #(rp/cmd! :upload-file-media-object %))))
(defn resolve-text-content
[node context]
(let [resolve (:resolve context)]
@ -290,456 +89,6 @@
(uuid? (get fill :stroke-color-ref-file))
(d/update-when :stroke-color-ref-file resolve)))))))
(defn resolve-data-ids
[data type context]
(let [resolve (:resolve context)]
(-> data
(d/update-when :fill-color-ref-id resolve)
(d/update-when :fill-color-ref-file resolve)
(d/update-when :stroke-color-ref-id resolve)
(d/update-when :stroke-color-ref-file resolve)
(d/update-when :component-id resolve)
(d/update-when :component-file resolve)
(d/update-when :shape-ref resolve)
(cond-> (= type :text)
(d/update-when :content resolve-text-content context))
(cond-> (:fills data)
(d/update-when :fills resolve-fills-content context))
(cond-> (:strokes data)
(d/update-when :strokes resolve-strokes-content context))
(cond-> (and (= type :frame) (= :grid (:layout data)))
(update
:layout-grid-cells
(fn [cells]
(->> (vals cells)
(reduce (fn [cells {:keys [id shapes]}]
(assoc-in cells [id :shapes] (mapv resolve shapes)))
cells))))))))
(defn- translate-frame
[data type file]
(let [frame-id (:current-frame-id file)
frame (when (and (some? frame-id) (not= frame-id uuid/zero))
(fb/lookup-shape file frame-id))]
(if (some? frame)
(-> data
(d/update-when :x + (:x frame))
(d/update-when :y + (:y frame))
(cond-> (= :path type)
(update :content path/move-content (gpt/point (:x frame) (:y frame)))))
data)))
(defn process-import-node
[context file node]
(let [type (parser/get-type node)
close? (parser/close? node)]
(if close?
(case type
:frame (fb/close-artboard file)
:group (fb/close-group file)
:bool (fb/close-bool file)
:svg-raw (fb/close-svg-raw file)
#_default file)
(let [resolve (:resolve context)
old-id (parser/get-id node)
interactions (->> (parser/parse-interactions node)
(mapv #(update % :destination resolve)))
data (-> (parser/parse-data type node)
(resolve-data-ids type context)
(cond-> (some? old-id)
(assoc :id (resolve old-id)))
(cond-> (< (:version context 1) 2)
(translate-frame type file))
;; Shapes inside the deleted component should be stored with absolute coordinates
;; so we calculate that with the x and y stored in the context
(cond-> (:x context)
(assoc :x (:x context)))
(cond-> (:y context)
(assoc :y (:y context))))]
(try
(let [file (case type
:frame (fb/add-artboard file data)
:group (fb/add-group file data)
:bool (fb/add-bool file data)
:rect (fb/create-rect file data)
:circle (fb/create-circle file data)
:path (fb/create-path file data)
:text (fb/create-text file data)
:image (fb/create-image file data)
:svg-raw (fb/create-svg-raw file data)
#_default file)]
;; We store this data for post-processing after every shape has been
;; added
(cond-> file
(d/not-empty? interactions)
(assoc-in [:interactions (:id data)] interactions)))
(catch :default err
(log/error :hint (ex-message err) :cause err :js/data data)
(update file :errors conjv data)))))))
(defn setup-interactions
[file]
(letfn [(add-interactions
[file [id interactions]]
(->> interactions
(reduce #(fb/add-interaction %1 id %2) file)))
(process-interactions
[file]
(let [interactions (:interactions file)
file (dissoc file :interactions)]
(->> interactions (reduce add-interactions file))))]
(-> file process-interactions)))
(defn resolve-media
[context file-id node]
(if (or (and (not (parser/close? node))
(parser/has-image? node))
(parser/has-stroke-images? node)
(parser/has-fill-images? node))
(let [name (parser/get-image-name node)
has-image (parser/has-image? node)
image-data (parser/get-image-data node)
image-fill (parser/get-image-fill node)
fill-images-data (->> (parser/get-fill-images-data node)
(map #(assoc % :type :fill)))
stroke-images-data (->> (parser/get-stroke-images-data node)
(map #(assoc % :type :stroke)))
images-data (concat
fill-images-data
stroke-images-data
(when has-image
[{:href image-data}]))]
(->> (rx/from images-data)
(rx/mapcat (fn [image-data]
(->> (upload-media-files context file-id name (:href image-data))
(rx/catch #(do (.error js/console "Error uploading media: " name)
(rx/of node)))
(rx/map (fn [data]
(let [data
(cond-> data
(some? (:keep-aspect-ratio image-data))
(assoc :keep-aspect-ratio (:keep-aspect-ratio image-data)))]
[(:id image-data) data]))))))
(rx/reduce (fn [acc [id data]] (assoc acc id data)) {})
(rx/map
(fn [images]
(let [media (get images nil)]
(-> node
(assoc :images images)
(cond-> (some? media)
(->
(assoc-in [:attrs :penpot:media-id] (:id media))
(assoc-in [:attrs :penpot:media-width] (:width media))
(assoc-in [:attrs :penpot:media-height] (:height media))
(assoc-in [:attrs :penpot:media-mtype] (:mtype media))
(cond-> (some? (:keep-aspect-ratio media))
(assoc-in [:attrs :penpot:media-keep-aspect-ratio] (:keep-aspect-ratio media)))
(assoc-in [:attrs :penpot:fill-color] (:fill image-fill))
(assoc-in [:attrs :penpot:fill-color-ref-file] (:fill-color-ref-file image-fill))
(assoc-in [:attrs :penpot:fill-color-ref-id] (:fill-color-ref-id image-fill))
(assoc-in [:attrs :penpot:fill-opacity] (:fill-opacity image-fill))
(assoc-in [:attrs :penpot:fill-color-gradient] (:fill-color-gradient image-fill))))))))))
;; If the node is not an image just return the node
(->> (rx/of node)
(rx/observe-on :async))))
(defn media-node? [node]
(or (and (parser/shape? node)
(parser/has-image? node)
(not (parser/close? node)))
(parser/has-stroke-images? node)
(parser/has-fill-images? node)))
(defn import-page
[context file [page-id page-name content]]
(let [nodes (parser/node-seq content)
file-id (:id file)
resolve (:resolve context)
page-data (-> (parser/parse-page-data content)
(assoc :name page-name)
(assoc :id (resolve page-id)))
flows (->> (get page-data :flows)
(map #(update % :starting-frame resolve))
(d/index-by :id)
(not-empty))
guides (-> (get page-data :guides)
(update-vals #(update % :frame-id resolve))
(not-empty))
page-data (cond-> page-data
flows
(assoc :flows flows)
guides
(assoc :guides guides))
file (fb/add-page file page-data)
;; Preprocess nodes to parallel upload the images. Store the result in a table
;; old-node => node with image
;; that will be used in the second pass immediately
pre-process-images
(->> (rx/from nodes)
(rx/filter media-node?)
;; TODO: this should be merge-map, but we disable the
;; parallel upload until we resolve resource usage issues
;; on backend.
(rx/mapcat
(fn [node]
(->> (resolve-media context file-id node)
(rx/map (fn [result]
[node result])))))
(rx/reduce conj {}))]
(->> pre-process-images
(rx/merge-map
(fn [pre-proc]
(->> (rx/from nodes)
(rx/filter parser/shape?)
(rx/map (fn [node] (or (get pre-proc node) node)))
(rx/reduce (partial process-import-node context) file)
(rx/map (comp fb/close-page setup-interactions))))))))
(defn import-component [context file node]
(let [resolve (:resolve context)
content (parser/find-node node :g)
file-id (:id file)
old-id (parser/get-id node)
id (resolve old-id)
path (get-in node [:attrs :penpot:path] "")
type (parser/get-type content)
main-instance-id (resolve (uuid/parse (get-in node [:attrs :penpot:main-instance-id] "")))
main-instance-page (resolve (uuid/parse (get-in node [:attrs :penpot:main-instance-page] "")))
data (-> (parser/parse-data type content)
(assoc :path path)
(assoc :id id)
(assoc :main-instance-id main-instance-id)
(assoc :main-instance-page main-instance-page))
file (-> file (fb/start-component data type))
children (parser/node-seq node)]
(->> (rx/from children)
(rx/filter parser/shape?)
(rx/skip 1) ;; Skip the outer component and the respective closint tag
(rx/skip-last 1) ;; because they are handled in start-component an finish-component
(rx/mapcat (partial resolve-media context file-id))
(rx/reduce (partial process-import-node context) file)
(rx/map fb/finish-component))))
(defn import-deleted-component [context file node]
(let [resolve (:resolve context)
content (parser/find-node node :g)
file-id (:id file)
old-id (parser/get-id node)
id (resolve old-id)
path (get-in node [:attrs :penpot:path] "")
main-instance-id (resolve (uuid/parse (get-in node [:attrs :penpot:main-instance-id] "")))
main-instance-page (resolve (uuid/parse (get-in node [:attrs :penpot:main-instance-page] "")))
main-instance-x (-> (get-in node [:attrs :penpot:main-instance-x] "") (d/parse-double))
main-instance-y (-> (get-in node [:attrs :penpot:main-instance-y] "") (d/parse-double))
main-instance-parent (resolve (uuid/parse (get-in node [:attrs :penpot:main-instance-parent] "")))
main-instance-frame (resolve (uuid/parse (get-in node [:attrs :penpot:main-instance-frame] "")))
type (parser/get-type content)
data (-> (parser/parse-data type content)
(assoc :path path)
(assoc :id id)
(assoc :main-instance-id main-instance-id)
(assoc :main-instance-page main-instance-page)
(assoc :main-instance-x main-instance-x)
(assoc :main-instance-y main-instance-y)
(assoc :main-instance-parent main-instance-parent)
(assoc :main-instance-frame main-instance-frame))
file (-> file
(fb/start-component data)
(fb/start-deleted-component data))
component-id (:current-component-id file)
children (parser/node-seq node)
;; Shapes inside the deleted component should be stored with absolute coordinates so we include this info in the context.
context (-> context
(assoc :x main-instance-x)
(assoc :y main-instance-y))]
(->> (rx/from children)
(rx/filter parser/shape?)
(rx/skip 1)
(rx/skip-last 1)
(rx/mapcat (partial resolve-media context file-id))
(rx/reduce (partial process-import-node context) file)
(rx/map fb/finish-component)
(rx/map (partial fb/finish-deleted-component component-id)))))
(defn process-pages
[context file]
(let [index (:pages-index context)
get-page-data
(fn [page-id]
[page-id (get-in index [page-id :name])])
pages (->> (:pages context) (mapv get-page-data))]
(->> (rx/from pages)
(rx/tap (fn [[_ page-name]]
(progress! context :process-page page-name)))
(rx/mapcat
(fn [[page-id page-name]]
(->> (get-file context :page page-id)
(rx/map (fn [page-data] [page-id page-name page-data])))))
(rx/concat-reduce (partial import-page context) file))))
(defn process-library-colors
[context file]
(if (:has-colors context)
(let [resolve (:resolve context)
add-color
(fn [file color]
(let [color (-> color
(d/update-in-when [:gradient :type] keyword)
(d/update-in-when [:image :id] resolve)
(update :id resolve))]
(fb/add-library-color file color)))]
(->> (get-file context :colors-list)
(rx/merge-map identity)
(rx/mapcat
(fn [[id color]]
(let [color (assoc color :id id)
color-image (:image color)
upload-image? (some? color-image)
color-image-id (:id color-image)]
(if upload-image?
(->> (get-file context :colors color-image-id color-image)
(rx/map (fn [blob]
(let [content (.slice blob 0 (.-size blob) (:mtype color-image))]
{:name (:name color-image)
:id (resolve color-image-id)
:file-id (:id file)
:content content
:is-local false})))
(rx/tap #(progress! context :upload-media (:name %)))
(rx/merge-map #(rp/cmd! :upload-file-media-object %))
(rx/map (constantly color))
(rx/catch #(do (.error js/console (str "Error uploading color-image: " (:name color-image)))
(rx/empty))))
(rx/of color)))))
(rx/reduce add-color file)))
(rx/of file)))
(defn process-library-typographies
[context file]
(if (:has-typographies context)
(let [resolve (:resolve context)]
(->> (get-file context :typographies)
(rx/merge-map identity)
(rx/map (fn [[id typography]]
(-> typography
(d/kebab-keys)
(assoc :id (resolve id)))))
(rx/reduce fb/add-library-typography file)))
(rx/of file)))
(defn process-library-media
[context file]
(if (:has-media context)
(let [resolve (:resolve context)]
(->> (get-file context :media-list)
(rx/merge-map identity)
(rx/mapcat
(fn [[id media]]
(let [media (-> media
(assoc :id (resolve id))
(update :name str))]
(->> (get-file context :media id media)
(rx/map (fn [blob]
(let [content (.slice blob 0 (.-size blob) (:mtype media))]
{:name (:name media)
:id (:id media)
:file-id (:id file)
:content content
:is-local false})))
(rx/tap #(progress! context :upload-media (:name %)))
(rx/merge-map #(rp/cmd! :upload-file-media-object %))
(rx/map (constantly media))
(rx/catch #(do (.error js/console (str "Error uploading media: " (:name media)))
(rx/empty)))))))
(rx/reduce fb/add-library-media file)))
(rx/of file)))
(defn process-library-components
[context file]
(if (:has-components context)
(let [split-components
(fn [content] (->> (parser/node-seq content)
(filter #(= :symbol (:tag %)))))]
(->> (get-file context :components)
(rx/merge-map split-components)
(rx/concat-reduce (partial import-component context) file)))
(rx/of file)))
(defn process-deleted-components
[context file]
(if (:has-deleted-components context)
(let [split-components
(fn [content] (->> (parser/node-seq content)
(filter #(= :symbol (:tag %)))))]
(->> (get-file context :deleted-components)
(rx/merge-map split-components)
(rx/concat-reduce (partial import-deleted-component context) file)))
(rx/of file)))
(defn process-file
[context file]
(let [progress-str (rx/subject)
context (assoc context :progress progress-str)]
[progress-str
(->> (rx/of file)
(rx/merge-map (partial process-pages context))
(rx/tap #(progress! context :process-colors))
(rx/merge-map (partial process-library-colors context))
(rx/tap #(progress! context :process-typographies))
(rx/merge-map (partial process-library-typographies context))
(rx/tap #(progress! context :process-media))
(rx/merge-map (partial process-library-media context))
(rx/tap #(progress! context :process-components))
(rx/merge-map (partial process-library-components context))
(rx/tap #(progress! context :process-deleted-components))
(rx/merge-map (partial process-deleted-components context))
(rx/merge-map (partial send-changes context))
(rx/tap #(rx/end! progress-str)))]))
(defn create-files
[{:keys [system-features] :as context} files]
(let [data (group-by :file-id files)]
(rx/concat
(->> (rx/from files)
(rx/map #(merge context %))
(rx/merge-map (fn [context]
(->> (create-file context system-features)
(rx/map #(vector % (first (get data (:file-id context)))))))))
(->> (rx/from files)
(rx/map #(merge context %))
(rx/merge-map link-file-libraries)
(rx/ignore)))))
(defn parse-mtype [ba]
(let [u8 (js/Uint8Array. ba 0 4)
sg (areduce u8 i ret "" (str ret (if (zero? i) "" " ") (.toString (aget u8 i) 8)))]
@ -748,35 +97,6 @@
"1 13 32 206" "application/octet-stream"
"other")))
(defn- analyze-file-legacy-zip-entry
[features entry]
;; NOTE: LEGACY manifest reading mechanism, we can't
;; reuse the new read-zip-manifest funcion here
(->> (rx/from (uz/load (:body entry)))
(rx/merge-map #(get-file {:zip %} :manifest))
(rx/mapcat
(fn [manifest]
;; Checks if the file is exported with
;; components v2 and the current team
;; only supports components v1
(let [has-file-v2?
(->> (:files manifest)
(d/seek (fn [[_ file]] (contains? (set (:features file)) "components/v2"))))]
(if (and has-file-v2? (not (contains? features "components/v2")))
(rx/of (-> entry
(assoc :error "dashboard.import.analyze-error.components-v2")
(dissoc :body)))
(->> (rx/from (:files manifest))
(rx/map (fn [[file-id data]]
(-> entry
(dissoc :body)
(merge data)
(dissoc :shared)
(assoc :is-shared (:shared data))
(assoc :file-id file-id)
(assoc :status :success)))))))))))
;; NOTE: this is a limited subset schema for the manifest file of
;; binfile-v3 format; is used for partially parse it and read the
;; files referenced inside the exported file
@ -794,7 +114,7 @@
(sm/decoder schema:manifest sm/json-transformer))
(defn analyze-file
[features {:keys [uri] :as file}]
[{:keys [uri] :as file}]
(let [stream (->> (slurp-uri uri :buffer)
(rx/merge-map
(fn [body]
@ -819,10 +139,6 @@
(rx/share))]
(->> (rx/merge
(->> stream
(rx/filter (fn [entry] (= :legacy-zip (:type entry))))
(rx/merge-map (partial analyze-file-legacy-zip-entry features)))
(->> stream
(rx/filter (fn [entry] (= :binfile-v1 (:type entry))))
(rx/map (fn [entry]
@ -855,55 +171,16 @@
(rx/of (assoc file :error error :status :error))))))))
(defmethod impl/handler :analyze-import
[{:keys [files features]}]
[{:keys [files]}]
(->> (rx/from files)
(rx/merge-map (partial analyze-file features))))
(rx/merge-map analyze-file)))
(defmethod impl/handler :import-files
[{:keys [project-id files features]}]
(let [context {:project-id project-id
:resolve (resolve-factory)
:system-features features}
legacy-zip (filter #(= :legacy-zip (:type %)) files)
binfile-v1 (filter #(= :binfile-v1 (:type %)) files)
[{:keys [project-id files]}]
(let [binfile-v1 (filter #(= :binfile-v1 (:type %)) files)
binfile-v3 (filter #(= :binfile-v3 (:type %)) files)]
(rx/merge
;; NOTE: LEGACY, will be removed so no new development should be
;; done for this part
(->> (create-files context legacy-zip)
(rx/merge-map
(fn [[file data]]
(->> (uz/load-from-url (:uri data))
(rx/map #(-> context (assoc :zip %) (merge data)))
(rx/merge-map
(fn [context]
;; process file retrieves a stream that will emit progress notifications
;; and other that will emit the files once imported
(let [[progress-stream file-stream] (process-file context file)]
(rx/merge progress-stream
(->> file-stream
(rx/map
(fn [file]
(if-let [errors (not-empty (:errors file))]
{:status :error
:error (first errors)
:file-id (:file-id data)}
{:status :finish
:file-id (:file-id data)}))))))))
(rx/catch (fn [cause]
(let [data (ex-data cause)]
(log/error :hint (ex-message cause)
:file-id (:file-id data))
(when-let [explain (:explain data)]
(js/console.log explain)))
(rx/of {:status :error
:file-id (:file-id data)
:error (ex-message cause)})))))))
(->> (rx/from binfile-v1)
(rx/merge-map
(fn [data]

1167
frontend/src/app/worker/import/parser.cljs
View file

File diff suppressed because it is too large Load diff

250
frontend/src/lib/file_builder.cljs Normal file
View file

@ -0,0 +1,250 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns lib.file-builder
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.builder :as fb]
[app.common.json :as json]
[app.common.schema :as sm]
[app.common.uuid :as uuid]
[app.util.object :as obj]))
(def BuilderError
(obj/class
:name "BuilderError"
:extends js/Error
:constructor
(fn [this type code hint cause]
(.call js/Error this hint)
(set! (.-name this) (str "Exception: " hint))
(set! (.-type this) type)
(set! (.-code this) code)
(set! (.-hint this) hint)
(when (exists? js/Error.captureStackTrace)
(.captureStackTrace js/Error this))
(obj/add-properties!
this
{:name "cause"
:enumerable true
:this false
:get (fn [] cause)}
{:name "data"
:enumerable true
:this false
:get (fn []
(let [data (ex-data cause)]
(when-let [explain (::sm/explain data)]
(json/->js (sm/simplify explain)))))}))))
(defn- handle-exception
[cause]
(let [data (ex-data cause)]
(throw (new BuilderError
(d/name (get data :type :unknown))
(d/name (get data :code :unknown))
(or (get data :hint) (ex-message cause))
cause))))
(defn- decode-params
[params]
(if (obj/plain-object? params)
(json/->js params)
params))
(defn- create-file*
[file]
(let [state* (volatile! file)]
(obj/reify {:name "File"}
:id
{:get #(dm/str (:id @state*))}
:currentFrameId
{:get #(dm/str (::fb/current-frame-id @state*))}
:currentPageId
{:get #(dm/str (::fb/current-page-id @state*))}
:lastId
{:get #(dm/str (::fb/last-id @state*))}
:addPage
(fn [params]
(try
(let [params (-> params
(decode-params)
(fb/decode-page))]
(vswap! state* fb/add-page params)
(dm/str (::fb/current-page-id @state*)))
(catch :default cause
(handle-exception cause))))
:closePage
(fn []
(vswap! state* fb/close-page))
:addArtboard
(fn [params]
(try
(let [params (-> params
(json/->clj)
(assoc :type :frame)
(fb/decode-shape))]
(vswap! state* fb/add-artboard params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:closeArtboard
(fn []
(vswap! state* fb/close-artboard))
:addGroup
(fn [params]
(try
(let [params (-> params
(json/->clj)
(assoc :type :group)
(fb/decode-shape))]
(vswap! state* fb/add-group params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:closeGroup
(fn []
(vswap! state* fb/close-group))
:addBool
(fn [params]
(try
(let [params (-> params
(json/->clj)
(fb/decode-add-bool))]
(vswap! state* fb/add-bool params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:addRect
(fn [params]
(try
(let [params (-> params
(json/->clj)
(assoc :type :rect)
(fb/decode-shape))]
(vswap! state* fb/add-shape params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:addCircle
(fn [params]
(try
(let [params (-> params
(json/->clj)
(assoc :type :circle)
(fb/decode-shape))]
(vswap! state* fb/add-shape params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:addPath
(fn [params]
(try
(let [params (-> params
(json/->clj)
(assoc :type :path)
(fb/decode-shape))]
(vswap! state* fb/add-shape params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:addText
(fn [params]
(try
(let [params (-> params
(json/->clj)
(assoc :type :text)
(fb/decode-shape))]
(vswap! state* fb/add-shape params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:addLibraryColor
(fn [params]
(try
(let [params (-> params
(json/->clj)
(fb/decode-library-color)
(d/without-nils))]
(vswap! state* fb/add-library-color params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:addLibraryTypography
(fn [params]
(try
(let [params (-> params
(json/->clj)
(fb/decode-library-typography)
(d/without-nils))]
(vswap! state* fb/add-library-typography params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:addComponent
(fn [params]
(try
(let [params (-> params
(json/->clj)
(fb/decode-component)
(d/without-nils))]
(vswap! state* fb/add-component params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:addComponentInstance
(fn [params]
(try
(let [params (-> params
(json/->clj)
(fb/decode-add-component-instance)
(d/without-nils))]
(vswap! state* fb/add-component-instance params)
(dm/str (::fb/last-id @state*)))
(catch :default cause
(handle-exception cause))))
:getShape
(fn [shape-id]
(let [shape-id (uuid/parse shape-id)]
(some-> (fb/lookup-shape @state* shape-id)
(json/->js))))
:toMap
(fn []
(-> @state*
(d/without-qualified)
(json/->js))))))
(defn create-file
[params]
(try
(let [params (-> params json/->clj fb/decode-file)
file (fb/create-file params)]
(create-file* file))
(catch :default cause
(handle-exception cause))))

30
frontend/src/lib/playground/sample1.js Normal file
View file

@ -0,0 +1,30 @@
import * as penpot from "../../../target/library/penpot.js";
console.log(penpot);
try {
const file = penpot.createFile({name: "Test"});
file.addPage({name: "Foo Page"})
const boardId = file.addArtboard({name: "Foo Board"})
const rectId = file.addRect({name: "Foo Rect", width:100, height: 200})
file.addLibraryColor({color: "#fabada", opacity: 0.5})
console.log("created board", boardId);
console.log("created rect", rectId);
const board = file.getShape(boardId);
console.log("=========== BOARD =============")
console.dir(board, {depth: 10});
const rect = file.getShape(rectId);
console.log("=========== RECT =============")
console.dir(rect, {depth: 10});
// console.dir(file.toMap(), {depth:10});
} catch (e) {
console.log(e);
// console.log(e.data);
}
process.exit(0);