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

 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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -533,14 +533,98 @@
(assoc state :workspace-modifiers modif-tree)))))
(def ^:private xf:without-uuid-zero
(remove #(= % uuid/zero)))
(def ^:private transform-attrs
#{:selrect
:points
:x
:y
:r1
:r2
:r3
:r4
:shadow
:blur
:strokes
:width
:height
:content
:transform
:transform-inverse
:rotation
:flip-x
:flip-y
:grow-type
:position-data
:layout-gap
:layout-padding
:layout-item-h-sizing
:layout-item-max-h
:layout-item-max-w
:layout-item-min-h
:layout-item-min-w
:layout-item-v-sizing
:layout-padding-type
:layout-item-margin
:layout-item-margin-type
:layout-grid-cells
:layout-grid-columns
:layout-grid-rows})
(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? stack-undo? ignore-constraints
ignore-snap-pixel ignore-touched undo-group page-id]
:or {undo-transation? true stack-undo? false ignore-constraints false
ignore-snap-pixel false ignore-touched false}}]
([{: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 _]
@ -553,88 +637,17 @@
(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)]
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
:x
:y
:r1
:r2
:r3
:r4
:shadow
:blur
:strokes
:width
:height
:content
:transform
:transform-inverse
:rotation
:flip-x
:flip-y
:grow-type
:position-data
:layout-gap
:layout-padding
:layout-item-h-sizing
:layout-item-margin
:layout-item-max-h
:layout-item-max-w
:layout-item-min-h
:layout-item-min-w
:layout-item-v-sizing
:layout-padding-type
:layout-gap
:layout-item-margin
:layout-item-margin-type
:layout-grid-cells
:layout-grid-columns
:layout-grid-rows]})
;; We've applied the text-modifier so we can dissoc the temporary data
(rx/of (apply-modifiers* objects object-modifiers text-modifiers options)
(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)
(rx/of (clear-local-transform))
(rx/empty))

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]
:or {reg-objects? false save-undo? true stack-undo? false ignore-touched false with-objects? false}}]
(dm/assert!
"expected a valid coll of uuid's"
(sm/check-coll-of-uuid! ids))
(dm/assert! (fn? update-fn))
(assert (sm/check-coll-of-uuid ids))
(assert (fn? update-fn))
(ptk/reify ::update-shapes
ptk/WatchEvent
@ -162,9 +159,7 @@
([ids] (delete-shapes nil ids {}))
([page-id ids] (delete-shapes page-id ids {}))
([page-id ids options]
(dm/assert!
"expected a valid set of uuid's"
(sm/check-set-of-uuid! ids))
(assert (sm/check-set-of-uuid ids))
(ptk/reify ::delete-shapes
ptk/WatchEvent

View file

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

View file

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

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
(:require
[app.common.files.helpers :as cfh]
[app.common.logging :as l]
[app.common.types.token :as ctt]
[app.main.data.helpers :as dsh]
[app.main.data.workspace.shapes :as dwsh]
@ -9,6 +16,7 @@
[app.main.ui.workspace.tokens.changes :as wtch]
[app.main.ui.workspace.tokens.style-dictionary :as wtsd]
[app.main.ui.workspace.tokens.token-set :as wtts]
[app.util.time :as dt]
[beicon.v2.core :as rx]
[clojure.data :as data]
[clojure.set :as set]
@ -70,7 +78,7 @@
(reduce
(fn [acc [attrs v]]
(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)
;; Exact match in attrs
a (assoc a v)))
@ -127,8 +135,14 @@
[state resolved-tokens]
(let [file-id (get state :current-file-id)
current-page-id (get state :current-page-id)
fdata (dsh/lookup-file-data state file-id)]
(->> (rx/from (:pages fdata))
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/filter (fn [id] (not= id current-page-id)))))
(rx/mapcat
(fn [page-id]
(let [page
@ -140,6 +154,12 @@
actions
(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/from actions)
(->> (rx/from frame-ids)
@ -151,7 +171,11 @@
(fn [shape]
(dissoc shape :position-data))
{: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
[]
@ -164,6 +188,6 @@
(rx/mapcat (fn [sd-tokens]
(let [undo-id (js/Symbol)]
(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)
(rx/of (dwu/commit-undo-transaction undo-id)))))))))))