Helper functions to work with exceptions

exception.clj

(ns lib.clojure.exception
  (:require [clojure.test :as test]
            [lib.clojure-string.core :as string']
            [lib.clojure.lang :as lang])
  (:import (clojure.lang Associative ExceptionInfo)))

(set! *warn-on-reflection* true)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn throwable?
  "Test if `x` is `Throwable`."
  [x]
  (instance? Throwable x))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn ex-message-or-name
  "Returns the exception message or class name if the message is empty."
  [throwable]
  (or (-> (.getMessage ^Throwable throwable) (string'/not-empty))
      (.getCanonicalName (class throwable))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn ex-message-all
  "Builds single message from all nested exceptions.
   Includes optional `context` string as part of the message."
  ([throwable] (ex-message-all throwable nil))
  ([throwable, context]
   (when throwable
     (loop [sb (-> (StringBuilder.)
                   (cond-> context (-> (.append (str context))
                                       (.append "  >  ")))
                   (.append (ex-message-or-name throwable)))
            cause (.getCause ^Throwable throwable)]
       (if cause
         (recur (-> sb (.append "  >  ") (.append (ex-message-or-name cause)))
                (.getCause cause))
         (.toString sb))))))

(comment
  (ex-message-all (ex-info "One" {:x :one}
                           (ex-info "Two" {:x :two}
                                    (ex-info "Three" {:x :three}))))
  #_"One  >  Two  >  Three"
  (ex-message-all (ex-info "One" {:x :one}
                           (ex-info "Two" {:x :two}
                                    (ex-info "Three" {:x :three})))
                  "Prefix")
  #_"Prefix  >  One  >  Two  >  Three")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn ex-root-cause
  "Find root cause for exception."
  [throwable]
  (if-let [cause (ex-cause throwable)]
    (recur cause)
    throwable))

(comment
  (ex-root-cause (ex-info "One" {:x :one}
                          (ex-info "Two" {:x :two}
                                   (ex-info "Three" {:x :three})))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn some*
  "Returns the first logical true value of (pred throwable) for any exception
   in exception chain, else nil.
   Similar to `clojure.core/some` but for nested exceptions instead of collection."
  [pred throwable]
  (when (instance? Throwable throwable)
    (loop [e throwable]
      (when e
        (or (pred e)
            (recur (.getCause ^Throwable e)))))))

(defn- ex-with-class
  "Returns first exception with class `c` in exception chain."
  [throwable _ c]
  (->> throwable (some* (lang/select #(identical? c (class %))))))

(defn- ex-data-with-key
  "Returns first ex-data containing key `k` in exception chain."
  [throwable _ k]
  (->> throwable (some* (fn pred [throwable]
                          (when-let [d (ex-data throwable)]
                            (when (.entryAt ^Associative d k)
                              d))))))

(defn- ex-data-with-val
  "Returns first ex-data with entry [k v] in exception chain."
  [throwable _ k v]
  (->> throwable (some* (let [match? (if (some? v)
                                       (fn equals? [x] (.equals ^Object v x))
                                       nil?)]
                          (fn pred [throwable]
                            (when-let [d (ex-data throwable)]
                              (when-let [e (.entryAt ^Associative d k)]
                                (when (match? (.getValue e))
                                  d))))))))

(defn- ex-data-val
  "Returns value of first ex-data entry with key `k` in exception chain."
  ([throwable _ k] (ex-data-val throwable _ k nil))
  ([throwable _ k not-found]
   (if-let [e (->> throwable (some* (fn pred [throwable]
                                      (some-> ^Associative (ex-data throwable) (.entryAt k)))))]
     (val e)
     not-found)))

(defmulti ex-find
  "Search for `subject` across exception chain of the throwable."
  {:arglists '([throwable subject & params])}
  lang/second-arg)

(lang/add-method ex-find :ex-with-class ex-with-class)
(lang/add-method ex-find :ex-data-with-key ex-data-with-key)
(lang/add-method ex-find :ex-data-with-val ex-data-with-val)
(lang/add-method ex-find :ex-data-val ex-data-val)

(test/deftest ex-find-test
  (let [ma {:a 1 :type :a} mb {:b 2 :type :b :nil nil} mc {:c 3 :type :c}
        e (ex-info "A" ma (ex-info "B" mb (ex-info "C" mc)))
        not-found (Object.)]

    (test/are [form] form
      (false? (some? (ex-find e :ex-with-class Exception)))
      (true?, (some? (ex-find e :ex-with-class ExceptionInfo)))

      (= ma (ex-find e :ex-data-with-key :a))
      (= mc (ex-find e :ex-data-with-key :c))
      (= mb (ex-find e :ex-data-with-key :nil))
      (nil? (ex-find e :ex-data-with-key :x))

      (= mb (ex-find e :ex-data-with-val :b 2))
      (nil? (ex-find e :ex-data-with-val :b 1))
      (= mb (ex-find e :ex-data-with-val :nil nil))
      (= ma (ex-find e :ex-data-with-val :type :a))
      (= mc (ex-find e :ex-data-with-val :type :c))
      (nil? (ex-find e :ex-data-with-val :type :x))

      (= 1,,,,,,,,,,, (ex-find e :ex-data-val :a))
      (= 2,,,,,,,,,,, (ex-find e :ex-data-val :b))
      (= 3,,,,,,,,,,, (ex-find e :ex-data-val :c))
      (= :a,,,,,,,,,, (ex-find e :ex-data-val :type))
      (nil?,,,,,,,,,, (ex-find e :ex-data-val :nil))
      (nil?,,,,,,,,,, (ex-find e :ex-data-val :nil not-found))
      (nil?,,,,,,,,,, (ex-find e :ex-data-val :x))
      (= not-found,,, (ex-find e :ex-data-val :x not-found)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;