Replace all haystack.analyzer usage with orchard.stacktrace

Author: alexander-yakushev

project.clj

@@ -21,8 +21,7 @@
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :scm {:name "git" :url "https://github.com/clojure-emacs/cider-nrepl"}
   :dependencies [[nrepl/nrepl "1.3.1" :exclusions [org.clojure/clojure]]
-                 [cider/orchard "0.30.1" :exclusions [org.clojure/clojure]]
-                 ^:inline-dep [mx.cider/haystack "0.3.3" :exclusions [cider/orchard]]
+                 [cider/orchard "0.31.0" :exclusions [org.clojure/clojure]]
                  ^:inline-dep [thunknyc/profile "0.5.2"]
                  ^:inline-dep [mvxcvi/puget "1.3.4" :exclusions [org.clojure/clojure]]
                  ^:inline-dep [fipp ~fipp-version] ; can be removed in unresolved-tree mode

src/cider/nrepl.clj

@@ -12,7 +12,6 @@
    [cider.nrepl.middleware.util.cljs :as cljs]
    [cider.nrepl.print-method] ;; we load this namespace, so it's directly available to clients
    [compliment.core :as compliment]
-   [haystack.analyzer :as analyzer]
    [nrepl.middleware :refer [set-descriptor!]]
    [nrepl.middleware.caught :refer [wrap-caught]]
    [nrepl.middleware.print :refer [wrap-print wrap-print-optional-arguments]]
@@ -50,7 +49,6 @@
 ;; shipped with Orchard.
 (try (orchard.java/source-info 'mx.cider.orchard.LruMap)
      (catch Exception _))
-@analyzer/spec-abbrev
 
 (defn warmup-caches!
   "Warm up some of the dependency caches to improve UX performance for first hits.

src/cider/nrepl/middleware/debug.clj

@@ -7,15 +7,15 @@
    [cider.nrepl.middleware.util.cljs :as cljs]
    [cider.nrepl.middleware.util.instrument :as ins]
    [cider.nrepl.middleware.util.nrepl :refer [notify-client]]
-   [haystack.analyzer :as stacktrace.analyzer]
    [nrepl.middleware.interruptible-eval :refer [*msg*]]
    [nrepl.middleware.print :as print]
    [nrepl.misc :refer [response-for]]
    [nrepl.transport :as transport]
    [orchard.info :as info]
    [orchard.inspect :as inspect]
    [orchard.meta :as m]
-   [orchard.print])
+   [orchard.print]
+   [orchard.stacktrace :as stacktrace])
   (:import
    [clojure.lang Compiler$LocalBinding]
    [java.util UUID]))
@@ -219,7 +219,7 @@ this map (identified by a key), and will `dissoc` it afterwards."}
                     (when-not (instance? ThreadDeath root-ex#)
                       (debugger-send
                        {:status :eval-error
-                        :causes [(let [causes# (stacktrace.analyzer/analyze e# (::print/print-fn *msg*))]
+                        :causes [(let [causes# (stacktrace/analyze e# (::print/print-fn *msg*))]
                                    (when (coll? causes#) (last causes#)))]})))
                   error#))]
      (if (= error# ~sym)
@@ -291,11 +291,11 @@ this map (identified by a key), and will `dissoc` it afterwards."}
   (debugger-send
    {:status :stack
     :causes (if (instance? Throwable value)
-              (stacktrace.analyzer/analyze value (::print/print-fn *msg*))
+              (stacktrace/analyze value (::print/print-fn *msg*))
               [{:class      "StackTrace"
                 :message    "Harmless user-requested stacktrace"
                 :stacktrace (-> (Exception. "Dummy")
-                                (stacktrace.analyzer/analyze (::print/print-fn *msg*))
+                                (stacktrace/analyze (::print/print-fn *msg*))
                                 last :stacktrace)}])}))
 
 (def debug-commands

src/cider/nrepl/middleware/reload.clj

@@ -7,11 +7,11 @@
    [clj-reload.core :as reload]
    [clojure.main :refer [repl-caught]]
    [clojure.string :as str]
-   [haystack.analyzer :as analyzer]
    [nrepl.middleware.interruptible-eval :refer [*msg*]]
    [nrepl.middleware.print :as print]
    [nrepl.misc :refer [response-for]]
-   [nrepl.transport :as transport]))
+   [nrepl.transport :as transport]
+   [orchard.stacktrace :as stacktrace]))
 
 (defn- user-reload
   "Resolve clj-reload.core/<sym> from the user project or return fallback."
@@ -56,7 +56,7 @@
                 (respond msg {:status :ok}))
               (catch Throwable error
                 (respond msg {:status :error
-                              :error  (analyzer/analyze error print-fn)})
+                              :error  (stacktrace/analyze error print-fn)})
                 (binding [*msg* msg
                           *err* (print/replying-PrintWriter :err msg {})]
                   (repl-caught error)))))

src/cider/nrepl/middleware/stacktrace.clj

@@ -2,13 +2,12 @@
   "Cause and stacktrace analysis for exceptions"
   {:author "Jeff Valk"}
   (:require
+   [cider.nrepl.middleware.inspect :as middleware.inspect]
    [cider.nrepl.middleware.util.nrepl :refer [notify-client]]
-   [clojure.string :as str]
-   [haystack.analyzer :as analyzer]
    [nrepl.middleware.print :as print]
-   [cider.nrepl.middleware.inspect :as middleware.inspect]
    [nrepl.misc :refer [response-for]]
-   [nrepl.transport :as t]))
+   [nrepl.transport :as t]
+   [orchard.stacktrace :as stacktrace]))
 
 (defn- done
   "Send the done response to the client."
@@ -35,12 +34,12 @@
   [{:keys [session ::print/print-fn] :as msg}]
   (let [last-exception (@session #'*e)]
     (swap! session assoc #'*last-exception* last-exception) ;; note that *e can change later, so this entry isn't redundant
-    (send-analysis msg (analyzer/analyze last-exception print-fn))))
+    (send-analysis msg (stacktrace/analyze last-exception print-fn))))
 
 (defn- handle-analyze-last-stacktrace-op
   "Handle the analyze last stacktrace op."
   [{:keys [session] :as msg}]
-  (if (and session (@session #'*e))
+  (if (@session #'*e)
     (analyze-last-stacktrace msg)
     (no-error msg))
   (done msg))
@@ -53,17 +52,12 @@
   (handle-analyze-last-stacktrace-op msg)
   (notify-client msg "The `stacktrace` op is deprecated, please use `analyze-last-stacktrace` instead." :warning))
 
-(defn handle-inspect-last-exception-op [{:keys [index transport] :as msg}]
-  (let [le (when index
-             (some-> msg :session deref (get #'*last-exception*)))
-        cause (when le
-                (loop [n 0
-                       cause le]
-                  (if (= n index)
-                    cause
-                    (when cause
-                      (recur (inc n)
-                             (some-> ^Throwable cause .getCause))))))]
+(defn handle-inspect-last-exception-op [{:keys [session index transport] :as msg}]
+  (let [last-exception (@session #'*last-exception*)
+        causes (->> (iterate #(.getCause ^Throwable %) last-exception)
+                    (take-while some?))
+        cause (when index
+                (nth causes index nil))]
     (if cause
       (t/send transport (middleware.inspect/inspect-reply* msg cause))
       (no-error msg))

src/cider/nrepl/middleware/test.clj

@@ -9,14 +9,13 @@
    [clojure.string :as str]
    [clojure.test :as test]
    [clojure.walk :as walk]
-   [haystack.analyzer :as stacktrace.analyzer]
-   [haystack.parser.clojure.throwable :as throwable]
    [nrepl.middleware.interruptible-eval :as ie]
    [nrepl.middleware.print :as print]
    [nrepl.misc :refer [response-for]]
    [nrepl.transport :as t]
    [orchard.misc :as misc]
-   [orchard.query :as query]))
+   [orchard.query :as query]
+   [orchard.stacktrace :as stacktrace]))
 
 ;;; ## Overview
 ;;
@@ -66,19 +65,14 @@
 (defn stack-frame
   "Search the stacktrace of exception `e` for the function `f` and return info
   describing the stack frame, including var, class, and line."
-  ([^Exception e f]
-   (stack-frame (stacktrace.analyzer/directory-namespaces) e f))
-  ([namespaces ^Exception e f]
-   (when-let [class-name (some-> f class .getName)]
-     (->> e
-          .getStackTrace
-          (map throwable/StackTraceElement->vec)
-          (map (partial stacktrace.analyzer/analyze-frame namespaces))
-          (filter
-           #(when-let [frame-cname (:class %)]
-              (when (string? frame-cname)
-                (str/starts-with? frame-cname class-name))))
-          first))))
+  [^Exception e f]
+  (when-let [class-name (some-> f class .getName)]
+    (when-let [analyzed-trace (:stacktrace (first (stacktrace/analyze e)))]
+      (some #(when-let [frame-cname (:class %)]
+               (when (and (string? frame-cname)
+                          (str/starts-with? frame-cname class-name))
+                 %))
+            analyzed-trace))))
 
 (defn- print-object
   "Print `object` using println for matcher-combinators results and pprint
@@ -260,11 +254,9 @@
   finds the erring test fixture in the stacktrace and binds it as the current
   test var. Test count is decremented to indicate that no tests were run."
   [ns e]
-  (let [namespaces (stacktrace.analyzer/directory-namespaces)
-        frame (->> (concat (:clojure.test/once-fixtures (meta ns))
+  (let [frame (->> (concat (:clojure.test/once-fixtures (meta ns))
                            (:clojure.test/each-fixtures (meta ns)))
-                   (map (partial stack-frame namespaces e))
-                   (filter identity)
+                   (keep #(stack-frame e %))
                    (first))
         fixture (resolve (symbol (:var frame)))]
     (swap! current-report update-in [:summary :test] dec)
@@ -491,7 +483,7 @@
             (with-bindings (assoc @session #'ie/*msg* msg)
               (let [[ns var] (map misc/as-sym [ns var])]
                 (if-let [e (get-in @results [ns var index :error])]
-                  (doseq [cause (stacktrace.analyzer/analyze e print-fn)]
+                  (doseq [cause (stacktrace/analyze e print-fn)]
                     (t/send transport (response-for msg cause)))
                   (t/send transport (response-for msg :status :no-error))))))
           (fn []

src/cider/nrepl/middleware/util/error_handling.clj

@@ -20,7 +20,7 @@
 
 (def ^:private analyze-causes
   (delay
-    (requiring-resolve 'haystack.analyzer/analyze)))
+    (requiring-resolve 'orchard.stacktrace/analyze)))
 
 ;;; UTILITY FUNCTIONS
 

src/cider/nrepl/middleware/util/reload.clj

@@ -3,12 +3,12 @@
   {:added "0.47.0"}
   (:require
    [clojure.main :refer [repl-caught]]
-   [haystack.analyzer :as stacktrace.analyzer]
    [nrepl.middleware.interruptible-eval :refer [*msg*]]
    [nrepl.middleware.print :as print]
    [nrepl.misc :refer [response-for]]
    [nrepl.transport :as transport]
-   [orchard.misc :as misc]))
+   [orchard.misc :as misc]
+   [orchard.stacktrace :as stacktrace]))
 
 (defn error-reply
   [{:keys [error error-ns]}
@@ -17,7 +17,7 @@
   (transport/send
    transport
    (response-for msg (cond-> {:status :error}
-                       error (assoc :error (stacktrace.analyzer/analyze error print-fn))
+                       error (assoc :error (stacktrace/analyze error print-fn))
                        error-ns (assoc :error-ns error-ns))))
 
   (binding [*msg* msg