github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-05-03 07:08:44 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/staging' into develop

Browse Source
This commit is contained in:
Andrey Antukh 2024-01-25 23:26:55 +01:00
commit 8abab982e7
110 changed files with 2889 additions and 1440 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.clj-kondo/config.edn
View File

@ -5,6 +5,7 @@
promesa.exec.csp/go-loop clojure.core/loop
rumext.v2/defc clojure.core/defn
promesa.util/with-open clojure.core/with-open
app.common.schema.generators/let clojure.core/let
app.common.data/export clojure.core/def
app.common.data.macros/get-in clojure.core/get-in
app.common.data.macros/with-open clojure.core/with-open

2
backend/resources/log4j2-devenv.xml
View File

@ -30,7 +30,7 @@
<Logger name="app.util.websocket" level="info" />
<Logger name="app.redis" level="info" />
<Logger name="app.rpc.rlimit" level="info" />
<Logger name="app.rpc.climit" level="info" />
<Logger name="app.rpc.climit" level="debug" />
<Logger name="app.common.files.migrations" level="info" />
<Logger name="app.loggers" level="debug" additivity="false">

71
backend/resources/log4j2-experiments.xml Normal file
View File

@ -0,0 +1,71 @@
<?xml version="1.0" encoding="UTF-8"?>
<Configuration status="info" monitorInterval="30">
<Appenders>
<Console name="console" target="SYSTEM_OUT">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
alwaysWriteExceptions="true" />
</Console>
<RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
alwaysWriteExceptions="true" />
<Policies>
<SizeBasedTriggeringPolicy size="50M"/>
</Policies>
<DefaultRolloverStrategy max="9"/>
</RollingFile>
<RollingFile name="reports" fileName="logs/reports.log" filePattern="logs/reports-%i.log">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
alwaysWriteExceptions="true" />
<Policies>
<SizeBasedTriggeringPolicy size="100M"/>
</Policies>
<DefaultRolloverStrategy max="9"/>
</RollingFile>
</Appenders>
<Loggers>
<Logger name="io.lettuce" level="error" />
<Logger name="com.zaxxer.hikari" level="error"/>
<Logger name="org.postgresql" level="error" />
<Logger name="app.rpc.commands.binfile" level="debug" />
<Logger name="app.storage.tmp" level="info" />
<Logger name="app.worker" level="trace" />
<Logger name="app.msgbus" level="info" />
<Logger name="app.http.websocket" level="info" />
<Logger name="app.http.sse" level="info" />
<Logger name="app.util.websocket" level="info" />
<Logger name="app.redis" level="info" />
<Logger name="app.rpc.rlimit" level="info" />
<Logger name="app.rpc.climit" level="debug" />
<Logger name="app.common.files.migrations" level="info" />
<Logger name="app.loggers" level="debug" additivity="false">
<AppenderRef ref="main" level="debug" />
</Logger>
<Logger name="app.features" level="all" additivity="true">
<AppenderRef ref="reports" level="warn" />
<!-- <AppenderRef ref="main" level="debug" /> -->
</Logger>
<Logger name="app.srepl" level="all" additivity="true">
<AppenderRef ref="reports" level="warn" />
<!-- <AppenderRef ref="main" level="trace" /> -->
</Logger>
<Logger name="app" level="all" additivity="false">
<AppenderRef ref="main" level="trace" />
</Logger>
<Logger name="user" level="trace" additivity="false">
<AppenderRef ref="main" level="trace" />
</Logger>
<Root level="info">
<AppenderRef ref="main" />
</Root>
</Loggers>
</Configuration>

49
backend/scripts/repl-test Executable file
View File

@ -0,0 +1,49 @@
#!/usr/bin/env bash
source /home/penpot/backend/environ
export PENPOT_FLAGS="$PENPOT_FLAGS disable-backend-worker"
export OPTIONS="
-A:jmx-remote -A:dev \
-J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-J-Djdk.attach.allowAttachSelf \
-J-Dlog4j2.configurationFile=log4j2-experiments.xml \
-J-XX:-OmitStackTraceInFastThrow \
-J-XX:+UnlockDiagnosticVMOptions \
-J-XX:+DebugNonSafepoints \
-J-Djdk.tracePinnedThreads=full \
-J-Dpolyglot.engine.WarnInterpreterOnly=false \
-J--enable-preview";
# Setup HEAP
#export OPTIONS="$OPTIONS -J-Xms900m -J-Xmx900m -J-XX:+AlwaysPreTouch"
export OPTIONS="$OPTIONS -J-Xms1g -J-Xmx25g"
#export OPTIONS="$OPTIONS -J-Xms900m -J-Xmx900m -J-XX:+AlwaysPreTouch"
export PENPOT_HTTP_SERVER_IO_THREADS=2
export PENPOT_HTTP_SERVER_WORKER_THREADS=2
# Increase virtual thread pool size
# export OPTIONS="$OPTIONS -J-Djdk.virtualThreadScheduler.parallelism=16"
# Disable C2 Compiler
# export OPTIONS="$OPTIONS -J-XX:TieredStopAtLevel=1"
# Disable all compilers
# export OPTIONS="$OPTIONS -J-Xint"
# Setup GC
export OPTIONS="$OPTIONS -J-XX:+UseG1GC -J-Xlog:gc:logs/gc.log"
# Setup GC
#export OPTIONS="$OPTIONS -J-XX:+UseZGC -J-XX:+ZGenerational -J-Xlog:gc:gc.log"
# Enable ImageMagick v7.x support
# export OPTIONS="-J-Dim4java.useV7=true $OPTIONS";
export OPTIONS_EVAL="nil"
# export OPTIONS_EVAL="(set! *warn-on-reflection* true)"
set -ex
exec clojure $OPTIONS -M -e "$OPTIONS_EVAL" -m rebel-readline.main

5
backend/src/app/config.clj
View File

@ -209,7 +209,6 @@
(s/def ::telemetry-uri ::us/string)
(s/def ::telemetry-with-taiga ::us/boolean)
(s/def ::tenant ::us/string)
(s/def ::svgo-max-procs ::us/integer)
(s/def ::config
(s/keys :opt-un [::secret-key
@ -329,9 +328,7 @@
::telemetry-uri
::telemetry-referer
::telemetry-with-taiga
::tenant
::svgo-max-procs]))
::tenant]))
(def default-flags
[:enable-backend-api-doc

23
backend/src/app/db.clj
View File

@ -517,9 +517,11 @@
(defn rollback!
([conn]
(let [^Connection conn (get-connection conn)]
(l/trc :hint "explicit rollback requested")
(.rollback conn)))
(if (and (map? conn) (::savepoint conn))
(rollback! conn (::savepoint conn))
(let [^Connection conn (get-connection conn)]
(l/trc :hint "explicit rollback requested")
(.rollback conn))))
([conn ^Savepoint sp]
(let [^Connection conn (get-connection conn)]
(l/trc :hint "explicit rollback requested (savepoint)")
@ -538,8 +540,13 @@
(let [conn (::conn system)
sp (savepoint conn)]
(try
(let [result (apply f system params)]
(release! conn sp)
(let [system' (-> system
(assoc ::savepoint sp)
(dissoc ::rollback))
result (apply f system' params)]
(if (::rollback system)
(rollback! conn sp)
(release! conn sp))
result)
(catch Throwable cause
(.rollback ^Connection conn ^Savepoint sp)
@ -547,8 +554,10 @@
(::pool system)
(with-atomic [conn (::pool system)]
(let [system (assoc system ::conn conn)
result (apply f system params)]
(let [system' (-> system
(assoc ::conn conn)
(dissoc ::rollback))
result (apply f system' params)]
(when (::rollback system)
(rollback! conn))
result))

711
backend/src/app/features/components_v2.clj
View File

@ -16,21 +16,30 @@
[app.common.files.migrations :as fmg]
[app.common.files.shapes-helpers :as cfsh]
[app.common.files.validate :as cfv]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.path :as gshp]
[app.common.logging :as l]
[app.common.math :as mth]
[app.common.schema :as sm]
[app.common.svg :as csvg]
[app.common.svg.shapes-builder :as sbuilder]
[app.common.types.color :as ctc]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
[app.common.types.container :as ctn]
[app.common.types.file :as ctf]
[app.common.types.page :as ctp]
[app.common.types.pages-list :as ctpl]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.path :as ctsp]
[app.common.types.shape.text :as ctsx]
[app.common.uuid :as uuid]
[app.db :as db]
[app.db.sql :as sql]
[app.features.fdata :as fdata]
[app.http.sse :as sse]
[app.media :as media]
@ -41,29 +50,34 @@
[app.storage.tmp :as tmp]
[app.svgo :as svgo]
[app.util.blob :as blob]
[app.util.cache :as cache]
[app.util.pointer-map :as pmap]
[app.util.time :as dt]
[buddy.core.codecs :as bc]
[cuerdas.core :as str]
[datoteka.io :as io]
[promesa.core :as p]))
[promesa.exec :as px]
[promesa.util :as pu]))
(def ^:dynamic *stats*
"A dynamic var for setting up state for collect stats globally."
nil)
(def ^:dynamic *skip-on-error*
"A dynamic var for setting up the default error behavior."
true)
(def ^:dynamic *cache*
"A dynamic var for setting up a cache instance."
nil)
(def ^:dynamic *skip-on-graphic-error*
"A dynamic var for setting up the default error behavior for graphics processing."
nil)
(def ^:dynamic ^:private *system*
"An internal var for making the current `system` available to all
internal functions without the need to explicitly pass it top down."
nil)
(def ^:dynamic ^:private *max-procs*
"A dynamic variable that can optionally indicates the maxumum number
of concurrent graphics migration processes."
(def ^:dynamic ^:private *team-id*
"A dynamic var that holds the current processing team-id."
nil)
(def ^:dynamic ^:private *file-stats*
@ -91,21 +105,316 @@
;; FILE PREPARATION BEFORE MIGRATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def valid-color? (sm/lazy-validator ::ctc/recent-color))
(def valid-fill? (sm/lazy-validator ::cts/fill))
(def valid-stroke? (sm/lazy-validator ::cts/stroke))
(def valid-flow? (sm/lazy-validator ::ctp/flow))
(def valid-text-content?
(sm/lazy-validator ::ctsx/content))
(def valid-path-content?
(sm/lazy-validator ::ctsp/content))
(def valid-path-segment?
(sm/lazy-validator ::ctsp/segment))
(def valid-rgb-color-string?
(sm/lazy-validator ::ctc/rgb-color))
(defn- prepare-file-data
"Apply some specific migrations or fixes to things that are allowed in v1 but not in v2,
or that are the result of old bugs."
[file-data libraries]
(let [detached-ids (volatile! #{})
detach-shape
(fn [container shape]
;; Detach a shape. If it's inside a component, add it to detached-ids, for further use.
;; Detach a shape. If it's inside a component, add it to detached-ids. This list
;; is used later to process any other copy that was referencing a detached copy.
(let [is-component? (let [root-shape (ctst/get-shape container (:id container))]
(and (some? root-shape) (nil? (:parent-id root-shape))))]
(when is-component?
(vswap! detached-ids conj (:id shape)))
(ctk/detach-shape shape)))
fix-bad-children
(fn [file-data]
;; Remove any child that does not exist. And also remove duplicated children.
(letfn [(fix-container
[container]
(d/update-when container :objects update-vals (partial fix-shape container)))
(fix-shape
[container shape]
(let [objects (:objects container)]
(d/update-when shape :shapes
(fn [shapes]
(->> shapes
(d/removev #(nil? (get objects %)))
(into [] (distinct)))))))]
(-> file-data
(update :pages-index update-vals fix-container)
(d/update-when :components update-vals fix-container))))
fix-missing-image-metadata
(fn [file-data]
;; Delete broken image shapes with no metadata.
(letfn [(fix-container
[container]
(d/update-when container :objects #(reduce-kv fix-shape % %)))
(fix-shape
[objects id shape]
(if (and (cfh/image-shape? shape)
(nil? (:metadata shape)))
(-> objects
(dissoc id)
(d/update-in-when [(:parent-id shape) :shapes]
(fn [shapes] (filterv #(not= id %) shapes))))
objects))]
(-> file-data
(update :pages-index update-vals fix-container)
(d/update-when :components update-vals fix-container))))
fix-page-invalid-options
(fn [file-data]
(letfn [(update-page [page]
(update page :options fix-options))
(fix-background [options]
(if (and (contains? options :background)
(not (valid-rgb-color-string? (:background options))))
(dissoc options :background)
options))
(fix-options [options]
(-> options
;; Some pages has invalid data on flows, we proceed just to
;; delete them.
(d/update-when :flows #(filterv valid-flow? %))
(fix-background)))]
(update file-data :pages-index update-vals update-page)))
;; Sometimes we found that the file has issues in the internal
;; data structure of the local library; this function tries to
;; fix that issues.
fix-file-data
(fn [file-data]
(-> file-data
(d/update-when :colors dissoc nil)
(d/update-when :typographies dissoc nil)))
delete-big-geometry-shapes
(fn [file-data]
;; At some point in time, we had a bug that generated shapes
;; with huge geometries that did not validate the
;; schema. Since we don't have a way to fix those shapes, we
;; simply proceed to delete it. We ignore path type shapes
;; because they have not been affected by the bug.
(letfn [(fix-container [container]
(d/update-when container :objects #(reduce-kv fix-shape % %)))
(fix-shape [objects id shape]
(cond
(or (cfh/path-shape? shape)
(cfh/bool-shape? shape))
objects
(or (and (number? (:x shape)) (not (sm/valid-safe-number? (:x shape))))
(and (number? (:y shape)) (not (sm/valid-safe-number? (:y shape))))
(and (number? (:width shape)) (not (sm/valid-safe-number? (:width shape))))
(and (number? (:height shape)) (not (sm/valid-safe-number? (:height shape)))))
(-> objects
(dissoc id)
(d/update-in-when [(:parent-id shape) :shapes]
(fn [shapes] (filterv #(not= id %) shapes))))
:else
objects))]
(-> file-data
(update :pages-index update-vals fix-container)
(d/update-when :components update-vals fix-container))))
;; Some files has totally broken shapes, we just remove them
fix-completly-broken-shapes
(fn [file-data]
(letfn [(update-object [objects id shape]
(cond
(nil? (:type shape))
(let [ids (cfh/get-children-ids objects id)]
(-> objects
(dissoc id)
(as-> $ (reduce dissoc $ ids))
(d/update-in-when [(:parent-id shape) :shapes]
(fn [shapes] (filterv #(not= id %) shapes)))))
(and (cfh/text-shape? shape)
(not (seq (:content shape))))
(dissoc objects id)
:else
objects))
(update-container [container]
(d/update-when container :objects #(reduce-kv update-object % %)))]
(-> file-data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
fix-misc-shape-issues
(fn [file-data]
(letfn [(fix-container [container]
(d/update-when container :objects update-vals fix-shape))
(fix-shape [shape]
(cond-> shape
;; Some shapes has invalid gap value
(contains? shape :layout-gap)
(d/update-in-when [:layout-gap :column-gap]
(fn [gap]
(if (or (= gap ##Inf)
(= gap ##-Inf))
0
gap)))
(nil? (:name shape))
(assoc :name (d/name (:type shape)))
;; Fix broken fills
(seq (:fills shape))
(update :fills (fn [fills] (filterv valid-fill? fills)))
;; Fix broken strokes
(seq (:strokes shape))
(update :strokes (fn [strokes] (filterv valid-stroke? strokes)))
;; Fix some broken layout related attrs, probably
;; of copypaste on flex layout betatest period
(true? (:layout shape))
(assoc :layout :flex)
(number? (:layout-gap shape))
(as-> shape (let [n (:layout-gap shape)]
(assoc shape :layout-gap {:row-gap n :column-gap n})))))]
(-> file-data
(update :pages-index update-vals fix-container)
(d/update-when :components update-vals fix-container))))
;; There are some bugs in the past that allows convert text to
;; path and this fix tries to identify this cases and fix them converting
;; the shape back to text shape
fix-text-shapes-converted-to-path
(fn [file-data]
(letfn [(fix-container [container]
(d/update-when container :objects update-vals fix-shape))
(fix-shape [shape]
(if (and (cfh/path-shape? shape)
(contains? shape :content)
(some? (:selrect shape))
(valid-text-content? (:content shape)))
(let [selrect (:selrect shape)]
(-> shape
(assoc :x (:x selrect))
(assoc :y (:y selrect))
(assoc :width (:width selrect))
(assoc :height (:height selrect))
(assoc :type :text)))
shape))]
(-> file-data
(update :pages-index update-vals fix-container)
(d/update-when :components update-vals fix-container))))
fix-broken-paths
(fn [file-data]
(letfn [(fix-container [container]
(d/update-when container :objects update-vals fix-shape))
(fix-shape [shape]
(cond
(and (cfh/path-shape? shape)
(seq (:content shape))
(not (valid-path-content? (:content shape))))
(let [shape (update shape :content fix-path-content)
[points selrect] (gshp/content->points+selrect shape (:content shape))]
(-> shape
(dissoc :bool-content)
(dissoc :bool-type)
(assoc :points points)
(assoc :selrect selrect)))
;; When we fount a bool shape with no content,
;; we convert it to a simple rect
(and (cfh/bool-shape? shape)
(not (seq (:bool-content shape))))
(let [selrect (or (:selrect shape)
(grc/make-rect))
points (grc/rect->points selrect)]
(-> shape
(assoc :x (:x selrect))
(assoc :y (:y selrect))
(assoc :width (:height selrect))
(assoc :height (:height selrect))
(assoc :selrect selrect)
(assoc :points points)
(assoc :type :rect)
(assoc :transform (gmt/matrix))
(assoc :transform-inverse (gmt/matrix))
(dissoc :bool-content)
(dissoc :shapes)
(dissoc :content)))
:else
shape))
(fix-path-content [content]
(let [[seg1 :as content] (filterv valid-path-segment? content)]
(if (and seg1 (not= :move-to (:command seg1)))
(let [params (select-keys (:params seg1) [:x :y])]
(into [{:command :move-to :params params}] content))
content)))]
(-> file-data
(update :pages-index update-vals fix-container)
(d/update-when :components update-vals fix-container))))
fix-recent-colors
(fn [file-data]
;; Remove invalid colors in :recent-colors
(d/update-when file-data :recent-colors
(fn [colors]
(filterv valid-color? colors))))
fix-broken-parents
(fn [file-data]
;; Find children shapes whose parent-id is not set to the parent that contains them.
;; Remove them from the parent :shapes list.
(letfn [(fix-container
[container]
(d/update-when container :objects #(reduce-kv fix-shape % %)))
(fix-shape
[objects id shape]
(reduce (fn [objects child-id]
(let [child (get objects child-id)]
(cond-> objects
(and (some? child) (not= id (:parent-id child)))
(d/update-in-when [id :shapes]
(fn [shapes] (filterv #(not= child-id %) shapes))))))
objects
(:shapes shape)))]
(-> file-data
(update :pages-index update-vals fix-container)
(d/update-when :components update-vals fix-container))))
fix-orphan-shapes
(fn [file-data]
;; Find shapes that are not listed in their parent's children list.
@ -127,13 +436,13 @@
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
(d/update-when :components update-vals fix-container))))
remove-nested-roots
(fn [file-data]
;; Remove :component-root in head shapes that are nested.
(letfn [(fix-container [container]
(update container :objects update-vals (partial fix-shape container)))
(d/update-when container :objects update-vals (partial fix-shape container)))
(fix-shape [container shape]
(let [parent (ctst/get-shape container (:parent-id shape))]
@ -144,13 +453,13 @@
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
(d/update-when :components update-vals fix-container))))
add-not-nested-roots
(fn [file-data]
;; Add :component-root in head shapes that are not nested.
(letfn [(fix-container [container]
(update container :objects update-vals (partial fix-shape container)))
(d/update-when container :objects update-vals (partial fix-shape container)))
(fix-shape [container shape]
(let [parent (ctst/get-shape container (:parent-id shape))]
@ -161,13 +470,13 @@
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
(d/update-when :components update-vals fix-container))))
fix-orphan-copies
(fn [file-data]
;; Detach shapes that were inside a copy (have :shape-ref) but now they aren't.
(letfn [(fix-container [container]
(update container :objects update-vals (partial fix-shape container)))
(d/update-when container :objects update-vals (partial fix-shape container)))
(fix-shape [container shape]
(let [parent (ctst/get-shape container (:parent-id shape))]
@ -179,7 +488,7 @@
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
(d/update-when :components update-vals fix-container))))
remap-refs
(fn [file-data]
@ -223,32 +532,32 @@
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
(d/update-when :components update-vals fix-container))))
fix-copies-of-detached
fix-converted-copies
(fn [file-data]
;; Find any copy that is referencing a detached shape inside a component, and
;; undo the nested copy, converting it into a direct copy.
;; If the user has created a copy and then converted into a path or bool,
;; detach it because the synchronization will no longer work.
(letfn [(fix-container [container]
(update container :objects update-vals fix-shape))
(d/update-when container :objects update-vals (partial fix-shape container)))
(fix-shape [container shape]
(if (and (ctk/instance-head? shape)
(or (cfh/path-shape? shape)
(cfh/bool-shape? shape)))
(detach-shape container shape)
shape))]
(fix-shape [shape]
(cond-> shape
(@detached-ids (:shape-ref shape))
(dissoc shape
:component-id
:component-file
:component-root)))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
(d/update-when :components update-vals fix-container))))
transform-to-frames
(fn [file-data]
;; Transform component and copy heads to frames, and set the
;; frame-id of its childrens
(letfn [(fix-container [container]
(update container :objects update-vals fix-shape))
(d/update-when container :objects update-vals fix-shape))
(fix-shape [shape]
(if (or (nil? (:parent-id shape)) (ctk/instance-head? shape))
@ -262,7 +571,7 @@
shape))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
(d/update-when :components update-vals fix-container))))
remap-frame-ids
(fn [file-data]
@ -270,7 +579,7 @@
;; to point to the head instance.
(letfn [(fix-container
[container]
(update container :objects update-vals (partial fix-shape container)))
(d/update-when container :objects update-vals (partial fix-shape container)))
(fix-shape
[container shape]
@ -280,14 +589,14 @@
shape)))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
(d/update-when :components update-vals fix-container))))
fix-frame-ids
(fn [file-data]
;; Ensure that frame-id of all shapes point to the parent or to the frame-id
;; of the parent, and that the destination is indeed a frame.
(letfn [(fix-container [container]
(update container :objects #(cfh/reduce-objects % fix-shape %)))
(d/update-when container :objects #(cfh/reduce-objects % fix-shape %)))
(fix-shape [objects shape]
(let [parent (when (:parent-id shape)
@ -304,7 +613,7 @@
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))
(d/update-when :components update-vals fix-container))))
fix-component-nil-objects
(fn [file-data]
@ -316,38 +625,91 @@
(dissoc component :objects))
component))]
(-> file-data
(update :components update-vals fix-component))))
(d/update-when :components update-vals fix-component))))
fix-false-copies
(fn [file-data]
;; Find component heads that are not main-instance but have not :shape-ref.
;; Also shapes that have :shape-ref but are not in a copy.
(letfn [(fix-container
[container]
(update container :objects update-vals fix-shape))
(d/update-when container :objects update-vals (partial fix-shape container)))
(fix-shape
[shape]
(if (and (ctk/instance-head? shape)
(not (ctk/main-instance? shape))
(not (ctk/in-component-copy? shape)))
(ctk/detach-shape shape)
[container shape]
(if (or (and (ctk/instance-head? shape)
(not (ctk/main-instance? shape))
(not (ctk/in-component-copy? shape)))
(and (ctk/in-component-copy? shape)
(nil? (ctn/get-head-shape (:objects container) shape {:allow-main? true}))))
(detach-shape container shape)
shape))]
(-> file-data
(update :pages-index update-vals fix-container)
(update :components update-vals fix-container))))]
(d/update-when :components update-vals fix-container))))
fix-copies-of-detached
(fn [file-data]
;; Find any copy that is referencing a shape inside a component that have
;; been detached in a previous fix. If so, undo the nested copy, converting
;; it into a direct copy.
;;
;; WARNING: THIS SHOULD BE CALLED AT THE END OF THE PROCESS.
(letfn [(fix-container [container]
(d/update-when container :objects update-vals fix-shape))
(fix-shape [shape]
(cond-> shape
(@detached-ids (:shape-ref shape))
(dissoc shape
:component-id
:component-file
:component-root)))]
(-> file-data
(update :pages-index update-vals fix-container)
(d/update-when :components update-vals fix-container))))
fix-shape-nil-parent-id
(fn [file-data]
;; Ensure that parent-id and frame-id are not nil
(letfn [(fix-container [container]
(d/update-when container :objects update-vals fix-shape))
(fix-shape [shape]
(let [frame-id (or (:frame-id shape)
uuid/zero)
parent-id (or (:parent-id shape)
frame-id)]
(assoc shape :frame-id frame-id
:parent-id parent-id)))]
(-> file-data
(update :pages-index update-vals fix-container))))]
(-> file-data
(fix-file-data)
(fix-page-invalid-options)
(fix-completly-broken-shapes)
(fix-bad-children)
(fix-misc-shape-issues)
(fix-recent-colors)
(fix-missing-image-metadata)
(fix-text-shapes-converted-to-path)
(fix-broken-paths)
(delete-big-geometry-shapes)
(fix-broken-parents)
(fix-orphan-shapes)
(fix-orphan-copies)
(remove-nested-roots)
(add-not-nested-roots)
(fix-orphan-copies)
(remap-refs)
(fix-copies-of-detached)
(fix-converted-copies)
(transform-to-frames)
(remap-frame-ids)
(fix-frame-ids)
(fix-component-nil-objects)
(fix-false-copies))))
(fix-false-copies)
(fix-shape-nil-parent-id)
(fix-copies-of-detached)))) ; <- Do not add fixes after this one
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPONENTS MIGRATION
@ -574,7 +936,7 @@
(if (> ext-idx 0) (subs filename 0 ext-idx) filename)))
(defn- collect-and-persist-images
[svg-data file-id]
[svg-data file-id media-id]
(letfn [(process-image [{:keys [href] :as item}]
(try
(let [item (if (str/starts-with? href "data:")
@ -601,12 +963,13 @@
;; The media processing adds the data to the
;; input map and returns it.
(media/run {:cmd :info :input item}))
(catch Throwable cause
(l/warn :hint "unexpected exception on processing internal image shape (skiping)"
:cause cause)
(when-not *skip-on-error*
(throw cause)))))
(catch Throwable _
(let [team-id *team-id*]
(l/wrn :hint "unable to process embedded images on svg file"
:team-id (str team-id)
:file-id (str file-id)
:media-id (str media-id)))
nil)))
(persist-image [acc {:keys [path size width height mtype href] :as item}]
(let [storage (::sto/storage *system*)
@ -642,23 +1005,33 @@
(completing persist-image) {}))]
(assoc svg-data :image-data images))))
(defn- get-svg-content
(defn- resolve-sobject-id
[id]
(let [fmobject (db/get *system* :file-media-object {:id id}
{::sql/columns [:media-id]})]
(:media-id fmobject)))
(defn- get-sobject-content
[id]
(let [storage (::sto/storage *system*)
conn (::db/conn *system*)
fmobject (db/get conn :file-media-object {:id id})
sobject (sto/get-object storage (:media-id fmobject))]
sobject (sto/get-object storage id)]
(with-open [stream (sto/get-object-data storage sobject)]
(slurp stream))))
(defn- create-shapes-for-svg
[{:keys [id] :as mobj} file-id objects frame-id position]
(let [svg-text (get-svg-content id)
svg-text (svgo/optimize *system* svg-text)
svg-data (-> (csvg/parse svg-text)
(assoc :name (:name mobj))
(collect-and-persist-images file-id))]
(let [get-svg (fn [sid]
(let [svg-text (get-sobject-content sid)
svg-text (svgo/optimize *system* svg-text)]
(-> (csvg/parse svg-text)
(assoc :name (:name mobj)))))
sid (resolve-sobject-id id)
svg-data (if (cache/cache? *cache*)
(cache/get *cache* sid (px/wrap-bindings get-svg))
(get-svg sid))
svg-data (collect-and-persist-images svg-data file-id id)]
(sbuilder/create-svg-shapes svg-data position objects frame-id frame-id #{} false)))
@ -717,42 +1090,64 @@
(defn- create-media-grid
[fdata page-id frame-id grid media-group]
(let [process (fn [mobj position]
(let [position (gpt/add position (gpt/point grid-gap grid-gap))
tp1 (dt/tpoint)]
(try
(process-media-object fdata page-id frame-id mobj position)
(catch Throwable cause
(l/wrn :hint "unable to process file media object (skiping)"
:file-id (str (:id fdata))
:id (str (:id mobj))
:cause cause)
(if-not *skip-on-error*
(throw cause)
nil))
(finally
(l/trc :hint "graphic processed"
:file-id (str (:id fdata))
:media-id (str (:id mobj))
:elapsed (dt/format-duration (tp1)))))))]
(letfn [(process [fdata mobj position]
(let [position (gpt/add position (gpt/point grid-gap grid-gap))
tp (dt/tpoint)
err (volatile! false)]
(try
(let [changes (process-media-object fdata page-id frame-id mobj position)]
(cp/process-changes fdata changes false))
(catch Throwable cause
(vreset! err true)
(let [cause (pu/unwrap-exception cause)
edata (ex-data cause)
team-id *team-id*]
(cond
(instance? org.xml.sax.SAXParseException cause)
(l/inf :hint "skip processing media object: invalid svg found"
:team-id (str team-id)
:file-id (str (:id fdata))
:id (str (:id mobj)))
(instance? org.graalvm.polyglot.PolyglotException cause)
(l/inf :hint "skip processing media object: invalid svg found"
:team-id (str team-id)
:file-id (str (:id fdata))
:id (str (:id mobj)))
(= (:type edata) :not-found)
(l/inf :hint "skip processing media object: underlying object does not exist"
:team-id (str team-id)
:file-id (str (:id fdata))
:id (str (:id mobj)))
:else
(let [skip? *skip-on-graphic-error*]
(l/wrn :hint "unable to process file media object"
:skiped skip?
:team-id (str team-id)
:file-id (str (:id fdata))
:id (str (:id mobj))
:cause cause)
(when-not skip?
(throw cause))))
nil))
(finally
(let [elapsed (tp)]
(l/trc :hint "graphic processed"
:file-id (str (:id fdata))
:media-id (str (:id mobj))
:error @err
:elapsed (dt/format-duration elapsed)))))))]
(->> (d/zip media-group grid)
(partition-all (or *max-procs* 1))
(mapcat (fn [partition]
(->> partition
(map (fn [[mobj position]]
(sse/tap {:type :migration-progress
:section :graphics
:name (:name mobj)})
(p/vthread (process mobj position))))
(doall)
(map deref)
(doall))))
(filter some?)
(reduce (fn [fdata changes]
(-> (assoc-in fdata [:options :components-v2] true)
(cp/process-changes changes false)))
fdata))))
(reduce (fn [fdata [mobj position]]
(sse/tap {:type :migration-progress
:section :graphics
:name (:name mobj)})
(or (process fdata mobj position) fdata))
(assoc-in fdata [:options :components-v2] true)))))
(defn- migrate-graphics
[fdata]
@ -821,9 +1216,13 @@
(decode-row)
(update :data assoc :id id)
(update :data fdata/process-pointers deref)
(update :data fdata/process-objects (partial into {}))
(update :data (fn [data]
(if (> (:version data) 22)
(assoc data :version 22)
data)))
(fmg/migrate-file))))
(defn- get-team
[system team-id]
(-> (db/get system :team {:id team-id}
@ -832,17 +1231,12 @@
(decode-row)))
(defn- validate-file!
[file libs throw-on-validate?]
(try
(cfv/validate-file! file libs)
(cfv/validate-file-schema! file)
(catch Throwable cause
(if throw-on-validate?
(throw cause)
(l/wrn :hint "migrate:file:validation-error" :cause cause)))))
[file libs]
(cfv/validate-file! file libs)
(cfv/validate-file-schema! file))
(defn- process-file
[{:keys [::db/conn] :as system} id & {:keys [validate? throw-on-validate?]}]
[{:keys [::db/conn] :as system} id & {:keys [validate?]}]
(let [file (get-file system id)
libs (->> (files/get-file-libraries conn id)
@ -855,7 +1249,7 @@
(update :features conj "components/v2"))
_ (when validate?
(validate-file! file libs throw-on-validate?))
(validate-file! file libs))
file (if (contains? (:features file) "fdata/objects-map")
(fdata/enable-objects-map file)
@ -876,12 +1270,13 @@
(dissoc file :data)))
(def ^:private sql:get-and-lock-team-files
"SELECT f.id
FROM file AS f
JOIN project AS p ON (p.id = f.project_id)
WHERE p.team_id = ?
AND p.deleted_at IS NULL
AND f.deleted_at IS NULL
FOR UPDATE")
(defn- get-and-lock-files
@ -901,21 +1296,33 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn migrate-file!
[system file-id & {:keys [validate? throw-on-validate? max-procs]}]
(let [tpoint (dt/tpoint)]
[system file-id & {:keys [validate? skip-on-graphic-error? label]}]
(let [tpoint (dt/tpoint)]
(binding [*file-stats* (atom {})
*max-procs* max-procs]
*skip-on-graphic-error* skip-on-graphic-error?]
(try
(l/dbg :hint "migrate:file:start" :file-id (str file-id))
(l/dbg :hint "migrate:file:start"
:file-id (str file-id)
:validate validate?
:skip-on-graphic-error skip-on-graphic-error?)
(let [system (update system ::sto/storage media/configure-assets-storage)]
(db/tx-run! system
(fn [system]
(binding [*system* system]
(fsnap/take-file-snapshot! system {:file-id file-id :label "migration/components-v2"})
(process-file system file-id
:validate? validate?
:throw-on-validate? throw-on-validate?)))))
(try
(binding [*system* system]
(when (string? label)
(fsnap/take-file-snapshot! system {:file-id file-id
:label (str "migration/" label)}))
(process-file system file-id :validate? validate?))
(catch Throwable cause
(let [team-id *team-id*]
(l/wrn :hint "error on processing file"
:team-id (str team-id)
:file-id (str file-id))
(throw cause)))))))
(finally
(let [elapsed (tpoint)
components (get @*file-stats* :processed/components 0)
@ -925,46 +1332,52 @@
:file-id (str file-id)
:graphics graphics
:components components
:validate validate?
:elapsed (dt/format-duration elapsed))
(some-> *stats* (swap! update :processed/files (fnil inc 0)))
(some-> *team-stats* (swap! update :processed/files (fnil inc 0)))))))))
(defn migrate-team!
[system team-id & {:keys [validate? throw-on-validate? max-procs]}]
[system team-id & {:keys [validate? skip-on-graphic-error? label]}]
(l/dbg :hint "migrate:team:start"
:team-id (dm/str team-id))
(let [tpoint (dt/tpoint)
err (volatile! false)
migrate-file
(fn [system file-id]
(migrate-file! system file-id
:max-procs max-procs
:label label
:validate? validate?
:throw-on-validate? throw-on-validate?))
:skip-on-graphic-error? skip-on-graphic-error?))
migrate-team
(fn [{:keys [::db/conn] :as system} {:keys [id features] :as team}]
(let [features (-> features
(disj "ephimeral/v2-migration")
(conj "components/v2")
(conj "layout/grid")
(conj "styles/v2"))]
(fn [{:keys [::db/conn] :as system} team-id]
(let [{:keys [id features]} (get-team system team-id)]
(if (contains? features "components/v2")
(l/inf :hint "team already migrated")
(let [features (-> features
(disj "ephimeral/v2-migration")
(conj "components/v2")
(conj "layout/grid")
(conj "styles/v2"))]
(run! (partial migrate-file system)
(get-and-lock-files conn id))
(run! (partial migrate-file system)
(get-and-lock-files conn id))
(update-team-features! conn id features)))]
(update-team-features! conn id features)))))]
(binding [*team-stats* (atom {})]
(binding [*team-stats* (atom {})
*team-id* team-id]
(try
(db/tx-run! system (fn [system]
(db/exec-one! system ["SET idle_in_transaction_session_timeout = 0"])
(let [team (get-team system team-id)]
(if (contains? (:features team) "components/v2")
(l/inf :hint "team already migrated")
(migrate-team system team)))))
(db/tx-run! system migrate-team team-id)
(catch Throwable cause
(vreset! err true)
(throw cause))
(finally
(let [elapsed (tpoint)
components (get @*team-stats* :processed/components 0)
@ -973,9 +1386,21 @@
(some-> *stats* (swap! update :processed/teams (fnil inc 0)))
(l/dbg :hint "migrate:team:end"
:team-id (dm/str team-id)
:files files
:components components
:graphics graphics
:elapsed (dt/format-duration elapsed))))))))
(if (cache/cache? *cache*)
(let [cache-stats (cache/stats *cache*)]
(l/dbg :hint "migrate:team:end"
:team-id (dm/str team-id)
:files files
:components components
:graphics graphics
:crt (mth/to-fixed (:hit-rate cache-stats) 2)
:crq (str (:req-count cache-stats))
:error @err
:elapsed (dt/format-duration elapsed)))
(l/dbg :hint "migrate:team:end"
:team-id (dm/str team-id)
:files files
:components components
:graphics graphics
:elapsed (dt/format-duration elapsed)))))))))

4
backend/src/app/features/fdata.clj
View File

@ -27,7 +27,7 @@
(update :data (fn [fdata]
(-> fdata
(update :pages-index update-vals update-fn)
(update :components update-vals update-fn))))
(d/update-when :components update-vals update-fn))))
(update :features conj "fdata/objects-map"))))
(defn process-objects
@ -110,6 +110,6 @@
(update :data (fn [fdata]
(-> fdata
(update :pages-index update-vals pmap/wrap)
(update :components pmap/wrap))))
(d/update-when :components pmap/wrap))))
(update :features conj "fdata/pointer-map")))

6
backend/src/app/main.clj
View File

@ -301,7 +301,8 @@
::sto/storage (ig/ref ::sto/storage)}
:app.rpc/climit
{::mtx/metrics (ig/ref ::mtx/metrics)}
{::mtx/metrics (ig/ref ::mtx/metrics)
::wrk/executor (ig/ref ::wrk/executor)}
:app.rpc/rlimit
{::wrk/executor (ig/ref ::wrk/executor)}
@ -410,8 +411,7 @@
::migrations (ig/ref :app.migrations/migrations)}
::svgo/optimizer
{::wrk/executor (ig/ref ::wrk/executor)
::svgo/max-procs (cf/get :svgo-max-procs)}
{}
::audit.tasks/archive
{::props (ig/ref ::setup/props)

7
backend/src/app/redis.clj
View File

@ -91,7 +91,7 @@
(s/def ::connect? ::us/boolean)
(s/def ::io-threads ::us/integer)
(s/def ::worker-threads ::us/integer)
(s/def ::cache some?)
(s/def ::cache cache/cache?)
(s/def ::redis
(s/keys :req [::resources
@ -168,7 +168,7 @@
(defn- shutdown-resources
[{:keys [::resources ::cache ::timer]}]
(cache/invalidate-all! cache)
(cache/invalidate! cache)
(when resources
(.shutdown ^ClientResources resources))
@ -211,7 +211,8 @@
(defn get-or-connect
[{:keys [::cache] :as state} key options]
(us/assert! ::redis state)
(let [connection (cache/get cache key (fn [_] (connect* state options)))]
(let [create (fn [_] (connect* state options))
connection (cache/get cache key create)]
(-> state
(dissoc ::cache)
(assoc ::connection connection))))

115
backend/src/app/rpc/climit.clj
View File

@ -36,24 +36,14 @@
(-> (str id)
(subs 1)))
(defn- create-bulkhead-cache
[config]
(letfn [(load-fn [[id skey]]
(when-let [config (get config id)]
(l/trc :hint "insert into cache" :id (id->str id) :key skey)
(pbh/create :permits (or (:permits config) (:concurrency config))
:queue (or (:queue config) (:queue-size config))
:timeout (:timeout config)
:type :semaphore)))
(on-remove [key _ cause]
(defn- create-cache
[{:keys [::wrk/executor]}]
(letfn [(on-remove [key _ cause]
(let [[id skey] key]
(l/trc :hint "evict from cache" :id (id->str id) :key skey :reason (str cause))))]
(cache/create :executor :same-thread
(l/dbg :hint "destroy limiter" :id (id->str id) :key skey :reason (str cause))))]
(cache/create :executor executor
:on-remove on-remove
:keepalive "5m"
:load-fn load-fn)))
:keepalive "5m")))
(s/def ::config/permits ::us/integer)
(s/def ::config/queue ::us/integer)
@ -70,7 +60,7 @@
(s/def ::path ::fs/path)
(defmethod ig/pre-init-spec ::rpc/climit [_]
(s/keys :req [::mtx/metrics ::path]))
(s/keys :req [::mtx/metrics ::wrk/executor ::path]))
(defmethod ig/init-key ::rpc/climit
[_ {:keys [::path ::mtx/metrics] :as cfg}]
@ -78,7 +68,7 @@
(when-let [params (some->> path slurp edn/read-string)]
(l/inf :hint "initializing concurrency limit" :config (str path))
(us/verify! ::config params)
{::cache (create-bulkhead-cache params)
{::cache (create-cache cfg)
::config params
::mtx/metrics metrics})))
@ -89,13 +79,17 @@
(s/def ::rpc/climit
(s/nilable ::instance))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- create-limiter
[config [id skey]]
(l/dbg :hint "create limiter" :id (id->str id) :key skey)
(pbh/create :permits (or (:permits config) (:concurrency config))
:queue (or (:queue config) (:queue-size config))
:timeout (:timeout config)
:type :semaphore))
(defn invoke!
[cache metrics id key f]
(if-let [limiter (cache/get cache [id key])]
(defn- invoke!
[config cache metrics id key f]
(if-let [limiter (cache/get cache [id key] (partial create-limiter config))]
(let [tpoint (dt/tpoint)
labels (into-array String [(id->str id)])
wrapped (fn []
@ -147,7 +141,7 @@
:queue (:queue stats)
:max-permits (:max-permits stats)
:max-queue (:max-queue stats))
(pbh/invoke! limiter wrapped))
(px/invoke! limiter wrapped))
(catch ExceptionInfo cause
(let [{:keys [type code]} (ex-data cause)]
(if (= :bulkhead-error type)
@ -160,9 +154,43 @@
(measure! (pbh/get-stats limiter)))))
(do
(l/wrn :hint "unable to load limiter" :id (id->str id))
(l/wrn :hint "no limiter found" :id (id->str id))
(f))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MIDDLEWARE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def noop-fn (constantly nil))
(defn wrap
[{:keys [::rpc/climit ::mtx/metrics]} f {:keys [::id ::key-fn] :or {key-fn noop-fn} :as mdata}]
(if (and (some? climit) (some? id))
(let [cache (::cache climit)
config (::config climit)]
(if-let [config (get config id)]
(do
(l/dbg :hint "instrumenting method"
:limit (id->str id)
:service-name (::sv/name mdata)
:timeout (:timeout config)
:permits (:permits config)
:queue (:queue config)
:keyed? (not= key-fn noop-fn))
(fn [cfg params]
(invoke! config cache metrics id (key-fn params) (partial f cfg params))))
(do
(l/wrn :hint "no config found for specified queue" :id (id->str id))
f)))
f))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn configure
[{:keys [::rpc/climit]} id]
(us/assert! ::rpc/climit climit)
@ -171,37 +199,14 @@
(defn run!
"Run a function in context of climit.
Intended to be used in virtual threads."
([{:keys [::id ::cache ::mtx/metrics]} f]
(if (and cache id)
(invoke! cache metrics id nil f)
([{:keys [::id ::cache ::config ::mtx/metrics]} f]
(if-let [config (get config id)]
(invoke! config cache metrics id nil f)
(f)))
([{:keys [::id ::cache ::mtx/metrics]} f executor]
([{:keys [::id ::cache ::config ::mtx/metrics]} f executor]
(let [f #(p/await! (px/submit! executor f))]
(if (and cache id)
(invoke! cache metrics id nil f)
(if-let [config (get config id)]
(invoke! config cache metrics id nil f)
(f)))))
(def noop-fn (constantly nil))
(defn wrap
[{:keys [::rpc/climit ::mtx/metrics]} f {:keys [::id ::key-fn] :or {key-fn noop-fn} :as mdata}]
(if (and (some? climit) (some? id))
(if-let [config (get-in climit [::config id])]
(let [cache (::cache climit)]
(l/dbg :hint "instrumenting method"
:limit (id->str id)
:service-name (::sv/name mdata)
:timeout (:timeout config)
:permits (:permits config)
:queue (:queue config)
:keyed? (not= key-fn noop-fn))
(fn [cfg params]
(invoke! cache metrics id (key-fn params) (partial f cfg params))))
(do
(l/wrn :hint "no config found for specified queue" :id (id->str id))
f))
f))

4
backend/src/app/rpc/commands/auth.clj
View File

@ -333,7 +333,9 @@
(defn register-profile
[{:keys [::db/conn] :as cfg} {:keys [token fullname] :as params}]
(let [claims (tokens/verify (::main/props cfg) {:token token :iss :prepared-register})
params (assoc claims :fullname fullname)
params (-> claims
(into params)
(assoc :fullname fullname))
is-active (or (:is-active params)
(not (contains? cf/flags :email-verification)))

4
backend/src/app/rpc/commands/binfile.clj
View File

@ -664,9 +664,7 @@
(case feature
"components/v2"
(feat.compv2/migrate-file! options file-id
:max-procs 2
:validate? validate?
:throw-on-validate? true)
:validate? validate?)
"fdata/shape-data-type"
nil

46
backend/src/app/rpc/commands/files.clj
View File

@ -226,23 +226,37 @@
[{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
pmap/*tracked* (pmap/create-tracked)]
(let [file (fmg/migrate-file file)]
(let [;; For avoid unnecesary overhead of creating multiple pointers and
;; handly internally with objects map in their worst case (when
;; probably all shapes and all pointers will be readed in any
;; case), we just realize/resolve them before applying the
;; migration to the file
file (-> file
(update :data feat.fdata/process-pointers deref)
(update :data feat.fdata/process-objects (partial into {}))
(fmg/migrate-file))
;; NOTE: when file is migrated, we break the rule of no perform
;; mutations on get operations and update the file with all
;; migrations applied
;;
;; NOTE: the following code will not work on read-only mode, it
;; is a known issue; we keep is not implemented until we really
;; need this
(when (fmg/migrated? file)
(db/update! conn :file
{:data (blob/encode (:data file))
:features (db/create-array conn "text" (:features file))}
{:id id})
;; When file is migrated, we break the rule of no perform
;; mutations on get operations and update the file with all
;; migrations applied
;;
;; WARN: he following code will not work on read-only mode,
;; it is a known issue; we keep is not implemented until we
;; really need this.
file (if (contains? (:features file) "fdata/objects-map")
(feat.fdata/enable-objects-map file)
file)
file (if (contains? (:features file) "fdata/pointer-map")
(feat.fdata/enable-pointer-map file)
file)]
(when (contains? (:features file) "fdata/pointer-map")
(feat.fdata/persist-pointers! cfg id)))
(db/update! conn :file
{:data (blob/encode (:data file))
:features (db/create-array conn "text" (:features file))}
{:id id})
(when (contains? (:features file) "fdata/pointer-map")
(feat.fdata/persist-pointers! cfg id))
file)))
@ -266,7 +280,7 @@
::db/remove-deleted (not include-deleted?)
::sql/for-update lock-for-update?})
(decode-row))]
(if migrate?
(if (and migrate? (fmg/need-migration? file))
(migrate-file cfg file)
file)))

73
backend/src/app/rpc/commands/files_create.clj
View File

@ -18,14 +18,12 @@
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
[app.rpc.commands.files :as files]
[app.rpc.commands.projects :as projects]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.permissions :as perms]
[app.rpc.quotes :as quotes]
[app.util.blob :as blob]
[app.util.objects-map :as omap]
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[app.util.time :as dt]
@ -50,47 +48,52 @@
"expected a valid connection"
(db/connection? conn))
(let [id (or id (uuid/next))
(binding [pmap/*tracked* (pmap/create-tracked)
cfeat/*current* features]
(let [id (or id (uuid/next))
pointers (pmap/create-tracked)
pmap? (contains? features "fdata/pointer-map")
omap? (contains? features "fdata/objects-map")
data (binding [pmap/*tracked* pointers
cfeat/*current* features
cfeat/*wrap-with-objects-map-fn* (if omap? omap/wrap identity)
cfeat/*wrap-with-pointer-map-fn* (if pmap? pmap/wrap identity)]
(if create-page
data (if create-page
(ctf/make-file-data id)
(ctf/make-file-data id nil)))
(ctf/make-file-data id nil))
features (->> (set/difference features cfeat/frontend-only-features)
(db/create-array conn "text"))
file {:id id
:project-id project-id
:name name
:revn revn
:is-shared is-shared
:data data
:features features
:ignore-sync-until ignore-sync-until
:modified-at modified-at
:deleted-at deleted-at}
file (db/insert! conn :file
(d/without-nils
{:id id
:project-id project-id
:name name
:revn revn
:is-shared is-shared
:data (blob/encode data)
:features features
:ignore-sync-until ignore-sync-until
:modified-at modified-at
:deleted-at deleted-at}))]
file (if (contains? features "fdata/objects-map")
(feat.fdata/enable-objects-map file)
file)
(binding [pmap/*tracked* pointers]
(feat.fdata/persist-pointers! cfg id))
file (if (contains? features "fdata/pointer-map")
(feat.fdata/enable-pointer-map file)
file)
(->> (assoc params :file-id id :role :owner)
(create-file-role! conn))
file (d/without-nils file)]
(db/update! conn :project
{:modified-at (dt/now)}
{:id project-id})
(db/insert! conn :file
(-> file
(update :data blob/encode)
(update :features db/encode-pgarray conn "text"))
{::db/return-keys false})
(files/decode-row file)))
(when (contains? features "fdata/pointer-map")
(feat.fdata/persist-pointers! cfg id))
(->> (assoc params :file-id id :role :owner)
(create-file-role! conn))
(db/update! conn :project
{:modified-at (dt/now)}
{:id project-id})
file)))
(def ^:private schema:create-file
[:map {:title "create-file"}

31
backend/src/app/rpc/commands/files_update.clj
View File

@ -292,9 +292,20 @@
(let [file (update file :data (fn [data]
(-> data
(blob/decode)
(assoc :id (:id file))
(fmg/migrate-data)
(d/without-nils))))
(assoc :id (:id file)))))
;; For avoid unnecesary overhead of creating multiple pointers
;; and handly internally with objects map in their worst
;; case (when probably all shapes and all pointers will be
;; readed in any case), we just realize/resolve them before
;; applying the migration to the file
file (if (fmg/need-migration? file)
(-> file
(update :data feat.fdata/process-pointers deref)
(update :data feat.fdata/process-objects (partial into {}))
(fmg/migrate-file))
file)
;; WARNING: this ruins performance; maybe we need to find
;; some other way to do general validation
@ -305,14 +316,20 @@
(into [file] (map (fn [{:keys [id]}]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
pmap/*tracked* nil]
;; We do not resolve the objects maps here
;; because there is a lower probability that all
;; shapes needed to be loded into memory, so we
;; leeave it on lazy status
(-> (files/get-file cfg id :migrate? false)
(update :data feat.fdata/process-pointers deref) ; ensure all pointers resolved
(fmg/migrate-file))))))
(d/index-by :id)))
file (-> (files/check-version! file)
(update :revn inc)
(update :data cpc/process-changes changes))]
(update :data cpc/process-changes changes)
(update :data d/without-nils))]
(when (contains? cf/flags :soft-file-validation)
(soft-validate-file! file libs))
@ -329,12 +346,10 @@
(val/validate-file-schema! file))
(cond-> file
(and (contains? cfeat/*current* "fdata/objects-map")
(not (contains? cfeat/*previous* "fdata/objects-map")))
(contains? cfeat/*current* "fdata/objects-map")
(feat.fdata/enable-objects-map)
(and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map")))
(contains? cfeat/*current* "fdata/pointer-map")
(feat.fdata/enable-pointer-map)
:always

382
backend/src/app/srepl/components_v2.clj
View File

@ -6,13 +6,18 @@
(ns app.srepl.components-v2
(:require
[app.common.data :as d]
[app.common.logging :as l]
[app.common.pprint :as pp]
[app.common.uuid :as uuid]
[app.db :as db]
[app.features.components-v2 :as feat]
[app.main :as main]
[app.svgo :as svgo]
[app.util.cache :as cache]
[app.util.time :as dt]
[app.worker :as-alias wrk]
[cuerdas.core :as str]
[promesa.core :as p]
[promesa.exec :as px]
[promesa.exec.semaphore :as ps]
[promesa.util :as pu]))
@ -35,14 +40,9 @@
(fn [_ _ oldv newv]
(when (not= (:processed/files oldv)
(:processed/files newv))
(let [total (:total/files newv)
completed (:processed/files newv)
progress (/ (* completed 100.0) total)
elapsed (tpoint)]
(let [elapsed (tpoint)]
(l/dbg :hint "progress"
:completed (:processed/files newv)
:total (:total/files newv)
:progress (str (int progress) "%")
:elapsed (dt/format-duration elapsed))))))
(defn- report-progress-teams
@ -50,88 +50,147 @@
(fn [_ _ oldv newv]
(when (not= (:processed/teams oldv)
(:processed/teams newv))
(let [total (:total/teams newv)
completed (:processed/teams newv)
progress (/ (* completed 100.0) total)
progress (str (int progress) "%")
(let [completed (:processed/teams newv)
elapsed (dt/format-duration (tpoint))]
(when (fn? on-progress)
(on-progress {:total total
:elapsed elapsed
:completed completed
:progress progress}))
(on-progress {:elapsed elapsed
:completed completed}))
(l/dbg :hint "progress"
:completed completed
:progress progress
:elapsed elapsed)))))
(defn- get-total-files
[pool & {:keys [team-id]}]
(if (some? team-id)
(let [sql (str/concat
"SELECT count(f.id) AS count FROM file AS f "
" JOIN project AS p ON (p.id = f.project_id) "
" WHERE p.team_id = ? AND f.deleted_at IS NULL "
" AND p.deleted_at IS NULL")
res (db/exec-one! pool [sql team-id])]
(:count res))
(def ^:private sql:get-teams-by-created-at
"WITH teams AS (
SELECT id, features
FROM team
WHERE deleted_at IS NULL
ORDER BY created_at DESC
) SELECT * FROM TEAMS %(pred)s")
(let [sql (str/concat
"SELECT count(id) AS count FROM file "
" WHERE deleted_at IS NULL")
res (db/exec-one! pool [sql])]
(:count res))))
(def ^:private sql:get-teams-by-graphics
"WITH teams AS (
SELECT t.id, t.features,
(SELECT count(*)
FROM file_media_object AS fmo
JOIN file AS f ON (f.id = fmo.file_id)
JOIN project AS p ON (p.id = f.project_id)
WHERE p.team_id = t.id
AND fmo.mtype = 'image/svg+xml'
AND fmo.is_local = false) AS graphics
FROM team AS t
WHERE t.deleted_at IS NULL
ORDER BY 3 ASC
)
SELECT * FROM teams %(pred)s")
(defn- get-total-teams
[pool]
(let [sql (str/concat
"SELECT count(id) AS count FROM team "
" WHERE deleted_at IS NULL")
res (db/exec-one! pool [sql])]
(:count res)))
(def ^:private sql:get-teams-by-activity
"WITH teams AS (
SELECT t.id, t.features,
(SELECT coalesce(max(date_trunc('month', f.modified_at)), date_trunc('month', t.modified_at))
FROM file AS f
JOIN project AS p ON (f.project_id = p.id)
WHERE p.team_id = t.id) AS updated_at,
(SELECT coalesce(count(*), 0)
FROM file AS f
JOIN project AS p ON (f.project_id = p.id)
WHERE p.team_id = t.id) AS total_files
FROM team AS t
WHERE t.deleted_at IS NULL
ORDER BY 3 DESC, 4 DESC
)
SELECT * FROM teams %(pred)s")
(def ^:private sql:get-teams-by-report
"WITH teams AS (
SELECT t.id t.features, mr.name
FROM migration_report AS mr
JOIN team AS t ON (t.id = mr.team_id)
WHERE t.deleted_at IS NULL
AND mr.error IS NOT NULL
ORDER BY mr.created_at
) SELECT id, features FROM teams %(pred)s")
(defn- mark-team-migration!
[{:keys [::db/pool]} team-id]
;; We execute this out of transaction because we want this
;; change to be visible to all other sessions before starting
;; the migration
(let [sql (str "UPDATE team SET features = "
" array_append(features, 'ephimeral/v2-migration') "
" WHERE id = ?")]
(db/exec-one! pool [sql team-id])))
(defn- read-pred
[entries]
(let [entries (if (and (vector? entries)
(keyword? (first entries)))
[entries]
entries)]
(loop [params []
queries []
entries (seq entries)]
(if-let [[op val field] (first entries)]
(let [field (name field)
cond (case op
:lt (str/ffmt "% < ?" field)
:lte (str/ffmt "% <= ?" field)
:gt (str/ffmt "% > ?" field)
:gte (str/ffmt "% >= ?" field)
:eq (str/ffmt "% = ?" field))]
(recur (conj params val)
(conj queries cond)
(rest entries)))
(defn- unmark-team-migration!
[{:keys [::db/pool]} team-id]
;; We execute this out of transaction because we want this
;; change to be visible to all other sessions before starting
;; the migration
(let [sql (str "UPDATE team SET features = "
" array_remove(features, 'ephimeral/v2-migration') "
" WHERE id = ?")]
(db/exec-one! pool [sql team-id])))
(def ^:private sql:get-teams
"SELECT id, features
FROM team
WHERE deleted_at IS NULL
ORDER BY created_at ASC")
(let [sql (apply str "WHERE " (str/join " AND " queries))]
(apply vector sql params))))))
(defn- get-teams
[conn]
(->> (db/cursor conn sql:get-teams)
(map feat/decode-row)))
[conn query pred]
(let [query (d/nilv query :created-at)
sql (case query
:created-at sql:get-teams-by-created-at
:activity sql:get-teams-by-activity
:graphics sql:get-teams-by-graphics
:report sql:get-teams-by-report)
sql (if pred
(let [[pred-sql & pred-params] (read-pred pred)]
(apply vector
(str/format sql {:pred pred-sql})
pred-params))
[(str/format sql {:pred ""})])]
(->> (db/cursor conn sql {:chunk-size 500})
(map feat/decode-row)
(remove (fn [{:keys [features]}]
(contains? features "components/v2")))
(map :id))))
(def ^:private sql:report-table
"CREATE UNLOGGED TABLE IF NOT EXISTS migration_report (
id bigserial NOT NULL,
label text NOT NULL,
team_id UUID NOT NULL,
error text NULL,
created_at timestamptz NOT NULL DEFAULT now(),
elapsed bigint NOT NULL,
PRIMARY KEY (label, created_at, id)
)")
(defn- create-report-table!
[system]
(db/exec-one! system [sql:report-table]))
(defn- clean-reports!
[system label]
(db/delete! system :migration-report {:label label}))
(defn- report!
[system team-id label elapsed error]
(db/insert! system :migration-report
{:label label
:team-id team-id
:elapsed (inst-ms elapsed)
:error error}
{::db/return-keys false}))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn migrate-file!
[system file-id & {:keys [rollback? max-procs]
:or {rollback? true}}]
[file-id & {:keys [rollback? validate? label] :or {rollback? true validate? false}}]
(l/dbg :hint "migrate:start" :rollback rollback?)
(let [tpoint (dt/tpoint)
file-id (if (string? file-id)
@ -139,8 +198,10 @@
file-id)]
(binding [feat/*stats* (atom {})]
(try
(-> (assoc system ::db/rollback rollback?)
(feat/migrate-file! file-id :max-procs max-procs))
(-> (assoc main/system ::db/rollback rollback?)
(feat/migrate-file! file-id
:validate? validate?
:label label))
(-> (deref feat/*stats*)
(assoc :elapsed (dt/format-duration (tpoint))))
@ -153,47 +214,36 @@
(l/dbg :hint "migrate:end" :rollback rollback? :elapsed elapsed)))))))
(defn migrate-team!
[{:keys [::db/pool] :as system} team-id & {:keys [rollback? skip-on-error validate? max-procs]
:or {rollback? true
skip-on-error true
validate? false
max-procs 1}
:as opts}]
[team-id & {:keys [rollback? skip-on-graphic-error? validate? label]
:or {rollback? true
validate? true
skip-on-graphic-error? false}}]
(l/dbg :hint "migrate:start" :rollback rollback?)
(let [team-id (if (string? team-id)
(parse-uuid team-id)
team-id)
total (get-total-files pool :team-id team-id)
stats (atom {:total/files total})
stats (atom {})
tpoint (dt/tpoint)]
(add-watch stats :progress-report (report-progress-files tpoint))
(binding [feat/*stats* stats
feat/*skip-on-error* skip-on-error]
(binding [feat/*stats* stats]
(try
(mark-team-migration! system team-id)
(-> (assoc system ::db/rollback rollback?)
(-> (assoc main/system ::db/rollback rollback?)
(feat/migrate-team! team-id
:max-procs max-procs
:label label
:validate? validate?
:throw-on-validate? (not skip-on-error)))
:skip-on-graphic-error? skip-on-graphic-error?))
(print-stats!
(-> (deref feat/*stats*)
(dissoc :total/files)
(assoc :elapsed (dt/format-duration (tpoint)))))
(catch Throwable cause
(l/dbg :hint "migrate:error" :cause cause))
(finally
(unmark-team-migration! system team-id)
(let [elapsed (dt/format-duration (tpoint))]
(l/dbg :hint "migrate:end" :rollback rollback? :elapsed elapsed)))))))
@ -204,98 +254,118 @@
until thw maximum number of jobs is reached which by default has the
value of `1`. This is controled with the `:max-jobs` option.
Each tram migration process also can start multiple procs for
graphics migration, the total of that procs is controled with the
`:max-procs` option.
If you want to run this on multiple machines you will need to specify
the total number of partitions and the current partition.
Internally, the graphics migration process uses SVGO module which by
default has a limited number of maximum concurent
operations (globally), ensure setting up correct number with
PENPOT_SVGO_MAX_PROCS environment variable."
In order to get the report table populated, you will need to provide
a correct `:label`. That label is also used for persist a file
snaphot before continue with the migration."
[& {:keys [max-jobs max-items max-time rollback? validate? query
pred max-procs cache on-start on-progress on-error on-end
skip-on-graphic-error? label partitions current-partition]
:or {validate? false
rollback? true
max-jobs 1
current-partition 1
skip-on-graphic-error? true
max-items Long/MAX_VALUE}}]
[{:keys [::db/pool] :as system} & {:keys [max-jobs max-procs max-items
rollback? validate? preset
skip-on-error max-time
on-start on-progress on-error on-end]
:or {validate? false
rollback? true
skip-on-error true
preset :shutdown-on-failure
max-jobs 1
max-procs 10
max-items Long/MAX_VALUE}
:as opts}]
(when (int? partitions)
(when-not (int? current-partition)
(throw (IllegalArgumentException. "missing `current-partition` parameter")))
(when-not (<= 0 current-partition partitions)
(throw (IllegalArgumentException. "invalid value on `current-partition` parameter"))))
(let [total (get-total-teams pool)
stats (atom {:total/teams (min total max-items)})
(let [stats (atom {})
tpoint (dt/tpoint)
mtime (some-> max-time dt/duration)
tpoint (dt/tpoint)
mtime (some-> max-time dt/duration)
factory (px/thread-factory :virtual false :prefix "penpot/migration/")
executor (px/cached-executor :factory factory)
scope (px/structured-task-scope :preset preset :factory :virtual)
sjobs (ps/create :permits max-jobs)
max-procs (or max-procs max-jobs)
sjobs (ps/create :permits max-jobs)
sprocs (ps/create :permits max-procs)
cache (if (int? cache)
(cache/create :executor executor
:max-items cache)
nil)
migrate-team
(fn [{:keys [id features] :as team}]
(fn [team-id]
(let [tpoint (dt/tpoint)]
(try
(db/tx-run! (assoc main/system ::db/rollback rollback?)
(fn [system]
(db/exec-one! system ["SET idle_in_transaction_session_timeout = 0"])
(feat/migrate-team! system team-id
:label label
:validate? validate?
:skip-on-graphic-error? skip-on-graphic-error?)))
(when (string? label)
(report! main/system team-id label (tpoint) nil))
(catch Throwable cause
(l/wrn :hint "unexpected error on processing team (skiping)"
:team-id (str team-id)
:cause cause)
(when (string? label)
(report! main/system team-id label (tpoint) (ex-message cause))))
(finally
(ps/release! sjobs)))))
process-team
(fn [team-id]
(ps/acquire! sjobs)
(let [ts (tpoint)]
(cond
(and mtime (neg? (compare mtime ts)))
(if (and mtime (neg? (compare mtime ts)))
(do
(l/inf :hint "max time constraint reached"
:team-id (str id)
:team-id (str team-id)
:elapsed (dt/format-duration ts))
(ps/release! sjobs)
(reduced nil))
(or (contains? features "ephimeral/v2-migration")
(contains? features "components/v2"))
(do
(l/dbg :hint "skip team" :team-id (str id))
(ps/release! sjobs))
:else
(px/submit! scope (fn []
(try
(mark-team-migration! system id)
(-> (assoc system ::db/rollback rollback?)
(feat/migrate-team! id
:max-procs max-procs
:validate? validate?
:throw-on-validate? (not skip-on-error)))
(catch Throwable cause
(l/err :hint "unexpected error on processing team"
:team-id (str id)
:cause cause))
(finally
(ps/release! sjobs)
(unmark-team-migration! system id))))))))]
(px/run! executor (partial migrate-team team-id)))))]
(l/dbg :hint "migrate:start"
:label label
:rollback rollback?
:total total
:max-jobs max-jobs
:max-procs max-procs
:max-items max-items)
(add-watch stats :progress-report (report-progress-teams tpoint on-progress))
(binding [feat/*stats* stats
feat/*skip-on-error* skip-on-error]
feat/*cache* cache
svgo/*semaphore* sprocs]
(try
(when (fn? on-start)
(on-start {:total total :rollback rollback?}))
(on-start {:rollback rollback?}))
(db/tx-run! system
(fn [{:keys [::db/conn]}]
(run! (partial migrate-team)
(->> (get-teams conn)
(take max-items)))))
(try
(p/await! scope)
(finally
(pu/close! scope)))
(when (string? label)
(create-report-table! main/system)
(clean-reports! main/system label))
(db/tx-run! main/system
(fn [{:keys [::db/conn] :as system}]
(db/exec! conn ["SET statement_timeout = 0"])
(db/exec! conn ["SET idle_in_transaction_session_timeout = 0"])
(run! process-team
(->> (get-teams conn query pred)
(filter (fn [team-id]
(if (int? partitions)
(= current-partition (-> (uuid/hash-int team-id)
(mod partitions)
(inc)))
true)))
(take max-items)))
;; Close and await tasks
(pu/close! executor)))
(if (fn? on-end)
(-> (deref stats)

3
backend/src/app/srepl/helpers.clj
View File

@ -69,7 +69,8 @@
(fn [system]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
(-> (files/get-file system id :migrate? migrate?)
(update :data feat.fdata/process-pointers deref))))))
(update :data feat.fdata/process-pointers deref)
(update :data feat.fdata/process-objects (partial into {})))))))
(defn validate
"Validate structure, referencial integrity and semantic coherence of

25
backend/src/app/storage/s3.clj
View File

@ -51,6 +51,7 @@
software.amazon.awssdk.services.s3.model.DeleteObjectsRequest
software.amazon.awssdk.services.s3.model.DeleteObjectsResponse
software.amazon.awssdk.services.s3.model.GetObjectRequest
software.amazon.awssdk.services.s3.model.NoSuchKeyException
software.amazon.awssdk.services.s3.model.ObjectIdentifier
software.amazon.awssdk.services.s3.model.PutObjectRequest
software.amazon.awssdk.services.s3.model.S3Error
@ -126,17 +127,19 @@
(defmethod impl/get-object-data :s3
[backend object]
(us/assert! ::backend backend)
(letfn [(no-such-key? [cause]
(instance? software.amazon.awssdk.services.s3.model.NoSuchKeyException cause))
(handle-not-found [cause]
(ex/raise :type :not-found
:code :object-not-found
:hint "s3 object not found"
:cause cause))]
(-> (get-object-data backend object)
(p/catch no-such-key? handle-not-found)
(p/await!))))
(let [result (p/await (get-object-data backend object))]
(if (ex/exception? result)
(cond
(ex/instance? NoSuchKeyException result)
(ex/raise :type :not-found
:code :object-not-found
:hint "s3 object not found"
:cause result)
:else
(throw result))
result)))
(defmethod impl/get-object-bytes :s3
[backend object]
@ -298,7 +301,7 @@
[path]
(proxy [FilterInputStream] [(io/input-stream path)]
(close []
(fs/delete path)
(ex/ignoring (fs/delete path))
(proxy-super close))))
(defn- get-object-data

51
backend/src/app/svgo.clj
View File

@ -7,16 +7,10 @@
(ns app.svgo
"A SVG Optimizer service"
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.jsrt :as jsrt]
[app.common.logging :as l]
[app.common.spec :as us]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s]
[integrant.core :as ig]
[promesa.exec :as px]
[promesa.exec.bulkhead :as bh]
[promesa.exec.semaphore :as ps]
[promesa.util :as pu]))
@ -26,40 +20,23 @@
nil)
(defn optimize
[system data]
(dm/assert! "expect data to be a string" (string? data))
(letfn [(optimize-fn [pool]
(jsrt/run! pool
(fn [context]
(jsrt/set! context "svgData" data)
(jsrt/eval! context "penpotSvgo.optimize(svgData, {plugins: ['safeAndFastPreset']})"))))]
(try
(some-> *semaphore* ps/acquire!)
(let [{:keys [::jsrt/pool ::wrk/executor]} (::optimizer system)]
(dm/assert! "expect optimizer instance" (jsrt/pool? pool))
(px/invoke! executor (partial optimize-fn pool)))
(finally
(some-> *semaphore* ps/release!)))))
(s/def ::max-procs (s/nilable ::us/integer))
(defmethod ig/pre-init-spec ::optimizer [_]
(s/keys :req [::wrk/executor ::max-procs]))
(defmethod ig/prep-key ::optimizer
[_ cfg]
(merge {::max-procs 20} (d/without-nils cfg)))
[{pool ::optimizer} data]
(try
(some-> *semaphore* ps/acquire!)
(jsrt/run! pool
(fn [context]
(jsrt/set! context "svgData" data)
(jsrt/eval! context "penpotSvgo.optimize(svgData, {plugins: ['safeAndFastPreset']})")))
(finally
(some-> *semaphore* ps/release!))))
(defmethod ig/init-key ::optimizer
[_ {:keys [::wrk/executor ::max-procs]}]
(l/inf :hint "initializing svg optimizer pool" :max-procs max-procs)
(let [init (jsrt/resource->source "app/common/svg/optimizer.js")
executor (bh/create :type :executor :executor executor :permits max-procs)]
{::jsrt/pool (jsrt/pool :init init)
::wrk/executor executor}))
[_ _]
(l/inf :hint "initializing svg optimizer pool")
(let [init (jsrt/resource->source "app/common/svg/optimizer.js")]
(jsrt/pool :init init)))
(defmethod ig/halt-key! ::optimizer
[_ {:keys [::jsrt/pool]}]
[_ pool]
(l/info :hint "stopping svg optimizer pool")
(pu/close! pool))

80
backend/src/app/util/cache.clj
View File

@ -9,61 +9,71 @@
(:refer-clojure :exclude [get])
(:require
[app.util.time :as dt]
[promesa.core :as p]
[promesa.exec :as px])
(:import
com.github.benmanes.caffeine.cache.AsyncCache
com.github.benmanes.caffeine.cache.AsyncLoadingCache
com.github.benmanes.caffeine.cache.CacheLoader
com.github.benmanes.caffeine.cache.Cache
com.github.benmanes.caffeine.cache.Caffeine
com.github.benmanes.caffeine.cache.RemovalListener
com.github.benmanes.caffeine.cache.stats.CacheStats
java.time.Duration
java.util.concurrent.Executor
java.util.function.Function))
(set! *warn-on-reflection* true)
(defn create-listener
(defprotocol ICache
(get [_ k] [_ k load-fn] "get cache entry")
(invalidate! [_] [_ k] "invalidate cache"))
(defprotocol ICacheStats
(stats [_] "get stats"))
(defn- create-listener
[f]
(reify RemovalListener
(onRemoval [_ key val cause]
(when val
(f key val cause)))))
(defn create-loader
[f]
(reify CacheLoader
(load [_ key]
(f key))))
(defn- get-stats
[^Cache cache]
(let [^CacheStats stats (.stats cache)]
{:hit-rate (.hitRate stats)
:hit-count (.hitCount stats)
:req-count (.requestCount stats)
:miss-count (.missCount stats)
:miss-rate (.missRate stats)}))
(defn create
[& {:keys [executor on-remove load-fn keepalive]}]
(as-> (Caffeine/newBuilder) builder
(if on-remove (.removalListener builder (create-listener on-remove)) builder)
(if executor (.executor builder ^Executor (px/resolve-executor executor)) builder)
(if keepalive (.expireAfterAccess builder ^Duration (dt/duration keepalive)) builder)
(if load-fn
(.buildAsync builder ^CacheLoader (create-loader load-fn))
(.buildAsync builder))))
[& {:keys [executor on-remove max-size keepalive]}]
(let [cache (as-> (Caffeine/newBuilder) builder
(if (fn? on-remove) (.removalListener builder (create-listener on-remove)) builder)
(if executor (.executor builder ^Executor (px/resolve-executor executor)) builder)
(if keepalive (.expireAfterAccess builder ^Duration (dt/duration keepalive)) builder)
(if (int? max-size) (.maximumSize builder (long max-size)) builder)
(.recordStats builder)
(.buildAsync builder))
cache (.synchronous ^AsyncCache cache)]
(reify
ICache
(get [_ k]
(.getIfPresent ^Cache cache ^Object k))
(get [_ k load-fn]
(.get ^Cache cache
^Object k
^Function (reify Function
(apply [_ k]
(load-fn k)))))
(invalidate! [_]
(.invalidateAll ^Cache cache))
(invalidate! [_ k]
(.invalidateAll ^Cache cache ^Object k))
(defn invalidate-all!
[^AsyncCache cache]
(.invalidateAll (.synchronous cache)))
(defn get
([cache key]
(assert (instance? AsyncLoadingCache cache) "should be AsyncLoadingCache instance")
(p/await! (.get ^AsyncLoadingCache cache ^Object key)))
([cache key not-found-fn]
(assert (instance? AsyncCache cache) "should be AsyncCache instance")
(p/await! (.get ^AsyncCache cache
^Object key
^Function (reify
Function
(apply [_ key]
(not-found-fn key)))))))
ICacheStats
(stats [_]
(get-stats cache)))))
(defn cache?
[o]
(or (instance? AsyncCache o)
(instance? AsyncLoadingCache o)))
(satisfies? ICache o))

56
backend/src/app/util/pointer_map.clj
View File

@ -166,32 +166,36 @@
(assoc [this key val]
(when-not loaded? (load! this))
(let [odata (assoc odata key val)
mdata (assoc mdata :created-at (dt/now))
id (if modified? id (uuid/next))
pmap (PointerMap. id
mdata
odata
true
true)]
(some-> *tracked* (swap! assoc id pmap))
pmap))
(let [odata' (assoc odata key val)]
(if (identical? odata odata')
this
(let [mdata (assoc mdata :created-at (dt/now))
id (if modified? id (uuid/next))
pmap (PointerMap. id
mdata
odata'
true
true)]
(some-> *tracked* (swap! assoc id pmap))
pmap))))
(assocEx [_ _ _]
(throw (UnsupportedOperationException. "method not implemented")))
(without [this key]
(when-not loaded? (load! this))
(let [odata (dissoc odata key)
mdata (assoc mdata :created-at (dt/now))
id (if modified? id (uuid/next))
pmap (PointerMap. id
mdata
odata
true
true)]
(some-> *tracked* (swap! assoc id pmap))
pmap))
(let [odata' (dissoc odata key)]
(if (identical? odata odata')
this
(let [mdata (assoc mdata :created-at (dt/now))
id (if modified? id (uuid/next))
pmap (PointerMap. id
mdata
odata'
true
true)]
(some-> *tracked* (swap! assoc id pmap))
pmap))))
Counted
(count [this]
@ -206,6 +210,8 @@
(defn create
([]
(let [id (uuid/next)
mdata (assoc *metadata* :created-at (dt/now))
pmap (PointerMap. id mdata {} true true)]
(some-> *tracked* (swap! assoc id pmap))
@ -225,7 +231,15 @@
(do
(some-> *tracked* (swap! assoc (get-id data) data))
data)
(into (create) data)))
(let [mdata (assoc (meta data) :created-at (dt/now))
id (uuid/next)
pmap (PointerMap. id
mdata
data
true
true)]
(some-> *tracked* (swap! assoc id pmap))
pmap)))
(fres/add-handlers!
{:name "penpot/pointer-map/v1"

1
backend/src/app/util/time.clj
View File

@ -123,7 +123,6 @@
FileTime
(inst-ms* [v] (.toMillis ^FileTime v)))
(defmethod print-method Duration
[mv ^java.io.Writer writer]
(.write writer (str "#app/duration \"" (str/lower (subs (str mv) 2)) "\"")))

29
backend/test/backend_tests/rpc_file_test.clj
View File

@ -166,18 +166,21 @@
:name "test"
:id page-id}])
;; Check the number of fragments
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 2 (count rows))))
;; Check the number of fragments
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 2 (count rows))))
;; The file-gc should remove unused fragments
;; The file-gc should mark for remove unused fragments
(let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
;; Check the number of fragments
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 2 (count rows))))
;; The objects-gc should remove unused fragments
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 0 (:processed res))))
;; Check the number of fragments
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 2 (count rows))))
;; Add shape to page that should add a new fragment
(update-file!
@ -202,10 +205,14 @@
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 3 (count rows))))
;; The file-gc should remove unused fragments
;; The file-gc should mark for remove unused fragments
(let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
;; The objects-gc should remove unused fragments
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 0 (:processed res))))
;; Check the number of fragments; should be 3 because changes
;; are also holding pointers to fragments;
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
@ -235,8 +242,6 @@
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 2 (count rows)))))))
(t/deftest file-gc-task-with-thumbnails
(letfn [(add-file-media-object [& {:keys [profile-id file-id]}]
(let [mfile {:filename "sample.jpg"

50
backend/test/backend_tests/rpc_profile_test.clj
View File

@ -11,6 +11,7 @@
[app.config :as cf]
[app.db :as db]
[app.rpc :as-alias rpc]
[app.rpc.commands.profile :as profile]
[app.tokens :as tokens]
[app.util.time :as dt]
[backend-tests.helpers :as th]
@ -185,40 +186,12 @@
token (get-in out [:result :token])]
(t/is (string? token))
;; try register without token
(let [data {::th/type :register-profile
:fullname "foobar"
:accept-terms-and-privacy true}
out (th/command! data)]
(let [error (:error out)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :spec-validation))))
;; try correct register
(let [data {::th/type :register-profile
:token token
:fullname "foobar"
:accept-terms-and-privacy true
:accept-newsletter-subscription true}]
(let [{:keys [result error]} (th/command! data)]
(t/is (nil? error))))))
(t/deftest prepare-register-and-register-profile-1
(let [data {::th/type :prepare-register-profile
:email "user@example.com"
:password "foobar"}
out (th/command! data)
token (get-in out [:result :token])]
(t/is (string? token))
;; try register without token
(let [data {::th/type :register-profile
:fullname "foobar"
:accept-terms-and-privacy true}
out (th/command! data)]
;; (th/print-result! out)
(let [error (:error out)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
@ -228,11 +201,24 @@
(let [data {::th/type :register-profile
:token token
:fullname "foobar"
:utm_campaign "utma"
:mtm_campaign "mtma"
:accept-terms-and-privacy true
:accept-newsletter-subscription true}]
(let [{:keys [result error] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))))))
(let [{:keys [result error]} (th/command! data)]
(t/is (nil? error))))
(let [profile (some-> (th/db-get :profile {:email "user@example.com"})
(profile/decode-row))]
(t/is (= "penpot" (:auth-backend profile)))
(t/is (= "foobar" (:fullname profile)))
(t/is (false? (:is-active profile)))
(t/is (uuid? (:default-team-id profile)))
(t/is (uuid? (:default-project-id profile)))
(let [props (:props profile)]
(t/is (= "utma" (:penpot/utm-campaign props)))
(t/is (= "mtma" (:penpot/mtm-campaign props)))))))
(t/deftest prepare-register-and-register-profile-2
(with-redefs [app.rpc.commands.auth/register-retry-threshold (dt/duration 500)]

2
common/deps.edn
View File

@ -32,7 +32,7 @@
funcool/tubax {:mvn/version "2021.05.20-0"}
funcool/cuerdas {:mvn/version "2023.11.09-407"}
funcool/promesa {:git/sha "484b7f5c0d08d817746caa685ed9ac5583eb37fa"
funcool/promesa {:git/sha "0c5ed6ad033515a2df4b55addea044f60e9653d0"
:git/url "https://github.com/funcool/promesa"}
funcool/datoteka {:mvn/version "3.0.66"

13
common/src/app/common/data.cljc
View File

@ -7,7 +7,7 @@
(ns app.common.data
"A collection if helpers for working with data structures and other
data resources."
(:refer-clojure :exclude [read-string hash-map merge name update-vals
(:refer-clojure :exclude [read-string hash-map merge name
parse-double group-by iteration concat mapcat
parse-uuid max min])
#?(:cljs
@ -216,12 +216,19 @@
[coll]
(into [] (remove nil?) coll))
(defn without-nils
"Given a map, return a map removing key-value
pairs when value is `nil`."
([] (remove (comp nil? val)))
([]
(remove (comp nil? val)))
([data]
(into {} (without-nils) data)))
(reduce-kv (fn [data k v]
(if (nil? v)
(dissoc data k)
data))
data
data)))
(defn without-qualified
([]

35
common/src/app/common/exceptions.cljc
View File

@ -7,10 +7,12 @@
(ns app.common.exceptions
"A helpers for work with exceptions."
#?(:cljs (:require-macros [app.common.exceptions]))
(:refer-clojure :exclude [instance?])
(:require
#?(:clj [clojure.stacktrace :as strace])
[app.common.pprint :as pp]
[app.common.schema :as sm]
[clojure.core :as c]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[expound.alpha :as expound])
@ -20,6 +22,9 @@
#?(:clj (set! *warn-on-reflection* true))
(def ^:dynamic *data-length* 8)
(def ^:dynamic *data-level* 8)
(defmacro error
[& {:keys [type hint] :as params}]
`(ex-info ~(or hint (name type))
@ -49,20 +54,38 @@
(defn ex-info?
[v]
(instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v))
(c/instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v))
(defn error?
[v]
(instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v))
(c/instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v))
(defn exception?
[v]
(instance? #?(:clj java.lang.Throwable :cljs js/Error) v))
(c/instance? #?(:clj java.lang.Throwable :cljs js/Error) v))
#?(:clj
(defn runtime-exception?
[v]
(instance? RuntimeException v)))
(c/instance? RuntimeException v)))
#?(:clj
(defn instance?
[class cause]
(loop [cause cause]
(if (c/instance? class cause)
true
(if-let [cause (ex-cause cause)]
(recur cause)
false)))))
;; NOTE: idea for a macro for error handling
;; (pu/try-let [cause (p/await (get-object-data backend object))]
;; (ex/instance? NoSuchKeyException cause)
;; (ex/raise :type :not-found
;; :code :object-not-found
;; :hint "s3 object not found"
;; :cause cause))
(defn explain
[data & {:as opts}]
@ -91,8 +114,8 @@
data? true
explain? true
chain? true
data-length 8
data-level 5}}]
data-length *data-length*
data-level *data-level*}}]
(letfn [(print-trace-element [^StackTraceElement e]
(let [class (.getClassName e)

2
common/src/app/common/files/defaults.cljc
View File

@ -6,4 +6,4 @@
(ns app.common.files.defaults)
(def version 38)
(def version 44)

20
common/src/app/common/files/helpers.cljc
View File

@ -92,9 +92,11 @@
(= :image (dm/get-prop shape :type))))
(defn svg-raw-shape?
[shape]
(and (some? shape)
(= :svg-raw (dm/get-prop shape :type))))
([objects id]
(svg-raw-shape? (get objects id)))
([shape]
(and (some? shape)
(= :svg-raw (dm/get-prop shape :type)))))
(defn path-shape?
([objects id]
@ -753,3 +755,15 @@
[frame-id (get-parent-ids objects frame-id)]))]
(recur frame-id frame-parents (rest selected))))))
(defn fixed?
[objects shape-id]
(let [ids-to-check
(concat
[shape-id]
(get-children-ids objects shape-id)
(->> (get-parent-ids objects shape-id)
(take-while #(and (not= % uuid/zero) (not (root-frame? objects %))))))]
(boolean
(->> ids-to-check
(d/seek (fn [id] (dm/get-in objects [id :fixed-scroll])))))))

224
common/src/app/common/files/migrations.cljc
View File

@ -19,9 +19,11 @@
[app.common.geom.shapes.text :as gsht]
[app.common.logging :as l]
[app.common.math :as mth]
[app.common.schema :as sm]
[app.common.svg :as csvg]
[app.common.text :as txt]
[app.common.types.shape :as cts]
[app.common.types.shape.shadow :as ctss]
[app.common.uuid :as uuid]
[cuerdas.core :as str]))
@ -31,6 +33,10 @@
(defmulti migrate :version)
(defn need-migration?
[{:keys [data]}]
(> cfd/version (:version data 0)))
(defn migrate-data
([data] (migrate-data data version))
([data to-version]
@ -318,19 +324,21 @@
(= "#7B7D85" fill-color)))
(dissoc :fill-color :fill-opacity))))
(update-container [{:keys [objects] :as container}]
(loop [objects objects
shapes (->> (vals objects)
(filter cfh/image-shape?))]
(if-let [shape (first shapes)]
(let [{:keys [id frame-id] :as shape'} (process-shape shape)]
(if (identical? shape shape')
(recur objects (rest shapes))
(recur (-> objects
(assoc id shape')
(d/update-when frame-id dissoc :thumbnail))
(rest shapes))))
(assoc container :objects objects))))]
(update-container [container]
(if (contains? container :objects)
(loop [objects (:objects container)
shapes (->> (vals objects)
(filter cfh/image-shape?))]
(if-let [shape (first shapes)]
(let [{:keys [id frame-id] :as shape'} (process-shape shape)]
(if (identical? shape shape')
(recur objects (rest shapes))
(recur (-> objects
(assoc id shape')
(d/update-when frame-id dissoc :thumbnail))
(rest shapes))))
(assoc container :objects objects)))
container))]
(-> data
(update :pages-index update-vals update-container)
@ -380,7 +388,7 @@
(assign-fills)))
(update-container [container]
(update container :objects update-vals update-object))]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
@ -409,7 +417,7 @@
(assoc :fills [])))
(update-container [container]
(update container :objects update-vals update-object))]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
@ -424,7 +432,7 @@
(dissoc :position-data)))
(update-container [container]
(update container :objects update-vals update-object))]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
@ -440,7 +448,7 @@
(dissoc :position-data)))
(update-container [container]
(update container :objects update-vals update-object))]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
@ -527,7 +535,7 @@
(assoc object :frame-id calculated-frame-id)))
(update-container [container]
(update container :objects #(update-vals % (partial update-object %))))]
(d/update-when container :objects #(update-vals % (partial update-object %))))]
(-> data
(update :pages-index update-vals update-container)
@ -565,22 +573,7 @@
(update :content #(txt/transform-nodes invalid-node? fix-node %)))))
(update-container [container]
(update container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 30
[data]
(letfn [(update-object [object]
(if (and (cfh/frame-shape? object)
(not (:shapes object)))
(assoc object :shapes [])
object))
(update-container [container]
(update container :objects update-vals update-object))]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
@ -613,7 +606,8 @@
object)))
(update-container [container]
(update container :objects update-vals update-object))]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
@ -624,13 +618,13 @@
;; Ensure all root objects are well formed shapes.
(if (= (:id object) uuid/zero)
(-> object
(assoc :parent-id uuid/zero
:frame-id uuid/zero)
(assoc :parent-id uuid/zero)
(assoc :frame-id uuid/zero)
(cts/setup-shape))
object))
(update-container [container]
(update container :objects update-vals update-object))]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container))))
@ -642,7 +636,7 @@
(dissoc object :x :y :width :height)
object))
(update-container [container]
(update container :objects update-vals update-object))]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
@ -694,8 +688,158 @@
shape)))
(update-container [container]
(update container :objects update-vals update-shape))]
(d/update-when container :objects update-vals update-shape))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 39
[data]
(letfn [(update-shape [shape]
(cond
(and (cfh/bool-shape? shape)
(not (contains? shape :bool-content)))
(assoc shape :bool-content [])
(and (cfh/path-shape? shape)
(not (contains? shape :content)))
(assoc shape :content [])
:else
shape))
(update-container [container]
(d/update-when container :objects update-vals update-shape))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 40
[data]
(letfn [(update-shape [{:keys [content shapes] :as shape}]
;; Fix frame shape that in reallity is a path shape
(if (and (cfh/frame-shape? shape)
(contains? shape :selrect)
(seq content)
(not (seq shapes))
(contains? (first content) :command))
(-> shape
(assoc :type :path)
(assoc :x nil)
(assoc :y nil)
(assoc :width nil)
(assoc :height nil))
shape))
(update-container [container]
(d/update-when container :objects update-vals update-shape))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 41
[data]
(letfn [(update-shape [shape]
(cond
(or (cfh/bool-shape? shape)
(cfh/path-shape? shape))
shape
;; Fix all shapes that has geometry broken but still
;; preservers the selrect, so we recalculate the
;; geometry from selrect.
(and (contains? shape :selrect)
(or (nil? (:x shape))
(nil? (:y shape))
(nil? (:width shape))
(nil? (:height shape))))
(let [selrect (:selrect shape)]
(-> shape
(assoc :x (:x selrect))
(assoc :y (:y selrect))
(assoc :width (:width selrect))
(assoc :height (:height selrect))))
:else
shape))
(update-container [container]
(d/update-when container :objects update-vals update-shape))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 42
[data]
(letfn [(update-object [object]
(if (and (or (cfh/frame-shape? object)
(cfh/group-shape? object)
(cfh/bool-shape? object))
(not (:shapes object)))
(assoc object :shapes [])
object))
(update-container [container]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(def ^:private valid-fill?
(sm/lazy-validator ::cts/fill))
(defmethod migrate 43
[data]
(letfn [(number->string [v]
(if (number? v)
(str v)
v))
(update-text-node [node]
(-> node
(d/update-when :fills #(filterv valid-fill? %))
(d/update-when :font-size number->string)
(d/update-when :font-weight number->string)
(d/without-nils)))
(update-object [object]
(if (cfh/text-shape? object)
(update object :content #(txt/transform-nodes identity update-text-node %))
object))
(update-container [container]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(def ^:private valid-shadow?
(sm/lazy-validator ::ctss/shadow))
(defmethod migrate 44
[data]
(letfn [(fix-shadow [shadow]
(if (string? (:color shadow))
(let [color {:color (:color shadow)
:opacity 1}]
(assoc shadow :color color))
shadow))
(update-object [object]
(d/update-when object :shadow
#(into []
(comp (map fix-shadow)
(filter valid-shadow?))
%)))
(update-container [container]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))

16
common/src/app/common/files/repair.cljc
View File

@ -66,6 +66,19 @@
(pcb/with-file-data file-data)
(pcb/update-shapes [(:parent-id shape)] repair-shape))))
(defmethod repair-error :duplicated-children
[_ {:keys [shape page-id] :as error} file-data _]
(let [repair-shape
(fn [shape]
; Remove duplicated
(log/debug :hint " -> remove duplicated children")
(update shape :shapes distinct))]
(log/dbg :hint "repairing shape :duplicated-children" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
(defmethod repair-error :child-not-found
[_ {:keys [shape page-id args] :as error} file-data _]
(let [repair-shape
@ -326,7 +339,8 @@
(log/dbg :hint "repairing shape :nested-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
(pcb/update-shapes [(:id shape)] repair-shape)
(pcb/change-parent uuid/zero [shape] nil {:component-swap true}))))
(defmethod repair-error :root-copy-not-allowed
[_ {:keys [shape page-id] :as error} file-data _]

115
common/src/app/common/files/validate.cljc
View File

@ -26,6 +26,7 @@
#{:invalid-geometry
:parent-not-found
:child-not-in-parent
:duplicated-children
:child-not-found
:frame-not-found
:invalid-frame
@ -105,7 +106,7 @@
(nil? (:selrect shape))
(nil? (:points shape))))
(report-error :invalid-geometry
"Shape greometry is invalid"
"Shape geometry is invalid"
shape file page)))
(defn- check-parent-children
@ -123,6 +124,11 @@
(str/ffmt "Shape % not in parent's children list" (:id shape))
shape file page)))
(when-not (= (count (:shapes shape)) (count (distinct (:shapes shape))))
(report-error :duplicated-children
(str/ffmt "Shape % has duplicated children" (:id shape))
shape file page))
(doseq [child-id (:shapes shape)]
(let [child (ctst/get-shape page child-id)]
(if (nil? child)
@ -367,63 +373,63 @@
[shape-id file page libraries & {:keys [context] :or {context :not-component}}]
(let [shape (ctst/get-shape page shape-id)]
(when (some? shape)
(do
(check-geometry shape file page)
(check-parent-children shape file page)
(check-frame shape file page)
(check-geometry shape file page)
(check-parent-children shape file page)
(check-frame shape file page)
(if (ctk/instance-head? shape)
(if (not= :frame (:type shape))
(report-error :instance-head-not-frame
"Instance head should be a frame"
(if (ctk/instance-head? shape)
(if (not= :frame (:type shape))
(report-error :instance-head-not-frame
"Instance head should be a frame"
shape file page)
(if (ctk/instance-root? shape)
(if (ctk/main-instance? shape)
(if (not= context :not-component)
(report-error :root-main-not-allowed
"Root main component not allowed inside other component"
shape file page)
(check-shape-main-root-top shape file page libraries))
(if (not= context :not-component)
(report-error :root-copy-not-allowed
"Root copy component not allowed inside other component"
shape file page)
(check-shape-copy-root-top shape file page libraries)))
(if (ctk/main-instance? shape)
;; mains can't be nested into mains
(if (or (= context :not-component) (= context :main-top))
(report-error :nested-main-not-allowed
"Nested main component only allowed inside other component"
shape file page)
(check-shape-main-root-nested shape file page libraries))
(if (= context :not-component)
(report-error :nested-copy-not-allowed
"Nested copy component only allowed inside other component"
shape file page)
(check-shape-copy-root-nested shape file page libraries)))))
(if (ctk/in-component-copy? shape)
(if-not (#{:copy-top :copy-nested :copy-any} context)
(report-error :not-head-copy-not-allowed
"Non-root copy only allowed inside a copy"
shape file page)
(check-shape-copy-not-root shape file page libraries))
(if (ctk/instance-root? shape)
(if (ctk/main-instance? shape)
(if (not= context :not-component)
(report-error :root-main-not-allowed
"Root main component not allowed inside other component"
shape file page)
(check-shape-main-root-top shape file page libraries))
(if (not= context :not-component)
(report-error :root-copy-not-allowed
"Root copy component not allowed inside other component"
shape file page)
(check-shape-copy-root-top shape file page libraries)))
(if (ctk/main-instance? shape)
(if (= context :not-component)
(report-error :nested-main-not-allowed
"Nested main component only allowed inside other component"
shape file page)
(check-shape-main-root-nested shape file page libraries))
(if (= context :not-component)
(report-error :nested-copy-not-allowed
"Nested copy component only allowed inside other component"
shape file page)
(check-shape-copy-root-nested shape file page libraries)))))
(if (ctk/in-component-copy? shape)
(if-not (#{:copy-top :copy-nested :copy-any} context)
(report-error :not-head-copy-not-allowed
"Non-root copy only allowed inside a copy"
(if (ctn/inside-component-main? (:objects page) shape)
(if-not (#{:main-top :main-nested :main-any} context)
(report-error :not-head-main-not-allowed
"Non-root main only allowed inside a main component"
shape file page)
(check-shape-copy-not-root shape file page libraries))
(check-shape-main-not-root shape file page libraries))
(if (ctn/inside-component-main? (:objects page) shape)
(if-not (#{:main-top :main-nested :main-any} context)
(report-error :not-head-main-not-allowed
"Non-root main only allowed inside a main component"
shape file page)
(check-shape-main-not-root shape file page libraries))
(if (#{:main-top :main-nested :main-any} context)
(report-error :not-component-not-allowed
"Not compoments are not allowed inside a main"
shape file page)
(check-shape-not-component shape file page libraries)))))))))
(if (#{:main-top :main-nested :main-any} context)
(report-error :not-component-not-allowed
"Not compoments are not allowed inside a main"
shape file page)
(check-shape-not-component shape file page libraries))))))))
(defn- check-component
"Validate semantic coherence of a component. Report all errors found."
@ -483,6 +489,9 @@
(sm/lazy-explainer ::ctf/data))
(defn validate-file-schema!
"Validates the file itself, without external dependencies, it
performs the schema checking and some semantical validation of the
content."
[{:keys [id data] :as file}]
(when-not (valid-fdata? data)
(ex/raise :type :validation

1
common/src/app/common/geom/shapes/path.cljc
View File

@ -981,6 +981,7 @@
selrect (-> points
(gco/transform-points points-center transform-inverse)
(grc/points->rect))]
[points selrect]))
(defn open-path?

7
common/src/app/common/schema.cljc
View File

@ -14,6 +14,7 @@
[app.common.schema.generators :as sg]
[app.common.schema.openapi :as-alias oapi]
[app.common.schema.registry :as sr]
[app.common.time :as tm]
[app.common.uri :as u]
[app.common.uuid :as uuid]
[clojure.core :as c]
@ -625,7 +626,8 @@
{:title "inst"
:description "Satisfies Inst protocol"
:error/message "expected to be number in safe range"
:gen/gen (sg/small-int)
:gen/gen (->> (sg/small-int)
(sg/fmap (fn [v] (tm/instant v))))
::oapi/type "number"
::oapi/format "int64"}})
@ -658,6 +660,9 @@
;; ---- PREDICATES
(def valid-safe-number?
(lazy-validator ::safe-number))
(def check-safe-int!
(check-fn ::safe-int))

10
common/src/app/common/schema/generators.cljc
View File

@ -5,7 +5,7 @@
;; Copyright (c) KALEIDOS INC
(ns app.common.schema.generators
(:refer-clojure :exclude [set subseq uuid for filter map])
(:refer-clojure :exclude [set subseq uuid for filter map let])
#?(:cljs (:require-macros [app.common.schema.generators]))
(:require
[app.common.schema.registry :as sr]
@ -37,6 +37,10 @@
[& params]
`(tp/for-all ~@params))
(defmacro let
[& params]
`(tg/let ~@params))
(defn check!
[p & {:keys [num] :or {num 20} :as options}]
(tc/quick-check num p (assoc options :reporter-fn default-reporter-fn :max-size 50)))
@ -124,6 +128,10 @@
[f g]
(tg/fmap f g))
(defn mcat
[f g]
(tg/bind g f))
(defn tuple
[& opts]
(apply tg/tuple opts))

75
common/src/app/common/svg.cljc
View File

@ -31,7 +31,7 @@
(def xml-id-regex #"#([:A-Z_a-z\xC0-\xD6\xD8-\xF6\xF8-\u02FF\u0370-\u037D\u037F-\u1FFF\u200C-\u200D\u2070-\u218F\u2C00-\u2FEF\u3001-\uD7FF\uF900-\uFDCF\uFDF0-\uFFFD\u10000-\uEFFFF][\.\-\:0-9\xB7A-Z_a-z\xC0-\xD6\xD8-\xF6\xF8-\u02FF\u0300-\u036F\u0370-\u037D\u037F-\u1FFF\u200C-\u200D\u203F-\u2040\u2070-\u218F\u2C00-\u2FEF\u3001-\uD7FF\uF900-\uFDCF\uFDF0-\uFFFD\u10000-\uEFFFF]*)")
(def matrices-regex #"(matrix|translate|scale|rotate|skewX|skewY)\(([^\)]*)\)")
(def number-regex #"[+-]?\d*(\.\d+)?(e[+-]?\d+)?")
(def number-regex #"[+-]?\d*(\.\d+)?([eE][+-]?\d+)?")
(def tags-to-remove #{:linearGradient :radialGradient :metadata :mask :clipPath :filter :title})
@ -759,40 +759,39 @@
;; Transforms spec:
;; https://www.w3.org/TR/SVG11/single-page.html#coords-TransformAttribute
(defn format-translate-params
(defn- format-translate-params
[params]
(assert (or (= (count params) 1) (= (count params) 2)))
(if (= (count params) 1)
[(gpt/point (nth params 0) 0)]
[(gpt/point (nth params 0) (nth params 1))]))
(defn format-scale-params
(defn- format-scale-params
[params]
(assert (or (= (count params) 1) (= (count params) 2)))
(if (= (count params) 1)
[(gpt/point (nth params 0))]
[(gpt/point (nth params 0) (nth params 1))]))
(defn format-rotate-params
(defn- format-rotate-params
[params]
(assert (or (= (count params) 1) (= (count params) 3)) (str "??" (count params)))
(if (= (count params) 1)
[(nth params 0) (gpt/point 0 0)]
[(nth params 0) (gpt/point (nth params 1) (nth params 2))]))
(defn format-skew-x-params
(defn- format-skew-x-params
[params]
(assert (= (count params) 1))
[(nth params 0) 0])
(defn format-skew-y-params
(defn- format-skew-y-params
[params]
(assert (= (count params) 1))
[0 (nth params 0)])
(defn to-matrix
[{:keys [type params]}]
(assert (#{"matrix" "translate" "scale" "rotate" "skewX" "skewY"} type))
(defn- to-matrix
[type params]
(case type
"matrix" (apply gmt/matrix params)
"translate" (apply gmt/translate-matrix (format-translate-params params))
@ -801,20 +800,27 @@
"skewX" (apply gmt/skew-matrix (format-skew-x-params params))
"skewY" (apply gmt/skew-matrix (format-skew-y-params params))))
(defn parse-transform
[transform-attr]
(if transform-attr
(let [process-matrix
(fn [[_ type params]]
(let [params (->> (re-seq number-regex params)
(filter #(-> % first seq))
(map (comp d/parse-double first)))]
{:type type :params params}))
(def ^:private
xf-parse-numbers
(comp
(map first)
(keep not-empty)
(map d/parse-double)))
(defn parse-numbers
[data]
(->> (re-seq number-regex data)
(into [] xf-parse-numbers)))
(defn parse-transform
[transform]
(if (string? transform)
(->> (re-seq matrices-regex transform)
(map (fn [[_ type params]]
(let [params (parse-numbers params)]
(to-matrix type params))))
(reduce gmt/multiply (gmt/matrix)))
matrices (->> (re-seq matrices-regex transform-attr)
(map process-matrix)
(map to-matrix))]
(reduce gmt/multiply (gmt/matrix) matrices))
(gmt/matrix)))
(defn format-move [[x y]] (str "M" x " " y))
@ -872,11 +878,21 @@
transform
(update :transform append-transform))))
(defn inherit-attributes [group-attrs {:keys [attrs] :as node}]
(defn inherit-attributes
[group-attrs {:keys [attrs] :as node}]
(if (map? node)
(let [attrs (-> (format-styles attrs)
(add-transform (:transform group-attrs)))
attrs (d/deep-merge (select-keys group-attrs inheritable-props) attrs)]
(let [attrs (-> (format-styles attrs)
(add-transform (:transform group-attrs)))
group-attrs (format-styles group-attrs)
;; Don't inherit a property that is already in the style attribute
inherit-style (-> (:style group-attrs) (d/without-keys (keys attrs)))
inheritable-props (->> inheritable-props (remove #(contains? (:styles attrs) %)))
group-attrs (-> group-attrs (assoc :style inherit-style))
attrs (-> (select-keys group-attrs inheritable-props)
(d/deep-merge attrs)
(d/without-nils))]
(assoc node :attrs attrs))
node))
@ -958,8 +974,7 @@
is-other? #{:r :stroke-width}]
(if is-percent?
;; JS parseFloat removes the % symbol
(let [attr-num (d/parse-double attr-val)]
(let [attr-num (d/parse-double (str/rtrim attr-val "%"))]
(str (cond
(is-x? attr-key) (fix-coord :x :width attr-num)
(is-y? attr-key) (fix-coord :y :height attr-num)
@ -975,7 +990,7 @@
(fix-percent-attr-numeric [_ attr-val]
(let [is-percent? (str/ends-with? attr-val "%")]
(if is-percent?
(str (let [attr-num (d/parse-double attr-val)]
(str (let [attr-num (d/parse-double (str/rtrim attr-val "%"))]
(/ attr-num 100)))
attr-val)))
@ -988,7 +1003,7 @@
(get-in node [:attrs :patternUnits])
(get-in node [:attrs :clipUnits]))]
(cond-> node
(= "objectBoundingBox" units)
(or (= "objectBoundingBox" units) (nil? units))
(update :attrs fix-percent-attrs-numeric)
(not= "objectBoundingBox" units)

108
common/src/app/common/svg/shapes_builder.cljc
View File

@ -57,13 +57,14 @@
clean-value))
(defn- svg-dimensions
[data]
(let [width (dm/get-in data [:attrs :width] 100)
height (dm/get-in data [:attrs :height] 100)
viewbox (or (dm/get-in data [:attrs :viewBox])
[{:keys [attrs] :as data}]
(let [width (:width attrs 100)
height (:height attrs 100)
viewbox (or (:viewBox attrs)
(dm/str "0 0 " width " " height))
[x y width height] (->> (str/split viewbox #"\s+")
(map d/parse-double))
[x y width height] (csvg/parse-numbers viewbox)
width (if (= width 0) 1 width)
height (if (= height 0) 1 height)]
@ -265,19 +266,19 @@
(gmt/transform-in (gpt/point svg-data)))
origin (gpt/negate (gpt/point svg-data))
rect (-> (parse-rect-attrs attrs)
vbox (parse-rect-attrs attrs)
rect (-> vbox
(update :x - (:x origin))
(update :y - (:y origin)))
props (-> (dissoc attrs :x :y :width :height :rx :ry :transform)
(csvg/attrs->props))]
(cts/setup-shape
(-> (calculate-rect-metadata rect transform)
(assoc :type :rect)
(assoc :name name)
(assoc :frame-id frame-id)
(assoc :svg-viewbox rect)
(assoc :svg-viewbox vbox)
(assoc :svg-attrs props)
;; We need to ensure fills are empty on import process
;; because setup-shape assings one by default.
@ -303,6 +304,11 @@
rx (d/nilv r rx)
ry (d/nilv r ry)
;; There are some svg circles in the internet that does not
;; have cx and cy attrs, so we default them to 0
cx (d/nilv cx 0)
cy (d/nilv cy 0)
origin (gpt/negate (gpt/point svg-data))
rect (grc/make-rect
@ -395,9 +401,9 @@
(str/trim (:stroke style)))
color (cond
(= stroke "currentColor") clr/black
(= stroke "none") nil
:else (clr/parse stroke))
(= stroke "currentColor") clr/black
(= stroke "none") nil
(clr/color-string? stroke) (clr/parse stroke))
opacity (when (some? color)
(d/parse-double
@ -415,17 +421,21 @@
(get style :strokeLinecap))
linecap (some-> linecap str/trim keyword)
attrs (-> attrs
(dissoc :stroke)
(dissoc :strokeWidth)
(dissoc :strokeOpacity)
(update :style (fn [style]
(-> style
(dissoc :stroke)
(dissoc :strokeLinecap)
(dissoc :strokeWidth)
(dissoc :strokeOpacity))))
(d/without-nils))]
attrs
(-> attrs
(cond-> linecap
(dissoc :strokeLinecap))
(cond-> (some? color)
(dissoc :stroke :strokeWidth :strokeOpacity))
(update
:style
(fn [style]
(-> style
(cond-> linecap
(dissoc :strokeLinecap))
(cond-> (some? color)
(dissoc :stroke :strokeWidth :strokeOpacity)))))
(d/without-nils))]
(cond-> (assoc shape :svg-attrs attrs)
(some? color)
@ -467,6 +477,16 @@
(-> (update-in [:svg-attrs :style] dissoc :mixBlendMode)
(assoc :blend-mode (-> (dm/get-in shape [:svg-attrs :style :mixBlendMode]) assert-valid-blend-mode)))))
(defn setup-other [shape]
(cond-> shape
(= (dm/get-in shape [:svg-attrs :display]) "none")
(-> (update-in [:svg-attrs :style] dissoc :display)
(assoc :hidden true))
(= (dm/get-in shape [:svg-attrs :style :display]) "none")
(-> (update :svg-attrs dissoc :display)
(assoc :hidden true))))
(defn tag->name
"Given a tag returns its layer name"
[tag]
@ -488,8 +508,16 @@
att-refs (csvg/find-attr-references attrs)
defs (get svg-data :defs)
references (csvg/find-def-references defs att-refs)
href-id (-> (or (:href attrs) (:xlink:href attrs) " ") (subs 1))
use-tag? (and (= :use tag) (contains? defs href-id))]
href-id (or (:href attrs) (:xlink:href attrs) " ")
href-id (if (and (string? href-id)
(pos? (count href-id)))
(subs href-id 1)
href-id)
use-tag? (and (= :use tag)
(some? href-id)
(contains? defs href-id))]
(if use-tag?
(let [;; Merge the data of the use definition with the properties passed as attributes
@ -518,20 +546,20 @@
:image (create-image-shape name frame-id svg-data element)
#_other (create-raw-svg name frame-id svg-data element))]
(when (some? shape)
(let [shape (-> shape
(assoc :svg-defs (select-keys defs references))
(setup-fill)
(setup-stroke)
(setup-opacity)
(update :svg-attrs (fn [attrs]
(if (empty? (:style attrs))
(dissoc attrs :style)
attrs))))]
[(cond-> shape
hidden (assoc :hidden true))
[(-> shape
(assoc :svg-defs (select-keys defs references))
(setup-fill)
(setup-stroke)
(setup-opacity)
(setup-other)
(update :svg-attrs (fn [attrs]
(if (empty? (:style attrs))
(dissoc attrs :style)
attrs)))
(cond-> ^boolean hidden
(assoc :hidden true)))
(cond->> (:content element)
(contains? csvg/parent-tags tag)
(mapv #(csvg/inherit-attributes attrs %)))]))))))
(cond->> (:content element)
(contains? csvg/parent-tags tag)
(mapv (partial csvg/inherit-attributes attrs)))])))))

53
common/src/app/common/time.cljc
View File

@ -4,16 +4,16 @@
;;
;; Copyright (c) KALEIDOS INC
;; Here we put the time functions that are common between frontend and backend.
;; In the future we may create an unified API for both.
(ns app.common.time
"A new cross-platform date and time API. It should be prefered over
a platform specific implementation found on `app.util.time`."
#?(:cljs
(:require
["luxon" :as lxn])
:clj
(:import
java.time.Instant)))
java.time.Instant
java.time.Duration)))
#?(:cljs
(def DateTime lxn/DateTime))
@ -24,4 +24,47 @@
(defn now
[]
#?(:clj (Instant/now)
:cljs (.local ^js DateTime)))
:cljs (.local ^js DateTime)))
(defn instant
[s]
#?(:clj (Instant/ofEpochMilli s)
:cljs (.fromMillis ^js DateTime s #js {:zone "local" :setZone false})))
#?(:cljs
(extend-protocol IComparable
DateTime
(-compare [it other]
(if ^boolean (.equals it other)
0
(if (< (inst-ms it) (inst-ms other)) -1 1)))
Duration
(-compare [it other]
(if ^boolean (.equals it other)
0
(if (< (inst-ms it) (inst-ms other)) -1 1)))))
#?(:cljs
(extend-type DateTime
cljs.core/IEquiv
(-equiv [o other]
(and (instance? DateTime other)
(== (.valueOf o) (.valueOf other))))))
#?(:cljs
(extend-protocol cljs.core/Inst
DateTime
(inst-ms* [inst] (.toMillis ^js inst))
Duration
(inst-ms* [inst] (.toMillis ^js inst)))
:clj
(extend-protocol clojure.core/Inst
Duration
(inst-ms* [v] (.toMillis ^Duration v))
Instant
(inst-ms* [v] (.toEpochMilli ^Instant v))))

26
common/src/app/common/types/color.cljc
View File

@ -70,18 +70,20 @@
[:offset ::sm/safe-number]]]]])
(sm/define! ::color
[:map {:title "Color"}
[:id {:optional true} ::sm/uuid]
[:name {:optional true} :string]
[:path {:optional true} [:maybe :string]]
[:value {:optional true} [:maybe :string]]
[:color {:optional true} [:maybe ::rgb-color]]
[:opacity {:optional true} [:maybe ::sm/safe-number]]
[:modified-at {:optional true} ::sm/inst]
[:ref-id {:optional true} ::sm/uuid]
[:ref-file {:optional true} ::sm/uuid]
[:gradient {:optional true} [:maybe ::gradient]]
[:image {:optional true} [:maybe ::image-color]]])
[:and
[:map {:title "Color"}
[:id {:optional true} ::sm/uuid]
[:name {:optional true} :string]
[:path {:optional true} [:maybe :string]]
[:value {:optional true} [:maybe :string]]
[:color {:optional true} [:maybe ::rgb-color]]
[:opacity {:optional true} [:maybe ::sm/safe-number]]
[:modified-at {:optional true} ::sm/inst]
[:ref-id {:optional true} ::sm/uuid]
[:ref-file {:optional true} ::sm/uuid]
[:gradient {:optional true} [:maybe ::gradient]]
[:image {:optional true} [:maybe ::image-color]]]
[::sm/contains-any {:strict true} [:color :gradient :image]]])
(sm/define! ::recent-color
[:and

46
common/src/app/common/types/container.cljc
View File

@ -387,3 +387,49 @@
(if (ctk/in-component-copy? parent)
true
(has-any-copy-parent? objects (:parent-id shape))))))
(defn has-any-main?
"Check if the shape has any children or parent that is a main component."
[objects shape]
(let [children (cfh/get-children-with-self objects (:id shape))
parents (cfh/get-parents objects (:id shape))]
(or
(some ctk/main-instance? children)
(some ctk/main-instance? parents))))
(defn valid-shape-for-component?
"Check if a main component can be generated from this shape in terms of nested components:
- A main can't be the ancestor of another main
- A main can't be nested in copies"
[objects shape]
(and
(not (has-any-main? objects shape))
(not (has-any-copy-parent? objects shape))))
(defn- invalid-structure-for-component?
"Check if the structure generated nesting children in parent is invalid in terms of nested components"
[objects parent children]
(let [selected-main-instance? (some true? (map #(has-any-main? objects %) children))
parent-in-component? (in-any-component? objects parent)
comps-nesting-loop? (not (->> children
(map #(cfh/components-nesting-loop? objects (:id %) (:id parent)))
(every? nil?)))]
(or
;;We don't want to change the structure of component copies
(ctk/in-component-copy? parent)
;; If we are moving something containing a main instance the container can't be part of a component (neither main nor copy)
(and selected-main-instance? parent-in-component?)
;; Avoid placing a shape as a direct or indirect child of itself,
;; or inside its main component if it's in a copy.
comps-nesting-loop?)))
(defn find-valid-parent-and-frame-ids
"Navigate trough the ancestors until find one that is valid"
[parent-id objects children]
(let [parent (get objects parent-id)]
(if (invalid-structure-for-component? objects parent children)
(find-valid-parent-and-frame-ids (:parent-id parent) objects children)
[parent-id
(if (= :frame (:type parent))
parent-id
(:frame-id parent))])))

11
common/src/app/common/types/page.cljc
View File

@ -7,7 +7,6 @@
(ns app.common.types.page
(:require
[app.common.data :as d]
[app.common.features :as cfeat]
[app.common.schema :as sm]
[app.common.types.color :as-alias ctc]
[app.common.types.grid :as ctg]
@ -71,13 +70,9 @@
(defn make-empty-page
[id name]
(let [wrap-objects-fn cfeat/*wrap-with-objects-map-fn*
wrap-pointer-fn cfeat/*wrap-with-pointer-map-fn*]
(-> empty-page-data
(assoc :id id)
(assoc :name name)
(update :objects wrap-objects-fn)
(wrap-pointer-fn))))
(-> empty-page-data
(assoc :id id)
(assoc :name name)))
;; --- Helpers for flow

117
common/src/app/common/types/shape.cljc
View File

@ -25,6 +25,7 @@
[app.common.types.shape.export :as ctse]
[app.common.types.shape.interactions :as ctsi]
[app.common.types.shape.layout :as ctsl]
[app.common.types.shape.path :as ctsp]
[app.common.types.shape.shadow :as ctss]
[app.common.types.shape.text :as ctsx]
[app.common.uuid :as uuid]
@ -46,6 +47,7 @@
:bool
:rect
:path
:text
:circle
:svg-raw
:image})
@ -126,21 +128,24 @@
[:stroke-color-gradient {:optional true} ::ctc/gradient]
[:stroke-image {:optional true} ::ctc/image-color]])
(sm/define! ::minimal-shape-attrs
(sm/define! ::shape-base-attrs
[:map {:title "ShapeMinimalRecord"}
[:id {:optional false} ::sm/uuid]
[:name {:optional false} :string]
[:type {:optional false} [::sm/one-of shape-types]]
[:x {:optional false} [:maybe ::sm/safe-number]]
[:y {:optional false} [:maybe ::sm/safe-number]]
[:width {:optional false} [:maybe ::sm/safe-number]]
[:height {:optional false} [:maybe ::sm/safe-number]]
[:selrect {:optional false} ::selrect]
[:points {:optional false} ::points]
[:transform {:optional false} ::gmt/matrix]
[:transform-inverse {:optional false} ::gmt/matrix]
[:parent-id {:optional false} ::sm/uuid]
[:frame-id {:optional false} ::sm/uuid]])
[:id ::sm/uuid]
[:name :string]
[:type [::sm/one-of shape-types]]
[:selrect ::selrect]
[:points ::points]
[:transform ::gmt/matrix]
[:transform-inverse ::gmt/matrix]
[:parent-id ::sm/uuid]
[:frame-id ::sm/uuid]])
(sm/define! ::shape-geom-attrs
[:map {:title "ShapeGeometryAttrs"}
[:x ::sm/safe-number]
[:y ::sm/safe-number]
[:width ::sm/safe-number]
[:height ::sm/safe-number]])
(sm/define! ::shape-attrs
[:map {:title "ShapeAttrs"}
@ -199,7 +204,7 @@
(sm/define! ::group-attrs
[:map {:title "GroupAttrs"}
[:type [:= :group]]
[:shapes {:optional true} [:maybe [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]]])
[:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]])
(sm/define! ::frame-attrs
[:map {:title "FrameAttrs"}
@ -212,7 +217,7 @@
(sm/define! ::bool-attrs
[:map {:title "BoolAttrs"}
[:type [:= :bool]]
[:shapes {:optional true} [:maybe [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]]
[:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
;; FIXME: improve this schema
[:bool-type :keyword]
@ -252,16 +257,7 @@
(sm/define! ::path-attrs
[:map {:title "PathAttrs"}
[:type [:= :path]]
[:x {:optional true} [:maybe ::sm/safe-number]]
[:y {:optional true} [:maybe ::sm/safe-number]]
[:width {:optional true} [:maybe ::sm/safe-number]]
[:height {:optional true} [:maybe ::sm/safe-number]]
[:content
{:optional true}
[:vector
[:map
[:command :keyword]
[:params {:optional true} [:maybe :map]]]]]])
[:content ::ctsp/content]])
(sm/define! ::text-attrs
[:map {:title "TextAttrs"}
@ -271,72 +267,96 @@
(sm/define! ::shape-map
[:multi {:dispatch :type :title "Shape"}
[:group
[:merge {:title "GroupShape"}
[:and {:title "GroupShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::minimal-shape-attrs
::group-attrs
::ctsl/layout-child-attrs]]
[:frame
[:merge {:title "FrameShape"}
::minimal-shape-attrs
[:and {:title "FrameShape"}
::shape-base-attrs
::shape-geom-attrs
::frame-attrs
::ctsl/layout-attrs
::ctsl/layout-child-attrs]]
[:bool
[:merge {:title "BoolShape"}
[:and {:title "BoolShape"}
::shape-base-attrs
::shape-attrs
::minimal-shape-attrs
::bool-attrs
::ctsl/layout-child-attrs]]
[:rect
[:merge {:title "RectShape"}
[:and {:title "RectShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::minimal-shape-attrs
::rect-attrs
::ctsl/layout-child-attrs]]
[:circle
[:merge {:title "CircleShape"}
[:and {:title "CircleShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::minimal-shape-attrs
::circle-attrs
::ctsl/layout-child-attrs]]
[:image
[:merge {:title "ImageShape"}
[:and {:title "ImageShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::minimal-shape-attrs
::image-attrs
::ctsl/layout-child-attrs]]
[:svg-raw
[:merge {:title "SvgRawShape"}
[:and {:title "SvgRawShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::minimal-shape-attrs
::svg-raw-attrs
::ctsl/layout-child-attrs]]
[:path
[:merge {:title "PathShape"}
[:and {:title "PathShape"}
::shape-base-attrs
::shape-attrs
::minimal-shape-attrs
::path-attrs
::ctsl/layout-child-attrs]]
[:text
[:merge {:title "TextShape"}
[:and {:title "TextShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::minimal-shape-attrs
::text-attrs
::ctsl/layout-child-attrs]]])
(sm/define! ::shape
[:and
{:title "Shape"
:gen/gen (->> (sg/generator ::shape-map)
:gen/gen (->> (sg/generator ::shape-base-attrs)
(sg/mcat (fn [{:keys [type] :as shape}]
(sg/let [attrs1 (sg/generator ::shape-attrs)
attrs2 (sg/generator ::shape-geom-attrs)
attrs3 (case type
:text (sg/generator ::text-attrs)
:path (sg/generator ::path-attrs)
:svg-raw (sg/generator ::svg-raw-attrs)
:image (sg/generator ::image-attrs)
:circle (sg/generator ::circle-attrs)
:rect (sg/generator ::rect-attrs)
:bool (sg/generator ::bool-attrs)
:group (sg/generator ::group-attrs)
:frame (sg/generator ::frame-attrs))]
(if (or (= type :path)
(= type :bool))
(merge attrs1 shape attrs3)
(merge attrs1 shape attrs2 attrs3)))))
(sg/fmap map->Shape))}
::shape-map
[:fn shape?]])
@ -491,7 +511,12 @@
the shape. The props must have :x :y :width :height."
[{:keys [type] :as props}]
(let [shape (make-minimal-shape type)
shape (merge shape (d/without-nils props))
;; The props can be custom records that does not
;; work properly with without-nils, so we first make
;; it plain map for proceed
props (d/without-nils (into {} props))
shape (merge shape (d/without-nils (into {} props)))
shape (case (:type shape)
(:bool :path) (setup-path shape)
:image (-> shape setup-rect setup-image)

47
common/src/app/common/types/shape/path.cljc Normal file
View File

@ -0,0 +1,47 @@
;; 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.common.types.shape.path
(:require
[app.common.schema :as sm]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEMA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sm/define! ::segment
[:multi {:title "PathSegment" :dispatch :command}
[:line-to
[:map
[:command [:= :line-to]]
[:params
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]]]]]
[:close-path
[:map
[:command [:= :close-path]]]]
[:move-to
[:map
[:command [:= :move-to]]
[:params
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]]]]]
[:curve-to
[:map
[:command [:= :curve-to]]
[:params
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]
[:c1x ::sm/safe-number]
[:c1y ::sm/safe-number]
[:c2x ::sm/safe-number]
[:c2y ::sm/safe-number]]]]]])
(sm/define! ::content
[:vector ::segment])

12
common/src/app/common/types/shape/shadow.cljc
View File

@ -7,8 +7,7 @@
(ns app.common.types.shape.shadow
(:require
[app.common.schema :as sm]
[app.common.types.color :as ctc]
[app.common.types.shape.shadow.color :as-alias shadow-color]))
[app.common.types.color :as ctc]))
(def styles #{:drop-shadow :inner-shadow})
@ -21,11 +20,4 @@
[:blur ::sm/safe-number]
[:spread ::sm/safe-number]
[:hidden :boolean]
;;FIXME: reuse color?
[:color
[:map
[:color {:optional true} :string]
[:opacity {:optional true} ::sm/safe-number]
[:gradient {:optional true} [:maybe ::ctc/gradient]]
[:file-id {:optional true} [:maybe ::sm/uuid]]
[:id {:optional true} [:maybe ::sm/uuid]]]]])
[:color ::ctc/color]])

54
common/src/app/common/types/shape_tree.cljc
View File

@ -176,11 +176,11 @@
(->> (get-root-shapes objects)
(mapv :id)))
(defn get-base
[objects id-a id-b]
(defn- get-base
[id-a id-b id-parents]
(let [[parents-a parents-a-index] (cfh/get-parent-ids-with-index objects id-a)
[parents-b parents-b-index] (cfh/get-parent-ids-with-index objects id-b)
(let [[parents-a parents-a-index] (get id-parents id-a)
[parents-b parents-b-index] (get id-parents id-b)
parents-a (cons id-a parents-a)
parents-b (into #{id-b} parents-b)
@ -194,9 +194,9 @@
[base-id idx-a idx-b]))
(defn- is-shape-over-shape?
[objects base-shape-id over-shape-id bottom-frames?]
[objects base-shape-id over-shape-id bottom-frames? id-parents]
(let [[base-id index-a index-b] (get-base objects base-shape-id over-shape-id)]
(let [[base-id index-a index-b] (get-base base-shape-id over-shape-id id-parents)]
(cond
;; The base the base shape, so the other item is below (if not bottom-frames)
(= base-id base-shape-id)
@ -234,33 +234,37 @@
([objects ids {:keys [bottom-frames?] :as options
:or {bottom-frames? false}}]
(letfn [(comp [id-a id-b]
(cond
(= id-a id-b)
0
;; Create an index of the parents of the shapes. This will speed the sorting because we use
;; this information down the line.
(let [id-parents (into {} (map #(vector % (cfh/get-parent-ids-with-index objects %))) ids)]
(letfn [(comp [id-a id-b]
(cond
(= id-a id-b)
0
(is-shape-over-shape? objects id-a id-b bottom-frames?)
1
(is-shape-over-shape? objects id-a id-b bottom-frames? id-parents)
1
:else
-1))]
(sort comp ids))))
:else
-1))]
(sort comp ids)))))
(defn sort-z-index-objects
([objects items]
(sort-z-index-objects objects items nil))
([objects items {:keys [bottom-frames?]
:or {bottom-frames? false}}]
(d/unstable-sort
(fn [obj-a obj-b]
(let [id-a (dm/get-prop obj-a :id)
id-b (dm/get-prop obj-b :id)]
(if (= id-a id-b)
0
(if ^boolean (is-shape-over-shape? objects id-a id-b bottom-frames?)
1
-1))))
items)))
(let [id-parents (into {} (map #(vector (dm/get-prop % :id) (cfh/get-parent-ids-with-index objects (dm/get-prop % :id)))) items)]
(d/unstable-sort
(fn [obj-a obj-b]
(let [id-a (dm/get-prop obj-a :id)
id-b (dm/get-prop obj-b :id)]
(if (= id-a id-b)
0
(if ^boolean (is-shape-over-shape? objects id-a id-b bottom-frames? id-parents)
1
-1))))
items))))
(defn get-frame-by-position
([objects position]

9
common/src/app/common/uuid.cljc
View File

@ -75,3 +75,12 @@
with base62. It is only safe to use with uuid v4 and penpot custom v8"
[id]
(impl/short-v8 (dm/str id))))
#?(:clj
(defn hash-int
[id]
(let [a (.getMostSignificantBits ^UUID id)
b (.getLeastSignificantBits ^UUID id)]
(+ (clojure.lang.Murmur3/hashLong a)
(clojure.lang.Murmur3/hashLong b)))))

3
frontend/resources/images/icons/download-refactor.svg Normal file
View File

@ -0,0 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 16 16" stroke-linecap="round" stroke-linejoin="round">
<path d="M14 10v2.667A1.334 1.334 0 0112.667 14H3.333A1.334 1.334 0 012 12.667V10m2.667-3.333L8 10m0 0l3.333-3.333M8 10V2"/>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 244 B

3
frontend/resources/images/icons/feedback-refactor.svg Normal file
View File

@ -0,0 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 16 16" stroke-linecap="round" stroke-linejoin="round">
<path d="M5.333 6.667h.007m2.66 0h.007m2.66 0h.006M14 10a1.333 1.333 0 01-1.333 1.333h-8L2 14V3.333A1.333 1.333 0 013.333 2h9.334A1.333 1.333 0 0114 3.333V10z"/>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 281 B

3
frontend/resources/images/icons/pin-refactor.svg Normal file
View File

@ -0,0 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 16 16" stroke-linecap="round" stroke-linejoin="round">
<path d="M5.847 10.153L2.962 7.27a4.928 4.928 0 013.482-1.442h.845L10.654 1.5 14.5 5.346 10.173 8.71v.846a4.924 4.924 0 01-1.442 3.482l-2.884-2.886zm0 0L2 14"/>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 280 B

23
frontend/resources/styles/common/refactor/common-dashboard.scss
View File

@ -33,13 +33,6 @@
}
}
svg {
fill: $db-secondary;
height: $s-12;
margin-right: $s-4;
width: $s-12;
}
nav {
display: flex;
align-items: flex-end;
@ -98,7 +91,6 @@
display: flex;
align-items: center;
cursor: pointer;
margin-left: $s-8;
svg {
fill: $df-secondary;
@ -119,22 +111,9 @@
.dashboard-header-actions {
display: flex;
column-gap: $s-16;
}
.pin-icon {
margin: 0 $s-8 0 $s-24;
background-color: transparent;
border: none;
svg {
fill: $df-secondary;
}
&.active {
svg {
fill: $db-cuaternary;
}
}
}
.dashboard-header-options {
li {
a {

7
frontend/src/app/main/data/dashboard/shortcuts.cljs
View File

@ -32,9 +32,10 @@
:subsections [:general-dashboard]
:fn #(st/emit! (dd/create-element))}
:toggle-light-dark {:tooltip (ds/meta (ds/alt "Q"))
:command (ds/c-mod "alt+q")
:fn #(st/emit! (du/toggle-theme))}})
:toggle-theme {:tooltip (ds/meta (ds/alt "M"))
:command (ds/c-mod "alt+m")
:subsections [:general-dashboard]
:fn #(st/emit! (du/toggle-theme))}})
(defn get-tooltip [shortcut]
(assert (contains? shortcuts shortcut) (str shortcut))

15
frontend/src/app/main/data/viewer.cljs
View File

@ -558,7 +558,7 @@
;; --- Overlays
(defn- open-overlay*
[state frame position snap-to close-click-outside background-overlay animation]
[state frame position snap-to close-click-outside background-overlay animation fixed-source?]
(cond-> state
:always
(update :viewer-overlays conj
@ -568,7 +568,8 @@
:snap-to snap-to
:close-click-outside close-click-outside
:background-overlay background-overlay
:animation animation})
:animation animation
:fixed-source? fixed-source?})
(some? animation)
(assoc-in [:viewer-animations (:id frame)]
@ -588,7 +589,7 @@
:animation animation})))
(defn open-overlay
[frame-id position snap-to close-click-outside background-overlay animation]
[frame-id position snap-to close-click-outside background-overlay animation fixed-source?]
(dm/assert! (uuid? frame-id))
(dm/assert! (gpt/point? position))
(dm/assert! (or (nil? close-click-outside)
@ -613,12 +614,13 @@
snap-to
close-click-outside
background-overlay
animation)
animation
fixed-source?)
state)))))
(defn toggle-overlay
[frame-id position snap-to close-click-outside background-overlay animation]
[frame-id position snap-to close-click-outside background-overlay animation fixed-source?]
(dm/assert! (uuid? frame-id))
(dm/assert! (gpt/point? position))
(dm/assert! (or (nil? close-click-outside)
@ -644,7 +646,8 @@
snap-to
close-click-outside
background-overlay
animation)
animation
fixed-source?)
(close-overlay* state
(:id frame)
(ctsi/invert-direction animation)))))))

107
frontend/src/app/main/data/workspace.cljs
View File

@ -1845,18 +1845,9 @@
tree-root (get-tree-root-shapes pobjects)
only-one-root-shape? (and
(< 1 (count pobjects))
(= 1 (count tree-root)))
all-objects (merge page-objects pobjects)
comps-nesting-loop? (not (->> (keys pobjects)
(map #(cfh/components-nesting-loop? all-objects % (:id base)))
(every? nil?)))]
(= 1 (count tree-root)))]
(cond
comps-nesting-loop?
;; Avoid placing a shape as a direct or indirect child of itself,
;; or inside its main component if it's in a copy.
[uuid/zero uuid/zero (gpt/subtract position orig-pos)]
(selected-frame? state)
(if (or (any-same-frame-from-selected? state (keys pobjects))
@ -1869,7 +1860,7 @@
paste-y (:y selected-frame-obj)
delta (gpt/subtract (gpt/point paste-x paste-y) orig-pos)]
[(:frame-id base) parent-id delta index])
[parent-id delta index])
;; Paste inside selected frame otherwise
(let [selected-frame-obj (get page-objects (first page-selected))
@ -1902,20 +1893,19 @@
;; - Align it to the limits on the x and y axis
;; - Respect the distance of the object to the right and bottom in the original frame
(gpt/point paste-x paste-y))]
[frame-id frame-id delta (dec (count (:shapes selected-frame-obj)))]))
[frame-id delta (dec (count (:shapes selected-frame-obj)))]))
(empty? page-selected)
(let [frame-id (ctst/top-nested-frame page-objects position)
delta (gpt/subtract position orig-pos)]
[frame-id frame-id delta])
[frame-id delta])
:else
(let [frame-id (:frame-id base)
parent-id (:parent-id base)
(let [parent-id (:parent-id base)
delta (if in-viewport?
(gpt/subtract position orig-pos)
(gpt/subtract (gpt/point (:selrect base)) orig-pos))]
[frame-id parent-id delta index]))))
[parent-id delta index]))))
;; Change the indexes of the pasted shapes
(change-add-obj-index [objects selected index change]
@ -1953,64 +1943,65 @@
(ptk/reify ::paste-shapes
ptk/WatchEvent
(watch [it state _]
(let [file-id (:current-file-id state)
page (wsh/lookup-page state)
(let [file-id (:current-file-id state)
page (wsh/lookup-page state)
media-idx (->> (:media pdata)
(d/index-by :prev-id))
media-idx (->> (:media pdata)
(d/index-by :prev-id))
selected (:selected pdata)
objects (:objects pdata)
selected (:selected pdata)
objects (:objects pdata)
position (deref ms/mouse-position)
position (deref ms/mouse-position)
;; Calculate position for the pasted elements
[frame-id
parent-id
[candidate-parent-id
delta
index] (calculate-paste-position state objects selected position)
index] (calculate-paste-position state objects selected position)
;; We don't want to change the structure of component
;; copies If the parent-id or the frame-id are
;; component-copies, we need to get the first not copy
;; parent
parent-id (:id (ctn/get-first-not-copy-parent (:objects page) parent-id))
frame-id (:id (ctn/get-first-not-copy-parent (:objects page) frame-id))
page-objects (:objects page)
objects (update-vals objects (partial process-shape file-id frame-id parent-id))
all-objects (merge (:objects page) objects)
[parent-id
frame-id] (ctn/find-valid-parent-and-frame-ids candidate-parent-id page-objects (vals objects))
libraries (wsh/get-libraries state)
ldata (wsh/get-file state file-id)
index (if (= candidate-parent-id parent-id)
index
0)
drop-cell (when (ctl/grid-layout? all-objects parent-id)
(gslg/get-drop-cell frame-id all-objects position))
objects (update-vals objects (partial process-shape file-id frame-id parent-id))
changes (-> (dws/prepare-duplicate-changes all-objects page selected delta it libraries ldata file-id)
(pcb/amend-changes (partial process-rchange media-idx))
(pcb/amend-changes (partial change-add-obj-index objects selected index)))
all-objects (merge page-objects objects)
libraries (wsh/get-libraries state)
ldata (wsh/get-file state file-id)
drop-cell (when (ctl/grid-layout? all-objects parent-id)
(gslg/get-drop-cell frame-id all-objects position))
changes (-> (dws/prepare-duplicate-changes all-objects page selected delta it libraries ldata file-id)
(pcb/amend-changes (partial process-rchange media-idx))
(pcb/amend-changes (partial change-add-obj-index objects selected index)))
;; Adds a resize-parents operation so the groups are
;; updated. We add all the new objects
changes (->> (:redo-changes changes)
(filter add-obj?)
(map :id)
(pcb/resize-parents changes))
changes (->> (:redo-changes changes)
(filter add-obj?)
(map :id)
(pcb/resize-parents changes))
selected (into (d/ordered-set)
(comp
(filter add-obj?)
(filter #(contains? selected (:old-id %)))
(map :obj)
(map :id))
(:redo-changes changes))
selected (into (d/ordered-set)
(comp
(filter add-obj?)
(filter #(contains? selected (:old-id %)))
(map :obj)
(map :id))
(:redo-changes changes))
changes (cond-> changes
(some? drop-cell)
(pcb/update-shapes [parent-id]
#(ctl/add-children-to-cell % selected all-objects drop-cell)))
undo-id (js/Symbol)]
changes (cond-> changes
(some? drop-cell)
(pcb/update-shapes [parent-id]
#(ctl/add-children-to-cell % selected all-objects drop-cell)))
undo-id (js/Symbol)]
(rx/of (dwu/start-undo-transaction undo-id)
(dch/commit-changes changes)

43
frontend/src/app/main/data/workspace/libraries.cljs
View File

@ -340,12 +340,16 @@
(ptk/reify ::add-component
ptk/WatchEvent
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
selected (->> (wsh/lookup-selected state)
(cfh/clean-loops objects)
(remove #(ctn/has-any-copy-parent? objects (get objects %)))) ;; We don't want to change the structure of component copies
components-v2 (features/active-feature? state "components/v2")]
(rx/of (add-component2 selected components-v2))))))
(let [objects (wsh/lookup-page-objects state)
selected (->> (wsh/lookup-selected state)
(cfh/clean-loops objects))
selected-objects (map #(get objects %) selected)
components-v2 (features/active-feature? state "components/v2")
;; We don't want to change the structure of component copies
can-make-component (every? true? (map #(ctn/valid-shape-for-component? objects %) selected-objects))]
(when can-make-component
(rx/of (add-component2 selected components-v2)))))))
(defn add-multiple-components
"Add several new components to current file library, from the currently selected shapes."
@ -353,19 +357,22 @@
(ptk/reify ::add-multiple-components
ptk/WatchEvent
(watch [_ state _]
(let [components-v2 (features/active-feature? state "components/v2")
objects (wsh/lookup-page-objects state)
selected (->> (wsh/lookup-selected state)
(cfh/clean-loops objects)
(remove #(ctn/has-any-copy-parent? objects (get objects %)))) ;; We don't want to change the structure of component copies
added-components (map
#(add-component2 [%] components-v2)
selected)
(let [components-v2 (features/active-feature? state "components/v2")
objects (wsh/lookup-page-objects state)
selected (->> (wsh/lookup-selected state)
(cfh/clean-loops objects))
selected-objects (map #(get objects %) selected)
;; We don't want to change the structure of component copies
can-make-component (every? true? (map #(ctn/valid-shape-for-component? objects %) selected-objects))
added-components (map
#(add-component2 [%] components-v2)
selected)
undo-id (js/Symbol)]
(rx/concat
(rx/of (dwu/start-undo-transaction undo-id))
(rx/from added-components)
(rx/of (dwu/commit-undo-transaction undo-id)))))))
(when can-make-component
(rx/concat
(rx/of (dwu/start-undo-transaction undo-id))
(rx/from added-components)
(rx/of (dwu/commit-undo-transaction undo-id))))))))
(defn rename-component
"Rename the component with the given id, in the current file library."

5
frontend/src/app/main/data/workspace/path/drawing.cljs
View File

@ -276,7 +276,8 @@
(cond-> (some? drop-index)
(with-meta {:index drop-index})))))))))
(defn handle-new-shape-result [shape-id]
(defn handle-new-shape-result
[shape-id]
(ptk/reify ::handle-new-shape-result
ptk/UpdateEvent
(update [_ state]
@ -293,7 +294,7 @@
ptk/WatchEvent
(watch [_ state _]
(let [content (get-in state [:workspace-drawing :object :content] [])]
(if (seq content)
(if (and (seq content) (> (count content) 1))
(rx/of (setup-frame)
(dwdc/handle-finish-drawing)
(dwe/start-edition-mode shape-id)

6
frontend/src/app/main/data/workspace/path/edition.cljs
View File

@ -319,9 +319,9 @@
(= (ptk/type %) ::start-path-edit))))
interrupt (->> stream (rx/filter #(= % :interrupt)) (rx/take 1))]
(rx/concat
(rx/of (dwc/hide-toolbar))
(rx/of (undo/start-path-undo))
(rx/of (drawing/change-edit-mode mode))
(rx/of (dwc/hide-toolbar)
(undo/start-path-undo)
(drawing/change-edit-mode mode))
(->> interrupt
(rx/map #(stop-path-edit id))
(rx/take-until stopper)))))))

6
frontend/src/app/main/data/workspace/path/shortcuts.cljs
View File

@ -8,6 +8,7 @@
(:require
[app.main.data.shortcuts :as ds]
[app.main.data.workspace :as dw]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.path :as drp]
[app.main.store :as st]
[beicon.v2.core :as rx]
@ -26,10 +27,13 @@
;; Not interrupt when we're editing a path
(let [edition-id (or (get-in state [:workspace-drawing :object :id])
(get-in state [:workspace-local :edition]))
content (get-in state [:workspace-drawing :object :content])
path-edit-mode (get-in state [:workspace-local :edit-path edition-id :edit-mode])]
(if-not (= :draw path-edit-mode)
(rx/of :interrupt)
(rx/empty))))))
(if (<= (count content) 1)
(rx/of (dwc/show-toolbar))
(rx/empty)))))))
(def shortcuts
{:move-nodes {:tooltip "M"

76
frontend/src/app/main/data/workspace/selection.cljs
View File

@ -59,7 +59,7 @@
(assoc-in state [:workspace-local :selrect] selrect))))
(defn handle-area-selection
[preserve? ignore-groups?]
[preserve?]
(ptk/reify ::handle-area-selection
ptk/WatchEvent
(watch [_ state stream]
@ -114,7 +114,20 @@
(rx/buffer-time 100)
(rx/map last)
(rx/pipe (rxo/distinct-contiguous))
(rx/map #(select-shapes-by-current-selrect preserve? ignore-groups?))))
(rx/with-latest-from ms/keyboard-mod ms/keyboard-shift)
(rx/map
(fn [[_ mod? shift?]]
(select-shapes-by-current-selrect shift? mod?))))
;; The last "tick" from the mouse cannot be buffered so we are sure
;; a selection is returned. Without this we can have empty selections on
;; very fast movement
(->> selrect-stream
(rx/last)
(rx/with-latest-from ms/keyboard-mod ms/keyboard-shift)
(rx/map
(fn [[_ mod? shift?]]
(select-shapes-by-current-selrect shift? mod? false)))))
(->> (rx/of (update-selrect nil))
;; We need the async so the current event finishes before updating the selrect
@ -307,34 +320,39 @@
;; --- Select Shapes (By selrect)
(defn select-shapes-by-current-selrect
[preserve? ignore-groups?]
(ptk/reify ::select-shapes-by-current-selrect
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state)
selected (wsh/lookup-selected state)
initial-set (if preserve?
selected
lks/empty-linked-set)
selrect (dm/get-in state [:workspace-local :selrect])
blocked? (fn [id] (dm/get-in objects [id :blocked] false))]
([preserve? ignore-groups?]
(select-shapes-by-current-selrect preserve? ignore-groups? true))
([preserve? ignore-groups? buffered?]
(ptk/reify ::select-shapes-by-current-selrect
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state)
selected (wsh/lookup-selected state)
initial-set (if preserve?
selected
lks/empty-linked-set)
selrect (dm/get-in state [:workspace-local :selrect])
blocked? (fn [id] (dm/get-in objects [id :blocked] false))
(when selrect
(rx/empty)
(->> (uw/ask-buffered!
{:cmd :selection/query
:page-id page-id
:rect selrect
:include-frames? true
:ignore-groups? ignore-groups?
:full-frame? true
:using-selrect? true})
(rx/map #(cfh/clean-loops objects %))
(rx/map #(into initial-set (comp
(filter (complement blocked?))
(remove (partial cfh/hidden-parent? objects))) %))
(rx/map select-shapes)))))))
ask-worker (if buffered? uw/ask-buffered! uw/ask!)]
(if (some? selrect)
(->> (ask-worker
{:cmd :selection/query
:page-id page-id
:rect selrect
:include-frames? true
:ignore-groups? ignore-groups?
:full-frame? true
:using-selrect? true})
(rx/filter some?)
(rx/map #(cfh/clean-loops objects %))
(rx/map #(into initial-set (comp
(filter (complement blocked?))
(remove (partial cfh/hidden-parent? objects))) %))
(rx/map select-shapes))
(rx/empty)))))))
(defn select-inside-group
[group-id position]

7
frontend/src/app/main/data/workspace/shortcuts.cljs
View File

@ -551,9 +551,10 @@
;; THEME
:toggle-light-dark {:tooltip (ds/meta (ds/alt "Q"))
:command (ds/c-mod "alt+q")
:fn #(st/emit! (du/toggle-theme))}})
:toggle-theme {:tooltip (ds/meta (ds/alt "M"))
:command (ds/c-mod "alt+m")
:subsections [:basics]
:fn #(st/emit! (du/toggle-theme))}})
(def opacity-shortcuts
(into {} (->>

27
frontend/src/app/main/data/workspace/transforms.cljs
View File

@ -560,13 +560,14 @@
(rx/map
(fn [[move-vector mod?]]
(let [position (gpt/add from-position move-vector)
exclude-frames (if mod? exclude-frames exclude-frames-siblings)
target-frame (ctst/top-nested-frame objects position exclude-frames)
flex-layout? (ctl/flex-layout? objects target-frame)
grid-layout? (ctl/grid-layout? objects target-frame)
drop-index (when flex-layout? (gslf/get-drop-index target-frame objects position))
cell-data (when (and grid-layout? (not mod?)) (gslg/get-drop-cell target-frame objects position))]
(let [position (gpt/add from-position move-vector)
exclude-frames (if mod? exclude-frames exclude-frames-siblings)
target-frame (ctst/top-nested-frame objects position exclude-frames)
[target-frame _] (ctn/find-valid-parent-and-frame-ids target-frame objects shapes)
flex-layout? (ctl/flex-layout? objects target-frame)
grid-layout? (ctl/grid-layout? objects target-frame)
drop-index (when flex-layout? (gslf/get-drop-index target-frame objects position))
cell-data (when (and grid-layout? (not mod?)) (gslg/get-drop-cell target-frame objects position))]
(array move-vector target-frame drop-index cell-data))))
(rx/take-until stopper))]
@ -587,16 +588,12 @@
[(assoc move-vector :x 0) :x]
:else
[move-vector nil])
[move-vector nil])]
nesting-loop? (some #(cfh/components-nesting-loop? objects (:id %) target-frame) shapes)
is-component-copy? (ctk/in-component-copy? (get objects target-frame))]
(cond-> (dwm/create-modif-tree ids (ctm/move-modifiers move-vector))
(and (not nesting-loop?) (not is-component-copy?))
(dwm/build-change-frame-modifiers objects selected target-frame drop-index cell-data)
:always
(dwm/set-modifiers false false {:snap-ignore-axis snap-ignore-axis}))))))
(-> (dwm/create-modif-tree ids (ctm/move-modifiers move-vector))
(dwm/build-change-frame-modifiers objects selected target-frame drop-index cell-data)
(dwm/set-modifiers false false {:snap-ignore-axis snap-ignore-axis}))))))
(->> move-stream
(rx/with-latest-from ms/mouse-position-alt)

11
frontend/src/app/main/refs.cljs
View File

@ -86,7 +86,7 @@
[files selected]
(let [get-file #(get files %)
sim-file #(select-keys % [:id :name :project-id :is-shared])
xform (comp (map get-file)
xform (comp (keep get-file)
(map sim-file))]
(->> (into #{} xform selected)
(d/index-by :id))))
@ -96,14 +96,15 @@
;; we need to this because :dashboard-search-result is a list
;; of maps and we need a map of maps (using :id as key).
(let [files (d/index-by :id (:dashboard-search-result state))]
(dashboard-extract-selected files (dm/get-in state [:dashboard-local :selected-files]))))
(->> (dm/get-in state [:dashboard-local :selected-files])
(dashboard-extract-selected files))))
st/state))
(def dashboard-selected-files
(l/derived (fn [state]
(dashboard-extract-selected (:dashboard-files state)
(dm/get-in state [:dashboard-local :selected-files])))
st/state =))
(->> (dm/get-in state [:dashboard-local :selected-files])
(dashboard-extract-selected (:dashboard-files state))))
st/state))
;; ---- Workspace refs

14
frontend/src/app/main/streams.cljs
View File

@ -112,6 +112,20 @@
(rx/sub! ob sub)
sub))
(defonce keyboard-shift
(let [sub (rx/behavior-subject nil)
ob (->> keyboard
(rx/filter kbd/shift-key?)
(rx/map kbd/key-down-event?)
;; Fix a situation caused by using `ctrl+alt` kind of
;; shortcuts, that makes keyboard-alt stream
;; registering the key pressed but on blurring the
;; window (unfocus) the key down is never arrived.
(rx/merge window-blur)
(rx/pipe (rxo/distinct-contiguous)))]
(rx/sub! ob sub)
sub))
(defonce keyboard-meta
(let [sub (rx/behavior-subject nil)
ob (->> keyboard

1
frontend/src/app/main/ui/context.cljs
View File

@ -29,3 +29,4 @@
(def workspace-read-only? (mf/create-context nil))
(def is-component? (mf/create-context false))
(def sidebar (mf/create-context nil))

16
frontend/src/app/main/ui/dashboard/file_menu.cljs
View File

@ -54,12 +54,14 @@
projects))
(mf/defc file-menu
[{:keys [files show? on-edit on-menu-close top left navigate? origin parent-id] :as props}]
{::mf/wrap-props false}
[{:keys [files show? on-edit on-menu-close top left navigate? origin parent-id]}]
(assert (seq files) "missing `files` prop")
(assert (boolean? show?) "missing `show?` prop")
(assert (fn? on-edit) "missing `on-edit` prop")
(assert (fn? on-menu-close) "missing `on-menu-close` prop")
(assert (boolean? navigate?) "missing `navigate?` prop")
(let [is-lib-page? (= :libraries origin)
is-search-page? (= :search origin)
top (or top 0)
@ -88,15 +90,15 @@
(apply st/emit! (map dd/duplicate-file files))
(st/emit! (dm/success (tr "dashboard.success-duplicate-file" (i18n/c (count files))))))
delete-fn
on-delete-accept
(fn [_]
(apply st/emit! (map dd/delete-file files))
(st/emit! (dm/success (tr "dashboard.success-delete-file" (i18n/c (count files))))))
(st/emit! (dm/success (tr "dashboard.success-delete-file" (i18n/c (count files))))
(dd/clear-selected-files)))
on-delete
(fn [event]
(dom/stop-propagation event)
(let [num-shared (filter #(:is-shared %) files)]
(if (< 0 (count num-shared))
@ -104,7 +106,7 @@
{:type :delete-shared-libraries
:origin :delete
:ids (into #{} (map :id) files)
:on-accept delete-fn
:on-accept on-delete-accept
:count-libraries (count num-shared)}))
(if multi?
@ -113,13 +115,13 @@
:title (tr "modals.delete-file-multi-confirm.title" file-count)
:message (tr "modals.delete-file-multi-confirm.message" file-count)
:accept-label (tr "modals.delete-file-multi-confirm.accept" file-count)
:on-accept delete-fn}))
:on-accept on-delete-accept}))
(st/emit! (modal/show
{:type :confirm
:title (tr "modals.delete-file-confirm.title")
:message (tr "modals.delete-file-confirm.message")
:accept-label (tr "modals.delete-file-confirm.accept")
:on-accept delete-fn}))))))
:on-accept on-delete-accept}))))))
on-move-success
(fn [team-id project-id]

21
frontend/src/app/main/ui/dashboard/files.cljs
View File

@ -13,6 +13,7 @@
[app.main.store :as st]
[app.main.ui.dashboard.grid :refer [grid]]
[app.main.ui.dashboard.inline-edition :refer [inline-edition]]
[app.main.ui.dashboard.pin-button :refer [pin-button*]]
[app.main.ui.dashboard.project-menu :refer [project-menu]]
[app.main.ui.hooks :as hooks]
[app.main.ui.icons :as i]
@ -92,7 +93,7 @@
[:div {:class (stl/css :dashboard-header-actions)}
[:a
{:class (stl/css :btn-secondary :btn-small)
{:class (stl/css :btn-secondary :btn-small :new-file)
:tab-index "0"
:on-click on-create-click
:data-test "new-file"
@ -102,21 +103,11 @@
(tr "dashboard.new-file")]
(when-not (:is-default project)
[:button
{:class (stl/css-case :icon true
:pin-icon true
:tooltip true
:tooltip-bottom true
:active (:is-pinned project))
:tab-index "0"
[:> pin-button*
{:tab-index 0
:is-pinned (:is-pinned project)
:on-click toggle-pin
:alt (tr "dashboard.pin-unpin")
:on-key-down (fn [event]
(when (kbd/enter? event)
(toggle-pin event)))}
(if (:is-pinned project)
i/pin-fill
i/pin)])
:on-key-down (fn [event] (when (kbd/enter? event) (toggle-pin event)))}])
[:div
{:class (stl/css :icon :tooltip :tooltip-bottom-left)

4
frontend/src/app/main/ui/dashboard/files.scss
View File

@ -26,3 +26,7 @@
margin-top: $s-12;
}
}
.new-file {
margin-inline-end: $s-8;
}

9
frontend/src/app/main/ui/dashboard/grid.cljs
View File

@ -7,6 +7,7 @@
(ns app.main.ui.dashboard.grid
(:require-macros [app.main.style :as stl])
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.logging :as log]
@ -217,6 +218,9 @@
{:wrap [mf/memo]}
[{:keys [file origin library-view?] :as props}]
(let [file-id (:id file)
;; FIXME: this breaks react hooks rule, hooks should never to
;; be in a conditional code
selected-files (if (= origin :search)
(mf/deref refs/dashboard-selected-search)
(mf/deref refs/dashboard-selected-files))
@ -446,8 +450,9 @@
[:& loading-placeholder]
(seq files)
(for [slice (partition-all limit files)]
[:ul {:class (stl/css :grid-row)}
(for [[index slice] (d/enumerate (partition-all limit files))]
[:ul {:class (stl/css :grid-row) :key (dm/str index)}
(when @dragging?
[:li {:class (stl/css :grid-item)}])
(for [item slice]

11
frontend/src/app/main/ui/dashboard/import.cljs
View File

@ -216,7 +216,9 @@
[:div {:class (stl/css :file-name-label)}
(:name file)
(when is-shared? i/library-refactor)])
(when is-shared?
[:span {:class (stl/css :icon)}
i/library-refactor])])
[:div {:class (stl/css :edit-entry-buttons)}
(when (= "application/zip" (:type file))
@ -242,9 +244,10 @@
(let [library-data (->> @state :files (d/seek #(= library-id (:file-id %))))
error? (or (:deleted? library-data) (:import-error library-data))]
(when (some? library-data)
[:div {:class (stl/css-case :linked-library-tag true
:error error?)}
i/detach-refactor (:name library-data)])))]]))
[:div {:class (stl/css :linked-library)}
(:name library-data)
[:span {:class (stl/css-case :linked-library-tag true
:error error?)} i/detach-refactor]])))]]))
(mf/defc import-dialog
{::mf/register modal/components

48
frontend/src/app/main/ui/dashboard/import.scss vendored
View File

@ -107,7 +107,19 @@
}
.file-name-label {
@include titleTipography;
display: flex;
align-items: center;
gap: $s-12;
flex-grow: 1;
.icon {
@include flexCenter;
height: $s-16;
width: $s-16;
svg {
@extend .button-icon-small;
stroke: var(--icon-foreground);
}
}
}
.edit-entry-buttons {
@include flexRow;
@ -128,18 +140,22 @@
color: var(--modal-text-foreground-color);
}
.linked-libraries {
.linked-library {
display: flex;
align-items: center;
gap: $s-12;
color: var(--modal-text-foreground-color);
.linked-library-tag {
@include flexCenter;
height: $s-24;
width: $s-16;
width: $s-24;
svg {
@extend .button-icon;
stroke: var(--icon-foreground);
}
&.error {
svg {
stroke: var(--error-color);
stroke: var(--status-error-color);
}
}
}
@ -147,46 +163,46 @@
&.loading {
.file-name {
color: var(--pending-color);
color: var(--status-pending-color);
.file-icon {
:global(#loader-pencil) {
color: var(--pending-color);
stroke: var(--pending-color);
fill: var(--pending-color);
color: var(--status-pending-color);
stroke: var(--status-pending-color);
fill: var(--status-pending-color);
}
}
}
}
&.warning {
.file-name {
color: var(--warning-color);
color: var(--status-warning-color);
.file-icon svg {
stroke: var(--warning-color);
stroke: var(--status-warning-color);
}
.file-icon.icon-fill svg {
fill: var(--warning-color);
fill: var(--status-warning-color);
}
}
}
&.success {
.file-name {
color: var(--ok-color);
color: var(--status-success-color);
.file-icon svg {
stroke: var(--ok-color);
stroke: var(--status-success-color);
}
.file-icon.icon-fill svg {
fill: var(--ok-color);
fill: var(--status-success-color);
}
}
}
&.error {
.file-name {
color: var(--error-color);
color: var(--status-error-color);
.file-icon svg {
stroke: var(--error-color);
stroke: var(--status-error-color);
}
.file-icon.icon-fill svg {
fill: var(--error-color);
fill: var(--status-error-color);
}
}
}

26
frontend/src/app/main/ui/dashboard/pin_button.cljs Normal file
View File

@ -0,0 +1,26 @@
;; 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.main.ui.dashboard.pin-button
(:require-macros
[app.common.data.macros :as dm]
[app.main.style :as stl]
[app.main.ui.icons :refer [icon-xref]])
(:require
[app.main.ui.icons :as i]
[app.util.i18n :as i18n :refer [tr]]
[rumext.v2 :as mf]))
(def pin-icon (icon-xref :pin-refactor (stl/css :icon)))
(mf/defc pin-button*
{::mf/props :obj}
[{:keys [aria-label is-pinned class] :as props}]
(let [aria-label (or aria-label (tr "dashboard.pin-unpin"))
class (dm/str (or class "") " " (stl/css-case :button true :button-active is-pinned))
props (mf/spread-props props {:class class
:aria-label aria-label})]
[:> "button" props pin-icon]))

33
frontend/src/app/main/ui/dashboard/pin_button.scss Normal file
View File

@ -0,0 +1,33 @@
// 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
@use "common/refactor/common-refactor.scss" as *;
.button {
--pin-button-icon-color: #{$df-secondary};
--pin-button-bg-color: none;
width: $s-32;
height: $s-32;
background: var(--pin-button-bg-color);
border: none;
border-radius: $br-8;
display: grid;
place-content: center;
cursor: pointer;
}
.button-active {
--pin-button-icon-color: #{$da-primary};
--pin-button-bg-color: #{$db-cuaternary};
}
.icon {
width: $s-16;
height: $s-16;
fill: none;
stroke: var(--pin-button-icon-color);
}

14
frontend/src/app/main/ui/dashboard/projects.cljs
View File

@ -20,6 +20,7 @@
[app.main.store :as st]
[app.main.ui.dashboard.grid :refer [line-grid]]
[app.main.ui.dashboard.inline-edition :refer [inline-edition]]
[app.main.ui.dashboard.pin-button :refer [pin-button*]]
[app.main.ui.dashboard.project-menu :refer [project-menu]]
[app.main.ui.hooks :as hooks]
[app.main.ui.icons :as i]
@ -304,18 +305,7 @@
[:div {:class (stl/css :project-actions)}
(when-not (:is-default project)
[:button
{:class (stl/css-case :pin-icon true
:tooltip true
:tooltip-bottom true
:active (:is-pinned project))
:on-click toggle-pin
:alt (tr "dashboard.pin-unpin")
:aria-label (tr "dashboard.pin-unpin")
:tab-index "0"}
(if (:is-pinned project)
i/pin-fill
i/pin)])
[:> pin-button* {:is-pinned (:is-pinned project) :on-click toggle-pin :tab-index 0}])
[:button
{:class (stl/css :btn-secondary :btn-small :tooltip :tooltip-bottom)

20
frontend/src/app/main/ui/dashboard/projects.scss
View File

@ -125,26 +125,6 @@
}
}
}
.pin-icon {
cursor: pointer;
display: flex;
align-items: center;
margin-right: $s-16;
background-color: transparent;
border: none;
svg {
width: $s-16;
height: $s-16;
fill: $df-secondary;
}
&.active {
svg {
fill: $da-primary;
}
}
}
}
.grid-container {

2
frontend/src/app/main/ui/dashboard/sidebar.cljs
View File

@ -698,7 +698,7 @@
:team-id (:id team)
:selected? (= (:id item) (:id project))}])]
[:div {:class (stl/css :sidebar-empty-placeholder)}
[:span {:class (stl/css :icon)} i/pin]
[:span {:class (stl/css :icon)} i/pin-refactor]
[:span {:class (stl/css :text)} (tr "dashboard.no-projects-placeholder")]])]]))
(mf/defc profile-section

5
frontend/src/app/main/ui/dashboard/sidebar.scss
View File

@ -258,12 +258,13 @@
padding: $s-12;
color: $df-secondary;
display: flex;
align-items: flex-start;
align-items: center;
.icon {
padding: 0 $s-12;
svg {
fill: $df-secondary;
fill: none;
stroke: currentColor;
width: $s-12;
height: $s-12;
}

2
frontend/src/app/main/ui/dashboard/templates.cljs
View File

@ -113,7 +113,7 @@
:alt (:name item)}]]
[:div {:class (stl/css :card-name)}
[:span (:name item)]
[:span {:class (stl/css :icon)} i/download]]]]))
[:span {:class (stl/css :icon)} i/download-refactor]]]]))
(mf/defc card-item-link
{::mf/wrap-props false}

3
frontend/src/app/main/ui/dashboard/templates.scss
View File

@ -157,7 +157,8 @@
svg {
width: $s-16;
height: $s-16;
fill: $df-secondary;
fill: none;
stroke: currentColor;
}
span {
font-weight: $fw500;

1
frontend/src/app/main/ui/debug/components_preview.cljs
View File

@ -248,7 +248,6 @@
{:title "Button tertiary with icon"}
[:button {:class (stl/css :button-tertiary)}
i/add-refactor]]]
[:div {:class (stl/css :components-group)}
[:h3 "Inputs"]
[:& component-wrapper

6
frontend/src/app/main/ui/delete_shared.cljs
View File

@ -26,7 +26,7 @@
::mf/register-as :delete-shared-libraries
::mf/wrap-props false}
[{:keys [ids on-accept on-cancel accept-style origin count-libraries]}]
(let [references* (mf/use-state {})
(let [references* (mf/use-state nil)
references (deref references*)
on-accept (or on-accept noop)
@ -78,8 +78,8 @@
(mf/with-effect [ids]
(->> (rx/from ids)
(rx/map #(array-map :file-id %))
(rx/mapcat #(rp/cmd! :get-library-file-references %))
(rx/filter some?)
(rx/mapcat #(rp/cmd! :get-library-file-references {:file-id %}))
(rx/mapcat identity)
(rx/map (juxt :id :name))
(rx/reduce conj [])

3
frontend/src/app/main/ui/export.cljs
View File

@ -328,8 +328,7 @@
::mf/register-as :export
::mf/wrap-props false}
[{:keys [team-id files has-libraries? binary? features]}]
(let [_ (println "-a-a-a-a")
state* (mf/use-state
(let [state* (mf/use-state
#(let [files (mapv (fn [file] (assoc file :loading? true)) files)]
{:status :prepare
:selected :all

6
frontend/src/app/main/ui/hooks.cljs
View File

@ -215,11 +215,15 @@
([stream on-subscribe]
(use-stream stream (mf/deps) on-subscribe))
([stream deps on-subscribe]
(use-stream stream deps on-subscribe nil))
([stream deps on-subscribe on-dispose]
(mf/use-effect
deps
(fn []
(let [sub (->> stream (rx/subs! on-subscribe))]
#(rx/dispose! sub))))))
#(do
(rx/dispose! sub)
(when on-dispose (on-dispose))))))))
;; https://reactjs.org/docs/hooks-faq.html#how-to-get-the-previous-props-or-state
(defn use-previous

4
frontend/src/app/main/ui/icons.clj
View File

@ -11,9 +11,9 @@
[rumext.v2]))
(defmacro icon-xref
[id]
[id & [class]]
(let [href (str "#icon-" (name id))
class (str "icon-" (name id))]
class (or class (str "icon-" (name id)))]
`(rumext.v2/html
[:svg {:width 500 :height 500 :class ~class}
[:use {:href ~href}]])))

3
frontend/src/app/main/ui/icons.cljs
View File

@ -329,6 +329,7 @@
(def ^:icon desc-sort-refactor (icon-xref :desc-sort-refactor))
(def ^:icon detach-refactor (icon-xref :detach-refactor))
(def ^:icon document-refactor (icon-xref :document-refactor))
(def ^:icon download-refactor (icon-xref :download-refactor))
(def ^:icon drop-refactor (icon-xref :drop-refactor))
(def ^:icon easing-linear-refactor (icon-xref :easing-linear-refactor))
(def ^:icon easing-ease-refactor (icon-xref :easing-ease-refactor))
@ -338,6 +339,7 @@
(def ^:icon effects-refactor (icon-xref :effects-refactor))
(def ^:icon elipse-refactor (icon-xref :elipse-refactor))
(def ^:icon expand-refactor (icon-xref :expand-refactor))
(def ^:icon feedback-refactor (icon-xref :feedback-refactor))
(def ^:icon fill-content-refactor (icon-xref :fill-content-refactor))
(def ^:icon filter-refactor (icon-xref :filter-refactor))
(def ^:icon fixed-width-refactor (icon-xref :fixed-width-refactor))
@ -410,6 +412,7 @@
(def ^:icon path-refactor (icon-xref :path-refactor))
(def ^:icon pentool-refactor (icon-xref :pentool-refactor))
(def ^:icon picker-refactor (icon-xref :picker-refactor))
(def ^:icon pin-refactor (icon-xref :pin-refactor))
(def ^:icon play-refactor (icon-xref :play-refactor))
(def ^:icon rectangle-refactor (icon-xref :rectangle-refactor))
(def ^:icon reload-refactor (icon-xref :reload-refactor))

2
frontend/src/app/main/ui/settings/sidebar.cljs
View File

@ -104,7 +104,7 @@
(when (contains? cf/flags :user-feedback)
[:li {:class (when feedback? (stl/css :current))
:on-click go-settings-feedback}
i/msg-info
i/feedback-refactor
[:span {:class (stl/css :element-title)} (tr "labels.give-feedback")]])]]]))
(mf/defc sidebar

3
frontend/src/app/main/ui/settings/sidebar.scss
View File

@ -60,7 +60,8 @@
}
svg {
fill: currentColor;
stroke: currentColor;
fill: none;
margin-right: $s-8;
height: $s-12;
width: $s-12;

2
frontend/src/app/main/ui/shapes/attrs.cljs
View File

@ -157,7 +157,7 @@
[shape]
(add-layer-styles! #js {} shape))
(defn- get-svg-props
(defn get-svg-props
[shape render-id]
(let [attrs (get shape :svg-attrs {})
defs (get shape :svg-defs {})]

32
frontend/src/app/main/ui/shapes/custom_stroke.cljs
View File

@ -31,7 +31,7 @@
suffix (if (some? index) (dm/str "-" index) "")
clip-id (dm/str "inner-stroke-" render-id "-" shape-id suffix)
href (dm/str "#stroke-shape-" render-id "-" shape-id suffix)]
[:> "clipPath" #js {:id clip-id}
[:> "clipPath" {:id clip-id}
[:use {:href href}]]))
(mf/defc outer-stroke-mask
@ -473,28 +473,30 @@
shape-blur (get shape :blur)
shape-fills (get shape :fills)
shape-shadow (get shape :shadow)
shape-strokes (get shape :strokes)
shape-strokes (not-empty (get shape :strokes))
svg-attrs (attrs/get-svg-props shape render-id)
style (-> (obj/get props "style")
(obj/clone)
(attrs/add-layer-styles! shape))
props #js {:id stroke-id
:className "strokes"
:style style}
props (mf/spread-props svg-attrs
{:id stroke-id
:className "strokes"
:style style})]
props (if ^boolean (cfh/frame-shape? shape)
props
(cond-> props
(and (some? shape-blur)
(not ^boolean (:hidden shape-blur)))
(obj/set! "filter" (dm/fmt "url(#filter-blur-%)" render-id))
(and (empty? shape-fills)
(some? (->> shape-shadow (remove :hidden) seq)))
(obj/set! "filter" (dm/fmt "url(#filter-%)" render-id))))]
(when-not ^boolean (cfh/frame-shape? shape)
(when (and (some? shape-blur)
(not ^boolean (:hidden shape-blur)))
(obj/set! props "filter" (dm/fmt "url(#filter-blur-%)" render-id)))
(when (d/not-empty? shape-strokes)
(when (and (empty? shape-fills)
(some? (->> shape-shadow (remove :hidden) not-empty)))
(obj/set! props "filter" (dm/fmt "url(#filter-%)" render-id))))
(when (some? shape-strokes)
[:> :g props
(for [[index value] (reverse (d/enumerate shape-strokes))]
[:& shape-custom-stroke {:shape shape

78
frontend/src/app/main/ui/viewer.cljs
View File

@ -139,6 +139,7 @@
background-overlay? (:background-overlay overlay)
overlay-frame (:frame overlay)
overlay-position (:position overlay)
fixed-base? (:fixed-source? overlay)
size
(mf/with-memo [page overlay zoom]
@ -168,21 +169,42 @@
:top 0}
:on-click on-click}])
[:div {:class (stl/css :viewer-overlay :viewport-container)
:id (dm/str "overlay-" (:id overlay-frame))
:style {:width (:width size)
:height (:height size)
:left (* (:x overlay-position) zoom)
:top (* (:y overlay-position) zoom)}}
(if fixed-base?
[:div {:class (stl/css :viewport-container-wrapper)
:style {:position "absolute"
:left (* (:x overlay-position) zoom)
:top (* (:y overlay-position) zoom)
:width (:width size)
:height (:height size)
:z-index 2}}
[:div {:class (stl/css :viewer-overlay :viewport-container)
:id (dm/str "overlay-" (:id overlay-frame))
:style {:width (:width size)
:height (:height size)
:position "fixed"}}
[:& interactions/viewport
{:frame overlay-frame
:base-frame frame
:frame-offset overlay-position
:size size
:delta delta
:page page
:interactions-mode interactions-mode}]]]
[:& interactions/viewport
{:frame overlay-frame
:base-frame frame
:frame-offset overlay-position
:size size
:delta delta
:page page
:interactions-mode interactions-mode}]]]))
[:div {:class (stl/css :viewer-overlay :viewport-container)
:id (dm/str "overlay-" (:id overlay-frame))
:style {:width (:width size)
:height (:height size)
:left (* (:x overlay-position) zoom)
:top (* (:y overlay-position) zoom)}}
[:& interactions/viewport
{:frame overlay-frame
:base-frame frame
:frame-offset overlay-position
:size size
:delta delta
:page page
:interactions-mode interactions-mode}]])]))
(mf/defc viewer-wrapper
{::mf/wrap-props false}
@ -354,7 +376,6 @@
wrapper (dom/get-element "inspect-svg-wrapper")
section (dom/get-element "inspect-svg-container")
target (.-target event)]
;; TODO: Reemplazar el dom/class? por un data-attribute
(when (or (dom/child? target wrapper) (dom/id? target "inspect-svg-container"))
(let [norm-event ^js (nw/normalize-wheel event)
mod? (kbd/mod? event)
@ -436,7 +457,9 @@
fullscreen-dom? (dom/fullscreen?)]
(when (not= fullscreen? fullscreen-dom?)
(if fullscreen?
(wapi/request-fullscreen wrapper)
(let [layout (dom/get-element "viewer-layout")]
(dom/set-data! layout "force-visible" false)
(wapi/request-fullscreen wrapper))
(wapi/exit-fullscreen))))))
(mf/use-effect
@ -521,16 +544,9 @@
:data-fullscreen fullscreen?
:data-force-visible (:show-thumbnails local)}
[:div {:class (stl/css :viewer-content)}
[:& header/header {:project project
:index index
:file file
:page page
:frame frame
:permissions permissions
:zoom zoom
:section section
:interactions-mode interactions-mode}]
[:button {:on-click on-thumbnails-close
:class (stl/css-case :thumbnails-close true
@ -587,7 +603,17 @@
:overlays overlays
:zoom zoom
:section section
:index index}]]))]]]))
:index index}]]))]]
[:& header/header {:project project
:index index
:file file
:page page
:frame frame
:permissions permissions
:zoom zoom
:section section
:interactions-mode interactions-mode}]]))
;; --- Component: Viewer

27
frontend/src/app/main/ui/viewer.scss
View File

@ -23,6 +23,15 @@
background-color: var(--viewer-background-color);
}
.empty-state {
@include titleTipography;
color: var(--empty-message-foreground-color);
display: grid;
place-items: center;
height: 100%;
width: 100%;
}
.viewer-header {
grid-row: 1 / span 1;
}
@ -58,6 +67,7 @@
flex-flow: wrap;
overflow: auto;
}
.inspect-layout .viewer-section {
flex-wrap: nowrap;
margin-top: 0;
@ -76,6 +86,7 @@
top: calc(50vh - $s-32);
z-index: $z-index-2;
background-color: var(--viewer-controls-background-color);
transition: transform 400ms ease 300ms;
svg {
@extend .button-icon;
stroke: var(--icon-foreground);
@ -189,3 +200,19 @@
[data-force-visible="true"] .viewer-bottom {
transform: translateY(0);
}
[data-fullscreen="true"] .viewer-go-next {
transform: translateX($s-40);
}
[data-fullscreen="true"] .viewer-go-prev {
transform: translateX(-$s-40);
}
[data-force-visible="true"] .viewer-go-next {
transform: translateX(0);
}
[data-force-visible="true"] .viewer-go-prev {
transform: translateX(0);
}

12
frontend/src/app/main/ui/viewer/header.scss
View File

@ -303,10 +303,20 @@
}
/** FULLSCREEN */
[data-fullscreen="true"] .viewer-header::after {
content: " ";
position: absolute;
width: 100%;
height: $s-48;
left: 0;
top: $s-48;
}
[data-fullscreen="true"] .viewer-header {
transform: translateY(-$s-48);
}
[data-force-visible="true"] .viewer-header {
[data-force-visible="true"] .viewer-header,
[data-fullscreen="true"] .viewer-header:hover {
transform: translateY(0);
}

23
frontend/src/app/main/ui/viewer/inspect/exports.cljs
View File

@ -86,27 +86,26 @@
(mf/use-callback
(mf/deps shapes)
(fn [index event]
(let [target (dom/get-target event)
value (dom/get-value target)
value (d/parse-double value)]
(swap! exports assoc-in [index :scale] value))))
(let [scale (d/parse-double event)]
(swap! exports assoc-in [index :scale] scale))))
on-suffix-change
(mf/use-callback
(mf/deps shapes)
(fn [index event]
(let [target (dom/get-target event)
value (dom/get-value target)]
(fn [event]
(let [value (dom/get-target-val event)
index (-> (dom/get-current-target event)
(dom/get-data "value")
(d/parse-integer))]
(swap! exports assoc-in [index :suffix] value))))
on-type-change
(mf/use-callback
(mf/deps shapes)
(fn [index event]
(let [target (dom/get-target event)
value (dom/get-value target)
value (keyword value)]
(swap! exports assoc-in [index :type] value))))
(let [type (keyword event)]
(swap! exports assoc-in [index :type] type))))
manage-key-down
(mf/use-callback
(fn [event]
@ -177,7 +176,7 @@
:type "text"
:value (:suffix export)
:placeholder (tr "workspace.options.export.suffix")
:data-value index
:data-value (str index)
:on-change on-suffix-change
:on-key-down manage-key-down}]]]

98
frontend/src/app/main/ui/viewer/interactions.cljs
View File

@ -39,6 +39,23 @@
(into [frame-id])
(reduce update-fn objects))))
(defn get-fixed-ids
[objects]
(let [fixed-ids (filter :fixed-scroll (vals objects))
;; we have to consider the children if the fixed element is a group
fixed-children-ids
(into #{} (mapcat #(cfh/get-children-ids objects (:id %)) fixed-ids))
parent-children-ids
(->> fixed-ids
(mapcat #(cons (:id %) (cfh/get-parent-ids objects (:id %))))
(remove #(= % uuid/zero)))
fixed-ids
(concat fixed-children-ids parent-children-ids)]
fixed-ids))
(mf/defc viewport-svg
{::mf/wrap [mf/memo]
::mf/wrap-props false}
@ -48,31 +65,25 @@
base (unchecked-get props "base")
offset (unchecked-get props "offset")
size (unchecked-get props "size")
fixed? (unchecked-get props "fixed?")
delta (or (unchecked-get props "delta") (gpt/point 0 0))
vbox (:vbox size)
fixed-ids (filter :fixed-scroll (vals (:objects page)))
frame (cond-> frame fixed? (assoc :fixed-scroll true))
;; we have con consider the children if the fixed element is a group
fixed-children-ids
(into #{} (mapcat #(cfh/get-children-ids (:objects page) (:id %)) fixed-ids))
objects (:objects page)
objects (cond-> objects fixed? (assoc-in [(:id frame) :fixed-scroll] true))
parent-children-ids
(->> fixed-ids
(mapcat #(cons (:id %) (cfh/get-parent-ids (:objects page) (:id %))))
(remove #(= % uuid/zero)))
fixed-ids
(concat fixed-children-ids parent-children-ids)
fixed-ids (get-fixed-ids objects)
not-fixed-ids
(->> (remove (set fixed-ids) (keys (:objects page)))
(->> (remove (set fixed-ids) (keys objects))
(remove #(= % uuid/zero)))
calculate-objects
(fn [ids]
(->> ids
(map (d/getf (:objects page)))
(map (d/getf objects))
(concat [frame])
(d/index-by :id)
(prepare-objects frame size delta)))
@ -112,28 +123,41 @@
[:& (mf/provider shapes/base-frame-ctx) {:value base}
[:& (mf/provider shapes/frame-offset-ctx) {:value offset}
;; We have two different svgs for fixed and not fixed elements so we can emulate the sticky css attribute in svg
[:svg {:class (stl/css :fixed)
:view-box vbox
:width (:width size)
:height (:height size)
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"
:fill "none"
:style {:width (:width size)
:height (:height size)}}
[:& wrapper-fixed {:shape fixed-frame :view-box vbox}]]
(if fixed?
[:svg {:class (stl/css :fixed)
:view-box vbox
:width (:width size)
:height (:height size)
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"
:fill "none"}
[:& wrapper-not-fixed {:shape frame :view-box vbox}]]
[:svg {:class (stl/css :not-fixed)
:view-box vbox
:width (:width size)
:height (:height size)
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"
:fill "none"}
[:& wrapper-not-fixed {:shape frame :view-box vbox}]]]]))
[:*
;; We have two different svgs for fixed and not fixed elements so we can emulate the sticky css attribute in svg
[:svg {:class (stl/css :fixed)
:view-box vbox
:width (:width size)
:height (:height size)
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"
:fill "none"
:style {:width (:width size)
:height (:height size)
:z-index 1}}
[:& wrapper-fixed {:shape fixed-frame :view-box vbox}]]
[:svg {:class (stl/css :not-fixed)
:view-box vbox
:width (:width size)
:height (:height size)
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"
:fill "none"}
[:& wrapper-not-fixed {:shape frame :view-box vbox}]]])]]))
(mf/defc viewport
{::mf/wrap [mf/memo]
@ -150,7 +174,8 @@
page (unchecked-get props "page")
frame (unchecked-get props "frame")
base (unchecked-get props "base-frame")]
base (unchecked-get props "base-frame")
fixed? (unchecked-get props "fixed?")]
(mf/with-effect [mode]
(let [on-click
@ -190,7 +215,8 @@
:base base
:offset offset
:size size
:delta delta}]))
:delta delta
:fixed? fixed?}]))
(mf/defc flows-menu
{::mf/wrap [mf/memo]}

16
frontend/src/app/main/ui/viewer/shapes.cljs
View File

@ -70,6 +70,7 @@
background-overlay (:background-overlay interaction)
overlays-ids (set (map :id overlays))
relative-to-base-frame (find-relative-to-base-frame relative-to-shape objects overlays-ids base-frame)
fixed-base? (cfh/fixed? objects relative-to-id)
[position snap-to] (ctsi/calc-overlay-position interaction
shape
objects
@ -83,7 +84,8 @@
snap-to
close-click-outside
background-overlay
(:animation interaction)))))
(:animation interaction)
fixed-base?))))
:toggle-overlay
(let [dest-frame-id (:destination interaction)
@ -96,6 +98,7 @@
relative-to-shape (or (get objects relative-to-id) base-frame)
overlays-ids (set (map :id overlays))
relative-to-base-frame (find-relative-to-base-frame relative-to-shape objects overlays-ids base-frame)
fixed-base? (cfh/fixed? objects (:id base-frame))
[position snap-to] (ctsi/calc-overlay-position interaction
shape
objects
@ -112,7 +115,8 @@
snap-to
close-click-outside
background-overlay
(:animation interaction)))))
(:animation interaction)
fixed-base?))))
:close-overlay
(let [dest-frame-id (or (:destination interaction)
@ -152,6 +156,7 @@
relative-to-shape (or (get objects relative-to-id) base-frame)
overlays-ids (set (map :id overlays))
relative-to-base-frame (find-relative-to-base-frame relative-to-shape objects overlays-ids base-frame)
fixed-base? (cfh/fixed? objects (:id base-frame))
[position snap-to] (ctsi/calc-overlay-position interaction
shape
objects
@ -168,7 +173,8 @@
snap-to
close-click-outside
background-overlay
(:animation interaction)))))
(:animation interaction)
fixed-base?))))
:close-overlay
@ -184,6 +190,7 @@
background-overlay (:background-overlay interaction)
overlays-ids (set (map :id overlays))
relative-to-base-frame (find-relative-to-base-frame relative-to-shape objects overlays-ids base-frame)
fixed-base? (cfh/fixed? objects (:id base-frame))
[position snap-to] (ctsi/calc-overlay-position interaction
shape
objects
@ -197,7 +204,8 @@
snap-to
close-click-outside
background-overlay
(:animation interaction)))))
(:animation interaction)
fixed-base?))))
nil))
(defn- on-pointer-down

2
frontend/src/app/main/ui/workspace.cljs
View File

@ -29,7 +29,6 @@
[app.main.ui.workspace.sidebar :refer [left-sidebar right-sidebar]]
[app.main.ui.workspace.sidebar.collapsable-button :refer [collapsed-button]]
[app.main.ui.workspace.sidebar.history :refer [history-toolbox]]
[app.main.ui.workspace.top-toolbar :refer [top-toolbar]]
[app.main.ui.workspace.viewport :refer [viewport]]
[app.util.debug :as dbg]
[app.util.dom :as dom]
@ -110,7 +109,6 @@
(when-not hide-ui?
[:*
[:& top-toolbar {:layout layout}]
(if (:collapse-left-sidebar layout)
[:& collapsed-button]
[:& left-sidebar {:layout layout

4
frontend/src/app/main/ui/workspace/context_menu.cljs
View File

@ -422,13 +422,13 @@
(let [components-v2 (features/use-feature "components/v2")
single? (= (count shapes) 1)
objects (deref refs/workspace-page-objects)
any-in-copy? (some true? (map #(ctn/has-any-copy-parent? objects %) shapes))
can-make-component (every? true? (map #(ctn/valid-shape-for-component? objects %) shapes))
heads (filter ctk/instance-head? shapes)
components-menu-entries (cmm/generate-components-menu-entries heads components-v2)
do-add-component #(st/emit! (dwl/add-component))
do-add-multiple-components #(st/emit! (dwl/add-multiple-components))]
[:*
(when-not any-in-copy? ;; We don't want to change the structure of component copies
(when can-make-component ;; We don't want to change the structure of component copies
[:*
[:& menu-separator]

73
frontend/src/app/main/ui/workspace/sidebar.cljs
View File

@ -12,6 +12,7 @@
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.components.tab-container :refer [tab-container tab-element]]
[app.main.ui.context :as muc]
[app.main.ui.hooks.resize :refer [use-resize-hook]]
[app.main.ui.workspace.comments :refer [comments-sidebar]]
[app.main.ui.workspace.left-header :refer [left-header]]
@ -58,23 +59,23 @@
on-tab-change
(mf/use-fn #(st/emit! (dw/go-to-layout %)))]
[:aside {:ref parent-ref
:id "left-sidebar-aside"
:data-size (str size)
:class (stl/css-case :left-settings-bar true
:global/two-row (<= size 300)
:global/three-row (and (> size 300) (<= size 400))
:global/four-row (> size 400))
:style #js {"--width" (dm/str size "px")}}
[:& (mf/provider muc/sidebar) {:value :left}
[:aside {:ref parent-ref
:id "left-sidebar-aside"
:data-size (str size)
:class (stl/css-case :left-settings-bar true
:global/two-row (<= size 300)
:global/three-row (and (> size 300) (<= size 400))
:global/four-row (> size 400))
:style #js {"--width" (dm/str size "px")}}
[:& left-header {:file file :layout layout :project project :page-id page-id
:class (stl/css :left-header)}]
[:& left-header {:file file :layout layout :project project :page-id page-id
:class (stl/css :left-header)}]
[:div {:on-pointer-down on-pointer-down
:on-lost-pointer-capture on-lost-pointer-capture
:on-pointer-move on-pointer-move
:class (stl/css :resize-area)}]
[:*
[:div {:on-pointer-down on-pointer-down
:on-lost-pointer-capture on-lost-pointer-capture
:on-pointer-move on-pointer-move
:class (stl/css :resize-area)}]
(cond
(true? shortcuts?)
[:& shortcuts-container {:class (stl/css :settings-bar-content)}]
@ -110,7 +111,6 @@
[:& layers-toolbox {:size-parent size
:size size-pages}]]]
(when-not ^boolean mode-inspect?
[:& tab-element {:id :assets
:title (tr "workspace.toolbar.assets")}
@ -159,27 +159,28 @@
(obj/set! "on-change-section" handle-change-section)
(obj/set! "on-expand" handle-expand))]
[:aside {:class (stl/css-case :right-settings-bar true
:not-expand (not can-be-expanded?)
:expanded (> size 276))
[:& (mf/provider muc/sidebar) {:value :right}
[:aside {:class (stl/css-case :right-settings-bar true
:not-expand (not can-be-expanded?)
:expanded (> size 276))
:id "right-sidebar-aside"
:data-size (str size)
:style #js {"--width" (when can-be-expanded? (dm/str size "px"))}}
(when can-be-expanded?
[:div {:class (stl/css :resize-area)
:on-pointer-down on-pointer-down
:on-lost-pointer-capture on-lost-pointer-capture
:on-pointer-move on-pointer-move}])
[:& right-header {:file file :layout layout :page-id page-id}]
:id "right-sidebar-aside"
:data-size (str size)
:style #js {"--width" (when can-be-expanded? (dm/str size "px"))}}
(when can-be-expanded?
[:div {:class (stl/css :resize-area)
:on-pointer-down on-pointer-down
:on-lost-pointer-capture on-lost-pointer-capture
:on-pointer-move on-pointer-move}])
[:& right-header {:file file :layout layout :page-id page-id}]
[:div {:class (stl/css :settings-bar-inside)}
(cond
(true? is-comments?)
[:& comments-sidebar]
[:div {:class (stl/css :settings-bar-inside)}
(cond
(true? is-comments?)
[:& comments-sidebar]
(true? is-history?)
[:& history-toolbox]
(true? is-history?)
[:& history-toolbox]
:else
[:> options-toolbox props])]]))
:else
[:> options-toolbox props])]]]))

1
frontend/src/app/main/ui/workspace/sidebar/assets/file_library.scss
View File

@ -14,6 +14,7 @@
&:last-child {
margin-block-end: $s-24;
}
height: 100%;
}
.file-name {

9
frontend/src/app/main/ui/workspace/sidebar/layer_item.cljs
View File

@ -10,7 +10,6 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.helpers :as cfh]
[app.common.types.component :as ctk]
[app.common.types.container :as ctn]
[app.common.types.shape.layout :as ctl]
[app.common.uuid :as uuid]
@ -261,7 +260,7 @@
on-drop
(mf/use-fn
(mf/deps id index objects expanded?)
(mf/deps id index objects expanded? selected)
(fn [side _data]
(let [shape (get objects id)
@ -276,6 +275,8 @@
:else
(cfh/get-parent-id objects id))
[parent-id _] (ctn/find-valid-parent-and-frame-ids parent-id objects (map #(get objects %) selected))
parent (get objects parent-id)
to-index (cond
@ -283,9 +284,7 @@
(and expanded? (= side :bot) (d/not-empty? (:shapes shape))) (count (:shapes parent))
(= side :top) (inc index)
:else index)]
(when-not (ctk/in-component-copy? parent) ;; We don't want to change the structure of component copies
(st/emit! (dw/relocate-selected-shapes parent-id to-index))))))
(st/emit! (dw/relocate-selected-shapes parent-id to-index)))))
on-hold
(mf/use-fn

13
frontend/src/app/main/ui/workspace/sidebar/options/menus/color_selection.cljs
View File

@ -152,8 +152,9 @@
:library-colors library-colors}))
(mf/defc color-selection-menu
{::mf/wrap [#(mf/memo' % (mf/check-props ["shapes"]))]}
[{:keys [shapes file-id shared-libs] :as props}]
{::mf/wrap [#(mf/memo' % (mf/check-props ["shapes"]))]
::mf/wrap-props false}
[{:keys [shapes file-id shared-libs]}]
(let [{:keys [grouped-colors library-colors colors]} (mf/with-memo [shapes file-id shared-libs]
(prepare-colors shapes file-id shared-libs))
@ -175,7 +176,9 @@
(fn [new-color old-color from-picker?]
(let [old-color (-> old-color (dissoc :name :path) d/without-nils)
;; When dragging on the color picker sometimes all the shapes hasn't updated the color to the prev value so we need this extra calculation
;; When dragging on the color picker sometimes all
;; the shapes hasn't updated the color to the prev
;; value so we need this extra calculation
shapes-by-old-color (get @grouped-colors* old-color)
prev-color (d/seek #(get @grouped-colors* %) @prev-colors*)
shapes-by-prev-color (get @grouped-colors* prev-color)
@ -225,7 +228,7 @@
[:div {:class (stl/css :element-content)}
[:div {:class (stl/css :selected-color-group)}
(for [[index color] (d/enumerate (take 3 library-colors))]
[:& color-row {:key (dm/str "library-color-" (:color color))
[:& color-row {:key (dm/str "library-color-" index)
:color color
:index index
:on-detach on-detach
@ -239,7 +242,7 @@
(tr "workspace.options.more-lib-colors")])
(when @expand-lib-color
(for [[index color] (d/enumerate (drop 3 library-colors))]
[:& color-row {:key (dm/str "library-color-" (:color color))
[:& color-row {:key (dm/str "library-color-" index)
:color color
:index index
:on-detach on-detach

Some files were not shown because too many files have changed in this diff Show More