From 4fe08dd53305ffa538daba2d8470fbae2b6fceb6 Mon Sep 17 00:00:00 2001 From: Michiel Borkent Date: Thu, 27 May 2021 11:35:40 +0200 Subject: [PATCH] Improve error reporting --- src/scittle/core.cljs | 25 +++++++-- src/scittle/impl/error.cljs | 109 ++++++++++++++++++++++++++++++++++++ 2 files changed, 129 insertions(+), 5 deletions(-) create mode 100644 src/scittle/impl/error.cljs diff --git a/src/scittle/core.cljs b/src/scittle/core.cljs index 94f28e8..ba4e037 100644 --- a/src/scittle/core.cljs +++ b/src/scittle/core.cljs @@ -2,7 +2,8 @@ (:refer-clojure :exclude [time]) (:require [goog.object :as gobject] [goog.string] - [sci.core :as sci])) + [sci.core :as sci] + [scittle.impl.error :as error])) (clojure.core/defmacro time "Evaluates expr and prints the time it took. Returns the value of expr." @@ -29,7 +30,13 @@ :allow :all}}))) (defn ^:export eval-string [s] - (sci/eval-string* @ctx s)) + (try (sci/eval-string* @ctx s) + (catch :default e + (error/error-handler e (:src @ctx)) + (let [sci-error? (isa? (:type (ex-data e)) :sci/error)] + (throw (if sci-error? + (or (ex-cause e) e) + e)))))) (defn register-plugin! [plug-in-name sci-opts] plug-in-name ;; unused for now @@ -38,15 +45,23 @@ (defn- eval-script-tags* [script-tags] (when-let [tag (first script-tags)] (if-let [text (not-empty (gobject/get tag "textContent"))] - (do (eval-string text) - (eval-script-tags* (rest script-tags))) + (let [scittle-id (str (gensym "scittle-tag-"))] + (gobject/set tag "scittle_id" scittle-id) + (swap! ctx assoc-in [:src scittle-id] text) + (sci/binding [sci/file scittle-id] + (eval-string text)) + (eval-script-tags* (rest script-tags))) (let [src (.getAttribute tag "src") req (js/XMLHttpRequest.) _ (.open req "GET" src true) _ (gobject/set req "onload" (fn [] (this-as this (let [response (gobject/get this "response")] - (eval-string response)) + (gobject/set tag "scittle_id" src) + ;; save source for error messages + (swap! ctx assoc-in [:src src] response) + (sci/binding [sci/file src] + (eval-string response))) (eval-script-tags* (rest script-tags)))))] (.send req))))) diff --git a/src/scittle/impl/error.cljs b/src/scittle/impl/error.cljs new file mode 100644 index 0000000..24413a7 --- /dev/null +++ b/src/scittle/impl/error.cljs @@ -0,0 +1,109 @@ +(ns scittle.impl.error + (:refer-clojure :exclude [println]) + (:require [clojure.string :as str] + [sci.impl.callstack :as cs])) + +(defn println [& strs] + (.error js/console (str/join " " strs))) + +(defn ruler [title] + (println (apply str "----- " title " " (repeat (- 50 7 (count title)) \-)))) + +(defn split-stacktrace [stacktrace verbose?] + (if verbose? [stacktrace] + (let [stack-count (count stacktrace)] + (if (<= stack-count 10) + [stacktrace] + [(take 5 stacktrace) + (drop (- stack-count 5) stacktrace)])))) + +(defn print-stacktrace + [stacktrace {:keys [:verbose?]}] + (let [stacktrace (cs/format-stacktrace stacktrace) + segments (split-stacktrace stacktrace verbose?) + [fst snd] segments] + (run! #(print % "\n") fst) + (when snd + (print "...\n") + (run! #(print % "\n") snd)))) + +(defn error-context [ex src-map] + (let [{:keys [:file :line :column]} (ex-data ex)] + (when (and file line) + (when-let [content (get src-map file)] + (let [matching-line (dec line) + start-line (max (- matching-line 4) 0) + end-line (+ matching-line 6) + [before after] (->> + (str/split-lines content) + (map-indexed list) + (drop start-line) + (take (- end-line start-line)) + (split-at (inc (- matching-line start-line)))) + snippet-lines (concat before + [[nil (str (str/join "" (repeat (dec column) " ")) + (str "^--- " (ex-message ex)))]] + after) + indices (map first snippet-lines) + max-size (reduce max 0 (map (comp count str) indices)) + snippet-lines (map (fn [[idx line]] + (if idx + (let [line-number (inc idx)] + (str (.padStart (str line-number) max-size "0") " " line)) + (str (str/join (repeat (+ 2 max-size) " ")) line))) + snippet-lines)] + (str "\n" (str/join "\n" snippet-lines))))))) + +(defn right-pad [s n] + (let [n (- n (count s))] + (str s (str/join (repeat n " "))))) + +(defn print-locals [locals] + (let [max-name-length (reduce max 0 (map (comp count str) + (keys locals))) + max-name-length (+ max-name-length 2)] + (println + (with-out-str (binding [*print-length* 10 + *print-level* 2] + (doseq [[k v] locals] + (print (str (right-pad (str k ": ") max-name-length))) + ;; print nil as nil + (prn v))))))) + +(defn error-handler [e src-map] + (let [d (ex-data e) + sci-error? (isa? (:type d) :sci/error) + stacktrace (some-> + d :sci.impl/callstack + cs/stacktrace)] + (ruler "Scittle error") + (when-let [name (.-name e)] + (when-not (= "Error" name) + (println "Type: " name))) + (when-let [m (.-message e)] + (println (str "Message: " m))) + (when-let [d (ex-data (ex-cause e) #_(.getCause e))] + (print (str "Data: ")) + (prn d)) + (let [{:keys [:file :line :column]} d] + (when line + (println (str "Location: " + (when file (str file ":")) + line ":" column"")))) + (when-let [phase (cs/phase e stacktrace)] + (println "Phase: " phase)) + (when-let [ec (when sci-error? + (error-context e src-map))] + (ruler "Context") + (println ec)) + (when-let [locals (not-empty (:locals d))] + (ruler "Locals") + (print-locals locals)) + (when sci-error? + (when-let + [st (let [st (with-out-str + (when stacktrace + (print-stacktrace stacktrace src-map)))] + (when-not (str/blank? st) st))] + (ruler "Stack trace") + (println st)))))