diff --git a/src/contrib/str.cljc b/src/contrib/str.cljc index fe89f6e7b..7f80d5c44 100644 --- a/src/contrib/str.cljc +++ b/src/contrib/str.cljc @@ -156,3 +156,76 @@ This function is a wrapper for goog.i18n.MessageFormat, supporting a subset of t (defn date ([pattern] (partial date (new DateTimeFormat (or (DATE-FORMATS pattern) pattern)))) ([formatter date] (.format formatter date)))) + +(defn match-position "Return the position of the first `regex` match in `string`." + [regex string] + #?(:clj (let [matcher (re-matcher regex string)] + (if (re-find matcher) + (.start matcher) + 0)) + :cljs (if-let [match (.exec ^js regex string)] + (.-index match) + 0))) + +(tests + (match-position #" at " "") := 0 + (match-position #" at " "foo at bar") := 3 + (match-position #" at " "foo.bar at baz") := 7 + ) + +(defn pad-string "left-pad the first `regex` match in `string` to shift it to the given `position`. + e.g.: (pad-string #\"@\" 5 \"left@right\") => \"left @right\" -- because 'left' is 4 chars " + [regex position string] + (let [match-position (match-position regex string)] + (if (zero? match-position) + string + (str (subs string 0 match-position) + (apply str (repeat (- position match-position) " ")) + (subs string match-position))))) + +(tests + (pad-string #"@" 5 "left@right") := "left @right" + (pad-string #" = " 0 "var x = 1;") := "var x = 1;" + (pad-string #" = " 5 "var x = 1;") := "var x = 1;" + (pad-string #" = " 6 "var x = 1;") := "var x = 1;" + (pad-string #" = " 10 "var x = 1;") := "var x = 1;" + (pad-string #" = " 6 "var x = 1; var y = 2;") := "var x = 1; var y = 2;" + ) + +(defn align-regexp* "Will align all `lines` to the first match of `regex`" [regex lines] + (let [max-match-position (apply max (map (partial match-position regex) lines))] + (map (partial pad-string regex max-match-position) lines))) + +(tests + (align-regexp* #" = " ["var foo = 1;" + "var bar = 11;" + "var asdf = 111;"]) + := ["var foo = 1;" + "var bar = 11;" + "var asdf = 111;"] + ) + +(defn align-regexp " +e.g. (align-regexp #\" = \" +\" +var x = 1; +var y = 2; +var asdf = 3; +\") +=> +\" +var x = 1; +var y = 2; +var asdf = 3; +\" + " [regex string] + (clojure.string/join "\n" (align-regexp* regex (clojure.string/split-lines string)))) + +(tests + (align-regexp #" = " + "var x = 1; +var y = 11; +var asdf = 111;") + := "var x = 1;\nvar y = 11;\nvar asdf = 111;" + ) + diff --git a/src/hyperfiddle/electric.cljc b/src/hyperfiddle/electric.cljc index f32437624..e6a983b8a 100644 --- a/src/hyperfiddle/electric.cljc +++ b/src/hyperfiddle/electric.cljc @@ -16,7 +16,8 @@ #?(:cljs [hyperfiddle.electric-client]) [hyperfiddle.electric.impl.io :as io] [hyperfiddle.electric.debug :as dbg] - [clojure.string :as str]) + [clojure.string :as str] + [contrib.str]) #?(:cljs (:require-macros [hyperfiddle.electric :refer [offload-task offload def check-electric client server fn fn* defn for-by for watch discard with-cycle @@ -247,38 +248,6 @@ executors are allowed (i.e. to control max concurrency, timeouts etc). Currently `(::lang/closure (let [~@(interleave args lang/arg-sym)] ~@body) ~debug-info) `(::lang/closure (do ~@body) ~debug-info)))) -(cc/defn- -splicev [args] (if (empty? args) args (into [] cat [(pop args) (peek args)]))) - -(hyperfiddle.electric/def Apply* - (hyperfiddle.electric/fn* [F args] - (let [spliced (-splicev args)] - (case (count spliced) - 0 (new F) - 1 (new F (nth spliced 0)) - 2 (new F (nth spliced 0) (nth spliced 1)) - 3 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2)) - 4 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3)) - 5 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4)) - 6 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5)) - 7 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6)) - 8 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7)) - 9 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8)) - 10 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9)) - 11 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10)) - 12 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11)) - 13 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12)) - 14 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13)) - 15 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14)) - 16 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14) (nth spliced 15)) - 17 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14) (nth spliced 15) (nth spliced 16)) - 18 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14) (nth spliced 15) (nth spliced 16) (nth spliced 17)) - 19 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14) (nth spliced 15) (nth spliced 16) (nth spliced 17) (nth spliced 18)) - 20 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14) (nth spliced 15) (nth spliced 16) (nth spliced 17) (nth spliced 18) (nth spliced 19)))))) - -(defmacro apply [F & args] - (assert (not (empty? args)) (str `apply " takes and Electric function and at least one argument. Given 0.")) ; matches clojure behavior - `(new Apply* ~F [~@args])) - (cc/defn -check-recur-arity [provided actual fname] (when (not= provided actual) (throw (ex-info (str "You `recur`d in " (or fname "") " with " provided @@ -357,7 +326,8 @@ executors are allowed (i.e. to control max concurrency, timeouts etc). Currently (?bind-self ?name)) {::dbg/name ?name, ::dbg/type (or (::dbg/type (meta ?name)) :reactive-fn) ::dbg/meta (merge (select-keys (meta &form) [:file :line]) - (select-keys (meta ?name) [:file :line]))})))) + (select-keys (meta ?name) [:file :line]) + {::dbg/ns (name (.getName *ns*))})})))) (defmacro defn [sym & fdecl] (let [[_defn sym' & _] (macroexpand `(cc/defn ~sym ~@fdecl))] ; GG: docstring support @@ -375,6 +345,38 @@ executors are allowed (i.e. to control max concurrency, timeouts etc). Currently (rest fdecl) fdecl))))) +(cc/defn- -splicev [args] (if (empty? args) args (into [] cat [(pop args) (peek args)]))) + +(hyperfiddle.electric/defn* Apply* [F args] ; we use `defn*` instead of e/def e/fn* for better stacktraces + (let [spliced (-splicev args)] + (case (count spliced) + 0 (new F) + 1 (new F (nth spliced 0)) + 2 (new F (nth spliced 0) (nth spliced 1)) + 3 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2)) + 4 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3)) + 5 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4)) + 6 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5)) + 7 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6)) + 8 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7)) + 9 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8)) + 10 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9)) + 11 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10)) + 12 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11)) + 13 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12)) + 14 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13)) + 15 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14)) + 16 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14) (nth spliced 15)) + 17 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14) (nth spliced 15) (nth spliced 16)) + 18 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14) (nth spliced 15) (nth spliced 16) (nth spliced 17)) + 19 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14) (nth spliced 15) (nth spliced 16) (nth spliced 17) (nth spliced 18)) + 20 (new F (nth spliced 0) (nth spliced 1) (nth spliced 2) (nth spliced 3) (nth spliced 4) (nth spliced 5) (nth spliced 6) (nth spliced 7) (nth spliced 8) (nth spliced 9) (nth spliced 10) (nth spliced 11) (nth spliced 12) (nth spliced 13) (nth spliced 14) (nth spliced 15) (nth spliced 16) (nth spliced 17) (nth spliced 18) (nth spliced 19))))) + +(defmacro apply [F & args] + (assert (not (empty? args)) (str `apply " takes and Electric function and at least one argument. Given 0.")) ; matches clojure behavior + `(new Apply* ~F [~@args])) + + (defmacro for-by {:style/indent 2} [kf bindings & body] @@ -466,19 +468,47 @@ Quoting it directly is idiomatic as well." Standard electric code runs on mount, therefore there is no `on-mount`." [f] `(new (on-unmount* ~f))) ; experimental -(cc/defn log-root-error [exception] - #?(:clj (log/error exception) - :cljs (println exception))) +(cc/defn log-root-error [exception async-stack-trace] + #?(:clj (let [ex (dbg/empty-client-exception exception) + ex (dbg/clean-jvm-stack-trace! (dbg/remove-async-stack-trace ex)) + ex (dbg/add-async-frames! ex async-stack-trace)] + (if-some [data (not-empty (dissoc (ex-data ex) ::type))] + (log/error ex "Uncaugh exception:" (ex-message ex) "\n" data) + (log/error ex "Uncaugh exception"))) + :cljs (js/console.error exception))) + +#?(:cljs + (cc/defn- client-log-server-error [message async-trace] + (let [err (js/Error. message)] + (set! (.-stack err) (first (str/split-lines (.-stack err)))) + (js/console.error err) ; We'd like to bundle these two messages into one, but chrome refuses to render "\n" after an exception. + ; We would need browser-custom formatting. Not worth it today. + (js/console.log (->> (dbg/render-async-stack-trace async-trace) + (contrib.str/align-regexp #" at ") + (dbg/left-pad-stack-trace 4)) + "\n" "This is a server-side exception. The full exception was printed on the server.")))) + +#?(:cljs + (cc/defn- client-log-client-error [ex async-trace] + (set! (.-stack ex) (dbg/cleanup-js-stack-trace (.-stack ex))) + (js/console.error ex) ; We'd like to bundle these two messages into one, but chrome refuses to render "\n" after an exception. + ; We would need browser-custom formatting. Not worth it today. + (js/console.log (->> (dbg/render-async-stack-trace async-trace) + (contrib.str/align-regexp #" at ") + (dbg/left-pad-stack-trace 4))))) (hyperfiddle.electric/defn ?PrintClientException [msg id] - (try (client - (if-some [ex (io/get-original-ex id)] - (do - (log-root-error ex) - (try (server (println "client logged an exception, too")) - (catch Pending _))) - (js/console.warn "exception printed on server: " msg))) - (catch Pending _))) + (server + (let [async-trace (::dbg/trace (ex-data lang/trace))] + (try + (client + (if-some [ex (io/get-original-ex id)] + (do + (client-log-client-error ex async-trace) + (try (server (log/info "This is a client-side exception. The full exception was printed on the client.")) + (catch Pending _))) + (client-log-server-error msg async-trace))) + (catch Pending _))))) (defmacro with-zero-config-entrypoint {:style/indent 0} @@ -488,8 +518,7 @@ Quoting it directly is idiomatic as well." (catch Pending _#) ; silently ignore (catch Cancelled e# (throw e#)) ; bypass catchall, app is shutting down (catch Throwable err# - (log-root-error (or (io/get-original-ex (dbg/ex-id lang/trace)) err#)) - (println (dbg/stack-trace lang/trace)) + (log-root-error (or (io/get-original-ex (dbg/ex-id lang/trace)) err#) (dbg/get-async-trace lang/trace)) (new ?PrintClientException (ex-message err#) (dbg/ex-id lang/trace))))) (defmacro boot-server [opts Main & args] diff --git a/src/hyperfiddle/electric/debug.cljc b/src/hyperfiddle/electric/debug.cljc index 1f58ec1d8..628b8b154 100644 --- a/src/hyperfiddle/electric/debug.cljc +++ b/src/hyperfiddle/electric/debug.cljc @@ -1,13 +1,14 @@ (ns hyperfiddle.electric.debug - (:require #_[hyperfiddle.electric.impl.runtime :as-alias r] - [clojure.string :as str] + (:require [clojure.string :as str] [contrib.data :as data] [hyperfiddle.electric.impl.ir :as-alias ir] - [hyperfiddle.rcf :as rcf :refer [tests]]) - (:import (hyperfiddle.electric Failure Pending) - (missionary Cancelled) - #?(:clj (clojure.lang ExceptionInfo)) - (hyperfiddle.electric FailureInfo))) + [hyperfiddle.rcf :as rcf :refer [tests]] + #?(:cljs [goog.testing.stacktrace :as st]) + [contrib.str]) + (:import #?(:clj (clojure.lang ExceptionInfo)) + (hyperfiddle.electric Failure Pending) + (hyperfiddle.electric FailureInfo) + (missionary Cancelled))) (defn ->id [] #?(:clj (java.util.UUID/randomUUID) @@ -30,13 +31,13 @@ (defn ex-id [ex] (.-id ^FailureInfo ex)) -(defn add-stack-frame [frame ex] - (let [frame (assoc frame ::origin PEER-ID)] - (if (instance? FailureInfo ex) - (ex-info* (ex-message ex) (update (ex-data ex) ::trace conj frame) (ex-id ex) (or (ex-cause ex) ex)) - (ex-info* (ex-message ex) {::trace [frame]} ex)))) +(defn add-stack-frame [stack-frame exception] + (let [stack-frame (assoc stack-frame ::origin PEER-ID)] + (if (instance? FailureInfo exception) + (ex-info* (ex-message exception) (update (ex-data exception) ::trace conj stack-frame) (ex-id exception) (or (ex-cause exception) exception)) + (ex-info* (ex-message exception) {::trace [stack-frame]} exception)))) -(defn concat-stacks [ex1 ex2] +(defn concat-async-stacks [ex1 ex2] (assert (instance? FailureInfo ex1)) (assert (instance? FailureInfo ex2)) (ex-info* (ex-message ex1) (update (ex-data ex1) ::trace into (::trace (ex-data ex2))) (or (ex-cause ex1) (ex-cause ex2) ex2))) @@ -49,75 +50,31 @@ (if (or (instance? Pending err) (instance? Cancelled err)) failure (Failure. (cond-> (add-stack-frame debug-info err) - (some? context) (concat-stacks context))))))) + (some? context) (concat-async-stacks context))))))) (tests "rewrapping keeps same ID" (def ex (ex-info* "x" {})) (ex-id ex) := (ex-id (add-stack-frame {} ex))) -(defn render-arg [arg] - (cond - (string? arg) arg - (ident? arg) arg - - (or (instance? hyperfiddle.electric.Failure arg) - #?(:clj (instance? Throwable arg) - :cljs (instance? js/Error arg))) - (symbol "") - - :else - (binding [*print-level* 1 - *print-length* 4] - (pr-str arg)))) - -(defn serializable-frame [frame] - (if (::serializable frame) - frame - (-> (update frame ::args (partial mapv render-arg)) - (assoc ::serializable true)))) - -(defn serializable [map] - (if (contains? map ::trace) - (update map ::trace (partial mapv serializable-frame)) - map)) - -(defn normalize-frame [frame] - (let [meta (::meta frame) - dbg-in-meta (data/select-ns :hyperfiddle.electric.debug (::meta frame))] - (merge frame dbg-in-meta {::meta (dissoc meta dbg-in-meta)}))) - -(declare frames) - -(defn expand-frame - "Turn a stack frame into a sequence of lines to report" - [frame] - (let [{::keys [type name args]} frame] - (case type - :apply (case name - ;; hyperfiddle.electric.impl.runtime/fail (concat (frames (second args)) [frame]) - [frame]) - [frame]))) - -(defn frames [err] - (some->> (::trace (ex-data err)) - (remove (fn [frame] (= {} (::fn frame)))) ; (do a b) => ({} a b) - (filter ::type) - (map normalize-frame) - (mapcat expand-frame))) - -(defn locate [frame] - (let [{::keys [origin type meta] :as frame} (normalize-frame frame)] - (cond-> frame - (and (not= PEER-ID origin) - (not (#{:transfer :toggle} type))) (assoc ::remote true) - (:line meta) (assoc ::line (:line meta)) - (:file meta) (assoc ::file (:file meta))))) +(defn normalize-async-stack-frame [stack-frame] + (let [meta (::meta stack-frame) + dbg-in-meta (data/select-ns :hyperfiddle.electric.debug (::meta stack-frame))] + (merge stack-frame dbg-in-meta {::meta (apply dissoc meta (keys dbg-in-meta))}))) + +(defn get-async-trace [exception] (::trace (ex-data exception))) + +(defn locate-stack-frame [{::keys [origin type meta] :as frame}] + (cond-> frame + (and (not= PEER-ID origin) + (not (#{:transfer :toggle} type))) (assoc ::remote? true) + (:line meta) (assoc ::line (:line meta)) + (:file meta) (assoc ::file (:file meta)))) (def fail? '#{hyperfiddle.electric.impl.runtime/fail}) -(defn render-frame [frame] +#_ (defn render-frame [frame] (let [{::keys [remote file line macro scope type name params args meta]} frame] - (->> ["in" + (->> [" in" (when remote "remote") (when macro "macro") (case scope @@ -128,28 +85,28 @@ (str/join " " (case type :apply (if (fail? name) - ["(throw" ~(render-arg (first args)) ")"] - `["(" ~name ~@(map render-arg args) ")"]) + ["(throw ...)"] + ["call to" name]) :eval (if (fail? (::fn frame)) - `["(throw" ~(render-arg (first args)) ")"] + ["(throw ...)"] (let [{::keys [action target method args]} frame] (case action :field-access ["(" (str ".-" method) target ")"] - :static-call `["(" ~(str target "/" method) ~@(map render-arg (rest args)) ")"] - :call `["(" ~(str "." method) ~target ~@(map render-arg (rest args))")"] + :static-call [(str target "/" method)] + :call [(str target "." method)] :fn-call (if (some? name) - `["(" (clojure.core/fn ~name [~@params] ~'...) ~@(map render-arg args) ")"] - `["(" (clojure.core/fn [~@params] ~'...) ~@(map render-arg args) ")"]) + `[(clojure.core/fn ~name [~@params] ~'...)] + `[(clojure.core/fn [~@params] ~'...)]) #_else (let [f (or (::fn frame) (::ir/form frame) "")] - `["(" ~f ~@(map render-arg args) ")"])))) + [(str "call to `" f "`")])))) :reactive-fn ["reactive" (if (some? name) - `(~'fn ~name ~args ~'...) - `(~'fn ~args ~'...))] - :reactive-defn ["reactive" `(~'defn ~name ~args ~'...)] + `(~'fn ~name ~'...) + `(~'fn ~'...))] + :reactive-defn ["reactive" 'defn (str "`" name "`")] :try ["(try ...)" ] - :catch [`(~'catch ~@args ~'...)] + :catch [`(~'catch ~'...)] :finally ["(finally ...)"] - :case-clause [`(~'case ~@args ~'...)] + :case-clause [`(~'case ~'...)] :case-default ["case default branch"] :transfer ["transfer to" (clojure.core/name name)] :toggle ["transfer"] @@ -162,15 +119,185 @@ (remove nil?) (str/join " ")))) -(defn render-stack-trace [err] - (->> (frames err) - (map locate) - (map render-frame) - (str/join "\n"))) +;;; CLJS stack frames + +;; #?(:cljs +;; (defn- get-running-js-script-location [] +;; (let [canonical-frame (->> (.-stack (js/Error.)) +;; (str/split-lines) +;; (first) +;; (st/canonicalize)) +;; [_file url] (str/split canonical-frame #"\sat\s") +;; parsed-url (js/URL. url) +;; origin (.-origin parsed-url) +;; pathname (.-pathname parsed-url) +;; pathname-without-file (str/join "/" (butlast (str/split pathname #"/")))] +;; (str origin pathname-without-file)))) + +(defn file->ns [file] + (when file + (when-let [match (second (re-find #"/?(.*)\..*$" (str file)))] + (str/replace match #"/" ".")))) + +(defn js-stack-frame-name [{::keys [name ns file] :as _stack-frame}] + (str (when (or ns file) (str (or ns (file->ns file)) ".")) name)) + +(defn js-stack-frame-location [{::keys [ns file line column]}] + (when (or ns file) + #?(:clj (str "(" (or ns file) (when line (str ":" line)) ")") + :cljs (str #_(get-running-js-script-location) #_"/" (or ns file) + (when line (str ":" line (when column (str ":" column)))))))) + +(defn render-canonical-js-stack-frame [frame] + (str (js-stack-frame-name frame) " at " (js-stack-frame-location frame))) + +;;; JVM stack frames + +(defn path->file [path] (when path (last (str/split (str path) #"/")))) + +(defn jvm-trace-element-class-name [{::keys [name ns file]}] + (str (or ns (file->ns file)) "$" name)) + +(defn jvm-trace-element-file-name [{::keys [ns file]}] + (cond + file (path->file file) + ns (-> (str/replace (str ns) #"-" "_") + (str/replace #"\." "/") + (path->file)) + :else "")) + +#?(:clj + (defn render-jvm-stack-frame [{::keys [name line] :as stack-frame}] + (StackTraceElement. (jvm-trace-element-class-name stack-frame) ;; canonicalize ns and filename to a_b.c$d + (str name) (jvm-trace-element-file-name stack-frame) (or line 0)))) + +;;; Common interface + +(defn render-stack-frame [stack-frame] + #?(:clj (render-jvm-stack-frame stack-frame) + :cljs (render-canonical-js-stack-frame stack-frame))) + +(defn cleanup-async-stack-trace [stack-trace] + (->> stack-trace + (filter ::type) + (map normalize-async-stack-frame) + (map locate-stack-frame) + (filter (fn [stack-frame] + (and (::name stack-frame) ; only keep namepd and located frames, others are useless + (or (::file stack-frame) + (::ns stack-frame))))))) + +(defn render-async-stack-trace [trace] + (let [trace-elements (->> trace + (cleanup-async-stack-trace) + (map render-stack-frame) + (dedupe))] + #?(:clj trace-elements + :cljs (not-empty (str/join "\n" trace-elements))))) + +(defn async-stack-trace [exception] + (render-async-stack-trace (get-async-trace exception))) + +;;; ------- + +(defn add-async-frames! [exception async-trace] + #?(:clj (let [exception (if (instance? hyperfiddle.electric.FailureInfo exception) (Throwable. (ex-message exception)) exception)] + (.setStackTrace ^Throwable exception (into-array StackTraceElement (concat (.getStackTrace exception) (render-async-stack-trace async-trace)))) + exception) + :cljs (set! (.-stack exception) (str (.-stack exception) "\n" (render-async-stack-trace async-trace))))) + + -(defn stack-trace [err] (render-stack-trace err)) (defn unwrap [exception] (if (= ::trace (:hyperfiddle.electric/type (ex-data exception))) - (ex-cause exception) + (or (ex-cause exception) exception) exception)) + +(defn remove-async-stack-trace [ex] + (unwrap + (cond + (instance? ExceptionInfo ex) (ex-info (ex-message ex) (dissoc (ex-data ex) ::trace) (remove-async-stack-trace (ex-cause ex))) + (instance? FailureInfo ex) (ex-info* (ex-message ex) (dissoc (ex-data ex) ::trace) (remove-async-stack-trace (ex-cause ex))) + :else ex))) + +#?(:clj + (defn clean-jvm-stack-trace! [ex] + (->> (seq (.getStackTrace ex)) + (take-while (fn [^StackTraceElement elem] + (not (clojure.string/starts-with? (.getClassName elem) "hyperfiddle.electric.impl.runtime" #_"hyperfiddle.electric.debug")))) + (reverse) + (drop-while (fn [^StackTraceElement elem] + (and (#{"clojure.lang.AFn" "clojure.core$apply"} (.getClassName elem)) + (#{"invoke" "applyTo" "invokeStatic" "applyToHelper"} (.getMethodName elem))))) + (reverse) + (into-array StackTraceElement) + (.setStackTrace ex)) + ex)) + +;; (comment +;; (clean-stack-trace! (try (apply inc nil) (catch Throwable t t)))) + +#?(:cljs + (defn parse-canonical-js-stack-frame [js-stack-frame] + (let [[name location] (-> js-stack-frame + (str/replace-first #"^>\s+" "") + (str/split #"\s+at\s+") + )] + {::name name, ::location location}))) + +#?(:cljs + (defn parse-js-stack-trace [js-stack-trace] + (->> (st/canonicalize js-stack-trace) + (str/split-lines) + (map parse-canonical-js-stack-frame)))) + +#?(:cljs + (defn serialize-canonical-js-stack-trace [parsed-js-stack-trace] + (->> parsed-js-stack-trace + (map (fn [{::keys [name location] :as _stack-frame}] + (str name " at " location))) + (str/join "\n")))) + +#?(:cljs + (defn cleanup-cljs-stack-trace [js-stack-trace] ; obtain a js-stack-trace with `(.-stack js-exception)` + (when js-stack-trace + (->> (parse-js-stack-trace js-stack-trace) + (filter ::location) + (take-while (fn [{::keys [location]}] (not (str/includes? location "hyperfiddle.electric.impl.runtime")))) + (reverse) + (drop-while (fn [{::keys [name]}] (str/starts-with? name "cljs.core.apply"))) + (reverse) + (serialize-canonical-js-stack-trace))))) + +(defn cleanup-js-stack-trace [js-stack-trace] ; obtain a js-stack-trace with `(.-stack js-exception)` + (when js-stack-trace + (->> (str/split-lines js-stack-trace) + (take-while #(not (str/includes? % "hyperfiddle.electric.impl.runtime"))) + (reverse) + (drop-while #(str/starts-with? % "cljs.core.apply")) + (reverse) + (str/join "\n")))) + +;; #?(:cljs +;; (defn dark-browser-theme? [] +;; (and (.-matchMedia js/window) (.-matches (.matchMedia js/window "(prefers-color-scheme: dark)"))))) + +(defn left-pad-stack-trace + ([string] + (left-pad-stack-trace 2 string)) + ([num-spaces string] + (let [pad (str/join "" (repeat num-spaces " "))] + (->> (str/split string #"\n") + (map (fn [line] (str pad line))) + (str/join "\n"))))) + + +;; (left-pad-stack-trace "a \n b") + +(defn empty-client-exception [exception] + #?(:clj + (if (instance? FailureInfo exception) + (doto (Throwable. (ex-message exception)) + (.setStackTrace (into-array StackTraceElement []))) + exception))) diff --git a/src/hyperfiddle/electric/impl/io.cljc b/src/hyperfiddle/electric/impl/io.cljc index 122044818..3e7bd4f90 100644 --- a/src/hyperfiddle/electric/impl/io.cljc +++ b/src/hyperfiddle/electric/impl/io.cljc @@ -85,8 +85,8 @@ (let [err (.-error ^Failure x)] (cond (instance? Cancelled err) [:cancelled] (instance? Pending err) [:pending] - (instance? Remote err) [:remote (dbg/serializable (ex-data err))] - :else [:exception (ex-message err) (dbg/serializable (ex-data err)) + (instance? Remote err) [:remote (ex-data err)] + :else [:exception (ex-message err) (ex-data err) (save-original-ex! err)]))))) (defn write-opts [] diff --git a/src/hyperfiddle/electric/impl/lang.clj b/src/hyperfiddle/electric/impl/lang.clj index 631724267..17f44c7f8 100644 --- a/src/hyperfiddle/electric/impl/lang.clj +++ b/src/hyperfiddle/electric/impl/lang.clj @@ -186,7 +186,6 @@ (analyze-me env (list ::closure default-clause {::dbg/type :case-default})) (mapv (fn [[test form]] (analyze-me env `(::closure ~form {::dbg/type :case-clause - ::dbg/args [~test] ::dbg/meta ~(meta form)}))) (partition 2 clauses)))))))) @@ -205,7 +204,6 @@ (analyze-them env (list ::closure default-clause {::dbg/type :case-default})) (eduction (partition-all 2) (map (fn [[test form]] (analyze-them env `(::closure ~form {::dbg/type :case-clause - ::dbg/args [~test] ::dbg/meta ~(meta form)})))) clauses))))) @@ -329,7 +327,7 @@ (::closure (let [~s (dbg/unwrap exception)] (binding [trace exception] ~@body)) - {::dbg/type :catch, ::dbg/args [~c ~s]}))] + {::dbg/type :catch}))] (case c (:default Throwable) `(r/clause ~f) @@ -339,14 +337,14 @@ (defn ->class-method-call [clazz method method-args env] (apply ir/apply (assoc (ir/eval (let [margs (repeatedly (count method-args) gensym)] `(fn [~@margs] (. ~clazz ~method ~@margs)))) - ::dbg/action :static-call, ::dbg/target clazz, ::dbg/method method, ::dbg/args method-args) + ::dbg/action :static-call, ::dbg/target clazz, ::dbg/method method) (mapv #(analyze-me env %) method-args))) (defn ->obj-method-call [o method method-args env] (apply ir/apply (assoc (ir/eval (let [margs (repeatedly (count method-args) gensym) oo (with-meta (gensym "o") (->meta o env))] `(fn [~oo ~@margs] (. ~oo ~method ~@margs)))) - ::dbg/action :call, ::dbg/target o, ::dbg/method method, ::dbg/args method-args) + ::dbg/action :call, ::dbg/target o, ::dbg/method method) (analyze-me env o) (mapv #(analyze-me env %) method-args))) @@ -542,7 +540,7 @@ (if-let [resolved (and (symbol? op) (= :cljs (get (::peers env) (::current env))) (->> (expand/resolve-cljs env op) (keep-if (comp '#{js} :ns)) :name))] (assoc (ir/eval (bound-js-fn resolved)) ::ir/tag 'js) - (assoc (analyze-me env op) ::dbg/fn op)) + (assoc (analyze-me env op) ::dbg/name op ::dbg/file (:file (meta op)) ::dbg/line (:line (meta op)))) (mapv #(analyze-me env %) args)))) (node-signifier? (meta form)) diff --git a/src/hyperfiddle/electric/impl/runtime.cljc b/src/hyperfiddle/electric/impl/runtime.cljc index 3c1243a77..1ee02a0d1 100644 --- a/src/hyperfiddle/electric/impl/runtime.cljc +++ b/src/hyperfiddle/electric/impl/runtime.cljc @@ -90,16 +90,16 @@ (defn handle-apply-error [debug-info args error] (if (= `fail (::dbg/name debug-info)) - (let [[thrown context] args] - (dbg/error (assoc (select-debug-info debug-info) ::dbg/args [thrown]) (Failure. error) context)) - (dbg/error (assoc (select-debug-info debug-info) ::dbg/args args) (Failure. error)))) + (let [[_thrown context] args] + (dbg/error (select-debug-info debug-info) (Failure. error) context)) + (dbg/error (select-debug-info debug-info) (Failure. error)))) (defn latest-apply [debug-info & args] (ca/check (partial every? some?) args debug-info) (apply m/latest (fn [f & args] (if-let [err (apply failure f args)] - (dbg/error (assoc (select-debug-info debug-info) ::dbg/args args) err) + (dbg/error (select-debug-info debug-info) err) (try (apply f args) (catch #?(:clj Throwable :cljs :default) e (handle-apply-error debug-info args e))))) @@ -110,7 +110,7 @@ (fn [x y] (let [args [x y]] (if-let [err (failure x y)] - (dbg/error (assoc debug-info ::dbg/args args) err) + (dbg/error debug-info err) ({} x y)))) x y)) @@ -1030,7 +1030,7 @@ ::ir/global (assoc f ::dbg/type :apply, ::dbg/name (symbol (::ir/name f))) ::ir/node (assoc f ::dbg/type :apply) ::ir/eval (cond-> (assoc f ::dbg/type :eval) - (not (::dbg/fn f)) (assoc ::dbg/fn (::ir/form f))) + (not (::dbg/name f)) (assoc ::dbg/form (::ir/form f))) ::ir/sub (assoc f ::dbg/type :apply) ::ir/input (assoc f ::dbg/type :apply) ::ir/apply (recur (::ir/fn f))