3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-18 23:56:11 +02:00
Code Issues Projects Releases Packages Wiki Activity

Merge pull request #6096 from penpot/niwinz-develop-token-fixes-3

Browse source 
✨ Add several improvements and fixes to tokens (part 3)
This commit is contained in:
Andrey Antukh 2025-03-19 12:30:05 +01:00 • committed by GitHub
commit 8fa24de3d4
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
11 changed files with 290 additions and 385 deletions
Download patch file Download diff file Expand all files Collapse all files

16
common/src/app/common/schema.cljc
View file

@ -1019,26 +1019,26 @@
(def valid-text? (def valid-text?
(validator ::text)) (validator ::text))
(def check-safe-int! (def check-safe-int
(check-fn ::safe-int)) (check-fn ::safe-int))
(def check-set-of-strings! (def check-set-of-strings
(check-fn ::set-of-strings)) (check-fn ::set-of-strings))
(def check-email! (def check-email
(check-fn ::email)) (check-fn ::email))
(def check-uuid! (def check-uuid
(check-fn ::uuid :hint "expected valid uuid instance")) (check-fn ::uuid :hint "expected valid uuid instance"))
(def check-string! (def check-string
(check-fn :string :hint "expected string")) (check-fn :string :hint "expected string"))
(def check-coll-of-uuid! (def check-coll-of-uuid
(check-fn ::coll-of-uuid)) (check-fn ::coll-of-uuid))
(def check-set-of-uuid! (def check-set-of-uuid
(check-fn ::set-of-uuid)) (check-fn ::set-of-uuid))
(def check-set-of-emails! (def check-set-of-emails
(check-fn [::set ::email])) (check-fn [::set ::email]))

306
common/src/app/common/types/shape/interactions.cljc
View file

@ -7,7 +7,6 @@
(ns app.common.types.shape.interactions (ns app.common.types.shape.interactions
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.helpers :as cfh] [app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.shapes.bounds :as gsb] [app.common.geom.shapes.bounds :as gsb]
@ -180,7 +179,7 @@
(sm/register! ::interaction schema:interaction) (sm/register! ::interaction schema:interaction)
(def check-interaction! (def check-interaction
(sm/check-fn schema:interaction)) (sm/check-fn schema:interaction))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -203,18 +202,13 @@
(defn set-event-type (defn set-event-type
[interaction event-type shape] [interaction event-type shape]
(dm/assert! (assert (check-interaction interaction))
"Should be an interraction map" (assert (contains? event-types event-type)
(check-interaction! interaction)) "should be a valid event type")
(dm/assert! (assert (or (not= event-type :after-delay)
"Should be a valid event type" (cfh/frame-shape? shape))
(contains? event-types event-type)) "the `:after-delay` event type incompatible with not frame shapes")
(dm/assert!
"The `:after-delay` event type incompatible with not frame shapes"
(or (not= event-type :after-delay)
(cfh/frame-shape? shape)))
(if (= (:event-type interaction) event-type) (if (= (:event-type interaction) event-type)
interaction interaction
@ -230,14 +224,9 @@
(defn set-action-type (defn set-action-type
[interaction action-type] [interaction action-type]
(assert (check-interaction interaction))
(dm/assert! (assert (contains? action-types action-type)
"Should be an interraction map" "Should be a valid event type")
(check-interaction! interaction))
(dm/assert!
"Should be a valid event type"
(contains? action-types action-type))
(let [new-interaction (let [new-interaction
(if (= (:action-type interaction) action-type) (if (= (:action-type interaction) action-type)
@ -284,18 +273,10 @@
(defn set-delay (defn set-delay
[interaction delay] [interaction delay]
(assert (check-interaction interaction))
(dm/assert! (assert (sm/check-safe-int delay))
"expected valid interaction map" (assert (has-delay interaction)
(check-interaction! interaction)) "expected compatible interaction event type")
(dm/assert!
"expected valid delay"
(sm/check-safe-int! delay))
(dm/assert!
"expected compatible interaction event type"
(has-delay interaction))
(assoc interaction :delay delay)) (assoc interaction :delay delay))
@ -315,14 +296,9 @@
(defn set-destination (defn set-destination
[interaction destination] [interaction destination]
(assert (check-interaction interaction))
(dm/assert! (assert (has-destination interaction)
"expected valid interaction map" "expected compatible interaction event type")
(check-interaction! interaction))
(dm/assert!
"expected compatible interaction event type"
(has-destination interaction))
(cond-> interaction (cond-> interaction
:always :always
@ -340,17 +316,11 @@
(defn set-preserve-scroll (defn set-preserve-scroll
[interaction preserve-scroll] [interaction preserve-scroll]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (boolean? preserve-scroll)
(check-interaction! interaction)) "expected boolean for `preserve-scroll`")
(assert (has-preserve-scroll interaction)
(dm/assert! "expected compatible interaction map with preserve-scroll")
"expected boolean for `preserve-scroll`"
(boolean? preserve-scroll))
(dm/assert!
"expected compatible interaction map with preserve-scroll"
(has-preserve-scroll interaction))
(assoc interaction :preserve-scroll preserve-scroll)) (assoc interaction :preserve-scroll preserve-scroll))
@ -361,17 +331,11 @@
(defn set-url (defn set-url
[interaction url] [interaction url]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (string? url)
(check-interaction! interaction)) "expected a string for `url`")
(assert (has-url interaction)
(dm/assert! "expected compatible interaction map with url param")
"expected a string for `url`"
(string? url))
(dm/assert!
"expected compatible interaction map with url param"
(has-url interaction))
(assoc interaction :url url)) (assoc interaction :url url))
@ -382,17 +346,12 @@
(defn set-overlay-pos-type (defn set-overlay-pos-type
[interaction overlay-pos-type shape objects] [interaction overlay-pos-type shape objects]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map"
(check-interaction! interaction))
(dm/assert! (assert (contains? overlay-positioning-types overlay-pos-type)
"expected valid overlay positioning type" "expected valid overlay positioning type")
(contains? overlay-positioning-types overlay-pos-type)) (assert (has-overlay-opts interaction)
"expected compatible interaction map")
(dm/assert!
"expected compatible interaction map"
(has-overlay-opts interaction))
(assoc interaction (assoc interaction
:overlay-pos-type overlay-pos-type :overlay-pos-type overlay-pos-type
@ -403,17 +362,11 @@
(defn toggle-overlay-pos-type (defn toggle-overlay-pos-type
[interaction overlay-pos-type shape objects] [interaction overlay-pos-type shape objects]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (contains? overlay-positioning-types overlay-pos-type)
(check-interaction! interaction)) "expected valid overlay positioning type")
(assert (has-overlay-opts interaction)
(dm/assert! "expected compatible interaction map")
"expected valid overlay positioning type"
(contains? overlay-positioning-types overlay-pos-type))
(dm/assert!
"expected compatible interaction map"
(has-overlay-opts interaction))
(let [new-pos-type (if (= (:overlay-pos-type interaction) overlay-pos-type) (let [new-pos-type (if (= (:overlay-pos-type interaction) overlay-pos-type)
:manual :manual
@ -427,17 +380,12 @@
(defn set-overlay-position (defn set-overlay-position
[interaction overlay-position] [interaction overlay-position]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (gpt/point? overlay-position)
(check-interaction! interaction)) "expected valid overlay position")
(assert (has-overlay-opts interaction)
"expected compatible interaction map")
(dm/assert!
"expected valid overlay position"
(gpt/point? overlay-position))
(dm/assert!
"expected compatible interaction map"
(has-overlay-opts interaction))
(assoc interaction (assoc interaction
:overlay-pos-type :manual :overlay-pos-type :manual
@ -446,52 +394,34 @@
(defn set-close-click-outside (defn set-close-click-outside
[interaction close-click-outside] [interaction close-click-outside]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (boolean? close-click-outside)
(check-interaction! interaction)) "expected boolean value for `close-click-outside`")
(assert (has-overlay-opts interaction)
(dm/assert! "expected compatible interaction map")
"expected boolean value for `close-click-outside`"
(boolean? close-click-outside))
(dm/assert!
"expected compatible interaction map"
(has-overlay-opts interaction))
(assoc interaction :close-click-outside close-click-outside)) (assoc interaction :close-click-outside close-click-outside))
(defn set-background-overlay (defn set-background-overlay
[interaction background-overlay] [interaction background-overlay]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (boolean? background-overlay)
(check-interaction! interaction)) "expected boolean value for `background-overlay`")
(assert (has-overlay-opts interaction)
(dm/assert! "expected compatible interaction map")
"expected boolean value for `background-overlay`"
(boolean? background-overlay))
(dm/assert!
"expected compatible interaction map"
(has-overlay-opts interaction))
(assoc interaction :background-overlay background-overlay)) (assoc interaction :background-overlay background-overlay))
(defn set-position-relative-to (defn set-position-relative-to
[interaction position-relative-to] [interaction position-relative-to]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (or (nil? position-relative-to)
(check-interaction! interaction)) (uuid? position-relative-to))
"expected valid uuid for `position-relative-to`")
(dm/assert! (assert (has-overlay-opts interaction)
"expected valid uuid for `position-relative-to`" "expected compatible interaction map")
(or (nil? position-relative-to)
(uuid? position-relative-to)))
(dm/assert!
"expected compatible interaction map"
(has-overlay-opts interaction))
(assoc interaction :position-relative-to position-relative-to)) (assoc interaction :position-relative-to position-relative-to))
@ -519,13 +449,9 @@
frame-offset] ;; if this interaction starts in a frame opened frame-offset] ;; if this interaction starts in a frame opened
;; on another interaction, this is the position ;; on another interaction, this is the position
;; of that frame ;; of that frame
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (has-overlay-opts interaction)
(check-interaction! interaction)) "expected compatible interaction map")
(dm/assert!
"expected compatible interaction map"
(has-overlay-opts interaction))
(let [;; When the interactive item is inside a nested frame we need to add to the offset the position (let [;; When the interactive item is inside a nested frame we need to add to the offset the position
;; of the parent-frame otherwise the position won't match ;; of the parent-frame otherwise the position won't match
@ -617,22 +543,15 @@
(defn set-animation-type (defn set-animation-type
[interaction animation-type] [interaction animation-type]
(dm/assert!
"expected valid interaction map"
(check-interaction! interaction))
(dm/assert! (assert (check-interaction interaction))
"expected valid value for `animation-type`" (assert (or (nil? animation-type)
(or (nil? animation-type) (contains? animation-types animation-type))
(contains? animation-types animation-type))) "expected valid value for `animation-type`")
(assert (has-animation? interaction)
(dm/assert! "expected interaction map compatible with animation")
"expected interaction map compatible with animation" (assert (allowed-animation? (:action-type interaction) animation-type)
(has-animation? interaction)) "expected allowed animation type")
(dm/assert!
"expected allowed animation type"
(allowed-animation? (:action-type interaction) animation-type))
(if (= (-> interaction :animation :animation-type) animation-type) (if (= (-> interaction :animation :animation-type) animation-type)
interaction interaction
@ -668,17 +587,10 @@
(defn set-duration (defn set-duration
[interaction duration] [interaction duration]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (sm/check-safe-int duration))
(check-interaction! interaction)) (assert (has-duration? interaction)
"expected compatible interaction map")
(dm/assert!
"expected valid duration"
(sm/check-safe-int! duration))
(dm/assert!
"expected compatible interaction map"
(has-duration? interaction))
(update interaction :animation assoc :duration duration)) (update interaction :animation assoc :duration duration))
@ -689,17 +601,11 @@
(defn set-easing (defn set-easing
[interaction easing] [interaction easing]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (contains? easing-types easing)
(check-interaction! interaction)) "expected valid easing")
(assert (has-easing? interaction)
(dm/assert! "expected compatible interaction map")
"expected valid easing"
(contains? easing-types easing))
(dm/assert!
"expected compatible interaction map"
(has-easing? interaction))
(update interaction :animation assoc :easing easing)) (update interaction :animation assoc :easing easing))
@ -712,17 +618,11 @@
(defn set-way (defn set-way
[interaction way] [interaction way]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (contains? way-types way)
(check-interaction! interaction)) "expected valid way")
(assert (has-way? interaction)
(dm/assert! "expected compatible interaction map")
"expected valid way"
(contains? way-types way))
(dm/assert!
"expected compatible interaction map"
(has-way? interaction))
(update interaction :animation assoc :way way)) (update interaction :animation assoc :way way))
@ -733,26 +633,20 @@
(defn set-direction (defn set-direction
[interaction direction] [interaction direction]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (contains? direction-types direction)
(check-interaction! interaction)) "expected valid direction")
(dm/assert! (assert (has-direction? interaction)
"expected valid direction" "expected compatible interaction map")
(contains? direction-types direction))
(dm/assert!
"expected compatible interaction map"
(has-direction? interaction))
(update interaction :animation assoc :direction direction)) (update interaction :animation assoc :direction direction))
(defn invert-direction (defn invert-direction
[animation] [animation]
(dm/assert! (assert (or (nil? animation)
"expected valid animation map" (check-animation! animation))
(or (nil? animation) "expected valid animation map")
(check-animation! animation)))
(case (:direction animation) (case (:direction animation)
:right :right
@ -768,24 +662,18 @@
(defn has-offset-effect? (defn has-offset-effect?
[interaction] [interaction]
; Offset-effect is ignored in slide animations of overlay actions ;; Offset-effect is ignored in slide animations of overlay actions
(and (= (:action-type interaction) :navigate) (and (= (:action-type interaction) :navigate)
(= (-> interaction :animation :animation-type) :slide))) (= (-> interaction :animation :animation-type) :slide)))
(defn set-offset-effect (defn set-offset-effect
[interaction offset-effect] [interaction offset-effect]
(dm/assert! (assert (check-interaction interaction))
"expected valid interaction map" (assert (boolean? offset-effect)
(check-interaction! interaction)) "expected valid boolean for `offset-effect`")
(assert (has-offset-effect? interaction)
(dm/assert! "expected compatible interaction map")
"expected valid boolean for `offset-effect`"
(boolean? offset-effect))
(dm/assert!
"expected compatible interaction map"
(has-offset-effect? interaction))
(update interaction :animation assoc :offset-effect offset-effect)) (update interaction :animation assoc :offset-effect offset-effect))

4
frontend/src/app/main/data/comments.cljs
View file

@ -648,9 +648,7 @@
(defn detach-comment-thread (defn detach-comment-thread
"Detach comment threads that are inside a frame when that frame is deleted" "Detach comment threads that are inside a frame when that frame is deleted"
[ids] [ids]
(dm/assert! (assert (sm/check-coll-of-uuid ids))
"expected a valid coll of uuid's"
(sm/check-coll-of-uuid! ids))
(ptk/reify ::detach-comment-thread (ptk/reify ::detach-comment-thread
ptk/WatchEvent ptk/WatchEvent

7
frontend/src/app/main/data/dashboard.cljs
View file

@ -536,11 +536,8 @@
(defn move-files (defn move-files
[{:keys [ids project-id] :as params}] [{:keys [ids project-id] :as params}]
(dm/assert! (uuid? project-id)) (assert (uuid? project-id))
(assert (sm/check-set-of-uuid ids))
(dm/assert!
"expected a valid set of uuids"
(sm/check-set-of-uuid! ids))
(ptk/reify ::move-files (ptk/reify ::move-files
ev/Event ev/Event

29
frontend/src/app/main/data/team.cljs
View file

@ -350,12 +350,10 @@
(defn create-invitations (defn create-invitations
[{:keys [emails role team-id resend?] :as params}] [{:keys [emails role team-id resend?] :as params}]
(dm/assert! (keyword? role))
(dm/assert! (uuid? team-id))
(dm/assert! (assert (keyword? role))
"expected a valid set of emails" (assert (uuid? team-id))
(sm/check-set-of-emails! emails)) (assert (sm/check-set-of-emails emails))
(ptk/reify ::create-invitations (ptk/reify ::create-invitations
ev/Event ev/Event
@ -376,11 +374,8 @@
(defn copy-invitation-link (defn copy-invitation-link
[{:keys [email team-id] :as params}] [{:keys [email team-id] :as params}]
(dm/assert! (assert (sm/check-email email))
"expected a valid email" (assert (uuid? team-id))
(sm/check-email! email))
(dm/assert! (uuid? team-id))
(ptk/reify ::copy-invitation-link (ptk/reify ::copy-invitation-link
IDeref IDeref
@ -406,12 +401,9 @@
(defn update-invitation-role (defn update-invitation-role
[{:keys [email team-id role] :as params}] [{:keys [email team-id role] :as params}]
(dm/assert! (assert (sm/check-email email))
"expected a valid email" (assert (uuid? team-id))
(sm/check-email! email)) (assert (contains? ctt/valid-roles role))
(dm/assert! (uuid? team-id))
(dm/assert! (contains? ctt/valid-roles role))
(ptk/reify ::update-invitation-role (ptk/reify ::update-invitation-role
IDeref IDeref
@ -428,8 +420,9 @@
(defn delete-invitation (defn delete-invitation
[{:keys [email team-id] :as params}] [{:keys [email team-id] :as params}]
(dm/assert! (sm/check-email! email)) (assert (sm/check-email email))
(dm/assert! (uuid? team-id)) (assert (uuid? team-id))
(ptk/reify ::delete-invitation (ptk/reify ::delete-invitation
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ _] (watch [_ _ _]

4
frontend/src/app/main/data/workspace/comments.cljs
View file

@ -134,9 +134,7 @@
;; Move comment threads that are inside a frame when that frame is moved" ;; Move comment threads that are inside a frame when that frame is moved"
(defmethod ptk/resolve ::move-frame-comment-threads (defmethod ptk/resolve ::move-frame-comment-threads
[_ ids] [_ ids]
(dm/assert! (assert (sm/check-coll-of-uuid ids))
"expected a valid coll of uuid's"
(sm/check-coll-of-uuid! ids))
(ptk/reify ::move-frame-comment-threads (ptk/reify ::move-frame-comment-threads
ptk/WatchEvent ptk/WatchEvent

147
frontend/src/app/main/data/workspace/modifiers.cljs
View file

@ -533,69 +533,11 @@
(assoc state :workspace-modifiers modif-tree))))) (assoc state :workspace-modifiers modif-tree)))))
(defn apply-modifiers (def ^:private xf:without-uuid-zero
([] (remove #(= % uuid/zero)))
(apply-modifiers nil))
([{:keys [modifiers undo-transation? stack-undo? ignore-constraints (def ^:private transform-attrs
ignore-snap-pixel ignore-touched undo-group page-id] #{:selrect
:or {undo-transation? true stack-undo? false ignore-constraints false
ignore-snap-pixel false ignore-touched false}}]
(ptk/reify ::apply-modifiers
ptk/WatchEvent
(watch [_ state _]
(let [text-modifiers (get state :workspace-text-modifier)
page-id (or page-id (:current-page-id state))
objects (dsh/lookup-page-objects state page-id)
object-modifiers
(if (some? modifiers)
(calculate-modifiers state ignore-constraints ignore-snap-pixel modifiers page-id)
(get state :workspace-modifiers))
ids
(into []
(remove #(= % uuid/zero))
(keys object-modifiers))
ids-with-children
(into ids
(mapcat (partial cfh/get-children-ids objects))
ids)
ignore-tree
(calculate-ignore-tree object-modifiers objects)
undo-id (js/Symbol)]
(rx/concat
(if undo-transation?
(rx/of (dwu/start-undo-transaction undo-id))
(rx/empty))
(rx/of (ptk/event ::dwg/move-frame-guides {:ids ids-with-children :modifiers object-modifiers})
(ptk/event ::dwcm/move-frame-comment-threads ids-with-children)
(dwsh/update-shapes
ids
(fn [shape]
(let [modif (get-in object-modifiers [(:id shape) :modifiers])
text-shape? (cfh/text-shape? shape)
position-data (when text-shape?
(dm/get-in text-modifiers [(:id shape) :position-data]))]
(-> shape
(gsh/transform-shape modif)
(cond-> (d/not-empty? position-data)
(assoc-position-data position-data shape))
(cond-> text-shape?
(update-grow-type shape)))))
{:reg-objects? true
:stack-undo? stack-undo?
:ignore-tree ignore-tree
:ignore-touched ignore-touched
:undo-group undo-group
:page-id page-id
;; Attributes that can change in the transform. This way we don't have to check
;; all the attributes
:attrs [:selrect
:points :points
:x :x
:y :y
@ -619,22 +561,93 @@
:layout-gap :layout-gap
:layout-padding :layout-padding
:layout-item-h-sizing :layout-item-h-sizing
:layout-item-margin
:layout-item-max-h :layout-item-max-h
:layout-item-max-w :layout-item-max-w
:layout-item-min-h :layout-item-min-h
:layout-item-min-w :layout-item-min-w
:layout-item-v-sizing :layout-item-v-sizing
:layout-padding-type :layout-padding-type
:layout-gap
:layout-item-margin :layout-item-margin
:layout-item-margin-type :layout-item-margin-type
:layout-grid-cells :layout-grid-cells
:layout-grid-columns :layout-grid-columns
:layout-grid-rows]}) :layout-grid-rows})
;; We've applied the text-modifier so we can dissoc the temporary data
(defn apply-modifiers*
"A lower-level version of apply-modifiers, that expects receive ready
to use objects, object-modifiers and text-modifiers."
[objects object-modifiers text-modifiers options]
(ptk/reify ::apply-modifiers*
ptk/WatchEvent
(watch [_ _ _]
(let [ids
(into [] xf:without-uuid-zero (keys object-modifiers))
ids-with-children
(into ids
(mapcat (partial cfh/get-children-ids objects))
ids)
ignore-tree
(calculate-ignore-tree object-modifiers objects)
options
(-> options
(assoc :reg-objects? true)
(assoc :ignore-tree ignore-tree)
;; Attributes that can change in the transform. This
;; way we don't have to check all the attributes
(assoc :attrs transform-attrs))
update-shape
(fn [shape]
(let [shape-id (dm/get-prop shape :id)
modifiers (dm/get-in object-modifiers [shape-id :modifiers])
text-shape? (cfh/text-shape? shape)
pos-data (when ^boolean text-shape?
(dm/get-in text-modifiers [shape-id :position-data]))]
(-> shape
(gsh/transform-shape modifiers)
(cond-> (d/not-empty? pos-data)
(assoc-position-data pos-data shape))
(cond-> text-shape?
(update-grow-type shape)))))]
(rx/of (ptk/event ::dwg/move-frame-guides {:ids ids-with-children :modifiers object-modifiers})
(ptk/event ::dwcm/move-frame-comment-threads ids-with-children)
(dwsh/update-shapes ids update-shape options))))))
(defn apply-modifiers
([]
(apply-modifiers nil))
([{:keys [modifiers undo-transation? ignore-constraints
ignore-snap-pixel page-id]
:or {undo-transation? true ignore-constraints false
ignore-snap-pixel false}
:as options}]
(ptk/reify ::apply-modifiers
ptk/WatchEvent
(watch [_ state _]
(let [text-modifiers (get state :workspace-text-modifier)
page-id (or page-id (:current-page-id state))
objects (dsh/lookup-page-objects state page-id)
object-modifiers
(if (some? modifiers)
(calculate-modifiers state ignore-constraints ignore-snap-pixel modifiers page-id)
(get state :workspace-modifiers))
undo-id
(js/Symbol)]
(rx/concat
(if undo-transation?
(rx/of (dwu/start-undo-transaction undo-id))
(rx/empty))
(rx/of (apply-modifiers* objects object-modifiers text-modifiers options)
(fn [state] (fn [state]
(update state :workspace-text-modifier #(apply dissoc % ids)))) (let [ids (into [] xf:without-uuid-zero (keys object-modifiers))]
(update state :workspace-text-modifier #(apply dissoc % ids)))))
(if (nil? modifiers) (if (nil? modifiers)
(rx/of (clear-local-transform)) (rx/of (clear-local-transform))
(rx/empty)) (rx/empty))

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

@ -51,11 +51,8 @@
([ids update-fn {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id ignore-touched undo-group with-objects? changed-sub-attr] ([ids update-fn {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id ignore-touched undo-group with-objects? changed-sub-attr]
:or {reg-objects? false save-undo? true stack-undo? false ignore-touched false with-objects? false}}] :or {reg-objects? false save-undo? true stack-undo? false ignore-touched false with-objects? false}}]
(dm/assert! (assert (sm/check-coll-of-uuid ids))
"expected a valid coll of uuid's" (assert (fn? update-fn))
(sm/check-coll-of-uuid! ids))
(dm/assert! (fn? update-fn))
(ptk/reify ::update-shapes (ptk/reify ::update-shapes
ptk/WatchEvent ptk/WatchEvent
@ -162,9 +159,7 @@
([ids] (delete-shapes nil ids {})) ([ids] (delete-shapes nil ids {}))
([page-id ids] (delete-shapes page-id ids {})) ([page-id ids] (delete-shapes page-id ids {}))
([page-id ids options] ([page-id ids options]
(dm/assert! (assert (sm/check-set-of-uuid ids))
"expected a valid set of uuid's"
(sm/check-set-of-uuid! ids))
(ptk/reify ::delete-shapes (ptk/reify ::delete-shapes
ptk/WatchEvent ptk/WatchEvent

38
frontend/src/app/main/data/workspace/transforms.cljs
View file

@ -340,35 +340,35 @@
(rx/filter (ptk/type? ::trigger-bounding-box-cloaking) stream))))))) (rx/filter (ptk/type? ::trigger-bounding-box-cloaking) stream)))))))
(defn update-dimensions (defn update-dimensions
"Change size of shapes, from the sideber options form. "Change size of shapes, from the sidebar options form
Will ignore pixel snap used in the options side panel" (will ignore pixel snap)"
([ids attr value] (update-dimensions ids attr value nil)) ([ids attr value] (update-dimensions ids attr value nil))
([ids attr value options] ([ids attr value options]
(dm/assert! (number? value)) (assert (number? value))
(dm/assert! (assert (every? uuid? ids)
"expected valid coll of uuids" "expected valid coll of uuids")
(every? uuid? ids)) (assert (contains? #{:width :height} attr)
(dm/assert! "expected valid attr")
"expected valid attr"
(contains? #{:width :height} attr))
(ptk/reify ::update-dimensions (ptk/reify ::update-dimensions
ptk/UpdateEvent ptk/WatchEvent
(update [_ state] (watch [_ state _]
(let [page-id (or (get options :page-id) (let [page-id
(or (get options :page-id)
(get state :current-page-id)) (get state :current-page-id))
objects (dsh/lookup-page-objects state page-id) objects
(dsh/lookup-page-objects state page-id)
get-modifier get-modifier
(fn [shape] (ctm/change-dimensions-modifiers shape attr value)) (fn [shape]
(ctm/change-dimensions-modifiers shape attr value))
modif-tree modif-tree
(-> (dwm/build-modif-tree ids objects get-modifier) (-> (dwm/build-modif-tree ids objects get-modifier)
(gm/set-objects-modifiers objects))] (gm/set-objects-modifiers objects))]
(assoc state :workspace-modifiers modif-tree))) (rx/of (dwm/apply-modifiers* objects modif-tree nil options)))))))
ptk/WatchEvent
(watch [_ _ _]
(rx/of (dwm/apply-modifiers options))))))
(defn change-orientation (defn change-orientation
"Change orientation of shapes, from the sidebar options form. "Change orientation of shapes, from the sidebar options form.

47
frontend/src/app/main/data/workspace/undo.cljs
View file

@ -22,7 +22,8 @@
;; Change this to :info :debug or :trace to debug this module ;; Change this to :info :debug or :trace to debug this module
(log/set-level! :warn) (log/set-level! :warn)
(def discard-transaction-time-millis (* 20 1000)) (def ^:private
discard-transaction-time-millis (* 20 1000))
(def ^:private (def ^:private
schema:undo-entry schema:undo-entry
@ -30,7 +31,7 @@
[:undo-changes [:vector ::cpc/change]] [:undo-changes [:vector ::cpc/change]]
[:redo-changes [:vector ::cpc/change]]]) [:redo-changes [:vector ::cpc/change]]])
(def check-undo-entry! (def check-undo-entry
(sm/check-fn schema:undo-entry)) (sm/check-fn schema:undo-entry))
(def MAX-UNDO-SIZE 50) (def MAX-UNDO-SIZE 50)
@ -48,8 +49,7 @@
(ptk/reify ::materialize-undo (ptk/reify ::materialize-undo
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(-> state (update state :workspace-undo assoc :index index))))
(assoc-in [:workspace-undo :index] index)))))
(defn- add-undo-entry (defn- add-undo-entry
[state entry] [state entry]
@ -88,12 +88,9 @@
(defn append-undo (defn append-undo
[entry stack?] [entry stack?]
(dm/assert!
"expected valid undo entry"
(check-undo-entry! entry))
(dm/assert! (assert (check-undo-entry entry))
(boolean? stack?)) (assert (boolean? stack?))
(ptk/reify ::append-undo (ptk/reify ::append-undo
ptk/UpdateEvent ptk/UpdateEvent
@ -118,17 +115,11 @@
(defn start-undo-transaction (defn start-undo-transaction
"Start a transaction, so that every changes inside are added together in a single undo entry." "Start a transaction, so that every changes inside are added together in a single undo entry."
[id] [id & {:keys [timeout] :or {timeout discard-transaction-time-millis}}]
(ptk/reify ::start-undo-transaction (ptk/reify ::start-undo-transaction
ptk/WatchEvent
(watch [_ _ _]
(->> (rx/of (check-open-transactions))
;; Wait the configured time
(rx/delay discard-transaction-time-millis)))
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(log/info :msg "start-undo-transaction") (log/info :hint "start-undo-transaction")
;; We commit the old transaction before starting the new one ;; We commit the old transaction before starting the new one
(let [current-tx (get-in state [:workspace-undo :transaction]) (let [current-tx (get-in state [:workspace-undo :transaction])
pending-tx (get-in state [:workspace-undo :transactions-pending])] pending-tx (get-in state [:workspace-undo :transactions-pending])]
@ -136,20 +127,28 @@
(nil? current-tx) (assoc-in [:workspace-undo :transaction] empty-tx) (nil? current-tx) (assoc-in [:workspace-undo :transaction] empty-tx)
(nil? pending-tx) (assoc-in [:workspace-undo :transactions-pending] #{id}) (nil? pending-tx) (assoc-in [:workspace-undo :transactions-pending] #{id})
(some? pending-tx) (update-in [:workspace-undo :transactions-pending] conj id) (some? pending-tx) (update-in [:workspace-undo :transactions-pending] conj id)
:always (update-in [:workspace-undo :transactions-pending-ts] assoc id (dt/now))))))) :always (update-in [:workspace-undo :transactions-pending-ts] assoc id (dt/now)))))
ptk/WatchEvent
(watch [_ _ _]
(when (and timeout (pos? timeout))
(->> (rx/of (check-open-transactions timeout))
;; Wait the configured time
(rx/delay timeout))))))
(defn discard-undo-transaction [] (defn discard-undo-transaction []
(ptk/reify ::discard-undo-transaction (ptk/reify ::discard-undo-transaction
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(log/info :msg "discard-undo-transaction") (log/info :hint "discard-undo-transaction")
(update state :workspace-undo dissoc :transaction :transactions-pending :transactions-pending-ts)))) (update state :workspace-undo dissoc :transaction :transactions-pending :transactions-pending-ts))))
(defn commit-undo-transaction [id] (defn commit-undo-transaction [id]
(ptk/reify ::commit-undo-transaction (ptk/reify ::commit-undo-transaction
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(log/info :msg "commit-undo-transaction") (log/info :hint "commit-undo-transaction")
(let [state (-> state (let [state (-> state
(update-in [:workspace-undo :transactions-pending] disj id) (update-in [:workspace-undo :transactions-pending] disj id)
(update-in [:workspace-undo :transactions-pending-ts] dissoc id))] (update-in [:workspace-undo :transactions-pending-ts] dissoc id))]
@ -166,15 +165,15 @@
(assoc state :workspace-undo {})))) (assoc state :workspace-undo {}))))
(defn check-open-transactions (defn check-open-transactions
[] [timeout]
(ptk/reify ::check-open-transactions (ptk/reify ::check-open-transactions
ptk/WatchEvent ptk/WatchEvent
(watch [_ state _] (watch [_ state _]
(log/info :msg "check-open-transactions") (log/info :hint "check-open-transactions" :timeout timeout)
(let [pending-ts (-> (dm/get-in state [:workspace-undo :transactions-pending-ts]) (let [pending-ts (-> (dm/get-in state [:workspace-undo :transactions-pending-ts])
(update-vals #(.toMillis (dt/diff (dt/now) %))))] (update-vals #(inst-ms (dt/diff (dt/now) %))))]
(->> pending-ts (->> pending-ts
(filter (fn [[_ ts]] (>= ts discard-transaction-time-millis))) (filter (fn [[_ ts]] (>= ts timeout)))
(rx/from) (rx/from)
(rx/tap #(js/console.warn (dm/str "FORCE COMMIT TRANSACTION AFTER " (second %) "MS"))) (rx/tap #(js/console.warn (dm/str "FORCE COMMIT TRANSACTION AFTER " (second %) "MS")))
(rx/map first) (rx/map first)

32
frontend/src/app/main/ui/workspace/tokens/update.cljs
View file

@ -1,6 +1,13 @@
;; 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.workspace.tokens.update (ns app.main.ui.workspace.tokens.update
(:require (:require
[app.common.files.helpers :as cfh] [app.common.files.helpers :as cfh]
[app.common.logging :as l]
[app.common.types.token :as ctt] [app.common.types.token :as ctt]
[app.main.data.helpers :as dsh] [app.main.data.helpers :as dsh]
[app.main.data.workspace.shapes :as dwsh] [app.main.data.workspace.shapes :as dwsh]
@ -9,6 +16,7 @@
[app.main.ui.workspace.tokens.changes :as wtch] [app.main.ui.workspace.tokens.changes :as wtch]
[app.main.ui.workspace.tokens.style-dictionary :as wtsd] [app.main.ui.workspace.tokens.style-dictionary :as wtsd]
[app.main.ui.workspace.tokens.token-set :as wtts] [app.main.ui.workspace.tokens.token-set :as wtts]
[app.util.time :as dt]
[beicon.v2.core :as rx] [beicon.v2.core :as rx]
[clojure.data :as data] [clojure.data :as data]
[clojure.set :as set] [clojure.set :as set]
@ -70,7 +78,7 @@
(reduce (reduce
(fn [acc [attrs v]] (fn [acc [attrs v]]
(cond (cond
(some attrs #{:widht :height}) (let [[_ a b] (data/diff #{:width :height} attrs)] (some attrs #{:width :height}) (let [[_ a b] (data/diff #{:width :height} attrs)]
(cond-> (assoc acc b v) (cond-> (assoc acc b v)
;; Exact match in attrs ;; Exact match in attrs
a (assoc a v))) a (assoc a v)))
@ -127,8 +135,14 @@
[state resolved-tokens] [state resolved-tokens]
(let [file-id (get state :current-file-id) (let [file-id (get state :current-file-id)
current-page-id (get state :current-page-id) current-page-id (get state :current-page-id)
fdata (dsh/lookup-file-data state file-id)] fdata (dsh/lookup-file-data state file-id)
tpoint (dt/tpoint-ms)]
(l/inf :status "START" :hint "update-tokens")
(->> (rx/concat
(rx/of current-page-id)
(->> (rx/from (:pages fdata)) (->> (rx/from (:pages fdata))
(rx/filter (fn [id] (not= id current-page-id)))))
(rx/mapcat (rx/mapcat
(fn [page-id] (fn [page-id]
(let [page (let [page
@ -140,6 +154,12 @@
actions actions
(actionize-shapes-update-info page-id attrs)] (actionize-shapes-update-info page-id attrs)]
(l/inf :status "PROGRESS"
:hint "update-tokens"
:page-id (str page-id)
:elapsed (tpoint)
::l/sync? true)
(rx/merge (rx/merge
(rx/from actions) (rx/from actions)
(->> (rx/from frame-ids) (->> (rx/from frame-ids)
@ -151,7 +171,11 @@
(fn [shape] (fn [shape]
(dissoc shape :position-data)) (dissoc shape :position-data))
{:page-id page-id {:page-id page-id
:ignore-touched true})))))))))) :ignore-touched true})))))))
(rx/finalize
(fn [_]
(let [elapsed (tpoint)]
(l/inf :status "END" :hint "update-tokens" :elapsed elapsed)))))))
(defn update-workspace-tokens (defn update-workspace-tokens
[] []
@ -164,6 +188,6 @@
(rx/mapcat (fn [sd-tokens] (rx/mapcat (fn [sd-tokens]
(let [undo-id (js/Symbol)] (let [undo-id (js/Symbol)]
(rx/concat (rx/concat
(rx/of (dwu/start-undo-transaction undo-id)) (rx/of (dwu/start-undo-transaction undo-id :timeout false))
(update-tokens state sd-tokens) (update-tokens state sd-tokens)
(rx/of (dwu/commit-undo-transaction undo-id))))))))))) (rx/of (dwu/commit-undo-transaction undo-id)))))))))))