Implement dedicated clojure.spec/assert stacktrace handling

src/cider/nrepl/middleware/stacktrace.clj

@@ -10,6 +10,7 @@
             [clojure.tools.nrepl.misc :refer [response-for]]
             [clojure.tools.nrepl.transport :as t]
             [clojure.java.io :as io]
+            [clojure.set :as set]
             [clojure.tools.namespace.find :as nsfind])
   (:import (clojure.lang Compiler$CompilerException)))
 
@@ -187,6 +188,50 @@
   (when-let [data (ex-data e)]
     (into {} (filter (comp (complement ex-data-blacklist) key) data))))
 
+(def spec-abbrev
+  (delay
+    (if (try (require 'clojure.spec) true
+             (catch Throwable _ false))
+      (resolve 'clojure.spec/abbrev)
+      (if (try (require 'clojure.spec.alpha) true
+               (catch Throwable _ false))
+        (resolve 'clojure.spec.alpha/abbrev)
+        #'identity))))
+
+(defn prepare-spec-data
+  "Prepare spec problems for display in user stacktraces.
+  Take in a map `ed` as returned by `clojure.spec/explain-data` and return a map
+  of pretty printed problems. The content of the returned map is modeled after
+  `clojure.spec/explain-printer`."
+  [ed pprint-fn]
+  (let [pp-str #(with-out-str (pprint-fn %))
+        problems (sort-by #(count (:path %))
+                          (or (:clojure.spec/problems ed)
+                              (:clojure.spec.alpha/problems ed)))]
+    {:spec (pr-str (or (:clojure.spec/spec ed)
+                       (:clojure.spec.alpha/spec ed)))
+     :value (pp-str (or (:clojure.spec/value ed)
+                        (:clojure.spec.alpha/value ed)))
+     :problems (for [{:keys [in val
+                             pred reason
+                             via path]
+                      :as prob} problems]
+                 (->> {:in (when-not (empty? in) (pr-str in))
+                       :val (pp-str val)
+                       :predicate (pr-str (@spec-abbrev pred))
+                       :reason reason ; <- always nil or string
+                       :spec (when-not (empty? via) (pr-str (last via)))
+                       :at (when-not (empty? path) (pr-str path))
+                       :extra (let [extras (->> #{:in :val :pred :reason :via :path
+                                                  :clojure.spec/failure
+                                                  :clojure.spec.alpha/failure}
+                                                (set/difference (set (keys prob)))
+                                                (select-keys prob))]
+                                (when-not (empty? extras)
+                                  (pp-str extras)))}
+                      (filter clojure.core/val)
+                      (into {})))}))
+
 (defn analyze-cause
   "Return a map describing the exception cause. If `ex-data` exists, a `:data`
   key is appended."
@@ -195,12 +240,20 @@
            :message (.getMessage e)
            :stacktrace (analyze-stacktrace e)}]
     (if-let [data (filtered-ex-data e)]
-      (assoc m :data (with-out-str (pprint-fn data)))
+      (if (or (:clojure.spec/failure data)
+              (:clojure.spec.alpha/failure data))
+        (assoc m
+               :message "Spec assertion failed."
+               :spec (prepare-spec-data data pprint-fn))
+        (assoc m
+               :data (with-out-str (pprint-fn data))))
       m)))
 
 (defn analyze-causes
   "Return the cause chain beginning with the thrown exception, with stack frames
-  for each."
+  for each. For `ex-info` exceptions response contains :data slot with pretty
+  printed data. For clojure.spec asserts, :spec slot contains a map of pretty
+  printed components describing spec failures."
   [e pprint-fn]
   (->> e
        (iterate #(.getCause ^Exception %))

test/spec/cider/nrepl/middleware/stacktrace_spec_test.clj

@@ -0,0 +1,60 @@
+(ns cider.nrepl.middleware.stacktrace-spec-test
+  (:require [cider.nrepl.middleware.stacktrace :refer :all]
+            [clojure.spec.alpha :as s]
+            [clojure.pprint :refer [pprint]]
+            [clojure.test :refer :all]))
+
+(s/check-asserts true)
+
+(defn causes
+  [form]
+  (analyze-causes
+    (try (eval form)
+         (catch Exception e
+           e))
+    pprint))
+
+(defn stack-frames
+  [form]
+  (analyze-stacktrace
+    (try (eval form)
+         (catch Exception e
+           e))))
+
+(def email-regex #"^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,63}$")
+(s/def ::email-type (s/and string? #(re-matches email-regex %)))
+(s/def ::first-name string?)
+(s/def ::last-name string?)
+(s/def ::email ::email-type)
+(s/def ::person (s/keys :req [::first-name ::last-name ::email]
+                        :opt [::phone]))
+
+(deftest spec-assert-stacktrace-test
+
+  (def broken-musk {::first-name "Elon"
+                    ::last-name "Musk"
+                    ::email "n/a"})
+
+  (def broken-musk-causes
+    (causes
+      `(s/assert ::person broken-musk)))
+
+  (testing "Spec assert components"
+    (is (= 1 (count broken-musk-causes)))
+    (is (:stacktrace (first broken-musk-causes)))
+    (is (:message (first broken-musk-causes)))
+    (is (:spec (first broken-musk-causes))))
+
+  (testing "Spec assert data components"
+    (let [spec (:spec (first broken-musk-causes))]
+      (is (:spec spec))
+      (is (string? (:value spec)))
+      (is (= 1 (count (:problems spec))))))
+
+  (testing "Spec assert problems components"
+    (let [probs (->> broken-musk-causes first :spec :problems first)]
+      (is (:in probs))
+      (is (:val probs))
+      (is (:predicate probs))
+      (is (:spec probs))
+      (is (:at probs)))))