Monkey-patch Kaocha to print Cursive-recognisable stack traces & more readable `nubank/matcher-combinators` diffs

better-deftest.clj

;; Discussion: https://clojurians.slack.com/archives/C0744GXCJ/p1666889779101459

(ns demo.better-deftest
  (:require [clojure.test :refer :all]))

(deftest default-stack-trace-test
  (is (throw (Exception. "BAMM"))))

(clojure.test/run-test default-stack-trace-test)

;;; `clojure.test` improvements
(alter-var-root
  #'clojure.test/deftest
  (constantly
    (fn deftest
      [&form &env name & body]
      (when clojure.test/*load-tests*
        `(defn ~(vary-meta name assoc :test `(fn ~name [] ~@body))
           [] (clojure.test/test-var (var ~name)))))))

(deftest enhanced-stack-trace-test
  (is (throw (Exception. "BAMM"))))

(clojure.test/run-test enhanced-stack-trace-test)

;; it will print
;;  at demo.better_deftest$enhanced_stack_trace_test__600.invokeStatic (better_deftest.clj:19)
;;     demo.better_deftest/enhanced_stack_trace_test (better_deftest.clj:19)
;; 
;; instead of the default anonymous fn:
;; 
;;  at demo.better_deftest$fn__513.invokeStatic (better_deftest.clj:4)
;;     demo.better_deftest/fn (better_deftest.clj:4)

harness.clj

;;; src/test/harness.clj
(ns test.harness)

(do (in-ns 'kaocha.report)

    ;; Print actual & expected values on their own lines,
    ;; so their indentation is consistent for the output of
    ;; https://github.com/nubank/matcher-combinators
    ;; `match?` assertion.
    
    (require '[clojure.pprint :as pp])

    (defmethod print-expr :default [m]
      (letfn [(pp [x]
                (pp/with-pprint-dispatch
                  pp/code-dispatch
                  (binding [*print-namespace-maps* false
                            pp/*print-right-margin* 80
                            pp/*print-miser-width* 40]
                    (pp/pprint x))))]
        (when (contains? m :expected)
          (println "\nEXPECTED:")
          (pp (:expected m)))
        (when (contains? m :actual)
          (println "\nACTUAL:")
          (println (:actual m)))))

    (defn testing-vars-str
      "Returns a string representation of the current test. Renders names
      in :testing-vars as a list, then the source file and line of current
      assertion."
      [{:keys [file line testing-vars kaocha/testable] :as m}]
      (let [file' (or file (some-> testable :kaocha.testable/meta :file))
            line' (or line (some-> testable :kaocha.testable/meta :line))]
        (str
          ;; Uncomment to include namespace in failure report:
          ;(ns-name (:ns (meta (first clojure.test/*testing-vars*)))) "/ "
          (munge
            (str/replace
              (or (some-> (:kaocha.testable/id testable) str (subs 1))
                  (and (seq testing-vars)
                       (reverse (map #(:name (meta %)) testing-vars))))
              "/" "$"))
          ".invoke"
          " (" file' ":" line' ")")))

    (defmethod fail-summary :kaocha/fail-type [{:keys [testing-contexts testing-vars] :as m}]
      (println (str "\n" (output/colored :red "FAIL") "\n at")
               (testing-vars-str m))
      (when (seq testing-contexts)
        (println (str/join " " (reverse testing-contexts))))
      (when-let [message (:message m)]
        (println message))
      (if-let [expr (::printed-expression m)]
        (print expr)
        (print-expr m))
      (print-output m))

    (defmethod fail-summary :error [{:keys [testing-contexts testing-vars] :as m}]
      (println (str "\n" (output/colored :red "ERROR") "\n at")
               (testing-vars-str m))
      (when (seq testing-contexts)
        (println (str/join " " (reverse testing-contexts))))
      (when-let [message (:message m)]
        (println message))
      (if-let [expr (::printed-expression m)]
        (print expr)
        (when-let [actual (:actual m)]
          (print "Exception: ")
          (if (throwable? actual)
            (stacktrace/print-cause-trace actual t/*stack-trace-depth*)
            (prn actual))))
      (print-output m))

    (in-ns 'test.harness))