mirror of
https://github.com/penpot/penpot.git
synced 2026-08-13 16:28:59 +00:00
Each event entry in `last-events` is now wrapped as
`{:name <event-type> :t (app.common.time/now)}` so every event carries a
wall-clock timestamp. A new helper `format-last-events` renders the
buffer as a multi-line string with ISO time and delta-since-previous-
event in ms, replacing the previous pprint dump in error reports.
This lets support/devs tell whether the events leading up to a crash
were spaced out (user action) or jammed together (runaway loop).
AI-assisted-by: minimax-m3
Signed-off-by: Andrey Antukh <niwi@niwi.nz>
150 lines
4.7 KiB
Clojure
150 lines
4.7 KiB
Clojure
;; 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 Sucursal en España SL
|
|
|
|
(ns app.main.store
|
|
(:require
|
|
[app.common.logging :as log]
|
|
[app.common.time :as ct]
|
|
[app.util.object :as obj]
|
|
[app.util.timers :as tm]
|
|
[beicon.v2.core :as rx]
|
|
[beicon.v2.operators :as rxo]
|
|
[cuerdas.core :as str]
|
|
[okulary.core :as l]
|
|
[potok.v2.core :as ptk]))
|
|
|
|
(log/set-level! :info)
|
|
|
|
(enable-console-print!)
|
|
|
|
(defonce loader (l/atom false))
|
|
(defonce on-error (l/atom identity))
|
|
|
|
(defmethod ptk/resolve :default
|
|
[type data]
|
|
(ptk/data-event type data))
|
|
|
|
(def on-event identity)
|
|
|
|
(def ^:dynamic *debug-events* false)
|
|
(def ^:dynamic *debug-events-time* false)
|
|
|
|
(def current-measure (atom nil))
|
|
|
|
(defn measure-time-to-render [event]
|
|
(if @current-measure
|
|
(swap! current-measure conj event)
|
|
|
|
(let [start (js/performance.now)]
|
|
(reset! current-measure [event])
|
|
|
|
(tm/raf
|
|
#(js/scheduler.postTask
|
|
(fn []
|
|
(let [time (- (js/performance.now) start)]
|
|
;; Only print sets that last over 1second
|
|
(when (> time 1000)
|
|
(println
|
|
(str time "|" (str/join "," @current-measure)))))
|
|
(reset! current-measure nil))
|
|
|
|
#js {"priority" "user-blocking"})))))
|
|
|
|
;; Only created in development build
|
|
(when *assert*
|
|
(def debug-exclude-events
|
|
#{:app.main.data.workspace.notifications/handle-pointer-update
|
|
:app.main.data.workspace.notifications/handle-pointer-send
|
|
:app.main.data.websocket/send-message
|
|
:app.main.data.workspace.selection/change-hover-state})
|
|
|
|
(set! on-event (fn [e]
|
|
(when (and *debug-events-time* (ptk/event? e))
|
|
(measure-time-to-render (ptk/type e)))
|
|
(when (and *debug-events*
|
|
(ptk/event? e)
|
|
(not (debug-exclude-events (ptk/type e))))
|
|
(.log js/console (str "[stream]: " (ptk/repr-event e)))))))
|
|
|
|
(defonce state
|
|
(ptk/store {:resolve ptk/resolve
|
|
:on-event on-event
|
|
:on-error (fn [cause]
|
|
(when cause
|
|
#_(log/error :hint "unexpected exception on store" :cause cause)
|
|
(@on-error cause)))}))
|
|
|
|
(defonce stream
|
|
(ptk/input-stream state))
|
|
|
|
(defonce last-events
|
|
(let [buffer (atom [])
|
|
omitset #{:potok.v2.core/undefined
|
|
:app.main.data.workspace.persistence/update-persistence-status
|
|
:app.main.data.websocket/send-message
|
|
:app.main.data.workspace.notifications/handle-pointer-send
|
|
:app.main.router/assign-exception}]
|
|
(->> (rx/merge
|
|
(->> stream
|
|
(rx/filter (ptk/type? :app.main.data.changes/commit))
|
|
(rx/map #(-> % deref :hint-origin)))
|
|
(rx/map ptk/type stream))
|
|
(rx/filter #(not (contains? omitset %)))
|
|
(rx/map str)
|
|
(rx/pipe (rxo/distinct-contiguous))
|
|
(rx/map (fn [event] {:name event :t (ct/now)}))
|
|
(rx/scan (fn [buffer event]
|
|
(cond-> (conj buffer event)
|
|
(> (count buffer) 50)
|
|
(pop)))
|
|
#queue [])
|
|
(rx/subs! #(reset! buffer (vec %))))
|
|
buffer))
|
|
|
|
(defn format-last-events
|
|
"Render the `last-events` buffer as a multi-line string with the
|
|
wall-clock time of each event and the delta (ms) since the previous
|
|
entry. The first entry has no delta. Useful for embedding in error
|
|
reports."
|
|
([] (format-last-events @last-events))
|
|
([events]
|
|
(let [lines
|
|
(loop [prev-t nil
|
|
xs (seq events)
|
|
out (transient [])]
|
|
(if xs
|
|
(let [{:keys [name t]} (first xs)
|
|
iso (ct/format-inst t :iso)
|
|
tail (if prev-t
|
|
(str " (+" (ct/diff-ms prev-t t) "ms)")
|
|
"")]
|
|
(recur t
|
|
(next xs)
|
|
(conj! out (str iso tail " " name))))
|
|
(persistent! out)))]
|
|
(str/join "\n" lines))))
|
|
|
|
(defn emit!
|
|
([] nil)
|
|
([event]
|
|
(ptk/emit! state event)
|
|
nil)
|
|
([event & events]
|
|
(apply ptk/emit! state (cons event events))
|
|
nil))
|
|
|
|
(defn async-emit!
|
|
[& params]
|
|
(tm/schedule #(apply emit! params)))
|
|
|
|
(defonce ongoing-tasks (l/atom #{}))
|
|
|
|
(add-watch ongoing-tasks ::ongoing-tasks
|
|
(fn [_ _ _ events]
|
|
(if (empty? events)
|
|
(obj/set! js/window "onbeforeunload" nil)
|
|
(obj/set! js/window "onbeforeunload" (constantly false)))))
|