penpot/frontend/src/app/main/store.cljs
Andrey Antukh 66b978c01e Add wall-clock timestamps to last-events buffer
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>
2026-07-23 10:50:06 +02:00

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)))))