Imitate clojure.main Error Reporting

Fixes #1004
planck-repl · Aug 18, 2019 · 249b3ef · 249b3ef
1 parent 60e8114
commit 249b3ef
Show file tree

Hide file tree

Showing 8 changed files with 166 additions and 52 deletions.
diff --git a/doc/running.md b/doc/running.md
@@ -65,3 +65,15 @@ Options that may be configured via `-co` / `--compile-opts` comprise:
 - [:verbose](https://clojurescript.org/reference/compiler-options#verbose)
 - [:warnings](https://clojurescript.org/reference/compiler-options#warnings)
 - [:warn-on-undeclared](https://clojurescript.org/reference/repl-options#warn-on-undeclared)
+
+### Error Reporting
+
+Planck will catch exceptions and use the same error triage and printing functionality present in the REPL. The full stack trace, ex-info, and other information will be printed to a target specified by the configuration.
+
+The three available error targets are:
+
+* file - write to a temp file (default, falls back to stderr)
+* stderr - write to stderr stream
+* none - don't write
+
+These error targets can be specified as an option to `planck` or `plk`: use `--report <target>`.
diff --git a/planck-c/engine.c b/planck-c/engine.c
@@ -620,7 +620,7 @@ void *do_engine_init(void *data) {
     set_print_sender(&discarding_sender);
 
     {
-        JSValueRef arguments[9];
+        JSValueRef arguments[10];
         arguments[0] = JSValueMakeBoolean(ctx, config.repl);
         arguments[1] = JSValueMakeBoolean(ctx, config.verbose);
         JSValueRef cache_path_ref = NULL;
@@ -649,9 +649,15 @@ void *do_engine_init(void *data) {
             compile_opts[i] = JSValueMakeString(ctx, compile_opts_str);
         }
         arguments[8] = JSObjectMakeArray(ctx, config.num_compile_opts, compile_opts, NULL);
+        JSValueRef report_ref = NULL;
+        if (config.report != NULL) {
+            JSStringRef report_str = JSStringCreateWithUTF8CString(config.report);
+            report_ref = JSValueMakeString(ctx, report_str);
+        }
+        arguments[9] = report_ref;
 
         JSValueRef ex = NULL;
-        JSObjectCallAsFunction(ctx, get_function("planck.repl", "init"), JSContextGetGlobalObject(ctx), 9,
+        JSObjectCallAsFunction(ctx, get_function("planck.repl", "init"), JSContextGetGlobalObject(ctx), 10,
                                arguments, &ex);
         debug_print_value("planck.repl/init", ctx, ex);
 

diff --git a/planck-c/globals.h b/planck-c/globals.h
@@ -30,6 +30,7 @@ struct config {
     char* optimizations;
     const char *theme;
     bool dumb_terminal;
+    char* report;
 
     char *main_ns_name;
     size_t num_rest_args;

diff --git a/planck-c/main.c b/planck-c/main.c
@@ -76,6 +76,8 @@ void usage(char *program_name) {
     "    -A x, --checked-arrays x    Enables checked arrays where x is either warn\n"
     "                                or error.\n"
     "    -a, --elide-asserts         Set *assert* to false to remove asserts\n"
+    "    --report target             Report uncaught exception to \"file\" (default),\n"
+    "                                \"stderr\", or \"none\"\n"
     "\n"
     "  main options:\n"
     "    -m ns-name, --main ns-name Call the -main function from a namespace with\n"
@@ -292,7 +294,7 @@ bool should_ignore_arg(const char *opt) {
     }
 
     // opt is a short opt or clump of short opts. If the clump
-    // ends with i, e, m, c, n, k, t, S, A, O, D, L, or \1
+    // ends with i, e, m, c, n, k, t, S, A, O, D, L, \1, or \2
     // then this opt takes an argument.
     int idx = 0;
     char c = 0;
@@ -314,7 +316,8 @@ bool should_ignore_arg(const char *opt) {
             last_c == 'O' ||
             last_c == 'D' ||
             last_c == 'L' ||
-            last_c == '\1');
+            last_c == '\1' ||
+            last_c == '\2');
 }
 
 void control_FTL_JIT() {
@@ -439,6 +442,7 @@ int main(int argc, char **argv) {
             {"init",             required_argument, NULL, 'i'},
             {"main",             required_argument, NULL, 'm'},
             {"compile-opts",     required_argument, NULL, '\1'},
+            {"report",           required_argument, NULL, '\2'},
 
             // development options
             {"javascript",       no_argument,       NULL, 'j'},
@@ -452,11 +456,23 @@ int main(int argc, char **argv) {
     // pass index_of_script_path_or_hyphen instead of argc to guarantee that everything
     // after a bare dash "-" or a script path gets passed as *command-line-args*
     while (!did_encounter_main_opt &&
-           (opt = getopt_long(index_of_script_path_or_hyphen, argv, "O:Xh?VS:D:L:\1:lvrA:sfak:je:t:n:dc:o:Ki:qm:", long_options, &option_index)) != -1) {
+           (opt = getopt_long(index_of_script_path_or_hyphen, argv, "O:Xh?VS:D:L:\1:\2:lvrA:sfak:je:t:n:dc:o:Ki:qm:", long_options, &option_index)) != -1) {
         switch (opt) {
             case '\1':
                 process_compile_opts(optarg);
                 break;
+            case '\2':
+                if (!strcmp(optarg, "file")) {
+                    config.report = "file";
+                } else if (!strcmp(optarg, "stderr")) {
+                    config.report = "stderr";
+                } else if (!strcmp(optarg, "none")) {
+                    config.report = "none";
+                } else {
+                    print_usage_error("report value must be file, stderr, or none", argv[0]);
+                    return EXIT_FAILURE;
+                }
+                break;
             case 'X':
                 init_launch_timing();
                 break;

diff --git a/planck-cljs/src/planck/core.cljs b/planck-cljs/src/planck/core.cljs
@@ -394,11 +394,7 @@
   "Resolves namespace-qualified sym per [[resolve]]. If initial resolve
   fails, attempts to require `sym`'s namespace and retries."
   [sym]
-  (if (qualified-symbol? sym)
-    (or (resolve sym)
-        (do (eval `(require '~(-> sym namespace symbol)))
-            (resolve sym)))
-    (throw (js/Error. (str "Not a qualified symbol: " sym)))))
+  (#'repl/requiring-resolve sym))
 
 (s/fdef requiring-resolve
   :args (s/cat :sym qualified-symbol?)

diff --git a/planck-cljs/src/planck/from/clojure/main.cljs b/planck-cljs/src/planck/from/clojure/main.cljs
@@ -0,0 +1,35 @@
+(ns ^:no-doc planck.from.clojure.main
+  (:require
+    [planck.core :refer [requiring-resolve with-open spit]]
+    [planck.io :as io :refer [temp-file]]
+    [cljs.repl]))
+
+;; Copied and revised for use in Planck
+(defn report-error
+  "Create and output an exception report for a Throwable to target.
+  Options:
+    :target - \"file\" (default), \"stderr\", \"none\"
+  If file is specified but cannot be written, falls back to stderr."
+  [t & {:keys [target]
+        :or   {target "file"} :as opts}]
+  (when-not (= target "none")
+    (let [trace (cljs.repl/Error->map t)
+          triage (cljs.repl/ex-triage trace)
+          message (cljs.repl/ex-str triage)
+          report (array-map
+                   :planck.repl/message message
+                   :planck.repl/triage triage
+                   :planck.repl/trace trace)
+          report-str (with-out-str
+                       (binding [*print-namespace-maps* false]
+                         ((requiring-resolve 'clojure.pprint/pprint) report)))
+          err-path (when (= target "file")
+                     (try
+                       (let [f (temp-file)]
+                         (spit f report-str)
+                         (:path f))
+                       (catch :default _)))] ;; ignore, fallback to stderr
+      (binding [*print-fn* *print-err-fn*]
+        (if err-path
+          (println (str message \newline "Full report at:" \newline err-path))
+          (println (str report-str \newline message)))))))
diff --git a/planck-cljs/src/planck/repl.cljs b/planck-cljs/src/planck/repl.cljs
@@ -359,7 +359,7 @@
   (swap! st update :options merge (select-keys opts passthrough-compiler-opts)))
 
 (defn- ^:export init
-  [repl verbose cache-path checked-arrays static-fns fn-invoke-direct elide-asserts optimizations compile-optss]
+  [repl verbose cache-path checked-arrays static-fns fn-invoke-direct elide-asserts optimizations compile-optss report]
   (when (exists? *command-line-args*)
     (set! ^:cljs.analyzer/no-resolve *command-line-args* (seq js/PLANCK_INITIAL_COMMAND_LINE_ARGS)))
   (load-core-analysis-caches repl)
@@ -391,7 +391,9 @@
                                   (when (not= optimizations "none")
                                     {:optimizations (keyword optimizations)})
                                   (when (contains? opts :optimizations)
-                                    {:optimizations (:optimizations opts)})))
+                                    {:optimizations (:optimizations opts)})
+                                  (when report
+                                    {:report report})))
     (init-closure-defines (:closure-defines opts))
     (init-warnings (:warnings opts) (:warn-on-undeclared opts true))
     (deps/index-opts opts)
@@ -1222,13 +1224,18 @@
   (load m (load-opts) cb))
 
 (declare ^{:arglists '([error])} skip-cljsjs-eval-error)
+(declare ^{:arglists '([sym])} requiring-resolve)
 
 (defn- handle-error
   [e include-stacktrace?]
-  (do
-    (print-error e include-stacktrace?)
-    (if (not (:repl @app-env))
-      (js/PLANCK_EXIT_WITH_VALUE 1)
+  (if (not (:repl @app-env))
+    (do
+      (if-some [report-target (:report @app-env)]
+        ((requiring-resolve 'planck.from.clojure.main/report-error) e :target report-target)
+        ((requiring-resolve 'planck.from.clojure.main/report-error) e))
+      (js/PLANCK_EXIT_WITH_VALUE 1))
+    (do
+      (print-error e include-stacktrace?)
       (set! *e (skip-cljsjs-eval-error e)))))
 
 (defn- get-eval-fn []
@@ -1342,15 +1349,15 @@
   (let [[_ fn local] (re-find #"(.*)_\$_(.*)" munged-sym)]
     (when fn
       (when-let [fn-sym (lookup-sym demunge-maps fn)]
-        (str fn-sym " " (demunge local))))))
+        (str fn-sym "$" (demunge local))))))
 
 (defn- demunge-protocol-fn
   [demunge-maps munged-sym]
   (let [[_ ns prot fn] (re-find #"(.*)\$(.*)\$(.*)\$arity\$.*" munged-sym)]
     (when ns
       (when-let [prot-sym (lookup-sym demunge-maps (str ns "$" prot))]
         (when-let [fn-sym (lookup-sym demunge-maps (str ns "$" fn))]
-          (str fn-sym " [" prot-sym "]"))))))
+          (str fn-sym "[" prot-sym "]"))))))
 
 (defn- sym-name-starts-with?
   [prefix sym]
@@ -1413,17 +1420,67 @@
              (js-file? file)))
     (str (file->ns-sym file) "/")))
 
-(defn- mapped-stacktrace-str
-  ([stacktrace sms]
-   (mapped-stacktrace-str stacktrace sms nil))
-  ([stacktrace sms opts]
-   (apply str
-     (for [{:keys [function file line column]} (st/mapped-stacktrace stacktrace sms opts)
-           :let [demunged (-> (str (when function (demunge-sym function)))
-                            (qualify file))]
-           :when (not= demunged "cljs.core/-invoke [cljs.core/IFn]")]
-       (str \tab demunged " (" file (when line (str ":" line))
-         (when column (str ":" column)) ")" \newline)))))
+(defn- demunge-stack-element [{:keys [function file] :as element}]
+  (let [demunged (-> (str (when function (demunge-sym function)))
+                   (qualify file))]
+    (assoc element :function demunged)))
+
+(defn- elide-stack-element? [element]
+  (= (:function element) "cljs.core/-invoke [cljs.core/IFn]"))
+
+(defn- mapped-stacktrace [stacktrace sms opts]
+  (into [] (comp
+             (map demunge-stack-element)
+             (remove elide-stack-element?))
+    (st/mapped-stacktrace stacktrace sms opts)))
+
+(defn- mapped-stacktrace->str
+  [mapped-stacktrace]
+  (apply str
+    (for [{:keys [function file line column]} mapped-stacktrace]
+      (str \tab function " (" file (when line (str ":" line))
+        (when column (str ":" column)) ")" \newline))))
+
+(def ^:private stack-truncation-functions
+  #{"PLANCK_EVAL"
+    "global code"
+    "planck$repl$run_main_impl"
+    "planck$pprint$width_adjust$force_eval"
+    "planck$repl$print_value"
+    "fipp$visit$IVisitor$visit_seq$arity$2"})
+
+(defn- extract-canonical-stacktrace [error]
+  (->> (st/parse-stacktrace
+         {}
+         (.-stack error)
+         {:ua-product :safari}
+         {:output-dir "file://(/goog/..)?"})
+    (drop-while #(string/starts-with? (:function %) "PLANCK_"))
+    (take-while #(not (stack-truncation-functions (:function %))))))
+
+(defn- error->mapped-stacktrace [error]
+  (load-core-macros-source-maps!)
+  (let [canonical-stacktrace (extract-canonical-stacktrace error)]
+    (load-bundled-source-maps! (distinct (map file->ns-sym (keep :file canonical-stacktrace))))
+    (mapped-stacktrace canonical-stacktrace
+      (or (:source-maps @planck.repl/st) {})
+      nil)))
+
+(defn- root-cause [e]
+  (if-some [cause (ex-cause e)]
+    (recur cause)
+    e))
+
+;; Monkey-patch Error->map to include stacktrace
+;; Perhaps in the future something can land in ClojureScript proper
+(let [orig-Error->map cljs.repl/Error->map]
+  (set! cljs.repl/Error->map
+    (fn [e] (let [m            (orig-Error->map e)]
+              (assoc m :trace
+                       (into [] (map (fn [{:keys [function file line column]}]
+                                       (let [function-sym (symbol function)]
+                                         [(symbol (namespace function-sym)) (symbol (name function-sym)) file line])))
+                         (error->mapped-stacktrace (root-cause e))))))))
 
 (defn- strip-source-map
   "Strips a source map down to the minimal representation needed for mapping
@@ -1491,14 +1548,6 @@
                (:file data))
       (str " at line " (:line data) " " (file-path (:file data))))))
 
-(def ^:private stack-truncation-functions
-  #{"PLANCK_EVAL"
-    "global code"
-    "planck$repl$run_main_impl"
-    "planck$pprint$width_adjust$force_eval"
-    "planck$repl$print_value"
-    "fipp$visit$IVisitor$visit_seq$arity$2"})
-
 (defn- explain-printer
   [ed]
   (let [pr'     #(print-value %
@@ -1561,21 +1610,7 @@
        (when-let [data (and print-ex-data? (ex-data error))]
          (print-value data {::as-code? false}))
        (when include-stacktrace?
-         (load-core-macros-source-maps!)
-         (let [canonical-stacktrace (->> (st/parse-stacktrace
-                                           {}
-                                           (.-stack error)
-                                           {:ua-product :safari}
-                                           {:output-dir "file://(/goog/..)?"})
-                                      (drop-while #(string/starts-with? (:function %) "PLANCK_"))
-                                      (take-while #(not (stack-truncation-functions (:function %)))))]
-           (load-bundled-source-maps! (distinct (map file->ns-sym (keep :file canonical-stacktrace))))
-           (println
-             ((:ex-stack-fn theme)
-              (mapped-stacktrace-str
-                canonical-stacktrace
-                (or (:source-maps @planck.repl/st) {})
-                nil)))))
+         (println ((:ex-stack-fn theme) (-> error error->mapped-stacktrace mapped-stacktrace->str))))
        (when-let [cause (.-cause error)]
          (recur cause include-stacktrace? message)))
      (let [error (cond-> error
@@ -2198,6 +2233,14 @@
   [sym]
   (ns-resolve (.-name *ns*) sym))
 
+(defn- requiring-resolve
+  [sym]
+  (if (qualified-symbol? sym)
+    (or (resolve sym)
+      (do (cljs.core/eval `(require '~(-> sym namespace symbol)))
+          (resolve sym)))
+    (throw (js/Error. (str "Not a qualified symbol: " sym)))))
+
 (defn get-arglists
   "Return the argument lists for the given symbol as string, or nil if not
   found."

diff --git a/planck-man/planck.1 b/planck-man/planck.1
@@ -221,6 +221,11 @@ script, the long form of this option must be used.
 .BR \-a ", " \-\-elide-asserts\ 
 Set *assert* to false to remove asserts
 
+.TP
+.BR " \-\-report\  \fItarget\fR
+Report uncaught exception to \fItarget\fR: "file" (default), 
+"stderr", or "none".
+
 .SS main-opts
 
 .TP