penpot/frontend/src/app/plugins/library.cljs
alonso.torres a5ad3caffe 🐛 Check and commit plugin component calls as the UI does
- The UI offers swap and reset only on copy heads, and detach only on
  copies that are not inside another copy. The plugin's swapComponent
  and resetOverrides accepted any shape inside a copy (F92), and its
  detach any shape at all (F93), and sent the same events, whose
  changes expect a head. swapComponent and resetOverrides report "The
  shape is not a component copy head" for anything else; detach
  reports a shape that is not a copy, or a copy inside another copy,
  by ctn/detachable?, which the detach event checks too. swapComponent
  looked up the target file before checking its argument, so a value
  that is not a component failed an assert instead of reporting
  "Component not valid".
- The plugin's switchVariant did not check whether the switch would
  nest a component in itself. The switch event checks that and calls
  the :on-error of its params' metadata; the plugin passed none, so
  the default, rx/throw, built an error observable that nothing used,
  and the call did nothing and reported nothing (F53). The plugin
  passes an :on-error that reports "The switch would create a
  component nesting loop", and the event's default does nothing.
- Choosing a property value in the design tab with several members
  selected sent, for each member, an event that set the value and
  another that cleared its error, each its own commit and undo entry.
  The plugin's setVariantProperty set the value and left the error as
  it was (F94). dwv/update-property-value takes the components, and
  sets the value and clears the error of each in one commit; the
  design tab passes the selected members, the plugin its component,
  and the composable interpreter the one member of its edit.

shape-bugfixes-test checks each plugin case on the proxy, and
workspace-variants-test sets a value on two members with errors.

AI-assisted-by: claude-opus-5-5

Co-Authored-By: Claude Opus 5.5 (1M context) <noreply@anthropic.com>
2026-10-15 00:35:55 +02:00

1274 lines
44 KiB
Clojure

;; 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 SUBSIDIARY SL
(ns app.plugins.library
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.variant :as cfv]
[app.common.geom.point :as gpt]
[app.common.schema :as sm]
[app.common.types.color :as clr]
[app.common.types.component :as ctk]
[app.common.types.file :as ctf]
[app.common.types.text :as txt]
[app.common.types.typography :as ctt]
[app.common.types.variant :as ctv]
[app.common.uuid :as uuid]
[app.main.data.plugins :as dp]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.texts :as dwt]
[app.main.data.workspace.variants :as dwv]
[app.main.fonts :as fonts]
[app.main.repo :as rp]
[app.main.store :as st]
[app.plugins.format :as format]
[app.plugins.parser :as parser]
[app.plugins.register :as r]
[app.plugins.shape :as shape]
[app.plugins.system-events :as se]
[app.plugins.text :as text]
[app.plugins.tokens :as tokens]
[app.plugins.utils :as u]
[app.util.object :as obj]
[beicon.v2.core :as rx]
[cuerdas.core :as str]
[potok.v2.core :as ptk]))
(declare lib-color-proxy)
(declare lib-typography-proxy)
(defn lib-color-proxy? [p]
(obj/type-of? p "LibraryColorProxy"))
(defn lib-color-proxy
[plugin-id file-id id]
(assert (uuid? file-id))
(assert (uuid? id))
(obj/reify {:name "LibraryColorProxy"}
:$plugin {:enumerable false :get (constantly plugin-id)}
:$id {:enumerable false :get (constantly id)}
:$file {:enumerable false :get (constantly file-id)}
:id {:get (fn [] (dm/str id))}
:libraryId {:get (fn [] (dm/str file-id))}
:fileId {:get #(dm/str file-id)}
:name
{:this true
:get #(-> % u/proxy->library-color :name)
:set
(fn [self value]
(cond
(not (string? value))
(u/not-valid plugin-id :name value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :name "Plugin doesn't have 'library:write' permission")
:else
(let [color (u/proxy->library-color self)
value (dm/str (d/nilv (:path color) "") " / " value)]
(st/emit! (dwl/rename-color file-id id value)))))}
:path
{:this true
:get #(-> % u/proxy->library-color :path)
:set
(fn [self value]
(cond
(not (string? value))
(u/not-valid plugin-id :path value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :path "Plugin doesn't have 'library:write' permission")
:else
(let [color (-> (u/proxy->library-color self)
(update :name #(str value " / " %)))]
(st/emit! (dwl/update-color color file-id)))))}
:color
{:this true
:get #(-> % u/proxy->library-color :color)
:set
(fn [self value]
(cond
(or (not (string? value)) (not (clr/valid-hex-color? value)))
(u/not-valid plugin-id :color value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :color "Plugin doesn't have 'library:write' permission")
:else
(let [color (-> (u/proxy->library-color self)
(assoc :color value)
(dissoc :gradient :image))]
(st/emit! (dwl/update-color-data color file-id)))))}
:opacity
{:this true
:get #(-> % u/proxy->library-color :opacity)
:set
(fn [self value]
(cond
(or (not (number? value)) (< value 0) (> value 1))
(u/not-valid plugin-id :opacity value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :opacity "Plugin doesn't have 'library:write' permission")
:else
(let [color (-> (u/proxy->library-color self)
(assoc :opacity value))]
(st/emit! (dwl/update-color-data color file-id)))))}
:gradient
{:this true
:get #(-> % u/proxy->library-color :gradient format/format-gradient)
:set
(fn [self value]
(let [value (parser/parse-gradient value)]
(cond
(not (sm/validate clr/schema:gradient value))
(u/not-valid plugin-id :gradient value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :gradient "Plugin doesn't have 'library:write' permission")
:else
(let [color (-> (u/proxy->library-color self)
(assoc :gradient value)
(dissoc :color :image))]
(st/emit! (dwl/update-color-data color file-id))))))}
:image
{:this true
:get #(-> % u/proxy->library-color :image format/format-image)
:set
(fn [self value]
(let [value (parser/parse-image-data value)]
(cond
(not (sm/validate clr/schema:image value))
(u/not-valid plugin-id :image value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :image "Plugin doesn't have 'library:write' permission")
:else
(let [color (-> (u/proxy->library-color self)
(assoc :image value)
(dissoc :color :gradient))]
(st/emit! (dwl/update-color-data color file-id))))))}
:remove
(fn []
(cond
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :remove "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (-> (dwl/delete-color {:id id})
(se/add-event plugin-id)))))
:clone
(fn []
(cond
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :clone "Plugin doesn't have 'library:write' permission")
:else
(let [color-id (uuid/next)
color (-> (u/locate-library-color file-id id)
(assoc :id color-id))]
(st/emit! (-> (dwl/add-color color {:rename? false})
(se/add-event plugin-id)))
(lib-color-proxy plugin-id id color-id))))
:asFill
(fn []
(let [color (u/locate-library-color file-id id)]
(format/format-fill
{:fill-color (:color color)
:fill-opacity (:opacity color)
:fill-color-gradient (:gradient color)
:fill-color-ref-file file-id
:fill-color-ref-id id
:fill-image (:image color)})))
:asStroke
(fn []
(let [color (u/locate-library-color file-id id)]
(format/format-stroke
{:stroke-color (:color color)
:stroke-opacity (:opacity color)
:stroke-color-gradient (:gradient color)
:stroke-color-ref-file file-id
:stroke-color-ref-id id
:stroke-image (:image color)
:stroke-style :solid
:stroke-alignment :inner})))
:getPluginData
(fn [key]
(cond
(not (string? key))
(u/not-valid plugin-id :getPluginData-key key)
:else
(let [color (u/locate-library-color file-id id)]
(dm/get-in color [:plugin-data (keyword "plugin" (str plugin-id)) key]))))
:setPluginData
(fn [key value]
(cond
(not= file-id (:current-file-id @st/state))
(u/not-valid plugin-id :setPluginData-non-local-library file-id)
(not (string? key))
(u/not-valid plugin-id :setPluginData-key key)
(and (some? value) (not (string? value)))
(u/not-valid plugin-id :setPluginData-value value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :setPluginData "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dp/set-plugin-data file-id :color id (keyword "plugin" (str plugin-id)) key value))))
:getPluginDataKeys
(fn []
(let [color (u/locate-library-color file-id id)]
(apply array (keys (dm/get-in color [:plugin-data (keyword "plugin" (str plugin-id))])))))
:getSharedPluginData
(fn [namespace key]
(cond
(not (string? namespace))
(u/not-valid plugin-id :getSharedPluginData-namespace namespace)
(not (string? key))
(u/not-valid plugin-id :getSharedPluginData-key key)
:else
(let [color (u/locate-library-color file-id id)]
(dm/get-in color [:plugin-data (keyword "shared" namespace) key]))))
:setSharedPluginData
(fn [namespace key value]
(cond
(not= file-id (:current-file-id @st/state))
(u/not-valid plugin-id :setSharedPluginData-non-local-library file-id)
(not (string? namespace))
(u/not-valid plugin-id :setSharedPluginData-namespace namespace)
(not (string? key))
(u/not-valid plugin-id :setSharedPluginData-key key)
(and (some? value) (not (string? value)))
(u/not-valid plugin-id :setSharedPluginData-value value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :setSharedPluginData "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dp/set-plugin-data file-id :color id (keyword "shared" namespace) key value))))
:getSharedPluginDataKeys
(fn [namespace]
(cond
(not (string? namespace))
(u/not-valid plugin-id :getSharedPluginDataKeys-namespace namespace)
:else
(let [color (u/locate-library-color file-id id)]
(apply array (keys (dm/get-in color [:plugin-data (keyword "shared" namespace)]))))))))
(defn lib-typography-proxy? [p]
(obj/type-of? p "LibraryTypographyProxy"))
(defn- font-data
[font variant]
{:font-id (:id font)
:font-family (:family font)
:font-variant-id (:id variant)
:font-style (:style variant)
:font-weight (:weight variant)})
(defn- variant-data
[variant]
{:font-variant-id (:id variant)
:font-style (:style variant)
:font-weight (:weight variant)})
(defn lib-typography-proxy
[plugin-id file-id id]
(assert (uuid? file-id))
(assert (uuid? id))
(obj/reify {:name "LibraryTypographyProxy"}
:$plugin {:enumerable false :get (constantly plugin-id)}
:$id {:enumerable false :get (constantly id)}
:$file {:enumerable false :get (constantly file-id)}
:id {:get (fn [] (dm/str id))}
:libraryId {:get (fn [] (dm/str file-id))}
:name
{:this true
:get #(-> % u/proxy->library-typography :name)
:set
(fn [self value]
(cond
(not (string? value))
(u/not-valid plugin-id :name value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :name "Plugin doesn't have 'library:write' permission")
:else
(let [typo (u/proxy->library-typography self)
value (dm/str (d/nilv (:path typo) "") " / " value)]
(st/emit! (-> (dwl/rename-typography file-id id value)
(se/add-event plugin-id))))))}
:path
{:this true
:get #(-> % u/proxy->library-typography :path)
:set
(fn [self value]
(cond
(not (string? value))
(u/not-valid plugin-id :path value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :path "Plugin doesn't have 'library:write' permission")
:else
(let [typo (-> (u/proxy->library-typography self)
(update :name #(str value " / " %)))]
(st/emit! (dwl/update-typography typo file-id)))))}
:fontId
{:this true
:get #(-> % u/proxy->library-typography :font-id)
:set
(fn [self value]
(let [font (when (string? value) (fonts/get-font-data value))
variant (fonts/get-default-variant font)]
(cond
(nil? font)
(u/not-valid plugin-id :fontId value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :fontId "Plugin doesn't have 'library:write' permission")
:else
(let [typo (-> (u/proxy->library-typography self)
(merge (font-data font variant)))]
(st/emit! (dwl/update-typography typo file-id))))))}
:fontFamily
{:this true
:get #(-> % u/proxy->library-typography :font-family)
:set
(fn [self value]
(let [font (when (string? value) (fonts/find-font-data {:family value}))
variant (fonts/get-default-variant font)]
(cond
(nil? font)
(u/not-valid plugin-id :fontFamily value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :fontFamily "Plugin doesn't have 'library:write' permission")
:else
(let [typo (-> (u/proxy->library-typography self)
(merge (font-data font variant)))]
(st/emit! (dwl/update-typography typo file-id))))))}
:fontVariantId
{:this true
:get #(-> % u/proxy->library-typography :font-variant-id)
:set
(fn [self value]
(let [typo (u/proxy->library-typography self)
font (fonts/get-font-data (:font-id typo))
variant (when (string? value) (fonts/find-variant font {:id value}))]
(cond
(nil? variant)
(u/not-valid plugin-id :fontVariantId value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :fontVariantId "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dwl/update-typography (merge typo (variant-data variant)) file-id)))))}
:fontSize
{:this true
:get #(-> % u/proxy->library-typography :font-size)
:set
(fn [self value]
(let [value (some-> value str/trim)]
(cond
(not (txt/valid-font-size? value))
(u/not-valid plugin-id :fontSize value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :fontSize "Plugin doesn't have 'library:write' permission")
:else
(let [typo (-> (u/proxy->library-typography self)
(assoc :font-size value))]
(st/emit! (dwl/update-typography typo file-id))))))}
:fontWeight
{:this true
:get #(-> % u/proxy->library-typography :font-weight)
:set
(fn [self value]
(let [typo (u/proxy->library-typography self)
font (fonts/get-font-data (:font-id typo))
variant (when (string? value)
(or (fonts/find-variant font {:style (:font-style typo) :weight value})
(fonts/find-variant font {:weight value})))]
(cond
(nil? variant)
(u/not-valid plugin-id :fontWeight value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :fontWeight "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dwl/update-typography (merge typo (variant-data variant)) file-id)))))}
:fontStyle
{:this true
:get #(-> % u/proxy->library-typography :font-style)
:set
(fn [self value]
(let [typo (u/proxy->library-typography self)
font (fonts/get-font-data (:font-id typo))
variant (when (string? value)
(or (fonts/find-variant font {:weight (:font-weight typo) :style value})
(fonts/find-variant font {:style value})))]
(cond
(nil? variant)
(u/not-valid plugin-id :fontStyle value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :fontStyle "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dwl/update-typography (merge typo (variant-data variant)) file-id)))))}
:lineHeight
{:this true
:get #(-> % u/proxy->library-typography :line-height)
:set
(fn [self value]
(let [value (some-> value str/trim)]
(cond
(not (txt/valid-line-height? value))
(u/not-valid plugin-id :lineHeight value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :lineHeight "Plugin doesn't have 'library:write' permission")
:else
(let [typo (-> (u/proxy->library-typography self)
(assoc :line-height value))]
(st/emit! (dwl/update-typography typo file-id))))))}
:letterSpacing
{:this true
:get #(-> % u/proxy->library-typography :letter-spacing)
:set
(fn [self value]
(let [value (some-> value str/trim)]
(cond
(not (txt/valid-letter-spacing? value))
(u/not-valid plugin-id :letterSpacing value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :letterSpacing "Plugin doesn't have 'library:write' permission")
:else
(let [typo (-> (u/proxy->library-typography self)
(assoc :letter-spacing value))]
(st/emit! (dwl/update-typography typo file-id))))))}
:textTransform
{:this true
:get #(-> % u/proxy->library-typography :text-transform)
:set
(fn [self value]
(cond
(not (txt/valid-text-transform? value))
(u/not-valid plugin-id :textTransform value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :textTransform "Plugin doesn't have 'library:write' permission")
:else
(let [typo (-> (u/proxy->library-typography self)
(assoc :text-transform value))]
(st/emit! (dwl/update-typography typo file-id)))))}
:setFont
(fn [font variant]
(cond
(not (obj/type-of? font "FontProxy"))
(u/not-valid plugin-id :setFont font)
(and (some? variant)
(or (not (obj/type-of? variant "FontVariantProxy"))
(not= (obj/get font "fontId") (obj/get variant "$font-id"))))
(u/not-valid plugin-id :setFont variant)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :setFont "Plugin doesn't have 'library:write' permission")
:else
;; When a variant is given read the variant-specific fields from it;
;; otherwise the FontProxy exposes the font's default variant fields.
(let [source (if (obj/type-of? variant "FontVariantProxy") variant font)
typo (-> (u/locate-library-typography file-id id)
(assoc :font-id (obj/get font "fontId")
:font-family (obj/get font "fontFamily")
:font-variant-id (obj/get source "fontVariantId")
:font-style (obj/get source "fontStyle")
:font-weight (obj/get source "fontWeight")))]
(st/emit! (dwl/update-typography typo file-id)))))
:remove
(fn []
(cond
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :remove "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (-> (dwl/delete-typography id)
(se/add-event plugin-id)))))
:clone
(fn []
(cond
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :clone "Plugin doesn't have 'library:write' permission")
:else
(let [typo-id (uuid/next)
typo (-> (u/locate-library-typography file-id id)
(assoc :id typo-id))]
(st/emit! (-> (dwl/add-typography typo false)
(se/add-event plugin-id)))
(lib-typography-proxy plugin-id id typo-id))))
:applyToText
(fn [shape]
(cond
(not (shape/shape-proxy? shape))
(u/not-valid plugin-id :applyToText shape)
(not (r/check-permission plugin-id "content:write"))
(u/not-valid plugin-id :applyToText "Plugin doesn't have 'content:write' permission")
(not (u/page-active? (obj/get shape "$page")))
(u/not-valid plugin-id :applyToText "Cannot modify a page that is not currently active")
:else
(let [shape-id (obj/get shape "$id")
typography (u/locate-library-typography file-id id)]
(st/emit! (dwt/apply-typography #{shape-id} typography file-id)))))
:applyToTextRange
(fn [range]
(cond
(not (text/text-range-proxy? range))
(u/not-valid plugin-id :applyToText range)
(not (r/check-permission plugin-id "content:write"))
(u/not-valid plugin-id :applyToText "Plugin doesn't have 'content:write' permission")
(not (u/page-active? (obj/get range "$page")))
(u/not-valid plugin-id :applyToText "Cannot modify a page that is not currently active")
:else
(let [shape-id (obj/get range "$id")
start (obj/get range "$start")
end (obj/get range "$end")
typography (u/locate-library-typography file-id id)
attrs (-> typography
(assoc :typography-ref-file file-id)
(assoc :typography-ref-id (:id typography))
(dissoc :id :name))]
(st/emit! (dwt/update-text-range shape-id start end attrs)))))
;; PLUGIN DATA
:getPluginData
(fn [key]
(cond
(not (string? key))
(u/not-valid plugin-id :typography-plugin-data-key key)
:else
(let [typography (u/locate-library-typography file-id id)]
(dm/get-in typography [:plugin-data (keyword "plugin" (str plugin-id)) key]))))
:setPluginData
(fn [key value]
(cond
(not= file-id (:current-file-id @st/state))
(u/not-valid plugin-id :setPluginData-non-local-library file-id)
(not (string? key))
(u/not-valid plugin-id :setPluginData-key key)
(and (some? value) (not (string? value)))
(u/not-valid plugin-id :setPluginData-value value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :setPluginData "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dp/set-plugin-data file-id :typography id (keyword "plugin" (str plugin-id)) key value))))
:getPluginDataKeys
(fn []
(let [typography (u/locate-library-typography file-id id)]
(apply array (keys (dm/get-in typography [:plugin-data (keyword "plugin" (str plugin-id))])))))
:getSharedPluginData
(fn [namespace key]
(cond
(not (string? namespace))
(u/not-valid plugin-id :getSharedPluginData-namespace namespace)
(not (string? key))
(u/not-valid plugin-id :getSharedPluginData-key key)
:else
(let [typography (u/locate-library-typography file-id id)]
(dm/get-in typography [:plugin-data (keyword "shared" namespace) key]))))
:setSharedPluginData
(fn [namespace key value]
(cond
(not= file-id (:current-file-id @st/state))
(u/not-valid plugin-id :setSharedPluginData-non-local-library file-id)
(not (string? namespace))
(u/not-valid plugin-id :setSharedPluginData-namespace namespace)
(not (string? key))
(u/not-valid plugin-id :setSharedPluginData-key key)
(and (some? value) (not (string? value)))
(u/not-valid plugin-id :setSharedPluginData-value value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :setSharedPluginData "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dp/set-plugin-data file-id :typography id (keyword "shared" namespace) key value))))
:getSharedPluginDataKeys
(fn [namespace]
(cond
(not (string? namespace))
(u/not-valid plugin-id :getSharedPluginDataKeys-namespace namespace)
:else
(let [typography (u/locate-library-typography file-id id)]
(apply array (keys (dm/get-in typography [:plugin-data (keyword "shared" namespace)]))))))))
(defn get-variant-components
[file-id variant-id]
(cfv/find-variant-components (-> file-id u/locate-file :data) variant-id))
(declare lib-component-proxy)
(defn variant-proxy
[plugin-id file-id id]
(obj/reify {:name "VariantProxy"}
:$plugin {:enumerable false :get (constantly plugin-id)}
:$file {:enumerable false :get (constantly file-id)}
:$id {:enumerable false :get (constantly id)}
:id {:get (fn [] (dm/str id))}
:libraryId {:get (fn [] (dm/str file-id))}
:properties
{:this true
:get (fn [_]
(->> (get-variant-components file-id id)
(mapcat :variant-properties)
(keep :name)
(set)
(apply array)))}
:currentValues
(fn [property]
(->> (get-variant-components file-id id)
(map
(fn [{:keys [variant-properties]}]
(->> variant-properties
(d/seek #(= (:name %) property)))))
(keep :value)
(set)
(apply array)))
:variantComponents
(fn []
(->> (get-variant-components file-id id)
(map :id)
(map #(lib-component-proxy plugin-id file-id %))
(apply array)))
:addVariant
(fn []
(cond
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :addVariant "Plugin doesn't have 'library:write' permission")
:else
(st/emit!
(se/event plugin-id "add-new-variant")
(dwv/add-new-variant id))))
:addProperty
(fn []
(cond
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :addProperty "Plugin doesn't have 'library:write' permission")
:else
(st/emit!
(se/event plugin-id "add-new-property")
(dwv/add-new-property id {:property-value "Value 1"}))))
:removeProperty
(fn [pos]
(let [properties (->> (get-variant-components file-id id) first :variant-properties)
nprops (count properties)]
(cond
(or (not (nat-int? pos)) (>= pos nprops))
(u/not-valid plugin-id :pos pos)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :removeProperty "Plugin doesn't have 'library:write' permission")
(not (ctv/can-remove-property? properties))
(u/not-valid plugin-id :removeProperty "A variant must keep at least one property")
:else
(st/emit!
(se/event plugin-id "remove-property")
(dwv/remove-property id pos)))))
:renameProperty
(fn [pos name]
(let [nprops (->> (get-variant-components file-id id) first :variant-properties count)]
(cond
(or (not (nat-int? pos)) (>= pos nprops))
(u/not-valid plugin-id :pos pos)
(not (ctv/valid-property-name? name))
(u/not-valid plugin-id :name name)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :renameProperty "Plugin doesn't have 'library:write' permission")
:else
(st/emit!
(dwv/update-property-name id pos (ctv/normalize-property-text name)
{:trigger "plugin:rename-property"})))))))
(set! shape/variant-proxy variant-proxy)
(defn lib-component-proxy? [p]
(obj/type-of? p "LibraryComponentProxy"))
(defn lib-component-proxy
[plugin-id file-id id]
(assert (uuid? file-id))
(assert (uuid? id))
(obj/reify {:name "LibraryComponentProxy"}
:$plugin {:enumerable false :get (constantly plugin-id)}
:$id {:enumerable false :get (constantly id)}
:$file {:enumerable false :get (constantly file-id)}
:id {:get (fn [] (dm/str id))}
:libraryId {:get (fn [] (dm/str file-id))}
:name
{:this true
:get #(-> % u/proxy->library-component :name)
:set
(fn [self value]
(cond
(not (string? value))
(u/not-valid plugin-id :name value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :name "Plugin doesn't have 'library:write' permission")
:else
(let [component (u/proxy->library-component self)
value (dm/str (d/nilv (:path component) "") " / " value)]
(st/emit! (dwv/rename-comp-or-variant-and-main id value)))))}
:path
{:this true
:get #(-> % u/proxy->library-component :path)
:set
(fn [self value]
(cond
(not (string? value))
(u/not-valid plugin-id :path value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :path "Plugin doesn't have 'library:write' permission")
:else
(let [component (u/proxy->library-component self)
value (dm/str value " / " (:name component))]
(st/emit! (dwv/rename-comp-or-variant-and-main id value)))))}
:remove
(fn []
(cond
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :remove "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dwl/delete-component {:id id}))))
:instance
(fn []
(cond
(not (r/check-permission plugin-id "content:write"))
(u/not-valid plugin-id :instance "Plugin doesn't have 'content:write' permission")
:else
(let [id-ref (atom nil)]
(st/emit! (-> (dwl/instantiate-component file-id id (gpt/point 0 0) {:id-ref id-ref :origin "plugin"})
(se/add-event plugin-id)))
(shape/shape-proxy plugin-id @id-ref))))
:getPluginData
(fn [key]
(cond
(not (string? key))
(u/not-valid plugin-id :component-plugin-data-key key)
:else
(let [component (u/locate-library-component file-id id)]
(dm/get-in component [:plugin-data (keyword "plugin" (str plugin-id)) key]))))
:setPluginData
(fn [key value]
(cond
(not= file-id (:current-file-id @st/state))
(u/not-valid plugin-id :setPluginData-non-local-library file-id)
(not (string? key))
(u/not-valid plugin-id :setPluginData-key key)
(and (some? value) (not (string? value)))
(u/not-valid plugin-id :setPluginData-value value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :setPluginData "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dp/set-plugin-data file-id :component id (keyword "plugin" (str plugin-id)) key value))))
:getPluginDataKeys
(fn []
(let [component (u/locate-library-component file-id id)]
(apply array (keys (dm/get-in component [:plugin-data (keyword "plugin" (str plugin-id))])))))
:getSharedPluginData
(fn [namespace key]
(cond
(not (string? namespace))
(u/not-valid plugin-id :component-plugin-data-namespace namespace)
(not (string? key))
(u/not-valid plugin-id :component-plugin-data-key key)
:else
(let [component (u/locate-library-component file-id id)]
(dm/get-in component [:plugin-data (keyword "shared" namespace) key]))))
:setSharedPluginData
(fn [namespace key value]
(cond
(not= file-id (:current-file-id @st/state))
(u/not-valid plugin-id :setSharedPluginData-non-local-library file-id)
(not (string? namespace))
(u/not-valid plugin-id :setSharedPluginData-namespace namespace)
(not (string? key))
(u/not-valid plugin-id :setSharedPluginData-key key)
(and (some? value) (not (string? value)))
(u/not-valid plugin-id :setSharedPluginData-value value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :setSharedPluginData "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dp/set-plugin-data file-id :component id (keyword "shared" namespace) key value))))
:getSharedPluginDataKeys
(fn [namespace]
(cond
(not (string? namespace))
(u/not-valid plugin-id :component-plugin-data-namespace namespace)
:else
(let [component (u/locate-library-component file-id id)]
(apply array (keys (dm/get-in component [:plugin-data (keyword "shared" namespace)]))))))
:mainInstance
(fn []
(let [file (u/locate-file file-id)
component (u/locate-library-component file-id id)
root (ctf/get-component-root (:data file) component)]
(when (some? root)
(shape/shape-proxy plugin-id file-id (:main-instance-page component) (:id root)))))
:isVariant
(fn []
(let [component (u/locate-library-component file-id id)]
(ctk/is-variant? component)))
:variants
{:enumerable false
:get
(fn []
(let [component (u/locate-library-component file-id id)]
(when (ctk/is-variant? component)
(variant-proxy plugin-id file-id (:variant-id component)))))}
:variantProps
{:get
(fn []
(let [component (u/locate-library-component file-id id)]
(when (ctk/is-variant? component)
(->> (:variant-properties component)
(reduce
(fn [acc {:keys [name value]}]
(obj/set! acc name value))
#js {})))))}
:variantError
{:get (fn []
(let [file (u/locate-file file-id)
component (u/locate-library-component file-id id)
root (ctf/get-component-root (:data file) component)]
(when (ctk/is-variant? component)
(:variant-error root))))}
:transformInVariant
(fn []
(let [component (u/locate-library-component file-id id)]
(cond
(or (nil? component)
(ctk/is-variant? component))
nil
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :transformInVariant "Plugin doesn't have 'library:write' permission")
:else
(st/emit!
(se/event plugin-id "transform-in-variant")
(dwv/transform-in-variant (:main-instance-id component))))))
:addVariant
(fn []
(let [component (u/locate-library-component file-id id)]
(cond
(or (nil? component)
(not (ctk/is-variant? component)))
nil
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :addVariant "Plugin doesn't have 'library:write' permission")
:else
(st/emit!
(se/event plugin-id "add-new-variant")
(dwv/add-new-variant (:main-instance-id component))))))
:setVariantProperty
(fn [pos value]
(let [nprops (-> (u/locate-library-component file-id id) :variant-properties count)]
(cond
(or (not (nat-int? pos)) (>= pos nprops))
(u/not-valid plugin-id :pos (str pos))
(not (ctv/valid-property-value? value))
(u/not-valid plugin-id :value value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :setVariantProperty "Plugin doesn't have 'library:write' permission")
:else
(st/emit!
(se/event plugin-id "variant-edit-property-value")
(dwv/update-property-value [id] pos (ctv/normalize-property-text value))))))))
(defn library-proxy? [p]
(obj/type-of? p "LibraryProxy"))
(defn library-proxy
[plugin-id file-id]
(assert (uuid? file-id) "File id not valid")
(obj/reify {:name "LibraryProxy"}
:$plugin {:enumerable false :get (constantly plugin-id)}
:$id {:enumerable false :get (constantly file-id)}
:id
{:this true
:get #(-> % u/proxy->file :id str)}
:name
{:this true
:get #(-> % u/proxy->file :name)}
:colors
{:this true
:get
(fn [_]
(let [file (u/locate-file file-id)
colors (->> file :data :colors keys (map #(lib-color-proxy plugin-id file-id %)))]
(apply array colors)))}
:typographies
{:this true
:get
(fn [_]
(let [file (u/locate-file file-id)
typographies (->> file :data :typographies keys (map #(lib-typography-proxy plugin-id file-id %)))]
(apply array typographies)))}
:components
{:this true
:get
(fn [_]
(let [file (u/locate-file file-id)
data (:data file)
components (->> data
:components
(remove (comp :deleted second))
(remove (comp #(cfv/is-secondary-variant? % data) second))
(map first)
(map #(lib-component-proxy plugin-id file-id %)))]
(apply array components)))}
:tokens
{:this true
:get
(fn [_]
(tokens/tokens-catalog plugin-id file-id))}
:createColor
(fn []
(cond
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :createColor "Plugin doesn't have 'library:write' permission")
:else
(let [color-id (uuid/next)]
(st/emit! (-> (dwl/add-color {:id color-id :name "Color" :color "#000000" :opacity 1} {:rename? false})
(se/add-event plugin-id)))
(lib-color-proxy plugin-id file-id color-id))))
:createTypography
(fn []
(cond
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :createTypography "Plugin doesn't have 'library:write' permission")
:else
(let [typography-id (uuid/next)]
(st/emit! (-> (dwl/add-typography (ctt/make-typography {:id typography-id :name "Typography"}) false)
(se/add-event plugin-id)))
(lib-typography-proxy plugin-id file-id typography-id))))
:createComponent
(fn [shapes]
(cond
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :createComponent "Plugin doesn't have 'library:write' permission")
:else
(let [id-ref (atom nil)
ids (into #{} (map #(obj/get % "$id")) shapes)]
(st/emit! (-> (dwl/add-component id-ref ids)
(se/add-event plugin-id)))
;; add-component only sets id-ref when it actually creates a
;; component; an empty selection or shapes that can't form one
;; leave it nil, so reject instead of returning a broken proxy.
(if-let [id @id-ref]
(lib-component-proxy plugin-id file-id id)
(u/not-valid plugin-id :createComponent "Cannot create a component from the given shapes")))))
;; Plugin data
:getPluginData
(fn [key]
(cond
(not (string? key))
(u/not-valid plugin-id :file-plugin-data-key key)
:else
(let [file (u/locate-file file-id)]
(dm/get-in file [:data :plugin-data (keyword "plugin" (str plugin-id)) key]))))
:setPluginData
(fn [key value]
(cond
(not= file-id (:current-file-id @st/state))
(u/not-valid plugin-id :setPluginData-non-local-library file-id)
(not (string? key))
(u/not-valid plugin-id :setPluginData-key key)
(and (some? value) (not (string? value)))
(u/not-valid plugin-id :setPluginData-value value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :setPluginData "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dp/set-plugin-data file-id :file (keyword "plugin" (str plugin-id)) key value))))
:getPluginDataKeys
(fn []
(let [file (u/locate-file file-id)]
(apply array (keys (dm/get-in file [:data :plugin-data (keyword "plugin" (str plugin-id))])))))
:getSharedPluginData
(fn [namespace key]
(cond
(not (string? namespace))
(u/not-valid plugin-id :file-plugin-data-namespace namespace)
(not (string? key))
(u/not-valid plugin-id :file-plugin-data-key key)
:else
(let [file (u/locate-file file-id)]
(dm/get-in file [:data :plugin-data (keyword "shared" namespace) key]))))
:setSharedPluginData
(fn [namespace key value]
(cond
(not= file-id (:current-file-id @st/state))
(u/not-valid plugin-id :setSharedPluginData-non-local-library file-id)
(not (string? namespace))
(u/not-valid plugin-id :setSharedPluginData-namespace namespace)
(not (string? key))
(u/not-valid plugin-id :setSharedPluginData-key key)
(and (some? value) (not (string? value)))
(u/not-valid plugin-id :setSharedPluginData-value value)
(not (r/check-permission plugin-id "library:write"))
(u/not-valid plugin-id :setSharedPluginData "Plugin doesn't have 'library:write' permission")
:else
(st/emit! (dp/set-plugin-data file-id :file (keyword "shared" namespace) key value))))
:getSharedPluginDataKeys
(fn [namespace]
(cond
(not (string? namespace))
(u/not-valid plugin-id :namespace namespace)
:else
(let [file (u/locate-file file-id)]
(apply array (keys (dm/get-in file [:data :plugin-data (keyword "shared" namespace)]))))))))
(defn library-subcontext
[plugin-id]
(obj/reify {:name "PenpotLibrarySubcontext"}
:$plugin {:enumerable false :get (constantly plugin-id)}
:local
{:get #(library-proxy plugin-id (:current-file-id @st/state))}
:connected
{:get
(fn []
(let [libraries (get @st/state :files)]
(apply array (->> libraries keys (map (partial library-proxy plugin-id))))))}
:availableLibraries
(fn []
(let [team-id (:current-team-id @st/state)]
(js/Promise.
(fn [resolve reject]
(let [current-libs (into #{} (map first) (get @st/state :files))]
(->> (rp/cmd! :get-team-shared-files {:team-id team-id})
(rx/map (fn [result]
(->> result
(filter #(not (contains? current-libs (:id %))))
(map
(fn [{:keys [id name library-summary]}]
#js {:id (dm/str id)
:name name
:numColors (-> library-summary :colors :count)
:numComponents (-> library-summary :components :count)
:numTypographies (-> library-summary :typographies :count)}))
(apply array))))
(rx/subs! resolve reject)))))))
:connectLibrary
(fn [library-id]
(js/Promise.
(fn [resolve reject]
(cond
(not (r/check-permission plugin-id "library:write"))
(u/reject-not-valid reject :connectLibrary "Plugin doesn't have 'library:write' permission")
(not (uuid/parse* library-id))
(u/reject-not-valid reject :connectLibrary library-id)
:else
(let [file-id (:current-file-id @st/state)
team-id (:current-team-id @st/state)
library-id (uuid/parse library-id)]
(->> (rp/cmd! :get-team-shared-files {:team-id team-id})
(rx/subs!
(fn [shared-files]
;; Only published libraries of the team can be linked
(if (or (= library-id file-id)
(not (some #(= library-id (:id %)) shared-files)))
(u/reject-not-valid reject :connectLibrary
(dm/str library-id " is not a published library"))
(do
(->> st/stream
(rx/filter (ptk/type? ::dwl/link-file-to-library-finished))
(rx/take 1)
(rx/subs! #(resolve (library-proxy plugin-id library-id)) reject))
(st/emit! (-> (dwl/link-file-to-library file-id library-id)
(se/add-event plugin-id))))))
reject)))))))))