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

♻️ 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

View file

@ -6,6 +6,36 @@
### :boom: Breaking changes & Deprecations ### :boom: Breaking changes & Deprecations
**Breaking changes on penpot library:**
- Change the signature of the `addPage` method: it now accepts an object (as a single argument) where you can pass `id`,
`name`, and `background` props (instead of the previous positional arguments)
- Rename the `file.createRect` method to `file.addRect`
- Rename the `file.createCircle` method to `file.addCircle`
- Rename the `file.createPath` method to `file.addPath`
- Rename the `file.createText` method to `file.addText`
- Rename `file.startComponent` to `file.addComponent` (to preserve the naming style)
- Rename `file.createComponentInstance` to `file.addComponentInstance` (to preserve the naming style)
- Rename `file.lookupShape` to `file.getShape`
- Rename `file.asMap` to `file.toMap`
- Remove `file.updateLibraryColor` (use `file.addLibraryColor` if you just need to replace a color)
- Remove `file.deleteLibraryColor` (this library is intended to build files)
- Remove `file.updateLibraryTypography` (use `file.addLibraryTypography` if you just need to replace a typography)
- Remove `file.deleteLibraryTypography` (this library is intended to build files)
- Remove `file.add/update/deleteLibraryMedia` (they are no longer supported by Penpot and have been replaced by components)
- Remove `file.deleteObject` (this library is intended to build files)
- Remove `file.updateObject` (this library is intended to build files)
- Remove `file.finishComponent` (it is no longer necessary; see below for more details on component creation changes)
- Change the `file.getCurrentPageId` function to a read-only `file.currentPageId` property
- Add `file.currentFrameId` read-only property
- Add `file.lastId` read-only property
There are also relevant semantic changes in how components should be created: this refactor removes
all notions of the old components (v1). Since v2, the shapes that are part of a component live on a
page. So, from now on, to create a component, you should first create a frame, then add shapes
and/or groups to that frame, and then create a component by declaring that frame as the component
root.
### :heart: Community contributions (Thank you!) ### :heart: Community contributions (Thank you!)
### :sparkles: New features ### :sparkles: New features

View file

@ -55,8 +55,8 @@
:features features :features features
:ignore-sync-until ignore-sync-until :ignore-sync-until ignore-sync-until
:modified-at modified-at :modified-at modified-at
:deleted-at deleted-at :deleted-at deleted-at}
:create-page create-page {:create-page create-page
:page-id page-id}) :page-id page-id})
file (-> (bfc/insert-file! cfg file) file (-> (bfc/insert-file! cfg file)
(bfc/decode-row))] (bfc/decode-row))]

View file

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

View file

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

View file

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

File diff suppressed because it is too large Load diff

View file

@ -732,20 +732,22 @@
(update-group [group objects] (update-group [group objects]
(let [lookup (d/getf objects) (let [lookup (d/getf objects)
children (->> group :shapes (map lookup))] children (get group :shapes)]
(cond (cond
;; If the group is empty we don't make any changes. Will be removed by a later process ;; If the group is empty we don't make any changes. Will be removed by a later process
(empty? children) (empty? children)
group group
(= :bool (:type group)) (= :bool (:type group))
(gsh/update-bool group children objects) (gsh/update-bool group objects)
(:masked-group group) (:masked-group group)
(set-mask-selrect group children) (->> (map lookup children)
(set-mask-selrect group))
:else :else
(gsh/update-group-selrect group children))))] (->> (map lookup children)
(gsh/update-group-selrect group)))))]
(if page-id (if page-id
(d/update-in-when data [:pages-index page-id :objects] reg-objects) (d/update-in-when data [:pages-index page-id :objects] reg-objects)

View file

@ -660,9 +660,13 @@
nil ;; so it does not need resize nil ;; so it does not need resize
(= (:type parent) :bool) (= (:type parent) :bool)
(gsh/update-bool parent children objects) (gsh/update-bool parent objects)
(= (:type parent) :group) (= (:type parent) :group)
;; FIXME: this functions should be
;; normalized in the same way as
;; update-bool in order to make all
;; this code consistent
(if (:masked-group parent) (if (:masked-group parent)
(gsh/update-mask-selrect parent children) (gsh/update-mask-selrect parent children)
(gsh/update-group-selrect parent children)))] (gsh/update-group-selrect parent children)))]

View file

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

View file

@ -85,24 +85,22 @@
(into {} p) (into {} p)
p)) p))
;; FIXME: make like matrix
(def schema:point (def schema:point
{:type ::point (sm/register!
:pred valid-point? {:type ::point
:type-properties :pred valid-point?
{:title "point" :type-properties
:description "Point" {:title "point"
:error/message "expected a valid point" :description "Point"
:gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int)) :error/message "expected a valid point"
(sg/fmap #(apply pos->Point %))) :gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
::oapi/type "string" (sg/fmap #(apply pos->Point %)))
::oapi/format "point" ::oapi/type "string"
:decode/json decode-point ::oapi/format "point"
:decode/string decode-point :decode/json decode-point
:encode/json point->json :decode/string decode-point
:encode/string point->str}}) :encode/json point->json
:encode/string point->str}}))
(sm/register! schema:point)
(defn point-like? (defn point-like?
[{:keys [x y] :as v}] [{:keys [x y] :as v}]

View file

@ -455,12 +455,12 @@
(defn update-bool (defn update-bool
"Calculates the selrect+points for the boolean shape" "Calculates the selrect+points for the boolean shape"
[shape _children objects] [shape objects]
(let [content (path/calc-bool-content shape objects) (let [content (path/calc-bool-content shape objects)
shape (assoc shape :content content)] shape (assoc shape :content content)]
(path/update-geometry shape))) (path/update-geometry shape)))
;; FIXME: revisit
(defn update-shapes-geometry (defn update-shapes-geometry
[objects ids] [objects ids]
(->> ids (->> ids
@ -474,7 +474,7 @@
(update-mask-selrect shape children) (update-mask-selrect shape children)
(cfh/bool-shape? shape) (cfh/bool-shape? shape)
(update-bool shape children objects) (update-bool shape objects)
(cfh/group-shape? shape) (cfh/group-shape? shape)
(update-group-selrect shape children) (update-group-selrect shape children)

View file

@ -28,10 +28,6 @@
[malli.transform :as mt] [malli.transform :as mt]
[malli.util :as mu])) [malli.util :as mu]))
(defprotocol ILazySchema
(-validate [_ o])
(-explain [_ o]))
(def default-options (def default-options
{:registry sr/default-registry}) {:registry sr/default-registry})
@ -51,10 +47,6 @@
[s] [s]
(m/type-properties s)) (m/type-properties s))
(defn- lazy-schema?
[s]
(satisfies? ILazySchema s))
(defn schema (defn schema
[s] [s]
(if (schema? s) (if (schema? s)
@ -111,12 +103,16 @@
(malli.error/error-value exp {:malli.error/mask-valid-values '...})) (malli.error/error-value exp {:malli.error/mask-valid-values '...}))
(defn optional-keys (defn optional-keys
[schema] ([schema]
(mu/optional-keys schema default-options)) (mu/optional-keys schema nil default-options))
([schema keys]
(mu/optional-keys schema keys default-options)))
(defn required-keys (defn required-keys
[schema] ([schema]
(mu/required-keys schema default-options)) (mu/required-keys schema nil default-options))
([schema keys]
(mu/required-keys schema keys default-options)))
(defn transformer (defn transformer
[& transformers] [& transformers]
@ -229,6 +225,11 @@
(let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))] (let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
(fn [v] (@vfn v)))) (fn [v] (@vfn v))))
(defn decode-fn
[s transformer]
(let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
(fn [v] (@vfn v))))
(defn humanize-explain (defn humanize-explain
"Returns a string representation of the explain data structure" "Returns a string representation of the explain data structure"
[{:keys [errors value]} & {:keys [length level]}] [{:keys [errors value]} & {:keys [length level]}]
@ -274,38 +275,36 @@
([s] (lookup sr/default-registry s)) ([s] (lookup sr/default-registry s))
([registry s] (schema (mr/schema registry s)))) ([registry s] (schema (mr/schema registry s))))
(defn- fast-check
"A fast path for checking process, assumes the ILazySchema protocol
implemented on the provided `s` schema. Sould not be used directly."
[s type code hint value]
(when-not ^boolean (-validate s value)
(let [explain (-explain s value)]
(throw (ex-info hint {:type type
:code code
:hint hint
::explain explain}))))
value)
(declare ^:private lazy-schema)
(defn check-fn (defn check-fn
"Create a predefined check function" "Create a predefined check function"
[s & {:keys [hint type code]}] [s & {:keys [hint type code]}]
(let [schema (if (lazy-schema? s) s (lazy-schema s)) (let [s (schema s)
hint (or ^boolean hint "check error") validator* (delay (m/validator s))
type (or ^boolean type :assertion) explainer* (delay (m/explainer s))
code (or ^boolean code :data-validation)] hint (or ^boolean hint "check error")
(partial fast-check schema type code hint))) type (or ^boolean type :assertion)
code (or ^boolean code :data-validation)]
(fn [value]
(let [validate-fn @validator*]
(when-not ^boolean (validate-fn value)
(let [explain-fn @explainer*
explain (explain-fn value)]
(throw (ex-info hint {:type type
:code code
:hint hint
::explain explain}))))
value))))
(defn check (defn check
"A helper intended to be used on assertions for validate/check the "A helper intended to be used on assertions for validate/check the
schema over provided data. Raises an assertion exception." schema over provided data. Raises an assertion exception.
[s value & {:keys [hint type code]}]
(let [s (if (lazy-schema? s) s (lazy-schema s)) Use only on non-performance sensitive code, because it creates the
hint (or ^boolean hint "check error") check-fn instance all the time it is invoked."
type (or ^boolean type :assertion) [s value & {:as opts}]
code (or ^boolean code :data-validation)] (let [check-fn (check-fn s opts)]
(fast-check s type code hint value))) (check-fn value)))
(defn type-schema (defn type-schema
[& {:as params}] [& {:as params}]
@ -319,11 +318,14 @@
([params] ([params]
(cond (cond
(map? params) (map? params)
(let [type (get params :type)] (let [mdata (meta params)
type (or (get mdata ::id)
(get mdata ::type)
(get params :type))]
(assert (qualified-keyword? type) "expected qualified keyword for `type`") (assert (qualified-keyword? type) "expected qualified keyword for `type`")
(let [s (m/-simple-schema params)] (let [s (m/-simple-schema params)]
(swap! sr/registry assoc type s) (swap! sr/registry assoc type s)
nil)) s))
(vector? params) (vector? params)
(let [mdata (meta params) (let [mdata (meta params)
@ -331,83 +333,19 @@
(get mdata ::type))] (get mdata ::type))]
(assert (qualified-keyword? type) "expected qualified keyword to be on metadata") (assert (qualified-keyword? type) "expected qualified keyword to be on metadata")
(swap! sr/registry assoc type params) (swap! sr/registry assoc type params)
nil) params)
(m/into-schema? params) (m/into-schema? params)
(let [type (m/-type params)] (let [type (m/-type params)]
(swap! sr/registry assoc type params)) (swap! sr/registry assoc type params)
params)
:else :else
(throw (ex-info "Invalid Arguments" {})))) (throw (ex-info "Invalid Arguments" {}))))
([type params] ([type params]
(let [s (if (map? params) (swap! sr/registry assoc type params)
(cond params))
(= :set (:type params))
(m/-collection-schema params)
(= :vector (:type params))
(m/-collection-schema params)
:else
(m/-simple-schema params))
params)]
(swap! sr/registry assoc type s)
nil)))
(defn- lazy-schema
"Create ans instance of ILazySchema"
[s]
(let [schema (schema s)
validator (delay (m/validator schema))
explainer (delay (m/explainer schema))]
(reify
m/AST
(-to-ast [_ options] (m/-to-ast schema options))
m/EntrySchema
(-entries [_] (m/-entries schema))
(-entry-parser [_] (m/-entry-parser schema))
m/Cached
(-cache [_] (m/-cache schema))
m/LensSchema
(-keep [_] (m/-keep schema))
(-get [_ key default] (m/-get schema key default))
(-set [_ key value] (m/-set schema key value))
m/Schema
(-validator [_]
(m/-validator schema))
(-explainer [_ path]
(m/-explainer schema path))
(-parser [_]
(m/-parser schema))
(-unparser [_]
(m/-unparser schema))
(-transformer [_ transformer method options]
(m/-transformer schema transformer method options))
(-walk [_ walker path options]
(m/-walk schema walker path options))
(-properties [_]
(m/-properties schema))
(-options [_]
(m/-options schema))
(-children [_]
(m/-children schema))
(-parent [_]
(m/-parent schema))
(-form [_]
(m/-form schema))
ILazySchema
(-validate [_ o]
(@validator o))
(-explain [_ o]
(@explainer o)))))
;; --- BUILTIN SCHEMAS ;; --- BUILTIN SCHEMAS

View file

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

View file

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

View file

@ -18,19 +18,19 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def schema:component (def schema:component
[:merge (sm/register!
[:map ^{::sm/type ::component}
[:id ::sm/uuid] [:merge
[:name :string] [:map
[:path {:optional true} [:maybe :string]] [:id ::sm/uuid]
[:modified-at {:optional true} ::sm/inst] [:name :string]
[:objects {:gen/max 10 :optional true} ::ctp/objects] [:path {:optional true} [:maybe :string]]
[:main-instance-id ::sm/uuid] [:modified-at {:optional true} ::sm/inst]
[:main-instance-page ::sm/uuid] [:objects {:gen/max 10 :optional true} ctp/schema:objects]
[:plugin-data {:optional true} ::ctpg/plugin-data]] [:main-instance-id ::sm/uuid]
::ctv/variant-component]) [:main-instance-page ::sm/uuid]
[:plugin-data {:optional true} ctpg/schema:plugin-data]]
(sm/register! ::component schema:component) ctv/schema:variant-component]))
(def check-component (def check-component
(sm/check-fn schema:component)) (sm/check-fn schema:component))

View file

@ -41,7 +41,7 @@
[:map-of {:gen/max 10} ::sm/uuid :map]] [:map-of {:gen/max 10} ::sm/uuid :map]]
[:plugin-data {:optional true} ::ctpg/plugin-data]]) [:plugin-data {:optional true} ::ctpg/plugin-data]])
(def check-container! (def check-container
(sm/check-fn ::container)) (sm/check-fn ::container))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -62,9 +62,9 @@
(defn get-container (defn get-container
[file type id] [file type id]
(dm/assert! (map? file)) (assert (map? file))
(dm/assert! (contains? valid-container-types type)) (assert (contains? valid-container-types type))
(dm/assert! (uuid? id)) (assert (uuid? id))
(-> (if (= type :page) (-> (if (= type :page)
(ctpl/get-page file id) (ctpl/get-page file id)
@ -74,13 +74,9 @@
(defn get-shape (defn get-shape
[container shape-id] [container shape-id]
(dm/assert! (assert (check-container container))
"expected valid container" (assert (uuid? shape-id)
(check-container! container)) "expected valid uuid for `shape-id`")
(dm/assert!
"expected valid uuid for `shape-id`"
(uuid? shape-id))
(-> container (-> container
(get :objects) (get :objects)

View file

@ -83,6 +83,7 @@
because sometimes we want to validate file without the data." because sometimes we want to validate file without the data."
[:map {:title "file"} [:map {:title "file"}
[:id ::sm/uuid] [:id ::sm/uuid]
[:name :string]
[:revn {:optional true} :int] [:revn {:optional true} :int]
[:vern {:optional true} :int] [:vern {:optional true} :int]
[:created-at {:optional true} ::sm/inst] [:created-at {:optional true} ::sm/inst]
@ -101,13 +102,15 @@
(sm/register! ::media schema:media) (sm/register! ::media schema:media)
(sm/register! ::colors schema:colors) (sm/register! ::colors schema:colors)
(sm/register! ::typographies schema:typographies) (sm/register! ::typographies schema:typographies)
(sm/register! ::media-object schema:media) (sm/register! ::media-object schema:media)
(def check-file-data! (def check-file
(sm/check-fn ::data)) (sm/check-fn schema:file :hint "check error on validating file"))
(def check-media-object! (def check-file-data
(sm/check-fn schema:data))
(def check-media-object
(sm/check-fn schema:media)) (sm/check-fn schema:media))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -134,33 +137,36 @@
(update :options assoc :components-v2 true))))) (update :options assoc :components-v2 true)))))
(defn make-file (defn make-file
[{:keys [id project-id name revn is-shared features [{:keys [id project-id name revn is-shared features migrations
ignore-sync-until modified-at deleted-at ignore-sync-until modified-at deleted-at]
create-page page-id] :or {is-shared false revn 0}}
:or {is-shared false revn 0 create-page true}}]
& {:keys [create-page page-id]
:or {create-page true}}]
(let [id (or id (uuid/next)) (let [id (or id (uuid/next))
data (if create-page data (if create-page
(if page-id (if page-id
(make-file-data id page-id) (make-file-data id page-id)
(make-file-data id)) (make-file-data id))
(make-file-data id nil)) (make-file-data id nil))
file {:id id file (d/without-nils
:project-id project-id {:id id
:name name :project-id project-id
:revn revn :name name
:vern 0 :revn revn
:is-shared is-shared :vern 0
:version version :is-shared is-shared
:data data :version version
:features features :data data
:ignore-sync-until ignore-sync-until :features features
:modified-at modified-at :migrations migrations
:deleted-at deleted-at}] :ignore-sync-until ignore-sync-until
:modified-at modified-at
:deleted-at deleted-at})]
(d/without-nils file))) (check-file file)))
;; Helpers ;; Helpers

View file

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

View file

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

View file

@ -120,35 +120,35 @@
[:vector {:gen/max 4 :gen/min 4} ::gpt/point]) [:vector {:gen/max 4 :gen/min 4} ::gpt/point])
(def schema:fill (def schema:fill
[:map {:title "Fill"} (sm/register!
[:fill-color {:optional true} ::ctc/rgb-color] ^{::sm/type ::fill}
[:fill-opacity {:optional true} ::sm/safe-number] [:map {:title "Fill"}
[:fill-color-gradient {:optional true} [:maybe ::ctc/gradient]] [:fill-color {:optional true} ::ctc/rgb-color]
[:fill-color-ref-file {:optional true} [:maybe ::sm/uuid]] [:fill-opacity {:optional true} ::sm/safe-number]
[:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]] [:fill-color-gradient {:optional true} [:maybe ::ctc/gradient]]
[:fill-image {:optional true} ::ctc/image-color]]) [:fill-color-ref-file {:optional true} [:maybe ::sm/uuid]]
[:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]]
[:fill-image {:optional true} ::ctc/image-color]]))
(sm/register! ::fill schema:fill) (def schema:stroke
(sm/register!
(def ^:private schema:stroke ^{::sm/type ::stroke}
[:map {:title "Stroke"} [:map {:title "Stroke"}
[:stroke-color {:optional true} :string] [:stroke-color {:optional true} :string]
[:stroke-color-ref-file {:optional true} ::sm/uuid] [:stroke-color-ref-file {:optional true} ::sm/uuid]
[:stroke-color-ref-id {:optional true} ::sm/uuid] [:stroke-color-ref-id {:optional true} ::sm/uuid]
[:stroke-opacity {:optional true} ::sm/safe-number] [:stroke-opacity {:optional true} ::sm/safe-number]
[:stroke-style {:optional true} [:stroke-style {:optional true}
[::sm/one-of #{:solid :dotted :dashed :mixed :none :svg}]] [::sm/one-of #{:solid :dotted :dashed :mixed :none :svg}]]
[:stroke-width {:optional true} ::sm/safe-number] [:stroke-width {:optional true} ::sm/safe-number]
[:stroke-alignment {:optional true} [:stroke-alignment {:optional true}
[::sm/one-of #{:center :inner :outer}]] [::sm/one-of #{:center :inner :outer}]]
[:stroke-cap-start {:optional true} [:stroke-cap-start {:optional true}
[::sm/one-of stroke-caps]] [::sm/one-of stroke-caps]]
[:stroke-cap-end {:optional true} [:stroke-cap-end {:optional true}
[::sm/one-of stroke-caps]] [::sm/one-of stroke-caps]]
[:stroke-color-gradient {:optional true} ::ctc/gradient] [:stroke-color-gradient {:optional true} ::ctc/gradient]
[:stroke-image {:optional true} ::ctc/image-color]]) [:stroke-image {:optional true} ::ctc/image-color]]))
(sm/register! ::stroke schema:stroke)
(def check-stroke (def check-stroke
(sm/check-fn schema:stroke)) (sm/check-fn schema:stroke))
@ -172,8 +172,7 @@
[:width ::sm/safe-number] [:width ::sm/safe-number]
[:height ::sm/safe-number]]) [:height ::sm/safe-number]])
;; FIXME: rename to shape-generic-attrs (def schema:shape-generic-attrs
(def schema:shape-attrs
[:map {:title "ShapeAttrs"} [:map {:title "ShapeAttrs"}
[:page-id {:optional true} ::sm/uuid] [:page-id {:optional true} ::sm/uuid]
[:component-id {:optional true} ::sm/uuid] [:component-id {:optional true} ::sm/uuid]
@ -277,7 +276,7 @@
[] []
(->> (sg/generator schema:shape-base-attrs) (->> (sg/generator schema:shape-base-attrs)
(sg/mcat (fn [{:keys [type] :as shape}] (sg/mcat (fn [{:keys [type] :as shape}]
(sg/let [attrs1 (sg/generator schema:shape-attrs) (sg/let [attrs1 (sg/generator schema:shape-generic-attrs)
attrs2 (sg/generator schema:shape-geom-attrs) attrs2 (sg/generator schema:shape-geom-attrs)
attrs3 (case type attrs3 (case type
:text (sg/generator schema:text-attrs) :text (sg/generator schema:text-attrs)
@ -295,94 +294,100 @@
(merge attrs1 shape attrs2 attrs3))))) (merge attrs1 shape attrs2 attrs3)))))
(sg/fmap create-shape))) (sg/fmap create-shape)))
(def schema:shape-attrs
[:multi {:dispatch :type
:decode/json (fn [shape]
(update shape :type keyword))
:title "Shape"}
[:group
[:merge {:title "GroupShape"}
ctsl/schema:layout-attrs
schema:group-attrs
schema:shape-generic-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:frame
[:merge {:title "FrameShape"}
ctsl/schema:layout-attrs
::ctsl/layout-attrs
schema:frame-attrs
schema:shape-generic-attrs
schema:shape-geom-attrs
schema:shape-base-attrs
::ctv/variant-shape
::ctv/variant-container]]
[:bool
[:merge {:title "BoolShape"}
ctsl/schema:layout-attrs
schema:bool-attrs
schema:shape-generic-attrs
schema:shape-base-attrs]]
[:rect
[:merge {:title "RectShape"}
ctsl/schema:layout-attrs
schema:rect-attrs
schema:shape-generic-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:circle
[:merge {:title "CircleShape"}
ctsl/schema:layout-attrs
schema:circle-attrs
schema:shape-generic-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:image
[:merge {:title "ImageShape"}
ctsl/schema:layout-attrs
schema:image-attrs
schema:shape-generic-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:svg-raw
[:merge {:title "SvgRawShape"}
ctsl/schema:layout-attrs
schema:svg-raw-attrs
schema:shape-generic-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:path
[:merge {:title "PathShape"}
ctsl/schema:layout-attrs
schema:path-attrs
schema:shape-generic-attrs
schema:shape-base-attrs]]
[:text
[:merge {:title "TextShape"}
ctsl/schema:layout-attrs
schema:text-attrs
schema:shape-generic-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]])
(def schema:shape (def schema:shape
[:and {:title "Shape" (sm/register!
:gen/gen (shape-generator) ^{::sm/type ::shape}
:decode/json {:leave decode-shape}} [:and {:title "Shape"
[:fn shape?] :gen/gen (shape-generator)
[:multi {:dispatch :type :decode/json {:leave decode-shape}}
:decode/json (fn [shape] [:fn shape?]
(update shape :type keyword)) schema:shape-attrs]))
:title "Shape"}
[:group
[:merge {:title "GroupShape"}
::ctsl/layout-child-attrs
schema:group-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:frame (def check-shape-generic-attrs
[:merge {:title "FrameShape"} (sm/check-fn schema:shape-generic-attrs))
::ctsl/layout-child-attrs
::ctsl/layout-attrs
schema:frame-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs
::ctv/variant-shape
::ctv/variant-container]]
[:bool (def check-shape-attrs
[:merge {:title "BoolShape"}
::ctsl/layout-child-attrs
schema:bool-attrs
schema:shape-attrs
schema:shape-base-attrs]]
[:rect
[:merge {:title "RectShape"}
::ctsl/layout-child-attrs
schema:rect-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:circle
[:merge {:title "CircleShape"}
::ctsl/layout-child-attrs
schema:circle-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:image
[:merge {:title "ImageShape"}
::ctsl/layout-child-attrs
schema:image-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:svg-raw
[:merge {:title "SvgRawShape"}
::ctsl/layout-child-attrs
schema:svg-raw-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:path
[:merge {:title "PathShape"}
::ctsl/layout-child-attrs
schema:path-attrs
schema:shape-attrs
schema:shape-base-attrs]]
[:text
[:merge {:title "TextShape"}
::ctsl/layout-child-attrs
schema:text-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]]])
(sm/register! ::shape schema:shape)
(def check-shape-attrs!
(sm/check-fn schema:shape-attrs)) (sm/check-fn schema:shape-attrs))
(def check-shape! (def check-shape
(sm/check-fn schema:shape (sm/check-fn schema:shape
:hint "expected valid shape")) :hint "expected valid shape"))

View file

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

View file

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

View file

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

View file

@ -23,9 +23,11 @@
(def schema:variant-component (def schema:variant-component
;; A component that is part of a variant set. ;; A component that is part of a variant set.
[:map (sm/register!
[:variant-id {:optional true} ::sm/uuid] ^{::sm/type ::variant-component}
[:variant-properties {:optional true} [:vector schema:variant-property]]]) [:map
[:variant-id {:optional true} ::sm/uuid]
[:variant-properties {:optional true} [:vector schema:variant-property]]]))
(def schema:variant-shape (def schema:variant-shape
;; The root shape of the main instance of a variant component. ;; The root shape of the main instance of a variant component.
@ -40,7 +42,6 @@
[:is-variant-container {:optional true} :boolean]]) [:is-variant-container {:optional true} :boolean]])
(sm/register! ::variant-property schema:variant-property) (sm/register! ::variant-property schema:variant-property)
(sm/register! ::variant-component schema:variant-component)
(sm/register! ::variant-shape schema:variant-shape) (sm/register! ::variant-shape schema:variant-shape)
(sm/register! ::variant-container schema:variant-container) (sm/register! ::variant-container schema:variant-container)

View file

@ -42,7 +42,7 @@
:dev :dev
{:extra-paths ["dev"] {:extra-paths ["dev"]
:extra-deps :extra-deps
{thheller/shadow-cljs {:mvn/version "2.28.18"} {thheller/shadow-cljs {:mvn/version "3.0.3"}
com.bhauman/rebel-readline {:mvn/version "RELEASE"} com.bhauman/rebel-readline {:mvn/version "RELEASE"}
org.clojure/tools.namespace {:mvn/version "RELEASE"} org.clojure/tools.namespace {:mvn/version "RELEASE"}
criterium/criterium {:mvn/version "RELEASE"} criterium/criterium {:mvn/version "RELEASE"}

View file

@ -25,6 +25,7 @@
"build:app:libs": "node ./scripts/build-libs.js", "build:app:libs": "node ./scripts/build-libs.js",
"build:app:main": "clojure -M:dev:shadow-cljs release main worker", "build:app:main": "clojure -M:dev:shadow-cljs release main worker",
"build:app": "yarn run clear:shadow-cache && yarn run build:app:main && yarn run build:app:libs", "build:app": "yarn run clear:shadow-cache && yarn run build:app:main && yarn run build:app:libs",
"build:library": "yarn run clear:shadow-cache && clojure -M:dev:shadow-cljs release library",
"e2e:server": "node ./scripts/e2e-server.js", "e2e:server": "node ./scripts/e2e-server.js",
"fmt:clj": "cljfmt fix --parallel=true src/ test/", "fmt:clj": "cljfmt fix --parallel=true src/ test/",
"fmt:clj:check": "cljfmt check --parallel=false src/ test/", "fmt:clj:check": "cljfmt check --parallel=false src/ test/",
@ -44,6 +45,7 @@
"watch:app:main": "clojure -M:dev:shadow-cljs watch main worker storybook", "watch:app:main": "clojure -M:dev:shadow-cljs watch main worker storybook",
"clear:shadow-cache": "rm -rf .shadow-cljs", "clear:shadow-cache": "rm -rf .shadow-cljs",
"watch:app": "yarn run clear:shadow-cache && concurrently \"yarn run watch:app:main\" \"yarn run watch:app:libs\"", "watch:app": "yarn run clear:shadow-cache && concurrently \"yarn run watch:app:main\" \"yarn run watch:app:libs\"",
"watch:library": "yarn run clear:shadow-cache && clojure -M:dev:shadow-cljs watch library",
"watch": "yarn run watch:app:assets", "watch": "yarn run watch:app:assets",
"watch:storybook": "concurrently \"storybook dev -p 6006 --no-open\" \"yarn run watch:storybook:assets\"", "watch:storybook": "concurrently \"storybook dev -p 6006 --no-open\" \"yarn run watch:storybook:assets\"",
"watch:storybook:assets": "node ./scripts/watch-storybook.js" "watch:storybook:assets": "node ./scripts/watch-storybook.js"
@ -89,7 +91,7 @@
"rimraf": "^6.0.1", "rimraf": "^6.0.1",
"sass": "^1.83.4", "sass": "^1.83.4",
"sass-embedded": "^1.83.4", "sass-embedded": "^1.83.4",
"shadow-cljs": "2.28.20", "shadow-cljs": "3.0.3",
"storybook": "^8.5.2", "storybook": "^8.5.2",
"svg-sprite": "^2.0.4", "svg-sprite": "^2.0.4",
"typescript": "^5.7.3", "typescript": "^5.7.3",

View file

@ -149,13 +149,16 @@
{:test {:init-fn frontend-tests.runner/init {:test {:init-fn frontend-tests.runner/init
:prepend-js ";if (typeof globalThis.navigator?.userAgent === 'undefined') { globalThis.navigator = {userAgent: ''}; };"}}} :prepend-js ";if (typeof globalThis.navigator?.userAgent === 'undefined') { globalThis.navigator = {userAgent: ''}; };"}}}
:lib-penpot :library
{:target :esm {:target :esm
:output-dir "resources/public/libs" :runtime :custom
:output-dir "target/library"
:devtools {:autoload false}
:modules :modules
{:penpot {:exports {:renderPage app.libs.render/render-page-export {:penpot
:createFile app.libs.file-builder/create-file-export}}} {:exports {BuilderError lib.file-builder/BuilderError
createFile lib.file-builder/create-file}}}
:compiler-options :compiler-options
{:output-feature-set :es2020 {:output-feature-set :es2020
@ -165,6 +168,8 @@
:release :release
{:compiler-options {:compiler-options
{:fn-invoke-direct true {:fn-invoke-direct true
:optimizations #shadow/env ["PENPOT_BUILD_OPTIMIZATIONS" :as :keyword :default :advanced]
:pretty-print false
:source-map true :source-map true
:elide-asserts true :elide-asserts true
:anon-fn-naming-policy :off :anon-fn-naming-policy :off

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

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

View file

@ -771,17 +771,16 @@
;; --- Update Shape Attrs ;; --- 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 (defn update-shape
[id attrs] [id attrs]
(dm/assert! (assert (uuid? id) "expected valid uuid for `id`")
"expected valid parameters" (let [attrs (cts/check-shape-generic-attrs attrs)]
(and (cts/check-shape-attrs! attrs) (ptk/reify ::update-shape
(uuid? id))) ptk/WatchEvent
(watch [_ _ _]
(ptk/reify ::update-shape (rx/of (dwsh/update-shapes [id] #(merge % attrs)))))))
ptk/WatchEvent
(watch [_ _ _]
(rx/of (dwsh/update-shapes [id] #(merge % attrs))))))
(defn start-rename-shape (defn start-rename-shape
"Start shape renaming process" "Start shape renaming process"
@ -832,10 +831,6 @@
(defn update-selected-shapes (defn update-selected-shapes
[attrs] [attrs]
(dm/assert!
"expected valid shape attrs"
(cts/check-shape-attrs! attrs))
(ptk/reify ::update-selected-shapes (ptk/reify ::update-selected-shapes
ptk/WatchEvent ptk/WatchEvent
(watch [_ state _] (watch [_ state _]

View file

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

View file

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

View file

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

View file

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

View file

@ -214,15 +214,15 @@
(nil? font) (nil? font)
(p/resolved font-id) (p/resolved font-id)
;; Font already loaded, we just continue ;; Font already loaded, we just continue
(contains? @loaded font-id) (contains? @loaded font-id)
(p/resolved 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) (contains? @loading font-id)
(get @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 :else
(let [on-load (fn [resolve] (let [on-load (fn [resolve]
(swap! loaded conj font-id) (swap! loaded conj font-id)

View file

@ -6,7 +6,7 @@
(ns app.util.object (ns app.util.object
"A collection of helpers for work with javascript objects." "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])) #?(:cljs (:require-macros [app.util.object]))
(:require (:require
[clojure.core :as c])) [clojure.core :as c]))
@ -93,6 +93,51 @@
(when (some? obj) (when (some? obj)
(js* "Object.entries(~{}).reduce((a, [k,v]) => (v == null ? a : (a[k]=v, a)), {}) " 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! (defmacro add-properties!
"Adds properties to an object using `.defineProperty`" "Adds properties to an object using `.defineProperty`"
[rsym & properties] [rsym & properties]

View file

@ -8,16 +8,10 @@
(:refer-clojure :exclude [resolve]) (:refer-clojure :exclude [resolve])
(:require (:require
[app.common.data :as d] [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.json :as json]
[app.common.logging :as log] [app.common.logging :as log]
[app.common.media :as cm]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.text :as ct] [app.common.text :as ct]
[app.common.time :as tm]
[app.common.types.path :as path]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.main.repo :as rp] [app.main.repo :as rp]
[app.util.http :as http] [app.util.http :as http]
@ -25,10 +19,8 @@
[app.util.sse :as sse] [app.util.sse :as sse]
[app.util.zip :as uz] [app.util.zip :as uz]
[app.worker.impl :as impl] [app.worker.impl :as impl]
[app.worker.import.parser :as parser]
[beicon.v2.core :as rx] [beicon.v2.core :as rx]
[cuerdas.core :as str] [cuerdas.core :as str]))
[tubax.core :as tubax]))
(log/set-level! :warn) (log/set-level! :warn)
@ -37,185 +29,12 @@
(def conjv (fnil conj [])) (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 (defn- read-zip-manifest
[zipfile] [zipfile]
(->> (uz/get-file zipfile "manifest.json") (->> (uz/get-file zipfile "manifest.json")
(rx/map :content) (rx/map :content)
(rx/map json/decode))) (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 (defn slurp-uri
([uri] (slurp-uri uri :text)) ([uri] (slurp-uri uri :text))
([uri response-type] ([uri response-type]
@ -225,26 +44,6 @@
:method :get}) :method :get})
(rx/map :body)))) (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 (defn resolve-text-content
[node context] [node context]
(let [resolve (:resolve context)] (let [resolve (:resolve context)]
@ -290,456 +89,6 @@
(uuid? (get fill :stroke-color-ref-file)) (uuid? (get fill :stroke-color-ref-file))
(d/update-when :stroke-color-ref-file resolve))))))) (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] (defn parse-mtype [ba]
(let [u8 (js/Uint8Array. ba 0 4) (let [u8 (js/Uint8Array. ba 0 4)
sg (areduce u8 i ret "" (str ret (if (zero? i) "" " ") (.toString (aget u8 i) 8)))] 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" "1 13 32 206" "application/octet-stream"
"other"))) "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 ;; NOTE: this is a limited subset schema for the manifest file of
;; binfile-v3 format; is used for partially parse it and read the ;; binfile-v3 format; is used for partially parse it and read the
;; files referenced inside the exported file ;; files referenced inside the exported file
@ -794,7 +114,7 @@
(sm/decoder schema:manifest sm/json-transformer)) (sm/decoder schema:manifest sm/json-transformer))
(defn analyze-file (defn analyze-file
[features {:keys [uri] :as file}] [{:keys [uri] :as file}]
(let [stream (->> (slurp-uri uri :buffer) (let [stream (->> (slurp-uri uri :buffer)
(rx/merge-map (rx/merge-map
(fn [body] (fn [body]
@ -819,10 +139,6 @@
(rx/share))] (rx/share))]
(->> (rx/merge (->> (rx/merge
(->> stream
(rx/filter (fn [entry] (= :legacy-zip (:type entry))))
(rx/merge-map (partial analyze-file-legacy-zip-entry features)))
(->> stream (->> stream
(rx/filter (fn [entry] (= :binfile-v1 (:type entry)))) (rx/filter (fn [entry] (= :binfile-v1 (:type entry))))
(rx/map (fn [entry] (rx/map (fn [entry]
@ -855,55 +171,16 @@
(rx/of (assoc file :error error :status :error)))))))) (rx/of (assoc file :error error :status :error))))))))
(defmethod impl/handler :analyze-import (defmethod impl/handler :analyze-import
[{:keys [files features]}] [{:keys [files]}]
(->> (rx/from files) (->> (rx/from files)
(rx/merge-map (partial analyze-file features)))) (rx/merge-map analyze-file)))
(defmethod impl/handler :import-files (defmethod impl/handler :import-files
[{:keys [project-id files features]}] [{:keys [project-id files]}]
(let [context {:project-id project-id (let [binfile-v1 (filter #(= :binfile-v1 (:type %)) files)
:resolve (resolve-factory)
:system-features features}
legacy-zip (filter #(= :legacy-zip (:type %)) files)
binfile-v1 (filter #(= :binfile-v1 (:type %)) files)
binfile-v3 (filter #(= :binfile-v3 (:type %)) files)] binfile-v3 (filter #(= :binfile-v3 (:type %)) files)]
(rx/merge (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/from binfile-v1)
(rx/merge-map (rx/merge-map
(fn [data] (fn [data]

File diff suppressed because it is too large Load diff

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

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

View file

@ -16,8 +16,7 @@
(t/deftest test-common-shape-properties (t/deftest test-common-shape-properties
(let [;; ==== Setup (let [;; ==== Setup
store (ths/setup-store store (ths/setup-store (cthf/sample-file :file1 :page-label :page1))
(cthf/sample-file :file1 :page-label :page1))
^js context (api/create-context "TEST") ^js context (api/create-context "TEST")

View file

@ -13,13 +13,21 @@
[cljs.pprint :refer [pprint]] [cljs.pprint :refer [pprint]]
[cljs.test :as t :include-macros true])) [cljs.test :as t :include-macros true]))
(def uuid-counter 1)
(defn get-mocked-uuid
[]
(let [counter (atom 0)]
(fn []
(uuid/custom 123456789 (swap! counter inc)))))
(t/deftest test-create-index (t/deftest test-create-index
(t/testing "Create empty data" (t/testing "Create empty data"
(let [data (sd/make-snap-data)] (let [data (sd/make-snap-data)]
(t/is (some? data)))) (t/is (some? data))))
(t/testing "Add empty page (only root-frame)" (t/testing "Add empty page (only root-frame)"
(let [page (-> (fb/create-file "Test") (let [page (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/get-current-page)) (fb/get-current-page))
@ -28,10 +36,11 @@
(t/is (some? data)))) (t/is (some? data))))
(t/testing "Create simple shape on root" (t/testing "Create simple shape on root"
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/create-rect (fb/add-shape
{:x 0 {:type :rect
:x 0
:y 0 :y 0
:width 100 :width 100
:height 100})) :height 100}))
@ -57,7 +66,7 @@
(t/is (= (first (nth result-x 2)) 100)))) (t/is (= (first (nth result-x 2)) 100))))
(t/testing "Add page with single empty frame" (t/testing "Add page with single empty frame"
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/add-artboard (fb/add-artboard
{:x 0 {:x 0
@ -66,10 +75,10 @@
:height 100}) :height 100})
(fb/close-artboard)) (fb/close-artboard))
frame-id (:last-id file) frame-id (::fb/last-id file)
page (fb/get-current-page file) page (fb/get-current-page file)
;; frame-id (:last-id file) ;; frame-id (::fb/last-id file)
data (-> (sd/make-snap-data) data (-> (sd/make-snap-data)
(sd/add-page page)) (sd/add-page page))
@ -81,47 +90,49 @@
(t/is (= (count result-frame-x) 3)))) (t/is (= (count result-frame-x) 3))))
(t/testing "Add page with some shapes inside frames" (t/testing "Add page with some shapes inside frames"
(let [file (-> (fb/create-file "Test") (with-redefs [uuid/next (get-mocked-uuid)]
(fb/add-page {:name "Page 1"}) (let [file (-> (fb/create-file {:name "Test"})
(fb/add-artboard (fb/add-page {:name "Page 1"})
{:x 0 (fb/add-artboard
:y 0 {:x 0
:width 100 :y 0
:height 100})) :width 100
frame-id (:last-id file) :height 100}))
file (-> file frame-id (::fb/last-id file)
(fb/create-rect
{:x 25
:y 25
:width 50
:height 50})
(fb/close-artboard))
page (fb/get-current-page file) file (-> file
(fb/add-shape
{:type :rect
:x 25
:y 25
:width 50
:height 50})
(fb/close-artboard))
;; frame-id (:last-id file) page (fb/get-current-page file)
data (-> (sd/make-snap-data)
(sd/add-page page))
result-zero-x (sd/query data (:id page) uuid/zero :x [0 100]) data (-> (sd/make-snap-data)
result-frame-x (sd/query data (:id page) frame-id :x [0 100])] (sd/add-page page))
(t/is (some? data)) result-zero-x (sd/query data (:id page) uuid/zero :x [0 100])
(t/is (= (count result-zero-x) 3)) result-frame-x (sd/query data (:id page) frame-id :x [0 100])]
(t/is (= (count result-frame-x) 5))))
(t/is (some? data))
(t/is (= (count result-zero-x) 3))
(t/is (= (count result-frame-x) 5)))))
(t/testing "Add a global guide" (t/testing "Add a global guide"
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/add-guide {:position 50 :axis :x}) (fb/add-guide {:position 50 :axis :x})
(fb/add-artboard {:x 200 :y 200 :width 100 :height 100}) (fb/add-artboard {:x 200 :y 200 :width 100 :height 100})
(fb/close-artboard)) (fb/close-artboard))
frame-id (:last-id file) frame-id (::fb/last-id file)
page (fb/get-current-page file) page (fb/get-current-page file)
;; frame-id (:last-id file) ;; frame-id (::fb/last-id file)
data (-> (sd/make-snap-data) data (-> (sd/make-snap-data)
(sd/add-page page)) (sd/add-page page))
@ -140,26 +151,26 @@
(t/is (= (count result-frame-y) 0)))) (t/is (= (count result-frame-y) 0))))
(t/testing "Add a frame guide" (t/testing "Add a frame guide"
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/add-artboard {:x 200 :y 200 :width 100 :height 100}) (fb/add-artboard {:x 200 :y 200 :width 100 :height 100})
(fb/close-artboard)) (fb/close-artboard))
frame-id (:last-id file) frame-id (::fb/last-id file)
file (-> file file (-> file
(fb/add-guide {:position 50 :axis :x :frame-id frame-id})) (fb/add-guide {:position 50 :axis :x :frame-id frame-id}))
page (fb/get-current-page file) page (fb/get-current-page file)
;; frame-id (:last-id file) data (-> (sd/make-snap-data)
data (-> (sd/make-snap-data) (sd/add-page page))
(sd/add-page page))
result-zero-x (sd/query data (:id page) uuid/zero :x [0 100]) result-zero-x (sd/query data (:id page) uuid/zero :x [0 100])
result-zero-y (sd/query data (:id page) uuid/zero :y [0 100]) result-zero-y (sd/query data (:id page) uuid/zero :y [0 100])
result-frame-x (sd/query data (:id page) frame-id :x [0 100]) result-frame-x (sd/query data (:id page) frame-id :x [0 100])
result-frame-y (sd/query data (:id page) frame-id :y [0 100])] result-frame-y (sd/query data (:id page) frame-id :y [0 100])]
(t/is (some? data)) (t/is (some? data))
;; We can snap in the root ;; We can snap in the root
(t/is (= (count result-zero-x) 0)) (t/is (= (count result-zero-x) 0))
@ -171,7 +182,7 @@
(t/deftest test-update-index (t/deftest test-update-index
(t/testing "Create frame on root and then remove it." (t/testing "Create frame on root and then remove it."
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/add-artboard (fb/add-artboard
{:x 0 {:x 0
@ -180,15 +191,15 @@
:height 100}) :height 100})
(fb/close-artboard)) (fb/close-artboard))
shape-id (:last-id file) shape-id (::fb/last-id file)
page (fb/get-current-page file) page (fb/get-current-page file)
;; frame-id (:last-id file) ;; frame-id (::fb/last-id file)
data (-> (sd/make-snap-data) data (-> (sd/make-snap-data)
(sd/add-page page)) (sd/add-page page))
file (-> file file (-> file
(fb/delete-object shape-id)) (fb/delete-shape shape-id))
new-page (fb/get-current-page file) new-page (fb/get-current-page file)
data (sd/update-page data page new-page) data (sd/update-page data page new-page)
@ -201,22 +212,23 @@
(t/is (= (count result-y) 0)))) (t/is (= (count result-y) 0))))
(t/testing "Create simple shape on root. Then remove it" (t/testing "Create simple shape on root. Then remove it"
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/create-rect (fb/add-shape
{:x 0 {:type :rect
:x 0
:y 0 :y 0
:width 100 :width 100
:height 100})) :height 100}))
shape-id (:last-id file) shape-id (::fb/last-id file)
page (fb/get-current-page file) page (fb/get-current-page file)
;; frame-id (:last-id file) ;; frame-id (::fb/last-id file)
data (-> (sd/make-snap-data) data (-> (sd/make-snap-data)
(sd/add-page page)) (sd/add-page page))
file (fb/delete-object file shape-id) file (fb/delete-shape file shape-id)
new-page (fb/get-current-page file) new-page (fb/get-current-page file)
data (sd/update-page data page new-page) data (sd/update-page data page new-page)
@ -229,17 +241,17 @@
(t/is (= (count result-y) 0)))) (t/is (= (count result-y) 0))))
(t/testing "Create shape inside frame, then remove it" (t/testing "Create shape inside frame, then remove it"
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/add-artboard (fb/add-artboard
{:x 0 {:x 0
:y 0 :y 0
:width 100 :width 100
:height 100})) :height 100}))
frame-id (:last-id file) frame-id (::fb/last-id file)
file (fb/create-rect file {:x 25 :y 25 :width 50 :height 50}) file (fb/add-shape file {:type :rect :x 25 :y 25 :width 50 :height 50})
shape-id (:last-id file) shape-id (::fb/last-id file)
file (fb/close-artboard file) file (fb/close-artboard file)
@ -247,7 +259,7 @@
data (-> (sd/make-snap-data) data (-> (sd/make-snap-data)
(sd/add-page page)) (sd/add-page page))
file (fb/delete-object file shape-id) file (fb/delete-shape file shape-id)
new-page (fb/get-current-page file) new-page (fb/get-current-page file)
data (sd/update-page data page new-page) data (sd/update-page data page new-page)
@ -260,16 +272,16 @@
(t/is (= (count result-frame-x) 3)))) (t/is (= (count result-frame-x) 3))))
(t/testing "Create global guide then remove it" (t/testing "Create global guide then remove it"
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/add-guide {:position 50 :axis :x})) (fb/add-guide {:position 50 :axis :x}))
guide-id (:last-id file) guide-id (::fb/last-id file)
file (-> (fb/add-artboard file {:x 200 :y 200 :width 100 :height 100}) file (-> (fb/add-artboard file {:x 200 :y 200 :width 100 :height 100})
(fb/close-artboard)) (fb/close-artboard))
frame-id (:last-id file) frame-id (::fb/last-id file)
page (fb/get-current-page file) page (fb/get-current-page file)
data (-> (sd/make-snap-data) (sd/add-page page)) data (-> (sd/make-snap-data) (sd/add-page page))
@ -293,14 +305,14 @@
(t/is (= (count result-frame-y) 0)))) (t/is (= (count result-frame-y) 0))))
(t/testing "Create frame guide then remove it" (t/testing "Create frame guide then remove it"
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/add-artboard {:x 200 :y 200 :width 100 :height 100}) (fb/add-artboard {:x 200 :y 200 :width 100 :height 100})
(fb/close-artboard)) (fb/close-artboard))
frame-id (:last-id file) frame-id (::fb/last-id file)
file (fb/add-guide file {:position 50 :axis :x :frame-id frame-id}) file (fb/add-guide file {:position 50 :axis :x :frame-id frame-id})
guide-id (:last-id file) guide-id (::fb/last-id file)
page (fb/get-current-page file) page (fb/get-current-page file)
data (-> (sd/make-snap-data) (sd/add-page page)) data (-> (sd/make-snap-data) (sd/add-page page))
@ -324,7 +336,7 @@
(t/is (= (count result-frame-y) 0)))) (t/is (= (count result-frame-y) 0))))
(t/testing "Update frame coordinates" (t/testing "Update frame coordinates"
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/add-artboard (fb/add-artboard
{:x 0 {:x 0
@ -333,17 +345,18 @@
:height 100}) :height 100})
(fb/close-artboard)) (fb/close-artboard))
frame-id (:last-id file) frame-id (::fb/last-id file)
page (fb/get-current-page file) page (fb/get-current-page file)
data (-> (sd/make-snap-data) (sd/add-page page)) data (-> (sd/make-snap-data) (sd/add-page page))
frame (fb/lookup-shape file frame-id) file (fb/update-shape file frame-id
new-frame (-> frame (fn [shape]
(dissoc :selrect :points) (-> shape
(assoc :x 200 :y 200) (dissoc :selrect :points)
(cts/setup-shape)) (assoc :x 200 :y 200)
(cts/setup-shape))))
file (fb/update-object file frame new-frame)
new-page (fb/get-current-page file) new-page (fb/get-current-page file)
data (sd/update-page data page new-page) data (sd/update-page data page new-page)
@ -360,27 +373,30 @@
(t/is (= (count result-frame-x-2) 3)))) (t/is (= (count result-frame-x-2) 3))))
(t/testing "Update shape coordinates" (t/testing "Update shape coordinates"
(let [file (-> (fb/create-file "Test") (let [file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/create-rect (fb/add-shape
{:x 0 {:type :rect
:x 0
:y 0 :y 0
:width 100 :width 100
:height 100})) :height 100}))
shape-id (:last-id file) shape-id (::fb/last-id file)
page (fb/get-current-page file) page (fb/get-current-page file)
data (-> (sd/make-snap-data) (sd/add-page page)) data (-> (sd/make-snap-data)
(sd/add-page page))
shape (fb/lookup-shape file shape-id) file (fb/update-shape file shape-id
new-shape (-> shape (fn [shape]
(dissoc :selrect :points) (-> shape
(assoc :x 200 :y 200)) (dissoc :selrect :points)
(assoc :x 200 :y 200)
(cts/setup-shape))))
file (fb/update-object file shape new-shape)
new-page (fb/get-current-page file) new-page (fb/get-current-page file)
;; FIXME: update
data (sd/update-page data page new-page) data (sd/update-page data page new-page)
result-zero-x-1 (sd/query data (:id page) uuid/zero :x [0 100]) result-zero-x-1 (sd/query data (:id page) uuid/zero :x [0 100])
result-zero-x-2 (sd/query data (:id page) uuid/zero :x [200 300])] result-zero-x-2 (sd/query data (:id page) uuid/zero :x [200 300])]
@ -391,17 +407,17 @@
(t/testing "Update global guide" (t/testing "Update global guide"
(let [guide {:position 50 :axis :x} (let [guide {:position 50 :axis :x}
file (-> (fb/create-file "Test") file (-> (fb/create-file {:name "Test"})
(fb/add-page {:name "Page 1"}) (fb/add-page {:name "Page 1"})
(fb/add-guide guide)) (fb/add-guide guide))
guide-id (:last-id file) guide-id (::fb/last-id file)
guide (assoc guide :id guide-id) guide (assoc guide :id guide-id)
file (-> (fb/add-artboard file {:x 500 :y 500 :width 100 :height 100}) file (-> (fb/add-artboard file {:x 500 :y 500 :width 100 :height 100})
(fb/close-artboard)) (fb/close-artboard))
frame-id (:last-id file) frame-id (::fb/last-id file)
page (fb/get-current-page file) page (fb/get-current-page file)
data (-> (sd/make-snap-data) (sd/add-page page)) data (-> (sd/make-snap-data) (sd/add-page page))

File diff suppressed because it is too large Load diff