mirror of
https://github.com/penpot/penpot.git
synced 2025-03-16 01:31:22 -05:00
Merge pull request #4067 from penpot/staging-migration
⚡ & 🐛 More fixes and performance enhacements for the migration process
This commit is contained in:
commit
79105e8034
25 changed files with 790 additions and 372 deletions
|
@ -7,6 +7,7 @@
|
|||
(ns user
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.debug :as debug]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.fressian :as fres]
|
||||
|
@ -55,8 +56,12 @@
|
|||
[promesa.exec :as px]))
|
||||
|
||||
(repl/disable-reload! (find-ns 'integrant.core))
|
||||
(repl/disable-reload! (find-ns 'app.common.debug))
|
||||
|
||||
(set! *warn-on-reflection* true)
|
||||
|
||||
(add-tap #'debug/tap-handler)
|
||||
|
||||
;; --- Benchmarking Tools
|
||||
|
||||
(defmacro run-quick-bench
|
||||
|
@ -132,12 +137,6 @@
|
|||
;; :v6 v6
|
||||
;; }])))
|
||||
|
||||
(defonce debug-tap
|
||||
(do
|
||||
(add-tap #(locking debug-tap
|
||||
(prn "tap debug:" %)))
|
||||
1))
|
||||
|
||||
|
||||
(defn calculate-frames
|
||||
[{:keys [data]}]
|
||||
|
|
|
@ -21,7 +21,7 @@
|
|||
<Logger name="com.zaxxer.hikari" level="error"/>
|
||||
<Logger name="org.postgresql" level="error" />
|
||||
|
||||
<Logger name="app.rpc.commands.binfile" level="debug" />
|
||||
<Logger name="app.binfile" level="debug" />
|
||||
<Logger name="app.storage.tmp" level="info" />
|
||||
<Logger name="app.worker" level="trace" />
|
||||
<Logger name="app.msgbus" level="info" />
|
||||
|
|
|
@ -31,6 +31,7 @@
|
|||
[app.common.types.components-list :as ctkl]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.grid :as ctg]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.types.shape :as cts]
|
||||
|
@ -105,10 +106,20 @@
|
|||
;; 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-recent-color?
|
||||
(sm/lazy-validator ::ctc/recent-color))
|
||||
|
||||
(def valid-color?
|
||||
(sm/lazy-validator ::ctc/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))
|
||||
|
@ -122,30 +133,61 @@
|
|||
(def valid-rgb-color-string?
|
||||
(sm/lazy-validator ::ctc/rgb-color))
|
||||
|
||||
(def valid-shape-points?
|
||||
(sm/lazy-validator ::cts/points))
|
||||
|
||||
(def valid-image-attrs?
|
||||
(sm/lazy-validator ::cts/image-attrs))
|
||||
|
||||
(def valid-column-grid-params?
|
||||
(sm/lazy-validator ::ctg/column-params))
|
||||
|
||||
(def valid-square-grid-params?
|
||||
(sm/lazy-validator ::ctg/square-params))
|
||||
|
||||
|
||||
(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. This list
|
||||
;; is used later to process any other copy that was referencing a detached copy.
|
||||
;; Detach a shape and make necessary adjustments.
|
||||
(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)))
|
||||
(and (some? root-shape) (nil? (:parent-id root-shape))))
|
||||
parent (ctst/get-shape container (:parent-id shape))
|
||||
in-copy? (ctn/in-any-component? (:objects container) parent)]
|
||||
|
||||
(letfn [(detach-recursive [container shape first?]
|
||||
|
||||
;; If the shape is inside a component, add it to detached-ids. This list is used
|
||||
;; later to process other copies that was referencing a detached nested copy.
|
||||
(when is-component?
|
||||
(vswap! detached-ids conj (:id shape)))
|
||||
|
||||
;; Detach the shape and all children until we find a subinstance.
|
||||
(if (or first? in-copy? (not (ctk/instance-head? shape)))
|
||||
(as-> container $
|
||||
(ctn/update-shape $ (:id shape) ctk/detach-shape)
|
||||
(reduce #(detach-recursive %1 %2 false)
|
||||
$
|
||||
(map (d/getf (:objects container)) (:shapes shape))))
|
||||
|
||||
;; If this is a subinstance head and the initial shape whas not itself a
|
||||
;; nested copy, stop detaching and promote it to root.
|
||||
(ctn/update-shape container (:id shape) #(assoc % :component-root true))))]
|
||||
|
||||
(detach-recursive container shape true))))
|
||||
|
||||
fix-bad-children
|
||||
(fn [file-data]
|
||||
;; Remove any child that does not exist. And also remove duplicated children.
|
||||
(letfn [(fix-container
|
||||
[container]
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects update-vals (partial fix-shape container)))
|
||||
|
||||
(fix-shape
|
||||
[container shape]
|
||||
(fix-shape [container shape]
|
||||
(let [objects (:objects container)]
|
||||
(d/update-when shape :shapes
|
||||
(fn [shapes]
|
||||
|
@ -160,12 +202,10 @@
|
|||
fix-missing-image-metadata
|
||||
(fn [file-data]
|
||||
;; Delete broken image shapes with no metadata.
|
||||
(letfn [(fix-container
|
||||
[container]
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects #(reduce-kv fix-shape % %)))
|
||||
|
||||
(fix-shape
|
||||
[objects id shape]
|
||||
(fix-shape [objects id shape]
|
||||
(if (and (cfh/image-shape? shape)
|
||||
(nil? (:metadata shape)))
|
||||
(-> objects
|
||||
|
@ -189,11 +229,28 @@
|
|||
(dissoc options :background)
|
||||
options))
|
||||
|
||||
(fix-saved-grids [options]
|
||||
(d/update-when options :saved-grids
|
||||
(fn [grids]
|
||||
(cond-> grids
|
||||
(and (contains? grids :column)
|
||||
(not (valid-column-grid-params? (:column grids))))
|
||||
(dissoc :column)
|
||||
|
||||
(and (contains? grids :row)
|
||||
(not (valid-column-grid-params? (:row grids))))
|
||||
(dissoc :row)
|
||||
|
||||
(and (contains? grids :square)
|
||||
(not (valid-square-grid-params? (:square grids))))
|
||||
(dissoc :square)))))
|
||||
|
||||
(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-saved-grids)
|
||||
(fix-background)))]
|
||||
|
||||
(update file-data :pages-index update-vals update-page)))
|
||||
|
@ -203,11 +260,19 @@
|
|||
;; fix that issues.
|
||||
fix-file-data
|
||||
(fn [file-data]
|
||||
(-> file-data
|
||||
(d/update-when :colors dissoc nil)
|
||||
(d/update-when :typographies dissoc nil)))
|
||||
(letfn [(fix-colors-library [colors]
|
||||
(let [colors (dissoc colors nil)]
|
||||
(reduce-kv (fn [colors id color]
|
||||
(if (valid-color? color)
|
||||
colors
|
||||
(dissoc colors id)))
|
||||
colors
|
||||
colors)))]
|
||||
(-> file-data
|
||||
(d/update-when :colors fix-colors-library)
|
||||
(d/update-when :typographies dissoc nil))))
|
||||
|
||||
delete-big-geometry-shapes
|
||||
fix-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
|
||||
|
@ -253,9 +318,16 @@
|
|||
(fn [shapes] (filterv #(not= id %) shapes)))))
|
||||
|
||||
(and (cfh/text-shape? shape)
|
||||
(not (seq (:content shape))))
|
||||
(not (valid-text-content? (:content shape))))
|
||||
(dissoc objects id)
|
||||
|
||||
(and (cfh/path-shape? shape)
|
||||
(not (valid-path-content? (:content shape))))
|
||||
(-> objects
|
||||
(dissoc id)
|
||||
(d/update-in-when [(:parent-id shape) :shapes]
|
||||
(fn [shapes] (filterv #(not= id %) shapes))))
|
||||
|
||||
:else
|
||||
objects))
|
||||
|
||||
|
@ -266,25 +338,125 @@
|
|||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
|
||||
fix-misc-shape-issues
|
||||
fix-shape-geometry
|
||||
(fn [file-data]
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects update-vals fix-shape))
|
||||
|
||||
(fix-shape [shape]
|
||||
(cond
|
||||
(and (cfh/image-shape? shape)
|
||||
(valid-image-attrs? shape)
|
||||
(grc/valid-rect? (:selrect shape))
|
||||
(not (valid-shape-points? (:points shape))))
|
||||
(let [selrect (:selrect shape)
|
||||
metadata (:metadata shape)
|
||||
selrect (grc/make-rect
|
||||
(:x selrect)
|
||||
(:y selrect)
|
||||
(:width metadata)
|
||||
(:height metadata))
|
||||
points (grc/rect->points selrect)]
|
||||
(assoc shape
|
||||
:selrect selrect
|
||||
:points points))
|
||||
|
||||
(and (cfh/text-shape? shape)
|
||||
(valid-text-content? (:content shape))
|
||||
(not (valid-shape-points? (:points shape)))
|
||||
(seq (:position-data shape)))
|
||||
(let [selrect (->> (:position-data shape)
|
||||
(map (juxt :x :y :width :height))
|
||||
(map #(apply grc/make-rect %))
|
||||
(grc/join-rects))
|
||||
points (grc/rect->points selrect)]
|
||||
|
||||
(assoc shape
|
||||
:x (:x selrect)
|
||||
:y (:y selrect)
|
||||
:width (:width selrect)
|
||||
:height (:height selrect)
|
||||
:selrect selrect
|
||||
:points points))
|
||||
|
||||
(and (or (cfh/rect-shape? shape)
|
||||
(cfh/svg-raw-shape? shape)
|
||||
(cfh/circle-shape? shape))
|
||||
(not (valid-shape-points? (:points shape)))
|
||||
(grc/valid-rect? (:selrect shape)))
|
||||
(let [selrect (if (grc/valid-rect? (:svg-viewbox shape))
|
||||
(:svg-viewbox shape)
|
||||
(:selrect shape))
|
||||
points (grc/rect->points selrect)]
|
||||
(assoc shape
|
||||
:x (:x selrect)
|
||||
:y (:y selrect)
|
||||
:width (:width selrect)
|
||||
:height (:height selrect)
|
||||
:selrect selrect
|
||||
:points points))
|
||||
|
||||
(and (= :icon (:type shape))
|
||||
(grc/valid-rect? (:selrect shape))
|
||||
(valid-shape-points? (:points shape)))
|
||||
(-> shape
|
||||
(assoc :type :rect)
|
||||
(dissoc :content)
|
||||
(dissoc :metadata)
|
||||
(dissoc :segments)
|
||||
(dissoc :x1 :y1 :x2 :y2))
|
||||
|
||||
(and (cfh/group-shape? shape)
|
||||
(grc/valid-rect? (:selrect shape))
|
||||
(not (valid-shape-points? (:points shape))))
|
||||
(assoc shape :points (grc/rect->points (:selrect shape)))
|
||||
|
||||
:else
|
||||
shape))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(d/update-when :components update-vals fix-container))))
|
||||
|
||||
fix-misc-shape-issues
|
||||
(fn [file-data]
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects update-vals fix-shape))
|
||||
|
||||
(fix-gap-value [gap]
|
||||
(if (or (= gap ##Inf)
|
||||
(= gap ##-Inf))
|
||||
0
|
||||
gap))
|
||||
|
||||
(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)))
|
||||
(update :layout-gap (fn [layout-gap]
|
||||
(if (number? layout-gap)
|
||||
{:row-gap layout-gap :column-gap layout-gap}
|
||||
(-> layout-gap
|
||||
(d/update-when :column-gap fix-gap-value)
|
||||
(d/update-when :row-gap fix-gap-value)))))
|
||||
|
||||
;; Fix name if missing
|
||||
(nil? (:name shape))
|
||||
(assoc :name (d/name (:type shape)))
|
||||
|
||||
;; Remove v2 info from components that have been copied and pasted
|
||||
;; from a v2 file
|
||||
(some? (:main-instance shape))
|
||||
(dissoc :main-instance)
|
||||
|
||||
(and (contains? shape :transform)
|
||||
(not (gmt/valid-matrix? (:transform shape))))
|
||||
(assoc :transform (gmt/matrix))
|
||||
|
||||
(and (contains? shape :transform-inverse)
|
||||
(not (gmt/valid-matrix? (:transform-inverse shape))))
|
||||
(assoc :transform-inverse (gmt/matrix))
|
||||
|
||||
;; Fix broken fills
|
||||
(seq (:fills shape))
|
||||
(update :fills (fn [fills] (filterv valid-fill? fills)))
|
||||
|
@ -296,11 +468,7 @@
|
|||
;; 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})))))]
|
||||
(assoc :layout :flex)))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
|
@ -342,13 +510,15 @@
|
|||
(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)))
|
||||
(let [shape (update shape :content fix-path-content)]
|
||||
(if (not (valid-path-content? (:content shape)))
|
||||
shape
|
||||
(let [[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
|
||||
|
@ -390,18 +560,16 @@
|
|||
;; Remove invalid colors in :recent-colors
|
||||
(d/update-when file-data :recent-colors
|
||||
(fn [colors]
|
||||
(filterv valid-color? colors))))
|
||||
(filterv valid-recent-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]
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects #(reduce-kv fix-shape % %)))
|
||||
|
||||
(fix-shape
|
||||
[objects id shape]
|
||||
(fix-shape [objects id shape]
|
||||
(reduce (fn [objects child-id]
|
||||
(let [child (get objects child-id)]
|
||||
(cond-> objects
|
||||
|
@ -476,20 +644,33 @@
|
|||
(fn [file-data]
|
||||
;; Detach shapes that were inside a copy (have :shape-ref) but now they aren't.
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects update-vals (partial fix-shape container)))
|
||||
(reduce fix-shape container (ctn/shapes-seq container)))
|
||||
|
||||
(fix-shape [container shape]
|
||||
(let [parent (ctst/get-shape container (:parent-id shape))]
|
||||
(let [shape (ctst/get-shape container (:id shape)) ; Get the possibly updated shape
|
||||
parent (ctst/get-shape container (:parent-id shape))]
|
||||
(if (and (ctk/in-component-copy? shape)
|
||||
(not (ctk/instance-head? shape))
|
||||
(not (ctk/in-component-copy? parent)))
|
||||
(detach-shape container shape)
|
||||
shape)))]
|
||||
container)))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(d/update-when :components update-vals fix-container))))
|
||||
|
||||
fix-components-without-id
|
||||
(fn [file-data]
|
||||
;; We have detected some components that have no :id attribute.
|
||||
;; Regenerate it from the components map.
|
||||
(letfn [(fix-component [id component]
|
||||
(if (some? (:id component))
|
||||
component
|
||||
(assoc component :id id)))]
|
||||
|
||||
(-> file-data
|
||||
(d/update-when :components #(d/mapm fix-component %)))))
|
||||
|
||||
remap-refs
|
||||
(fn [file-data]
|
||||
;; Remap shape-refs so that they point to the near main.
|
||||
|
@ -523,11 +704,9 @@
|
|||
(if (some? direct-shape-2)
|
||||
;; If it exists, there is nothing else to do.
|
||||
container
|
||||
;; If not found, detach shape and all children (stopping if a nested instance is reached)
|
||||
(let [children (ctn/get-children-in-instance (:objects container) (:id shape))]
|
||||
(reduce #(ctn/update-shape %1 (:id %2) (partial detach-shape %1))
|
||||
container
|
||||
children))))))))
|
||||
;; If not found, detach shape and all children.
|
||||
;; container
|
||||
(detach-shape container shape)))))))
|
||||
container))]
|
||||
|
||||
(-> file-data
|
||||
|
@ -539,14 +718,64 @@
|
|||
;; 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]
|
||||
(d/update-when container :objects update-vals (partial fix-shape container)))
|
||||
(reduce fix-shape container (ctn/shapes-seq 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))]
|
||||
container))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(d/update-when :components update-vals fix-container))))
|
||||
|
||||
wrap-non-group-component-roots
|
||||
(fn [file-data]
|
||||
;; Some components have a root that is not a group nor a frame
|
||||
;; (e.g. a path or a svg-raw). We need to wrap them in a frame
|
||||
;; for this one to became the root.
|
||||
(letfn [(fix-component [component]
|
||||
(let [root-shape (ctst/get-shape component (:id component))]
|
||||
(if (or (cfh/group-shape? root-shape)
|
||||
(cfh/frame-shape? root-shape))
|
||||
component
|
||||
(let [new-id (uuid/next)
|
||||
frame (-> (cts/setup-shape
|
||||
{:type :frame
|
||||
:id (:id component)
|
||||
:x (:x (:selrect root-shape))
|
||||
:y (:y (:selrect root-shape))
|
||||
:width (:width (:selrect root-shape))
|
||||
:height (:height (:selrect root-shape))
|
||||
:name (:name component)
|
||||
:shapes [new-id]})
|
||||
(assoc :frame-id nil
|
||||
:parent-id nil))
|
||||
root-shape' (assoc root-shape
|
||||
:id new-id
|
||||
:parent-id (:id frame)
|
||||
:frame-id (:id frame))]
|
||||
(update component :objects assoc
|
||||
(:id frame) frame
|
||||
(:id root-shape') root-shape')))))]
|
||||
|
||||
(-> file-data
|
||||
(d/update-when :components update-vals fix-component))))
|
||||
|
||||
detach-non-group-instance-roots
|
||||
(fn [file-data]
|
||||
;; If there is a copy instance whose root is not a frame or a group, it cannot
|
||||
;; be easily repaired, and anyway it's not working in production, so detach it.
|
||||
(letfn [(fix-container [container]
|
||||
(reduce fix-shape container (ctn/shapes-seq container)))
|
||||
|
||||
(fix-shape [container shape]
|
||||
(if (and (ctk/instance-head? shape)
|
||||
(not (#{:group :frame} (:type shape))))
|
||||
(detach-shape container shape)
|
||||
container))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
|
@ -554,7 +783,7 @@
|
|||
|
||||
transform-to-frames
|
||||
(fn [file-data]
|
||||
;; Transform component and copy heads to frames, and set the
|
||||
;; Transform component and copy heads fron group to frames, and set the
|
||||
;; frame-id of its childrens
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects update-vals fix-shape))
|
||||
|
@ -631,9 +860,8 @@
|
|||
(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]
|
||||
(d/update-when container :objects update-vals (partial fix-shape container)))
|
||||
(letfn [(fix-container [container]
|
||||
(reduce fix-shape container (ctn/shapes-seq container)))
|
||||
|
||||
(fix-shape
|
||||
[container shape]
|
||||
|
@ -643,74 +871,79 @@
|
|||
(and (ctk/in-component-copy? shape)
|
||||
(nil? (ctn/get-head-shape (:objects container) shape {:allow-main? true}))))
|
||||
(detach-shape container shape)
|
||||
shape))]
|
||||
container))]
|
||||
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
(d/update-when :components update-vals fix-container))))
|
||||
|
||||
|
||||
fix-component-root-without-component
|
||||
(fn [file-data]
|
||||
;; Ensure that if component-root is set component-file and component-id are set too
|
||||
(letfn [(fix-container [container]
|
||||
(d/update-when container :objects update-vals fix-shape))
|
||||
|
||||
(fix-shape [shape]
|
||||
(cond-> shape
|
||||
(and (ctk/instance-root? shape)
|
||||
(or (not (ctk/instance-head? shape))
|
||||
(not (some? (:component-file shape)))))
|
||||
(dissoc :component-id
|
||||
:component-file
|
||||
:component-root)))]
|
||||
(-> file-data
|
||||
(update :pages-index 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.
|
||||
;; 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)))]
|
||||
(ctk/detach-shape)))]
|
||||
(-> 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))))]
|
||||
(d/update-when :components 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-big-geometry-shapes)
|
||||
(fix-shape-geometry)
|
||||
(fix-completly-broken-shapes)
|
||||
(fix-bad-children)
|
||||
(fix-broken-parents)
|
||||
(fix-orphan-shapes)
|
||||
(fix-orphan-copies)
|
||||
(remove-nested-roots)
|
||||
(add-not-nested-roots)
|
||||
(fix-components-without-id)
|
||||
(remap-refs)
|
||||
(fix-converted-copies)
|
||||
(wrap-non-group-component-roots)
|
||||
(detach-non-group-instance-roots)
|
||||
(transform-to-frames)
|
||||
(remap-frame-ids)
|
||||
(fix-frame-ids)
|
||||
(fix-component-nil-objects)
|
||||
(fix-false-copies)
|
||||
(fix-shape-nil-parent-id)
|
||||
(fix-copies-of-detached)))) ; <- Do not add fixes after this one
|
||||
|
||||
(fix-component-root-without-component)
|
||||
(fix-copies-of-detached); <- Do not add fixes after this and fix-orphan-copies call
|
||||
; This extra call to fix-orphan-copies after fix-copies-of-detached because we can have detached subtrees with invalid shape-ref attributes
|
||||
(fix-orphan-copies))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; COMPONENTS MIGRATION
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
@ -100,11 +100,11 @@
|
|||
(let [profile (profile/get-profile pool profile-id)
|
||||
project-id (:default-project-id profile)]
|
||||
|
||||
(db/run! pool (fn [{:keys [::db/conn]}]
|
||||
(create-file conn {:id file-id
|
||||
:name (str "Cloned file: " filename)
|
||||
:project-id project-id
|
||||
:profile-id profile-id})
|
||||
(db/run! pool (fn [{:keys [::db/conn] :as cfg}]
|
||||
(create-file cfg {:id file-id
|
||||
:name (str "Cloned file: " filename)
|
||||
:project-id project-id
|
||||
:profile-id profile-id})
|
||||
(db/update! conn :file
|
||||
{:data data}
|
||||
{:id file-id})
|
||||
|
@ -141,11 +141,11 @@
|
|||
{::rres/status 200
|
||||
::rres/body "OK UPDATED"})
|
||||
|
||||
(db/run! pool (fn [{:keys [::db/conn]}]
|
||||
(create-file conn {:id file-id
|
||||
:name fname
|
||||
:project-id project-id
|
||||
:profile-id profile-id})
|
||||
(db/run! pool (fn [{:keys [::db/conn] :as cfg}]
|
||||
(create-file cfg {:id file-id
|
||||
:name fname
|
||||
:project-id project-id
|
||||
:profile-id profile-id})
|
||||
(db/update! conn :file
|
||||
{:data data}
|
||||
{:id file-id})
|
||||
|
|
|
@ -8,6 +8,7 @@
|
|||
(:refer-clojure :exclude [assert])
|
||||
(:require
|
||||
[app.binfile.v1 :as bf.v1]
|
||||
[app.common.logging :as l]
|
||||
[app.common.schema :as sm]
|
||||
[app.db :as db]
|
||||
[app.http.sse :as sse]
|
||||
|
@ -50,11 +51,16 @@
|
|||
::rres/headers {"content-type" "application/octet-stream"}
|
||||
::rres/body (reify rres/StreamableResponseBody
|
||||
(-write-body-to-stream [_ _ output-stream]
|
||||
(-> cfg
|
||||
(assoc ::bf.v1/ids #{file-id})
|
||||
(assoc ::bf.v1/embed-assets embed-assets)
|
||||
(assoc ::bf.v1/include-libraries include-libraries)
|
||||
(bf.v1/export-files! output-stream))))}))
|
||||
(try
|
||||
(-> cfg
|
||||
(assoc ::bf.v1/ids #{file-id})
|
||||
(assoc ::bf.v1/embed-assets embed-assets)
|
||||
(assoc ::bf.v1/include-libraries include-libraries)
|
||||
(bf.v1/export-files! output-stream))
|
||||
(catch Throwable cause
|
||||
(l/err :hint "exception on exporting file"
|
||||
:file-id (str file-id)
|
||||
:cause cause)))))}))
|
||||
|
||||
;; --- Command: import-binfile
|
||||
|
||||
|
|
|
@ -188,17 +188,27 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn migrate-file!
|
||||
[file-id & {:keys [rollback? validate? label] :or {rollback? true validate? false}}]
|
||||
[file-id & {:keys [rollback? validate? label cache skip-on-graphic-error?]
|
||||
:or {rollback? true
|
||||
validate? false
|
||||
skip-on-graphic-error? true}}]
|
||||
(l/dbg :hint "migrate:start" :rollback rollback?)
|
||||
(let [tpoint (dt/tpoint)
|
||||
(let [tpoint (dt/tpoint)
|
||||
file-id (if (string? file-id)
|
||||
(parse-uuid file-id)
|
||||
file-id)]
|
||||
(binding [feat/*stats* (atom {})]
|
||||
file-id)
|
||||
cache (if (int? cache)
|
||||
(cache/create :executor (::wrk/executor main/system)
|
||||
:max-items cache)
|
||||
nil)]
|
||||
|
||||
(binding [feat/*stats* (atom {})
|
||||
feat/*cache* cache]
|
||||
(try
|
||||
(-> (assoc main/system ::db/rollback rollback?)
|
||||
(feat/migrate-file! file-id
|
||||
:validate? validate?
|
||||
:skip-on-graphic-error? skip-on-graphic-error?
|
||||
:label label))
|
||||
|
||||
(-> (deref feat/*stats*)
|
||||
|
@ -212,22 +222,28 @@
|
|||
(l/dbg :hint "migrate:end" :rollback rollback? :elapsed elapsed)))))))
|
||||
|
||||
(defn migrate-team!
|
||||
[team-id & {:keys [rollback? skip-on-graphic-error? validate? label]
|
||||
[team-id & {:keys [rollback? skip-on-graphic-error? validate? label cache]
|
||||
:or {rollback? true
|
||||
validate? true
|
||||
skip-on-graphic-error? false}}]
|
||||
skip-on-graphic-error? true}}]
|
||||
|
||||
(l/dbg :hint "migrate:start" :rollback rollback?)
|
||||
|
||||
(let [team-id (if (string? team-id)
|
||||
(parse-uuid team-id)
|
||||
team-id)
|
||||
stats (atom {})
|
||||
tpoint (dt/tpoint)]
|
||||
(let [team-id (if (string? team-id)
|
||||
(parse-uuid team-id)
|
||||
team-id)
|
||||
stats (atom {})
|
||||
tpoint (dt/tpoint)
|
||||
|
||||
cache (if (int? cache)
|
||||
(cache/create :executor (::wrk/executor main/system)
|
||||
:max-items cache)
|
||||
nil)]
|
||||
|
||||
(add-watch stats :progress-report (report-progress-files tpoint))
|
||||
|
||||
(binding [feat/*stats* stats]
|
||||
(binding [feat/*stats* stats
|
||||
feat/*cache* cache]
|
||||
(try
|
||||
(-> (assoc main/system ::db/rollback rollback?)
|
||||
(feat/migrate-team! team-id
|
||||
|
@ -286,7 +302,7 @@
|
|||
sprocs (ps/create :permits max-procs)
|
||||
|
||||
cache (if (int? cache)
|
||||
(cache/create :executor executor
|
||||
(cache/create :executor (::wrk/executor main/system)
|
||||
:max-items cache)
|
||||
nil)
|
||||
migrate-team
|
||||
|
@ -382,3 +398,17 @@
|
|||
(l/dbg :hint "migrate:end"
|
||||
:rollback rollback?
|
||||
:elapsed elapsed)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; FILE PROCESS HELPERS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn delete-broken-files
|
||||
[{:keys [id data] :as file}]
|
||||
(if (-> data :options :components-v2 true?)
|
||||
(do
|
||||
(l/wrn :hint "found old components-v2 format"
|
||||
:file-id (str id)
|
||||
:file-name (:name file))
|
||||
(assoc file :deleted-at (dt/now)))
|
||||
file))
|
||||
|
|
|
@ -258,8 +258,11 @@
|
|||
max-jobs
|
||||
start-at
|
||||
on-file
|
||||
validate?
|
||||
rollback?]
|
||||
:or {max-jobs 1
|
||||
max-items Long/MAX_VALUE
|
||||
validate? true
|
||||
rollback? true}}]
|
||||
|
||||
(l/dbg :hint "process:start"
|
||||
|
@ -273,19 +276,19 @@
|
|||
sjobs (ps/create :permits max-jobs)
|
||||
|
||||
process-file
|
||||
(fn [file-id tpoint]
|
||||
(fn [file-id idx tpoint]
|
||||
(try
|
||||
(l/trc :hint "process:file:start" :file-id (str file-id))
|
||||
(l/trc :hint "process:file:start" :file-id (str file-id) :index idx)
|
||||
(db/tx-run! (assoc main/system ::db/rollback rollback?)
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [file' (get-file* system file-id)
|
||||
file (binding [*system* system]
|
||||
(on-file file'))]
|
||||
|
||||
(when (and (some? file)
|
||||
(not (identical? file file')))
|
||||
(when (and (some? file) (not (identical? file file')))
|
||||
|
||||
(cfv/validate-file-schema! file)
|
||||
(when validate?
|
||||
(cfv/validate-file-schema! file))
|
||||
|
||||
(let [file (if (contains? (:features file) "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
|
@ -300,36 +303,43 @@
|
|||
|
||||
(db/update! conn :file
|
||||
{:data (blob/encode (:data file))
|
||||
:deleted-at (:deleted-at file)
|
||||
:created-at (:created-at file)
|
||||
:modified-at (:modified-at file)
|
||||
:features (db/create-array conn "text" (:features file))
|
||||
:revn (:revn file)}
|
||||
{:id file-id}))))))
|
||||
(catch Throwable cause
|
||||
(l/wrn :hint "unexpected error on processing file (skiping)"
|
||||
:file-id (str file-id)
|
||||
:index idx
|
||||
:cause cause))
|
||||
(finally
|
||||
(ps/release! sjobs)
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/trc :hint "process:file:end"
|
||||
:file-id (str file-id)
|
||||
:index idx
|
||||
:elapsed elapsed)))))]
|
||||
|
||||
|
||||
(try
|
||||
(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! (fn [file-id]
|
||||
(ps/acquire! sjobs)
|
||||
(px/run! executor (partial process-file file-id (dt/tpoint))))
|
||||
(->> (db/cursor conn [sql:get-file-ids (or start-at (dt/now))])
|
||||
(take max-items)
|
||||
(map :id)))
|
||||
|
||||
;; Close and await tasks
|
||||
(pu/close! executor)))
|
||||
(try
|
||||
(reduce (fn [idx file-id]
|
||||
(ps/acquire! sjobs)
|
||||
(px/run! executor (partial process-file file-id idx (dt/tpoint)))
|
||||
(inc idx))
|
||||
0
|
||||
(->> (db/cursor conn [sql:get-file-ids (or start-at (dt/now))])
|
||||
(take max-items)
|
||||
(map :id)))
|
||||
(finally
|
||||
;; Close and await tasks
|
||||
(pu/close! executor)))))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/dbg :hint "process:error" :cause cause))
|
||||
|
|
|
@ -57,6 +57,14 @@
|
|||
#?(:cljs (instance? lkm/LinkedMap o)
|
||||
:clj (instance? LinkedMap o)))
|
||||
|
||||
(defn vec2
|
||||
"Creates a optimized vector compatible type of length 2 backed
|
||||
internally with MapEntry impl because it has faster access method
|
||||
for its fields."
|
||||
[o1 o2]
|
||||
#?(:clj (clojure.lang.MapEntry. o1 o2)
|
||||
:cljs (cljs.core/->MapEntry o1 o2 nil)))
|
||||
|
||||
#?(:clj
|
||||
(defmethod print-method clojure.lang.PersistentQueue [q, w]
|
||||
;; Overload the printer for queues so they look like fish
|
||||
|
@ -308,9 +316,12 @@
|
|||
(defn mapm
|
||||
"Map over the values of a map"
|
||||
([mfn]
|
||||
(map (fn [[key val]] [key (mfn key val)])))
|
||||
(map (fn [[key val]] (vec2 key (mfn key val)))))
|
||||
([mfn coll]
|
||||
(into {} (mapm mfn) coll)))
|
||||
(reduce-kv (fn [coll k v]
|
||||
(assoc coll k (mfn k v)))
|
||||
coll
|
||||
coll)))
|
||||
|
||||
(defn removev
|
||||
"Returns a vector of the items in coll for which (fn item) returns logical false"
|
||||
|
|
36
common/src/app/common/debug.clj
Normal file
36
common/src/app/common/debug.clj
Normal file
|
@ -0,0 +1,36 @@
|
|||
;; 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.debug
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.common.pprint :as pp]))
|
||||
|
||||
(defn pprint
|
||||
[expr]
|
||||
(l/raw! :debug
|
||||
(binding [*print-level* pp/default-level
|
||||
*print-length* pp/default-length]
|
||||
(with-out-str
|
||||
(println "tap dbg:")
|
||||
(pp/pprint expr {:max-width pp/default-width})))))
|
||||
|
||||
|
||||
(def store (atom {}))
|
||||
|
||||
(defn get-stored
|
||||
[]
|
||||
(deref store))
|
||||
|
||||
(defn tap-handler
|
||||
[v]
|
||||
(if (and (vector? v)
|
||||
(keyword (first v)))
|
||||
(let [[command obj] v]
|
||||
(case command
|
||||
(:print :prn :pprint) (pprint obj)
|
||||
:store (reset! store obj)))
|
||||
(pprint v)))
|
|
@ -6,4 +6,4 @@
|
|||
|
||||
(ns app.common.files.defaults)
|
||||
|
||||
(def version 44)
|
||||
(def version 46)
|
||||
|
|
|
@ -484,7 +484,7 @@
|
|||
(letfn [(red-fn [cur-idx id]
|
||||
(let [[prev-idx _] (first cur-idx)
|
||||
prev-idx (or prev-idx 0)
|
||||
cur-idx (conj cur-idx [(inc prev-idx) id])]
|
||||
cur-idx (conj cur-idx (d/vec2 (inc prev-idx) id))]
|
||||
(rec-index cur-idx id)))
|
||||
(rec-index [cur-idx id]
|
||||
(let [object (get objects id)]
|
||||
|
@ -509,10 +509,11 @@
|
|||
|
||||
(defn order-by-indexed-shapes
|
||||
[objects ids]
|
||||
(->> (indexed-shapes objects)
|
||||
(sort-by first)
|
||||
(filter (comp (into #{} ids) second))
|
||||
(map second)))
|
||||
(let [ids (if (set? ids) ids (set ids))]
|
||||
(->> (indexed-shapes objects)
|
||||
(filter (fn [o] (contains? ids (val o))))
|
||||
(sort-by key)
|
||||
(map val))))
|
||||
|
||||
(defn get-index-replacement
|
||||
"Given a collection of shapes, calculate their positions
|
||||
|
|
|
@ -6,6 +6,7 @@
|
|||
|
||||
(ns app.common.files.libraries-helpers
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.types.component :as ctk]
|
||||
|
@ -37,41 +38,50 @@
|
|||
use it as root. Otherwise, create a frame (v2) or group (v1) that contains all ids. Then, make a
|
||||
component with it, and link all shapes to their corresponding one in the component."
|
||||
[it shapes objects page-id file-id components-v2 prepare-create-group prepare-create-board]
|
||||
(let [changes (pcb/empty-changes it page-id)
|
||||
|
||||
from-singe-frame? (and (= 1 (count shapes)) (-> shapes first cfh/frame-shape?))
|
||||
(let [changes (pcb/empty-changes it page-id)
|
||||
shapes-count (count shapes)
|
||||
first-shape (first shapes)
|
||||
|
||||
from-singe-frame?
|
||||
(and (= 1 shapes-count)
|
||||
(cfh/frame-shape? first-shape))
|
||||
|
||||
[root changes old-root-ids]
|
||||
(if (and (= (count shapes) 1)
|
||||
(or (and (= (:type (first shapes)) :group) (not components-v2))
|
||||
(= (:type (first shapes)) :frame))
|
||||
(not (ctk/instance-head? (first shapes))))
|
||||
|
||||
[(first shapes)
|
||||
(if (and (= shapes-count 1)
|
||||
(or (and (cfh/group-shape? first-shape)
|
||||
(not components-v2))
|
||||
(cfh/frame-shape? first-shape))
|
||||
(not (ctk/instance-head? first-shape)))
|
||||
[first-shape
|
||||
(-> (pcb/empty-changes it page-id)
|
||||
(pcb/with-objects objects))
|
||||
(:shapes (first shapes))]
|
||||
(:shapes first-shape)]
|
||||
|
||||
(let [root-name (if (= 1 (count shapes))
|
||||
(:name (first shapes))
|
||||
(let [root-name (if (= 1 shapes-count)
|
||||
(:name first-shape)
|
||||
"Component 1")
|
||||
|
||||
[root changes] (if-not components-v2
|
||||
(prepare-create-group it ; These functions needs to be passed as argument
|
||||
objects ; to avoid a circular dependence
|
||||
page-id
|
||||
shapes
|
||||
root-name
|
||||
(not (ctk/instance-head? (first shapes))))
|
||||
(prepare-create-board changes
|
||||
(uuid/next)
|
||||
(:parent-id (first shapes))
|
||||
objects
|
||||
(map :id shapes)
|
||||
nil
|
||||
root-name
|
||||
true))]
|
||||
shape-ids (into (d/ordered-set) (map :id) shapes)
|
||||
|
||||
[root changes (map :id shapes)]))
|
||||
[root changes]
|
||||
(if-not components-v2
|
||||
(prepare-create-group it ; These functions needs to be passed as argument
|
||||
objects ; to avoid a circular dependence
|
||||
page-id
|
||||
shapes
|
||||
root-name
|
||||
(not (ctk/instance-head? first-shape)))
|
||||
(prepare-create-board changes
|
||||
(uuid/next)
|
||||
(:parent-id first-shape)
|
||||
objects
|
||||
shape-ids
|
||||
nil
|
||||
root-name
|
||||
true))]
|
||||
|
||||
[root changes shape-ids]))
|
||||
|
||||
changes
|
||||
(cond-> changes
|
||||
|
@ -79,8 +89,7 @@
|
|||
(pcb/update-shapes
|
||||
(:shapes root)
|
||||
(fn [shape]
|
||||
(-> shape
|
||||
(assoc :constraints-h :scale :constraints-v :scale)))))
|
||||
(assoc shape :constraints-h :scale :constraints-v :scale))))
|
||||
|
||||
objects' (assoc objects (:id root) root)
|
||||
|
||||
|
|
|
@ -109,11 +109,14 @@
|
|||
(assoc :points (grc/rect->points selrect))))))
|
||||
|
||||
(fix-empty-points [shape]
|
||||
(let [shape (cond-> shape
|
||||
(empty? (:selrect shape)) (cts/setup-rect))]
|
||||
(cond-> shape
|
||||
(empty? (:points shape))
|
||||
(assoc :points (grc/rect->points (:selrect shape))))))
|
||||
(if (empty? (:points shape))
|
||||
(-> shape
|
||||
(update :selrect (fn [selrect]
|
||||
(if (map? selrect)
|
||||
(grc/make-rect selrect)
|
||||
selrect)))
|
||||
(cts/setup-shape))
|
||||
shape))
|
||||
|
||||
(update-object [object]
|
||||
(cond-> object
|
||||
|
@ -620,6 +623,10 @@
|
|||
(-> object
|
||||
(assoc :parent-id uuid/zero)
|
||||
(assoc :frame-id uuid/zero)
|
||||
;; We explicitly dissoc them and let the shape-setup
|
||||
;; to regenerate it with valid values.
|
||||
(dissoc :selrect)
|
||||
(dissoc :points)
|
||||
(cts/setup-shape))
|
||||
object))
|
||||
|
||||
|
@ -843,3 +850,29 @@
|
|||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
|
||||
(defmethod migrate 45
|
||||
[data]
|
||||
(letfn [(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)))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals fix-shape))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container))))
|
||||
|
||||
(defmethod migrate 46
|
||||
[data]
|
||||
(letfn [(update-object [object]
|
||||
(dissoc object :thumbnail))
|
||||
|
||||
(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))))
|
||||
|
|
|
@ -39,16 +39,17 @@
|
|||
|
||||
(defn prepare-move-shapes-into-frame
|
||||
[changes frame-id shapes objects]
|
||||
(let [ordered-indexes (cfh/order-by-indexed-shapes objects shapes)
|
||||
parent-id (get-in objects [frame-id :parent-id])
|
||||
ordered-indexes (->> ordered-indexes (remove #(= % parent-id)))
|
||||
to-move-shapes (map (d/getf objects) ordered-indexes)]
|
||||
(if (d/not-empty? to-move-shapes)
|
||||
(let [parent-id (dm/get-in objects [frame-id :parent-id])
|
||||
shapes (remove #(= % parent-id) shapes)
|
||||
to-move (->> shapes
|
||||
(map (d/getf objects))
|
||||
(not-empty))]
|
||||
(if to-move
|
||||
(-> changes
|
||||
(cond-> (not (ctl/any-layout? objects frame-id))
|
||||
(pcb/update-shapes ordered-indexes ctl/remove-layout-item-data))
|
||||
(pcb/update-shapes ordered-indexes #(cond-> % (cfh/frame-shape? %) (assoc :hide-in-viewer true)))
|
||||
(pcb/change-parent frame-id to-move-shapes 0)
|
||||
(pcb/update-shapes shapes ctl/remove-layout-item-data))
|
||||
(pcb/update-shapes shapes #(cond-> % (cfh/frame-shape? %) (assoc :hide-in-viewer true)))
|
||||
(pcb/change-parent frame-id to-move 0)
|
||||
(cond-> (ctl/grid-layout? objects frame-id)
|
||||
(-> (pcb/update-shapes [frame-id] ctl/assign-cells {:with-objects? true})
|
||||
(pcb/reorder-grid-children [frame-id]))))
|
||||
|
@ -60,90 +61,102 @@
|
|||
changes id parent-id objects selected index frame-name without-fill? nil))
|
||||
|
||||
([changes id parent-id objects selected index frame-name without-fill? target-cell-id]
|
||||
(let [selected-objs (map #(get objects %) selected)
|
||||
new-index (or index
|
||||
(cfh/get-index-replacement selected objects))]
|
||||
(when (d/not-empty? selected)
|
||||
(let [srect (gsh/shapes->rect selected-objs)
|
||||
selected-id (first selected)
|
||||
(when-let [selected-objs (->> selected
|
||||
(map (d/getf objects))
|
||||
(not-empty))]
|
||||
|
||||
frame-id (dm/get-in objects [selected-id :frame-id])
|
||||
parent-id (or parent-id (dm/get-in objects [selected-id :parent-id]))
|
||||
base-parent (get objects parent-id)
|
||||
(let [;; We calculate here the ordered selection because it is used
|
||||
;; multiple times and this avoid the need of creating the index
|
||||
;; manytimes for single operation.
|
||||
selected' (cfh/order-by-indexed-shapes objects selected)
|
||||
new-index (or index
|
||||
(->> (first selected')
|
||||
(cfh/get-position-on-parent objects)
|
||||
(inc)))
|
||||
|
||||
layout-props
|
||||
(when (and (= 1 (count selected))
|
||||
(ctl/any-layout? base-parent))
|
||||
(let [shape (get objects selected-id)]
|
||||
(select-keys shape ctl/layout-item-props)))
|
||||
srect (gsh/shapes->rect selected-objs)
|
||||
selected-id (first selected)
|
||||
selected-obj (get objects selected-id)
|
||||
|
||||
target-cell-id
|
||||
(if (and (nil? target-cell-id)
|
||||
(ctl/grid-layout? objects parent-id))
|
||||
;; Find the top-left grid cell of the selected elements
|
||||
(let [ncols (count (:layout-grid-columns base-parent))]
|
||||
(->> selected
|
||||
(map #(ctl/get-cell-by-shape-id base-parent %))
|
||||
(apply min-key (fn [{:keys [row column]}] (+ (* ncols row) column)))
|
||||
:id))
|
||||
target-cell-id)
|
||||
frame-id (get selected-obj :frame-id)
|
||||
parent-id (or parent-id (get selected-obj :parent-id))
|
||||
base-parent (get objects parent-id)
|
||||
|
||||
attrs {:type :frame
|
||||
:x (:x srect)
|
||||
:y (:y srect)
|
||||
:width (:width srect)
|
||||
:height (:height srect)}
|
||||
layout-props
|
||||
(when (and (= 1 (count selected))
|
||||
(ctl/any-layout? base-parent))
|
||||
(select-keys selected-obj ctl/layout-item-props))
|
||||
|
||||
shape (cts/setup-shape
|
||||
(cond-> attrs
|
||||
(some? id)
|
||||
(assoc :id id)
|
||||
target-cell-id
|
||||
(if (and (nil? target-cell-id)
|
||||
(ctl/grid-layout? objects parent-id))
|
||||
;; Find the top-left grid cell of the selected elements
|
||||
(let [ncols (count (:layout-grid-columns base-parent))]
|
||||
(->> selected
|
||||
(map #(ctl/get-cell-by-shape-id base-parent %))
|
||||
(apply min-key (fn [{:keys [row column]}] (+ (* ncols row) column)))
|
||||
:id))
|
||||
target-cell-id)
|
||||
|
||||
(some? frame-name)
|
||||
(assoc :name frame-name)
|
||||
attrs
|
||||
{:type :frame
|
||||
:x (:x srect)
|
||||
:y (:y srect)
|
||||
:width (:width srect)
|
||||
:height (:height srect)}
|
||||
|
||||
:always
|
||||
(assoc :frame-id frame-id
|
||||
:parent-id parent-id
|
||||
:shapes (into [] selected))
|
||||
shape
|
||||
(cts/setup-shape
|
||||
(cond-> attrs
|
||||
(some? id)
|
||||
(assoc :id id)
|
||||
|
||||
(some? layout-props)
|
||||
(d/patch-object layout-props)
|
||||
(some? frame-name)
|
||||
(assoc :name frame-name)
|
||||
|
||||
(or (not= frame-id uuid/zero) without-fill?)
|
||||
(assoc :fills [] :hide-in-viewer true)))
|
||||
:always
|
||||
(assoc :frame-id frame-id
|
||||
:parent-id parent-id
|
||||
:shapes (into [] selected))
|
||||
|
||||
shape (with-meta shape {:index new-index})
|
||||
(some? layout-props)
|
||||
(d/patch-object layout-props)
|
||||
|
||||
[shape changes]
|
||||
(prepare-add-shape changes shape objects)
|
||||
(or (not= frame-id uuid/zero) without-fill?)
|
||||
(assoc :fills [] :hide-in-viewer true)))
|
||||
|
||||
changes
|
||||
(prepare-move-shapes-into-frame changes (:id shape) selected objects)
|
||||
shape
|
||||
(with-meta shape {:index new-index})
|
||||
|
||||
changes
|
||||
(cond-> changes
|
||||
(ctl/grid-layout? objects (:parent-id shape))
|
||||
(-> (pcb/update-shapes
|
||||
[(:parent-id shape)]
|
||||
(fn [parent objects]
|
||||
;; This restores the grid layout before adding and moving the shapes
|
||||
;; this is done because the add+move could have altered the layout and we
|
||||
;; want to do it after both operations are completed. Also here we could
|
||||
;; asign the new element to a target-cell
|
||||
(-> parent
|
||||
(assoc :layout-grid-cells (:layout-grid-cells base-parent))
|
||||
(assoc :layout-grid-rows (:layout-grid-rows base-parent))
|
||||
(assoc :layout-grid-columns (:layout-grid-columns base-parent))
|
||||
[shape changes]
|
||||
(prepare-add-shape changes shape objects)
|
||||
|
||||
(cond-> (some? target-cell-id)
|
||||
(assoc-in [:layout-grid-cells target-cell-id :shapes] [(:id shape)]))
|
||||
(ctl/assign-cells objects)))
|
||||
{:with-objects? true})
|
||||
changes
|
||||
(prepare-move-shapes-into-frame changes (:id shape) selected' objects)
|
||||
|
||||
(pcb/reorder-grid-children [(:parent-id shape)])))]
|
||||
changes
|
||||
(cond-> changes
|
||||
(ctl/grid-layout? objects (:parent-id shape))
|
||||
(-> (pcb/update-shapes
|
||||
[(:parent-id shape)]
|
||||
(fn [parent objects]
|
||||
;; This restores the grid layout before adding and moving the shapes
|
||||
;; this is done because the add+move could have altered the layout and we
|
||||
;; want to do it after both operations are completed. Also here we could
|
||||
;; asign the new element to a target-cell
|
||||
(-> parent
|
||||
(assoc :layout-grid-cells (:layout-grid-cells base-parent))
|
||||
(assoc :layout-grid-rows (:layout-grid-rows base-parent))
|
||||
(assoc :layout-grid-columns (:layout-grid-columns base-parent))
|
||||
|
||||
[shape changes])))))
|
||||
(cond-> (some? target-cell-id)
|
||||
(assoc-in [:layout-grid-cells target-cell-id :shapes] [(:id shape)]))
|
||||
(ctl/assign-cells objects)))
|
||||
{:with-objects? true})
|
||||
|
||||
(pcb/reorder-grid-children [(:parent-id shape)])))]
|
||||
|
||||
[shape changes]))))
|
||||
|
||||
|
||||
(defn prepare-create-empty-artboard
|
||||
|
|
|
@ -98,7 +98,8 @@
|
|||
(defn- check-geometry
|
||||
"Validate that the shape has valid coordinates, selrect and points."
|
||||
[shape file page]
|
||||
(when (and (not (#{:path :bool} (:type shape)))
|
||||
(when (and (not (or (cfh/path-shape? shape)
|
||||
(cfh/bool-shape? shape)))
|
||||
(or (nil? (:x shape)) ; This may occur in root shape (uuid/zero) in old files
|
||||
(nil? (:y shape))
|
||||
(nil? (:width shape))
|
||||
|
@ -112,61 +113,64 @@
|
|||
(defn- check-parent-children
|
||||
"Validate parent and children exists, and the link is bidirectional."
|
||||
[shape file page]
|
||||
(let [parent (ctst/get-shape page (:parent-id shape))]
|
||||
(let [parent (ctst/get-shape page (:parent-id shape))
|
||||
shape-id (:id shape)
|
||||
shapes (:shapes shape)]
|
||||
|
||||
(if (nil? parent)
|
||||
(report-error :parent-not-found
|
||||
(str/ffmt "Parent % not found" (:parent-id shape))
|
||||
shape file page)
|
||||
(do
|
||||
(when-not (cfh/root? shape)
|
||||
(when-not (some #{(:id shape)} (:shapes parent))
|
||||
(when-not (some #(= shape-id %) (:shapes parent))
|
||||
(report-error :child-not-in-parent
|
||||
(str/ffmt "Shape % not in parent's children list" (:id shape))
|
||||
(str/ffmt "Shape % not in parent's children list" shape-id)
|
||||
shape file page)))
|
||||
|
||||
(when-not (= (count (:shapes shape)) (count (distinct (:shapes shape))))
|
||||
(when-not (= (count shapes) (count (distinct shapes)))
|
||||
(report-error :duplicated-children
|
||||
(str/ffmt "Shape % has duplicated children" (:id shape))
|
||||
(str/ffmt "Shape % has duplicated children" shape-id)
|
||||
shape file page))
|
||||
|
||||
(doseq [child-id (:shapes shape)]
|
||||
(doseq [child-id shapes]
|
||||
(let [child (ctst/get-shape page child-id)]
|
||||
(if (nil? child)
|
||||
(report-error :child-not-found
|
||||
(str/ffmt "Child % not found in parent %" child-id (:id shape))
|
||||
(str/ffmt "Child % not found in parent %" child-id shape-id)
|
||||
shape file page
|
||||
:parent-id (:id shape)
|
||||
:parent-id shape-id
|
||||
:child-id child-id)
|
||||
(when (not= (:parent-id child) (:id shape))
|
||||
(when (not= (:parent-id child) shape-id)
|
||||
(report-error :invalid-parent
|
||||
(str/ffmt "Child % has invalid parent %" child-id (:id shape))
|
||||
(str/ffmt "Child % has invalid parent %" child-id shape-id)
|
||||
child file page
|
||||
:parent-id (:id shape))))))))))
|
||||
:parent-id shape-id)))))))))
|
||||
|
||||
(defn- check-frame
|
||||
"Validate that the frame-id shape exists and is indeed a frame. Also
|
||||
it must point to the parent shape (if this is a frame) or to the
|
||||
frame-id of the parent (if not)."
|
||||
[shape file page]
|
||||
(let [frame (ctst/get-shape page (:frame-id shape))]
|
||||
[{:keys [frame-id] :as shape} file page]
|
||||
(let [frame (ctst/get-shape page frame-id)]
|
||||
(if (nil? frame)
|
||||
(report-error :frame-not-found
|
||||
(str/ffmt "Frame % not found" (:frame-id shape))
|
||||
(str/ffmt "Frame % not found" frame-id)
|
||||
shape file page)
|
||||
(if (not= (:type frame) :frame)
|
||||
(report-error :invalid-frame
|
||||
(str/ffmt "Frame % is not actually a frame" (:frame-id shape))
|
||||
(str/ffmt "Frame % is not actually a frame" frame-id)
|
||||
shape file page)
|
||||
(let [parent (ctst/get-shape page (:parent-id shape))]
|
||||
(when (some? parent)
|
||||
(if (= (:type parent) :frame)
|
||||
(when-not (= (:frame-id shape) (:id parent))
|
||||
(when-not (= frame-id (:id parent))
|
||||
(report-error :invalid-frame
|
||||
(str/ffmt "Frame-id should point to parent %" (:id parent))
|
||||
shape file page))
|
||||
(when-not (= (:frame-id shape) (:frame-id parent))
|
||||
(when-not (= frame-id (:frame-id parent))
|
||||
(report-error :invalid-frame
|
||||
(str/ffmt "Frame-id should point to parent frame %" (:frame-id parent))
|
||||
(str/ffmt "Frame-id should point to parent frame %" frame-id)
|
||||
shape file page)))))))))
|
||||
|
||||
(defn- check-component-main-head
|
||||
|
@ -289,8 +293,7 @@
|
|||
(check-component-main-head shape file page libraries)
|
||||
(check-component-root shape file page)
|
||||
(check-component-not-ref shape file page)
|
||||
(doseq [child-id (:shapes shape)]
|
||||
(check-shape child-id file page libraries :context :main-top)))
|
||||
(run! #(check-shape % file page libraries :context :main-top) (:shapes shape)))
|
||||
|
||||
(defn- check-shape-main-root-nested
|
||||
"Root shape of a nested main instance
|
||||
|
@ -301,8 +304,7 @@
|
|||
(check-component-main-head shape file page libraries)
|
||||
(check-component-not-root shape file page)
|
||||
(check-component-not-ref shape file page)
|
||||
(doseq [child-id (:shapes shape)]
|
||||
(check-shape child-id file page libraries :context :main-nested)))
|
||||
(run! #(check-shape % file page libraries :context :main-nested) (:shapes shape)))
|
||||
|
||||
(defn- check-shape-copy-root-top
|
||||
"Root shape of a top copy instance
|
||||
|
@ -314,8 +316,7 @@
|
|||
(check-component-not-main-head shape file page libraries)
|
||||
(check-component-root shape file page)
|
||||
(check-component-ref shape file page libraries)
|
||||
(doseq [child-id (:shapes shape)]
|
||||
(check-shape child-id file page libraries :context :copy-top)))
|
||||
(run! #(check-shape % file page libraries :context :copy-top) (:shapes shape)))
|
||||
|
||||
(defn- check-shape-copy-root-nested
|
||||
"Root shape of a nested copy instance
|
||||
|
@ -326,8 +327,7 @@
|
|||
(check-component-not-main-head shape file page libraries)
|
||||
(check-component-not-root shape file page)
|
||||
(check-component-ref shape file page libraries)
|
||||
(doseq [child-id (:shapes shape)]
|
||||
(check-shape child-id file page libraries :context :copy-nested)))
|
||||
(run! #(check-shape % file page libraries :context :copy-nested) (:shapes shape)))
|
||||
|
||||
(defn- check-shape-main-not-root
|
||||
"Not-root shape of a main instance (not any attribute)"
|
||||
|
@ -335,8 +335,7 @@
|
|||
(check-component-not-main-not-head shape file page)
|
||||
(check-component-not-root shape file page)
|
||||
(check-component-not-ref shape file page)
|
||||
(doseq [child-id (:shapes shape)]
|
||||
(check-shape child-id file page libraries :context :main-any)))
|
||||
(run! #(check-shape % file page libraries :context :main-any) (:shapes shape)))
|
||||
|
||||
(defn- check-shape-copy-not-root
|
||||
"Not-root shape of a copy instance :shape-ref"
|
||||
|
@ -344,8 +343,7 @@
|
|||
(check-component-not-main-not-head shape file page)
|
||||
(check-component-not-root shape file page)
|
||||
(check-component-ref shape file page libraries)
|
||||
(doseq [child-id (:shapes shape)]
|
||||
(check-shape child-id file page libraries :context :copy-any)))
|
||||
(run! #(check-shape % file page libraries :context :copy-any) (:shapes shape)))
|
||||
|
||||
(defn- check-shape-not-component
|
||||
"Shape is not in a component or is a fostered children (not any
|
||||
|
@ -354,8 +352,7 @@
|
|||
(check-component-not-main-not-head shape file page)
|
||||
(check-component-not-root shape file page)
|
||||
(check-component-not-ref shape file page)
|
||||
(doseq [child-id (:shapes shape)]
|
||||
(check-shape child-id file page libraries :context :not-component)))
|
||||
(run! #(check-shape % file page libraries :context :not-component) (:shapes shape)))
|
||||
|
||||
(defn- check-shape
|
||||
"Validate referential integrity and semantic coherence of
|
||||
|
@ -439,6 +436,11 @@
|
|||
"Objects list cannot be nil"
|
||||
component file nil)))
|
||||
|
||||
(defn- get-orphan-shapes
|
||||
[{:keys [objects] :as page}]
|
||||
(let [xf (comp (map #(contains? objects (:parent-id %)))
|
||||
(map :id))]
|
||||
(into [] xf (vals objects))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PUBLIC API: VALIDATION FUNCTIONS
|
||||
|
@ -451,18 +453,14 @@
|
|||
[{:keys [data features] :as file} libraries]
|
||||
(when (contains? features "components/v2")
|
||||
(binding [*errors* (volatile! [])]
|
||||
(doseq [page (filter :id (ctpl/pages-seq data))]
|
||||
(let [orphans (->> page
|
||||
:objects
|
||||
vals
|
||||
(filter #(not (contains? (:objects page) (:parent-id %))))
|
||||
(map :id))]
|
||||
(check-shape uuid/zero file page libraries)
|
||||
(doseq [shape-id orphans]
|
||||
(check-shape shape-id file page libraries))))
|
||||
|
||||
(doseq [component (vals (:components data))]
|
||||
(check-component component file))
|
||||
(doseq [page (filter :id (ctpl/pages-seq data))]
|
||||
(check-shape uuid/zero file page libraries)
|
||||
(->> (get-orphan-shapes page)
|
||||
(run! #(check-shape % file page libraries))))
|
||||
|
||||
(->> (vals (:components data))
|
||||
(run! #(check-component % file)))
|
||||
|
||||
(-> *errors* deref not-empty))))
|
||||
|
||||
|
|
|
@ -67,7 +67,8 @@
|
|||
([a b c d e f]
|
||||
(pos->Matrix a b c d e f)))
|
||||
|
||||
(def number-regex #"[+-]?\d*(\.\d+)?(e[+-]?\d+)?")
|
||||
(def number-regex
|
||||
#"[+-]?\d*(\.\d+)?([eE][+-]?\d+)?")
|
||||
|
||||
(defn str->matrix
|
||||
[matrix-str]
|
||||
|
@ -76,8 +77,8 @@
|
|||
(map (comp d/parse-double first)))]
|
||||
(apply matrix params)))
|
||||
|
||||
(sm/def! ::matrix-map
|
||||
[:map {:title "MatrixMap"}
|
||||
(def ^:private schema:matrix-attrs
|
||||
[:map {:title "MatrixAttrs"}
|
||||
[:a ::sm/safe-double]
|
||||
[:b ::sm/safe-double]
|
||||
[:c ::sm/safe-double]
|
||||
|
@ -85,6 +86,10 @@
|
|||
[:e ::sm/safe-double]
|
||||
[:f ::sm/safe-double]])
|
||||
|
||||
(def valid-matrix?
|
||||
(sm/lazy-validator
|
||||
[:and [:fn matrix?] schema:matrix-attrs]))
|
||||
|
||||
(sm/def! ::matrix
|
||||
(letfn [(decode [o]
|
||||
(if (map? o)
|
||||
|
@ -101,7 +106,7 @@
|
|||
(dm/get-prop o :f) ","))]
|
||||
|
||||
{:type ::matrix
|
||||
:pred matrix?
|
||||
:pred valid-matrix?
|
||||
:type-properties
|
||||
{:title "matrix"
|
||||
:description "Matrix instance"
|
||||
|
|
|
@ -41,12 +41,6 @@
|
|||
[v]
|
||||
(instance? Point v))
|
||||
|
||||
(sm/def! ::point-map
|
||||
[:map {:title "PointMap"}
|
||||
[:x ::sm/safe-number]
|
||||
[:y ::sm/safe-number]])
|
||||
|
||||
|
||||
;; FIXME: deprecated
|
||||
(s/def ::x ::us/safe-number)
|
||||
(s/def ::y ::us/safe-number)
|
||||
|
@ -57,6 +51,16 @@
|
|||
(s/def ::point
|
||||
(s/and ::point-attrs point?))
|
||||
|
||||
|
||||
(def ^:private schema:point-attrs
|
||||
[:map {:title "PointAttrs"}
|
||||
[:x ::sm/safe-number]
|
||||
[:y ::sm/safe-number]])
|
||||
|
||||
(def valid-point?
|
||||
(sm/lazy-validator
|
||||
[:and [:fn point?] schema:point-attrs]))
|
||||
|
||||
(sm/def! ::point
|
||||
(letfn [(decode [p]
|
||||
(if (map? p)
|
||||
|
@ -71,7 +75,7 @@
|
|||
(dm/get-prop p :y)))]
|
||||
|
||||
{:type ::point
|
||||
:pred point?
|
||||
:pred valid-point?
|
||||
:type-properties
|
||||
{:title "point"
|
||||
:description "Point"
|
||||
|
|
|
@ -12,6 +12,8 @@
|
|||
[app.common.geom.point :as gpt]
|
||||
[app.common.math :as mth]
|
||||
[app.common.record :as rc]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.schema.generators :as sg]
|
||||
[app.common.transit :as t]))
|
||||
|
||||
(rc/defrecord Rect [x y width height x1 y1 x2 y2])
|
||||
|
@ -66,6 +68,31 @@
|
|||
h (mth/max height 0.01)]
|
||||
(pos->Rect x y w h x y (+ x w) (+ y h))))))
|
||||
|
||||
(def ^:private schema:rect-attrs
|
||||
[:map {:title "RectAttrs"}
|
||||
[:x ::sm/safe-number]
|
||||
[:y ::sm/safe-number]
|
||||
[:width ::sm/safe-number]
|
||||
[:height ::sm/safe-number]
|
||||
[:x1 ::sm/safe-number]
|
||||
[:y1 ::sm/safe-number]
|
||||
[:x2 ::sm/safe-number]
|
||||
[:y2 ::sm/safe-number]])
|
||||
|
||||
(sm/define! ::rect
|
||||
[:and
|
||||
{:gen/gen (->> (sg/tuple (sg/small-double)
|
||||
(sg/small-double)
|
||||
(sg/small-double)
|
||||
(sg/small-double))
|
||||
(sg/fmap #(apply make-rect %)))}
|
||||
[:fn rect?]
|
||||
schema:rect-attrs])
|
||||
|
||||
(def valid-rect?
|
||||
(sm/lazy-validator
|
||||
[:and [:fn rect?] schema:rect-attrs]))
|
||||
|
||||
(def empty-rect
|
||||
(make-rect 0 0 0.01 0.01))
|
||||
|
||||
|
|
|
@ -9,9 +9,26 @@
|
|||
(:require
|
||||
[me.flowthing.pp :as pp]))
|
||||
|
||||
(def default-level 8)
|
||||
(def default-length 25)
|
||||
(def default-width 120)
|
||||
|
||||
#?(:clj
|
||||
(defn set-defaults
|
||||
[& {:keys [level width length]}]
|
||||
(when length
|
||||
(alter-var-root #'default-length (constantly length)))
|
||||
(when width
|
||||
(alter-var-root #'default-width (constantly width)))
|
||||
(when level
|
||||
(alter-var-root #'default-level (constantly level)))
|
||||
nil))
|
||||
|
||||
(defn pprint
|
||||
[expr & {:keys [width level length]
|
||||
:or {width 120 level 8 length 25}}]
|
||||
:or {width default-width
|
||||
level default-level
|
||||
length default-length}}]
|
||||
(binding [*print-level* level
|
||||
*print-length* length]
|
||||
(pp/pprint expr {:max-width width})))
|
||||
|
|
|
@ -895,9 +895,10 @@
|
|||
|
||||
(defn map-nodes [mapfn node]
|
||||
(let [update-content
|
||||
(fn [content] (cond->> content
|
||||
(vector? content)
|
||||
(mapv (partial map-nodes mapfn))))]
|
||||
(fn [content]
|
||||
(cond->> content
|
||||
(vector? content)
|
||||
(mapv (partial map-nodes mapfn))))]
|
||||
|
||||
(cond-> node
|
||||
(map? node)
|
||||
|
@ -922,7 +923,8 @@
|
|||
value)))
|
||||
|
||||
(defn fix-default-values
|
||||
"Gives values to some SVG elements which defaults won't work when imported into the platform"
|
||||
"Gives values to some SVG elements which defaults won't work when
|
||||
imported into the platform"
|
||||
[svg-data]
|
||||
(let [add-defaults
|
||||
(fn [{:keys [tag attrs] :as node}]
|
||||
|
@ -984,29 +986,38 @@
|
|||
(fix-percent-attrs-viewbox [attrs]
|
||||
(d/mapm fix-percent-attr-viewbox attrs))
|
||||
|
||||
(fix-percent-attr-numeric [_ attr-val]
|
||||
(let [is-percent? (str/ends-with? attr-val "%")]
|
||||
(if is-percent?
|
||||
(str (let [attr-num (d/parse-double (str/rtrim attr-val "%"))]
|
||||
(/ attr-num 100)))
|
||||
attr-val)))
|
||||
(fix-percent-attr-numeric-val [val]
|
||||
(let [val (d/parse-double (str/rtrim val "%"))]
|
||||
(str (/ val 100))))
|
||||
|
||||
(fix-percent-attrs-numeric [attrs]
|
||||
(d/mapm fix-percent-attr-numeric attrs))
|
||||
(fix-percent-attr-numeric [attrs key val]
|
||||
(cond
|
||||
(= key :style)
|
||||
attrs
|
||||
|
||||
(str/starts-with? (d/name key) "data-")
|
||||
attrs
|
||||
|
||||
(str/ends-with? val "%")
|
||||
(assoc attrs key (fix-percent-attr-numeric-val val))
|
||||
|
||||
:else
|
||||
attrs))
|
||||
|
||||
(fix-percent-values [node]
|
||||
(let [units (or (get-in node [:attrs :filterUnits])
|
||||
(get-in node [:attrs :gradientUnits])
|
||||
(get-in node [:attrs :patternUnits])
|
||||
(get-in node [:attrs :clipUnits]))]
|
||||
|
||||
(cond-> node
|
||||
(or (= "objectBoundingBox" units) (nil? units))
|
||||
(update :attrs fix-percent-attrs-numeric)
|
||||
(update :attrs #(reduce-kv fix-percent-attr-numeric % %))
|
||||
|
||||
(not= "objectBoundingBox" units)
|
||||
(update :attrs fix-percent-attrs-viewbox))))]
|
||||
|
||||
(->> svg-data (map-nodes fix-percent-values)))))
|
||||
(map-nodes fix-percent-values svg-data))))
|
||||
|
||||
(defn collect-images [svg-data]
|
||||
(let [redfn (fn [acc {:keys [tag attrs]}]
|
||||
|
|
|
@ -193,7 +193,8 @@
|
|||
(defn create-group
|
||||
[name frame-id {:keys [x y width height offset-x offset-y] :as svg-data} {:keys [attrs]}]
|
||||
(let [transform (csvg/parse-transform (:transform attrs))
|
||||
attrs (-> (d/without-keys attrs csvg/inheritable-props)
|
||||
attrs (-> attrs
|
||||
(d/without-keys csvg/inheritable-props)
|
||||
(csvg/attrs->props))
|
||||
vbox (grc/make-rect offset-x offset-y width height)]
|
||||
(cts/setup-shape
|
||||
|
@ -304,6 +305,8 @@
|
|||
|
||||
rx (d/nilv r rx)
|
||||
ry (d/nilv r ry)
|
||||
rx (d/nilv rx 0)
|
||||
ry (d/nilv ry 0)
|
||||
|
||||
;; There are some svg circles in the internet that does not
|
||||
;; have cx and cy attrs, so we default them to 0
|
||||
|
|
|
@ -34,7 +34,7 @@
|
|||
|
||||
(defn pages-seq
|
||||
[fdata]
|
||||
(vals (:pages-index fdata)))
|
||||
(-> fdata :pages-index vals seq))
|
||||
|
||||
(defn update-page
|
||||
[file-data page-id f]
|
||||
|
|
|
@ -79,25 +79,6 @@
|
|||
(def text-align-types
|
||||
#{"left" "right" "center" "justify"})
|
||||
|
||||
(sm/define! ::selrect
|
||||
[:and
|
||||
{:title "Selrect"
|
||||
:gen/gen (->> (sg/tuple (sg/small-double)
|
||||
(sg/small-double)
|
||||
(sg/small-double)
|
||||
(sg/small-double))
|
||||
(sg/fmap #(apply grc/make-rect %)))}
|
||||
[:fn grc/rect?]
|
||||
[:map
|
||||
[:x ::sm/safe-number]
|
||||
[:y ::sm/safe-number]
|
||||
[:x1 ::sm/safe-number]
|
||||
[:x2 ::sm/safe-number]
|
||||
[:y1 ::sm/safe-number]
|
||||
[:y2 ::sm/safe-number]
|
||||
[:width ::sm/safe-number]
|
||||
[:height ::sm/safe-number]]])
|
||||
|
||||
(sm/define! ::points
|
||||
[:vector {:gen/max 4 :gen/min 4} ::gpt/point])
|
||||
|
||||
|
@ -133,7 +114,7 @@
|
|||
[:id ::sm/uuid]
|
||||
[:name :string]
|
||||
[:type [::sm/one-of shape-types]]
|
||||
[:selrect ::selrect]
|
||||
[:selrect ::grc/rect]
|
||||
[:points ::points]
|
||||
[:transform ::gmt/matrix]
|
||||
[:transform-inverse ::gmt/matrix]
|
||||
|
@ -156,7 +137,7 @@
|
|||
[:main-instance {:optional true} :boolean]
|
||||
[:remote-synced {:optional true} :boolean]
|
||||
[:shape-ref {:optional true} ::sm/uuid]
|
||||
[:selrect {:optional true} ::selrect]
|
||||
[:selrect {:optional true} ::grc/rect]
|
||||
[:points {:optional true} ::points]
|
||||
[:blocked {:optional true} :boolean]
|
||||
[:collapsed {:optional true} :boolean]
|
||||
|
|
|
@ -39,18 +39,7 @@
|
|||
|
||||
(def ^:private svgo-config
|
||||
{:multipass false
|
||||
:plugins
|
||||
[{:name "safePreset"
|
||||
:params {:overrides
|
||||
{:convertColors
|
||||
{:names2hex true
|
||||
:shorthex false
|
||||
:shortname false}
|
||||
:convertTransform
|
||||
{:matrixToTransform false
|
||||
:convertToShorts false
|
||||
:transformPrecision 4
|
||||
:leadingZero false}}}}]})
|
||||
:plugins ["safeAndFastPreset"]})
|
||||
|
||||
(defn svg->clj
|
||||
[[name text]]
|
||||
|
|
|
@ -72,13 +72,15 @@
|
|||
(watch [it state _]
|
||||
(let [page-id (:current-page-id state)
|
||||
objects (wsh/lookup-page-objects state page-id)
|
||||
shapes (->> shapes (remove #(dm/get-in objects [% :blocked])))
|
||||
shapes (->> shapes
|
||||
(remove #(dm/get-in objects [% :blocked]))
|
||||
(cfh/order-by-indexed-shapes objects))
|
||||
|
||||
changes (-> (pcb/empty-changes it page-id)
|
||||
(pcb/with-objects objects))
|
||||
changes (cfsh/prepare-move-shapes-into-frame changes
|
||||
frame-id
|
||||
shapes
|
||||
objects)]
|
||||
|
||||
changes (cfsh/prepare-move-shapes-into-frame changes frame-id shapes objects)]
|
||||
|
||||
(if (some? changes)
|
||||
(rx/of (dch/commit-changes changes))
|
||||
(rx/empty))))))
|
||||
|
|
Loading…
Add table
Reference in a new issue