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

This commit is contained in:
Andrey Antukh 2026-01-29 10:23:46 +01:00
commit 32454f5959
8 changed files with 345 additions and 329 deletions

View File

@ -79,7 +79,7 @@
(db/insert-many! pool :audit-log event-columns events)))) (db/insert-many! pool :audit-log event-columns events))))
(def valid-event-types (def valid-event-types
#{"action" "identify"}) #{"action" "identify" "trigger"})
(def schema:event (def schema:event
[:map {:title "Event"} [:map {:title "Event"}

View File

@ -16,6 +16,7 @@
[app.main.data.profile :as dp] [app.main.data.profile :as dp]
[app.main.data.websocket :as ws] [app.main.data.websocket :as ws]
[app.main.errors] [app.main.errors]
[app.main.features :as feat]
[app.main.rasterizer :as thr] [app.main.rasterizer :as thr]
[app.main.store :as st] [app.main.store :as st]
[app.main.ui :as ui] [app.main.ui :as ui]
@ -65,8 +66,11 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ stream] (watch [_ _ stream]
(rx/merge (rx/merge
(rx/of (ev/initialize) (if (contains? cf/flags :audit-log)
(dp/refresh-profile)) (rx/of (ev/initialize))
(rx/empty))
(rx/of (dp/refresh-profile))
;; Watch for profile deletion events ;; Watch for profile deletion events
(->> stream (->> stream
@ -87,7 +91,12 @@
(rx/map deref) (rx/map deref)
(rx/filter dp/is-authenticated?) (rx/filter dp/is-authenticated?)
(rx/take 1) (rx/take 1)
(rx/map #(ws/initialize))))))) (rx/map #(ws/initialize)))))
ptk/EffectEvent
(effect [_ state _]
(when-not (feat/active-feature? state "render-wasm/v1")
(thr/init!)))))
(defn ^:export init (defn ^:export init
[options] [options]
@ -97,7 +106,7 @@
(mw/init!) (mw/init!)
(i18n/init) (i18n/init)
(cur/init-styles) (cur/init-styles)
(thr/init!)
(init-ui) (init-ui)
(st/emit! (plugins/initialize) (st/emit! (plugins/initialize)
(initialize))) (initialize)))

View File

@ -31,40 +31,34 @@
(l/set-level! :info) (l/set-level! :info)
;; Defines the maximum buffer size, after events start discarding. ;; Defines the maximum buffer size, after events start discarding.
(def max-buffer-size 1024) (def ^:private ^:const max-buffer-size 1024)
;; Defines the maximum number of events that can go in a single batch. ;; Defines the maximum number of events that can go in a single batch.
(def max-chunk-size 100) (def ^:private ^:const max-chunk-size 100)
;; Defines the time window (in ms) within events belong to the same session. ;; Defines the time window (in ms) within events belong to the same session.
(def session-timeout (* 1000 60 30)) (def ^:private ^:const session-timeout (* 1000 60 30))
;; Min time for a long task to be reported to telemetry ;; Min time for a long task to be reported to telemetry
(def min-longtask-time 1000) (def ^:private ^:const min-longtask-time 1000)
;; Min time between long task reports ;; Min time between long task reports
(def debounce-longtask-time 1000) (def ^:private ^:const debounce-longtask-time 1000)
;; Min time for a long task to be reported to telemetry ;; Min time for a long task to be reported to telemetry
(def min-browser-event-time 1000) (def ^:private ^:const min-browser-event-time 1000)
;; Min time between long task reports ;; Min time between long task reports
(def debounce-browser-event-time 1000) (def ^:private ^:const debounce-browser-event-time 1000)
;; Min time for a long task to be reported to telemetry ;; Min time for a long task to be reported to telemetry
(def min-performace-event-time 1000) (def ^:private ^:const min-performace-event-time 1000)
;; Min time between long task reports ;; Min time between long task reports
(def debounce-performance-event-time 1000) (def ^:private ^:const debounce-performance-event-time 1000)
;; Def micro-benchmark iterations ;; Default micro-benchmark iterations
(def micro-benchmark-iterations 1e6) (def ^:private ^:const micro-benchmark-iterations 1e6)
;; Performance logs
(defonce ^:private longtask-observer* (atom nil))
(defonce ^:private stall-timer* (atom nil))
(defonce ^:private current-op* (atom nil))
;; --- CONTEXT ;; --- CONTEXT
@ -142,12 +136,12 @@
data data
data)) data))
(defn add-external-context-info (defn- add-external-context-info
[context] [context]
(let [external-context-info (json/->clj (cf/external-context-info))] (let [external-context-info (json/->clj (cf/external-context-info))]
(merge context external-context-info))) (merge context external-context-info)))
(defn- process-event-by-proto (defn- make-proto-event
[event] [event]
(let [data (d/deep-merge (-data event) (meta event)) (let [data (d/deep-merge (-data event) (meta event))
type (ptk/type event) type (ptk/type event)
@ -156,7 +150,6 @@
(assoc :event-origin (::origin data)) (assoc :event-origin (::origin data))
(assoc :event-namespace (namespace type)) (assoc :event-namespace (namespace type))
(assoc :event-symbol ev-name) (assoc :event-symbol ev-name)
(add-external-context-info)
(d/without-nils)) (d/without-nils))
props (-> data d/without-qualified simplify-props)] props (-> data d/without-qualified simplify-props)]
@ -165,7 +158,7 @@
:context context :context context
:props props})) :props props}))
(defn- process-data-event (defn- make-data-event
[event] [event]
(let [data (deref event) (let [data (deref event)
name (::name data)] name (::name data)]
@ -174,7 +167,6 @@
(let [type (::type data "action") (let [type (::type data "action")
context (-> (::context data) context (-> (::context data)
(assoc :event-origin (::origin data)) (assoc :event-origin (::origin data))
(add-external-context-info)
(d/without-nils)) (d/without-nils))
props (-> data d/without-qualified simplify-props)] props (-> data d/without-qualified simplify-props)]
{:type type {:type type
@ -182,57 +174,62 @@
:context context :context context
:props props})))) :props props}))))
(defn performance-payload (defn- make-event
"Create a standard event"
([result] ([result]
(let [props (aget result 0) (let [props (aget result 0)
profile-id (aget result 1)] profile-id (aget result 1)]
(performance-payload profile-id props))) (make-event profile-id props)))
([profile-id event]
(when-let [event (cond
(satisfies? Event event)
(make-proto-event event)
(ptk/data-event? event)
(make-data-event event))]
(assoc event :profile-id profile-id))))
(defn- make-performance-event
"Create a performance trigger event"
([result]
(let [props (aget result 0)
profile-id (aget result 1)]
(make-performance-event profile-id props)))
([profile-id props] ([profile-id props]
(let [{:keys [performance-info]} @st/state] (let [perf-info (get @st/state :performance-info)
{:type "action" name (get props ::name)]
:name "performance" {:type "trigger"
:context (merge @context performance-info) :name (str "performance-" name)
:props props :context {:file-stats (:counters perf-info)}
:props (-> props
(dissoc ::name)
(assoc :file-id (:file-id perf-info)))
:profile-id profile-id}))) :profile-id profile-id})))
(defn- process-performance-event (defn- process-performance-event
"Process performance sensitive events"
[result] [result]
(let [event (aget result 0) (let [event (aget result 0)
profile-id (aget result 1)] profile-id (aget result 1)]
(if (satisfies? PerformanceEvent event)
(if (and (satisfies? PerformanceEvent event)
(exists? js/globalThis)
(exists? (.-requestAnimationFrame js/globalThis))
(exists? (.-scheduler js/globalThis))
(exists? (.-postTask (.-scheduler js/globalThis))))
(rx/create (rx/create
(fn [subs] (fn [subs]
(let [start (perf/timestamp)] (let [start (perf/now)]
(js/requestAnimationFrame (js/requestAnimationFrame
#(js/scheduler.postTask #(.postTask js/scheduler
(fn [] (fn []
(let [time (- (perf/timestamp) start)] (let [time (- (perf/now) start)]
(when (> time min-performace-event-time) (when (> time min-performace-event-time)
(rx/push! (rx/push! subs
subs (make-performance-event profile-id
(performance-payload {::name "blocking-event"
profile-id :event-name (d/name (ptk/type event))
{::event (str (ptk/type event)) :duration time})))
:time time})))) (rx/end! subs)))
(rx/end! subs)) #js {:priority "user-blocking"}))
#js {"priority" "user-blocking"}))) nil)))
nil))
(rx/empty)))) (rx/empty))))
(defn- process-event
[event]
(cond
(satisfies? Event event)
(process-event-by-proto event)
(ptk/data-event? event)
(process-data-event event)))
;; --- MAIN LOOP ;; --- MAIN LOOP
(defn- append-to-buffer (defn- append-to-buffer
@ -260,7 +257,8 @@
(rx/of nil))) (rx/of nil)))
(defn performance-observer-event-stream (defn- user-input-observer
"Create user interaction/input event observer. Returns rx stream."
[] []
(if (and (exists? js/globalThis) (if (and (exists? js/globalThis)
(exists? (.-PerformanceObserver js/globalThis))) (exists? (.-PerformanceObserver js/globalThis)))
@ -273,18 +271,17 @@
(fn [entry] (fn [entry]
(when (and (= "event" (.-entryType entry)) (when (and (= "event" (.-entryType entry))
(> (.-duration entry) min-browser-event-time)) (> (.-duration entry) min-browser-event-time))
(rx/push! (rx/push! subs {::name "user-input"
subs :duration (.-duration entry)
{::event :observer-event :event-name (.-name entry)})))
:duration (.-duration entry)
:event-name (.-name entry)})))
(.getEntries list))))] (.getEntries list))))]
(.observe observer #js {:entryTypes #js ["event"]}) (.observe observer #js {:entryTypes #js ["event"]})
(fn [] (fn []
(.disconnect observer))))) (.disconnect observer)))))
(rx/empty))) (rx/empty)))
(defn performance-observer-longtask-stream (defn- longtask-observer
"Create a Long-Task performance observer. Returns rx stream."
[] []
(if (and (exists? js/globalThis) (if (and (exists? js/globalThis)
(exists? (.-PerformanceObserver js/globalThis))) (exists? (.-PerformanceObserver js/globalThis)))
@ -298,7 +295,7 @@
(when (and (= "longtask" (.-entryType entry)) (when (and (= "longtask" (.-entryType entry))
(> (.-duration entry) min-longtask-time)) (> (.-duration entry) min-longtask-time))
(rx/push! subs (rx/push! subs
{::event :observer-longtask {::name "long-task"
:duration (.-duration entry)}))) :duration (.-duration entry)})))
(.getEntries list))))] (.getEntries list))))]
(.observe observer #js {:entryTypes #js ["longtask"]}) (.observe observer #js {:entryTypes #js ["longtask"]})
@ -306,238 +303,156 @@
(.disconnect observer))))) (.disconnect observer)))))
(rx/empty))) (rx/empty)))
(defn- save-performance-info (defn- snapshot-performance-info
[] [{:keys [file-id]}]
(ptk/reify ::save-performance-info
ptk/UpdateEvent
(update [_ state]
(letfn [(count-shapes [file]
(->> file :data :pages-index
(reduce-kv
(fn [sum _ page]
(+ sum (count (:objects page))))
0)))
(count-library-data [files {:keys [id]}]
(let [data (dm/get-in files [id :data])]
{:components (count (:components data))
:colors (count (:colors data))
:typographies (count (:typographies data))}))]
(let [file-id (get state :current-file-id)
file (get-in state [:files file-id])
file-size (count-shapes file)
libraries (letfn [(count-shapes [file]
(-> (refs/select-libraries (:files state) (:id file)) (->> file :data :pages-index
(d/update-vals (partial count-library-data (:files state)))) (reduce-kv
(fn [sum _ page]
(+ sum (count (:objects page))))
0)))
lib-sizes (add-libraries-counters [state files]
(->> libraries (reduce (fn [state library-id]
(reduce-kv (let [data (dm/get-in files [library-id :data])]
(fn [acc _ {:keys [components colors typographies]}] (-> state
(-> acc (update :total-components + (count (:components data)))
(update :components + components) (update :total-colors + (count (:colors data)))
(update :colors + colors) (update :total-typographies + (count (:typographies data))))))
(update :typographies + typographies))) state
{}))] (refs/select-libraries files file-id)))]
(update state :performance-info
(fn [info]
(-> info
(assoc :file-size file-size)
(assoc :library-sizes lib-sizes)
(assoc :file-start-time (perf/now))))))))))
(defn store-performace-info (ptk/reify ::snapshot-performance-info
[]
(letfn [(micro-benchmark [state]
(let [start (perf/now)]
(loop [i micro-benchmark-iterations]
(when-not (zero? i)
(* (math/sin i) (math/sqrt i))
(recur (dec i))))
(let [end (perf/now)]
(update state :performance-info assoc :bench-result (- end start)))))]
(ptk/reify ::store-performace-info
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(-> state (update state :performance-info
micro-benchmark (fn [info]
(assoc-in [:performance-info :app-start-time] (perf/now)))) (let [files (get state :files)
file (get files file-id)]
(-> info
(assoc :file-id file-id)
(update :counters assoc :total-shapes (count-shapes file))
(update :counters add-libraries-counters files)))))))))
ptk/WatchEvent (defn- store-performace-info
(watch [_ _ stream] []
(->> stream (ptk/reify ::store-performace-info
(rx/filter (ptk/type? :app.main.data.workspace/all-libraries-resolved)) ptk/UpdateEvent
(rx/take 1) (update [_ state]
(rx/map save-performance-info)))))) (let [start (perf/now)
_ (loop [i micro-benchmark-iterations]
(when-not (zero? i)
(* (math/sin i) (math/sqrt i))
(recur (dec i))))
end (perf/now)]
(update state :performance-info assoc :bench (- end start))))
ptk/WatchEvent
(watch [_ _ stream]
(->> stream
(rx/filter (ptk/type? :app.main.data.workspace/all-libraries-resolved))
(rx/take 1)
(rx/map deref)
(rx/map snapshot-performance-info)))))
(defn initialize (defn initialize
[] []
(when (contains? cf/flags :audit-log) (ptk/reify ::initialize
(ptk/reify ::initialize ptk/WatchEvent
ptk/WatchEvent (watch [_ _ _]
(watch [_ _ _] (rx/of (store-performace-info)))
(rx/of (store-performace-info)))
ptk/EffectEvent ptk/EffectEvent
(effect [_ _ stream] (effect [_ _ stream]
(let [session (atom nil) (let [session (atom nil)
stopper (rx/filter (ptk/type? ::initialize) stream) stopper (rx/filter (ptk/type? ::initialize) stream)
buffer (atom #queue []) buffer (atom #queue [])
profile (->> (rx/from-atom storage/user {:emit-current-value? true}) profile (->> (rx/from-atom storage/user {:emit-current-value? true})
(rx/map :profile) (rx/map :profile)
(rx/map :id) (rx/map :id)
(rx/pipe (rxo/distinct-contiguous)))] (rx/pipe (rxo/distinct-contiguous)))]
(l/debug :hint "event instrumentation initialized") (l/debug :hint "event instrumentation initialized")
(->> (rx/merge (->> (rx/merge
(->> (rx/from-atom buffer) (->> (rx/from-atom buffer)
(rx/filter #(pos? (count %))) (rx/filter #(pos? (count %)))
(rx/debounce 2000)) (rx/debounce 2000))
(->> stream (->> stream
(rx/filter (ptk/type? :app.main.data.profile/logout)) (rx/filter (ptk/type? :app.main.data.profile/logout))
(rx/observe-on :async))) (rx/observe-on :async)))
(rx/map (fn [_] (rx/map (fn [_]
(into [] (take max-buffer-size) @buffer))) (into [] (take max-chunk-size) @buffer)))
(rx/with-latest-from profile) (rx/with-latest-from profile)
(rx/mapcat (fn [[chunk profile-id]] (rx/mapcat (fn [[chunk profile-id]]
(let [events (filterv #(= profile-id (:profile-id %)) chunk)] (let [events (filterv #(= profile-id (:profile-id %)) chunk)]
(->> (persist-events events) (->> (persist-events events)
(rx/tap (fn [_] (rx/tap (fn [_]
(l/debug :hint "events chunk persisted" :total (count chunk)))) (l/debug :hint "events chunk persisted" :total (count chunk))))
(rx/map (constantly chunk)))))) (rx/map (constantly chunk))))))
(rx/take-until stopper) (rx/take-until stopper)
(rx/subs! (fn [chunk] (rx/subs! (fn [chunk]
(swap! buffer remove-from-buffer (count chunk))) (swap! buffer remove-from-buffer (count chunk)))
(fn [cause] (fn [cause]
(l/error :hint "unexpected error on audit persistence" :cause cause)) (l/error :hint "unexpected error on audit persistence" :cause cause))
(fn [] (fn []
(l/debug :hint "audit persistence terminated")))) (l/debug :hint "audit persistence terminated"))))
(->> (rx/merge (->> (rx/merge
(->> stream (->> stream
(rx/with-latest-from profile) (rx/with-latest-from profile)
(rx/map (fn [result] (rx/map make-event))
(let [event (aget result 0)
profile-id (aget result 1)]
(some-> (process-event event)
(update :profile-id #(or % profile-id)))))))
(->> (performance-observer-event-stream) (->> (user-input-observer)
(rx/with-latest-from profile) (rx/with-latest-from profile)
(rx/map performance-payload) (rx/map make-performance-event)
(rx/debounce debounce-browser-event-time)) (rx/debounce debounce-browser-event-time))
(->> (performance-observer-longtask-stream) (->> (longtask-observer)
(rx/with-latest-from profile) (rx/with-latest-from profile)
(rx/map performance-payload) (rx/map make-performance-event)
(rx/debounce debounce-longtask-time)) (rx/debounce debounce-longtask-time))
(if (and (exists? js/globalThis)
(exists? (.-requestAnimationFrame js/globalThis))
(exists? (.-scheduler js/globalThis))
(exists? (.-postTask (.-scheduler js/globalThis))))
(->> stream (->> stream
(rx/with-latest-from profile) (rx/with-latest-from profile)
(rx/merge-map process-performance-event) (rx/merge-map process-performance-event)
(rx/debounce debounce-performance-event-time))) (rx/debounce debounce-performance-event-time))
(rx/empty)))
(rx/filter :profile-id) (rx/filter :profile-id)
(rx/map (fn [event] (rx/map (fn [event]
(let [session* (or @session (ct/now)) (let [session* (or @session (ct/now))
context (-> @context context (-> @context
(merge (:context event)) (merge (:context event))
(assoc :session session*) (assoc :session session*)
(assoc :external-session-id (cf/external-session-id)) (assoc :external-session-id (cf/external-session-id))
(d/without-nils))] (add-external-context-info)
(reset! session session*) (d/without-nils))]
(-> event (reset! session session*)
(assoc :timestamp (ct/now)) (-> event
(assoc :context context))))) (assoc :timestamp (ct/now))
(assoc :context context)))))
(rx/tap (fn [event] (rx/tap (fn [event]
(l/debug :hint "event enqueued") (l/debug :hint "event enqueued")
(swap! buffer append-to-buffer event))) (swap! buffer append-to-buffer event)))
(rx/switch-map #(rx/timer session-timeout)) (rx/switch-map #(rx/timer session-timeout))
(rx/take-until stopper) (rx/take-until stopper)
(rx/subs! (fn [_] (rx/subs! (fn [_]
(l/debug :hint "session reinitialized") (l/debug :hint "session reinitialized")
(reset! session nil)) (reset! session nil))
(fn [cause] (fn [cause]
(l/error :hint "error on event batching stream" :cause cause)) (l/error :hint "error on event batching stream" :cause cause))
(fn [] (fn []
(l/debug :hitn "events batching stream terminated"))))))))) (l/debug :hitn "events batching stream terminated"))))))))
(defn event (defn event
[props] [props]
(ptk/data-event ::event props)) (ptk/data-event ::event props))
;; --- DEVTOOLS PERF LOGGING
(defn install-long-task-observer! []
(when (and (some? (.-PerformanceObserver js/window)) (nil? @longtask-observer*))
(let [observer (js/PerformanceObserver.
(fn [list _]
(when (contains? cf/flags :perf-logs)
(doseq [entry (.getEntries list)]
(let [dur (.-duration entry)
start (.-startTime entry)
attrib (.-attribution entry)
attrib-count (when attrib (.-length attrib))
first-attrib (when (and attrib-count (> attrib-count 0)) (aget attrib 0))
attrib-name (when first-attrib (.-name first-attrib))
attrib-ctype (when first-attrib (.-containerType first-attrib))
attrib-cid (when first-attrib (.-containerId first-attrib))
attrib-csrc (when first-attrib (.-containerSrc first-attrib))]
(.warn js/console (str "[perf] long task " (Math/round dur) "ms at " (Math/round start) "ms"
(when first-attrib
(str " attrib:name=" attrib-name
" ctype=" attrib-ctype
" cid=" attrib-cid
" csrc=" attrib-csrc)))))))))]
(.observe observer #js{:entryTypes #js["longtask"]})
(reset! longtask-observer* observer))))
(defn start-event-loop-stall-logger!
"Log event loop stalls by measuring setInterval drift.
interval-ms: base interval
threshold-ms: drift over which we report"
[interval-ms threshold-ms]
(when (nil? @stall-timer*)
(let [last (atom (.now js/performance))
id (js/setInterval
(fn []
(when (contains? cf/flags :perf-logs)
(let [now (.now js/performance)
expected (+ @last interval-ms)
drift (- now expected)
current-op @current-op*
measures (.getEntriesByType js/performance "measure")
mlen (.-length measures)
last-measure (when (> mlen 0) (aget measures (dec mlen)))
meas-name (when last-measure (.-name last-measure))
meas-detail (when last-measure (.-detail last-measure))
meas-count (when meas-detail (unchecked-get meas-detail "count"))]
(reset! last now)
(when (> drift threshold-ms)
(.warn js/console
(str "[perf] event loop stall: " (Math/round drift) "ms"
(when current-op (str " op=" current-op))
(when meas-name (str " last=" meas-name))
(when meas-count (str " count=" meas-count))))))))
interval-ms)]
(reset! stall-timer* id))))
(defn init!
"Install perf observers in dev builds. Safe to call multiple times.
Perf logs are disabled by default. Enable them with the :perf-logs flag in config."
[]
(when ^boolean js/goog.DEBUG
(install-long-task-observer!)
(start-event-loop-stall-logger! 50 100)
;; Expose simple API on window for manual control in devtools
(let [api #js {:reset (fn []
(try
(.clearMarks js/performance)
(.clearMeasures js/performance)
(catch :default _ nil)))}]
(aset js/window "PenpotPerf" api))))

View File

@ -24,6 +24,7 @@
[app.common.types.shape :as cts] [app.common.types.shape :as cts]
[app.common.types.variant :as ctv] [app.common.types.variant :as ctv]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.changes :as dch] [app.main.data.changes :as dch]
[app.main.data.comments :as dcmt] [app.main.data.comments :as dcmt]
[app.main.data.common :as dcm] [app.main.data.common :as dcm]
@ -75,6 +76,7 @@
[app.util.dom :as dom] [app.util.dom :as dom]
[app.util.globals :as ug] [app.util.globals :as ug]
[app.util.http :as http] [app.util.http :as http]
[app.util.perf :as perf]
[app.util.storage :as storage] [app.util.storage :as storage]
[app.util.timers :as tm] [app.util.timers :as tm]
[app.util.webapi :as wapi] [app.util.webapi :as wapi]
@ -195,7 +197,7 @@
(rx/of (check-libraries-synchronization file-id libraries)))))) (rx/of (check-libraries-synchronization file-id libraries))))))
;; This events marks that all the libraries have been resolved ;; This events marks that all the libraries have been resolved
(rx/of (ptk/data-event ::all-libraries-resolved))) (rx/of (ptk/data-event ::all-libraries-resolved {:file-id file-id})))
(rx/take-until stopper-s)))))) (rx/take-until stopper-s))))))
(defn- workspace-initialized (defn- workspace-initialized
@ -348,10 +350,11 @@
:file-id file-id})))))) :file-id file-id}))))))
;; Install dev perf observers once the workspace is ready ;; Install dev perf observers once the workspace is ready
(->> stream (when (contains? cf/flags :perf-logs)
(rx/filter (ptk/type? ::workspace-initialized)) (->> stream
(rx/take 1) (rx/filter (ptk/type? ::workspace-initialized))
(rx/map (fn [_] (ev/init!)))) (rx/take 1)
(rx/tap (fn [_] (perf/setup)))))
(->> stream (->> stream
(rx/filter (ptk/type? ::dps/persistence-notification)) (rx/filter (ptk/type? ::dps/persistence-notification))

View File

@ -105,9 +105,15 @@
(if (dsh/lookup-page state file-id page-id) (if (dsh/lookup-page state file-id page-id)
(rx/concat (rx/concat
(rx/of (initialize-page* file-id page-id) (rx/of (initialize-page* file-id page-id)
(fdf/fix-deleted-fonts-for-page file-id page-id) (fdf/fix-deleted-fonts-for-page file-id page-id))
(dwth/watch-state-changes file-id page-id)
(dwl/watch-component-changes)) ;; Disable thumbnail generation in wasm renderer
(if (features/active-feature? state "render-wasm/v1")
(rx/empty)
(rx/of (dwth/watch-state-changes file-id page-id)))
(rx/of (dwl/watch-component-changes))
(let [profile (:profile state) (let [profile (:profile state)
props (get profile :props)] props (get profile :props)]
(when (not (:workspace-visited props)) (when (not (:workspace-visited props))

View File

@ -191,59 +191,63 @@
[page-id [event [old-data new-data]]] [page-id [event [old-data new-data]]]
(let [changes (:changes event) (let [changes (:changes event)
lookup-data-objects ;; cache for the get-frame-ids function
(fn [data page-id] frame-id-cache (atom {})]
(dm/get-in data [:pages-index page-id :objects]))
(letfn [(lookup-data-objects [data page-id]
(dm/get-in data [:pages-index page-id :objects]))
extract-ids (extract-ids [{:keys [page-id type] :as change}]
(fn [{:keys [page-id type] :as change}] (case type
(case type :add-obj [[page-id (:id change)]]
:add-obj [[page-id (:id change)]] :mod-obj [[page-id (:id change)]]
:mod-obj [[page-id (:id change)]] :del-obj [[page-id (:id change)]]
:del-obj [[page-id (:id change)]] :mov-objects (->> (:shapes change) (map #(vector page-id %)))
:mov-objects (->> (:shapes change) (map #(vector page-id %))) []))
[]))
get-frame-ids (get-frame-ids [id]
(fn get-frame-ids [id] (let [old-objects (lookup-data-objects old-data page-id)
(let [old-objects (lookup-data-objects old-data page-id) new-objects (lookup-data-objects new-data page-id)
new-objects (lookup-data-objects new-data page-id)
new-shape (get new-objects id) new-shape (get new-objects id)
old-shape (get old-objects id) old-shape (get old-objects id)
old-frame-id (if (cfh/frame-shape? old-shape) id (:frame-id old-shape)) old-frame-id (if (cfh/frame-shape? old-shape) id (:frame-id old-shape))
new-frame-id (if (cfh/frame-shape? new-shape) id (:frame-id new-shape)) new-frame-id (if (cfh/frame-shape? new-shape) id (:frame-id new-shape))
root-frame-old? (cfh/root-frame? old-objects old-frame-id) root-frame-old? (cfh/root-frame? old-objects old-frame-id)
root-frame-new? (cfh/root-frame? new-objects new-frame-id) root-frame-new? (cfh/root-frame? new-objects new-frame-id)
instance-root? (ctc/instance-root? new-shape)] instance-root? (ctc/instance-root? new-shape)]
(cond-> #{} (cond-> #{}
root-frame-old? root-frame-old?
(conj ["frame" old-frame-id]) (conj ["frame" old-frame-id])
root-frame-new? root-frame-new?
(conj ["frame" new-frame-id]) (conj ["frame" new-frame-id])
instance-root? instance-root?
(conj ["component" id]) (conj ["component" id])
(and (uuid? (:frame-id old-shape)) (and (uuid? (:frame-id old-shape))
(not= uuid/zero (:frame-id old-shape))) (not= uuid/zero (:frame-id old-shape)))
(into (get-frame-ids (:frame-id old-shape))) (into (get-frame-ids (:frame-id old-shape)))
(and (uuid? (:frame-id new-shape)) (and (uuid? (:frame-id new-shape))
(not= uuid/zero (:frame-id new-shape))) (not= uuid/zero (:frame-id new-shape)))
(into (get-frame-ids (:frame-id new-shape))))))] (into (get-frame-ids (:frame-id new-shape))))))
(into #{} (get-frame-ids-cached [id]
(comp (mapcat extract-ids) (or (get @frame-id-cache id)
(filter (fn [[page-id']] (= page-id page-id'))) (let [result (get-frame-ids id)]
(map (fn [[_ id]] id)) (swap! frame-id-cache assoc id result)
(mapcat get-frame-ids)) result)))]
changes))) (into #{}
(comp (mapcat extract-ids)
(filter (fn [[page-id']] (= page-id page-id')))
(map (fn [[_ id]] id))
(mapcat get-frame-ids-cached))
changes))))
(defn watch-state-changes (defn watch-state-changes
"Watch the state for changes inside frames. If a change is detected will force a rendering "Watch the state for changes inside frames. If a change is detected will force a rendering

View File

@ -111,6 +111,7 @@
"Initializes the rasterizer." "Initializes the rasterizer."
[] []
(let [iframe (dom/create-element "iframe")] (let [iframe (dom/create-element "iframe")]
(dom/set-attribute! iframe "id" "rasterizer")
(dom/set-attribute! iframe "src" origin) (dom/set-attribute! iframe "src" origin)
(dom/set-attribute! iframe "hidden" true) (dom/set-attribute! iframe "hidden" true)
(.addEventListener js/window "message" on-message) (.addEventListener js/window "message" on-message)

View File

@ -169,3 +169,81 @@
(let [end (timestamp)] (let [end (timestamp)]
(println (str "[" event "]" (- end start))))) (println (str "[" event "]" (- end start)))))
#js {"priority" "user-blocking"}))))) #js {"priority" "user-blocking"})))))
;; --- DEVTOOLS PERF LOGGING
(defonce ^:private longtask-observer* (atom nil))
(defonce ^:private stall-timer* (atom nil))
(defonce ^:private current-op* (atom nil))
(defn- install-long-task-observer
[]
(when (and (some? (.-PerformanceObserver js/window)) (nil? @longtask-observer*))
(let [observer (js/PerformanceObserver.
(fn [list _]
(doseq [entry (.getEntries list)]
(let [dur (.-duration entry)
start (.-startTime entry)
attrib (.-attribution entry)
attrib-count (when attrib (.-length attrib))
first-attrib (when (and attrib-count (> attrib-count 0)) (aget attrib 0))
attrib-name (when first-attrib (.-name first-attrib))
attrib-ctype (when first-attrib (.-containerType first-attrib))
attrib-cid (when first-attrib (.-containerId first-attrib))
attrib-csrc (when first-attrib (.-containerSrc first-attrib))]
(.warn js/console (str "[perf] long task " (Math/round dur) "ms at " (Math/round start) "ms"
(when first-attrib
(str " attrib:name=" attrib-name
" ctype=" attrib-ctype
" cid=" attrib-cid
" csrc=" attrib-csrc))))))))]
(.observe observer #js{:entryTypes #js["longtask"]})
(reset! longtask-observer* observer))))
(defn- start-event-loop-stall-logger
"Log event loop stalls by measuring setInterval drift.
Params:
- interval-ms: base interval
- threshold-ms: drift over which we report
"
[interval-ms threshold-ms]
(when (nil? @stall-timer*)
(let [last (atom (.now js/performance))
id (js/setInterval
(fn []
(let [now (.now js/performance)
expected (+ @last interval-ms)
drift (- now expected)
current-op @current-op*
measures (.getEntriesByType js/performance "measure")
mlen (.-length measures)
last-measure (when (> mlen 0) (aget measures (dec mlen)))
meas-name (when last-measure (.-name last-measure))
meas-detail (when last-measure (.-detail last-measure))
meas-count (when meas-detail (unchecked-get meas-detail "count"))]
(reset! last now)
(when (> drift threshold-ms)
(.warn js/console
(str "[perf] event loop stall: " (Math/round drift) "ms"
(when current-op (str " op=" current-op))
(when meas-name (str " last=" meas-name))
(when meas-count (str " count=" meas-count)))))))
interval-ms)]
(reset! stall-timer* id))))
(defn setup
"Install perf observers in dev builds. Safe to call multiple times.
Perf logs are disabled by default. Enable them with the :perf-logs
flag in config."
[]
(install-long-task-observer)
(start-event-loop-stall-logger 50 100)
;; Expose simple API on window for manual control in devtools
(let [api #js {:reset (fn []
(try
(.clearMarks js/performance)
(.clearMeasures js/performance)
(catch :default _ nil)))}]
(unchecked-set js/window "PenpotPerf" api)))