try-tagged macro

try-tagged.clj

(defn- try-tagged-template
  [tag-test catch-symbol & body]
  (let [catch-tagged-form (last body)
        [catch-sym ex tag data-sym & catch-body] catch-tagged-form]
    (s/validate [(s/one (s/eq catch-symbol) 'catch)
                 (s/one s/Symbol 'exception-binding)
                 (s/one s/Keyword 'tag)
                 (s/one s/Symbol 'ex-data-binding)]
                [catch-sym ex tag data-sym])
    `(let [tag-test# ~tag-test
           tag# ~tag]
       (try
         ~@(butlast body)
         (catch clojure.lang.ExceptionInfo ex#
           (let [{actual-tag# :tag :as ex-data#} (ex-data ex#)
                 ~data-sym ex-data#
                 ~ex ex#]
             (if (tag-test# actual-tag# tag#)
               (do
                 ~@catch-body)
               (throw ex#))))))))

(defmulti -try-tagged (fn [& form] (first (last form))))

(defmethod -try-tagged 'catch-exact
  [& body]
  (apply try-tagged-template = 'catch-exact body))

(defmethod -try-tagged 'catch
  [& body]
  (apply try-tagged-template isa? 'catch body))

(defmacro try*
  "Like try...catch exept cares about :tag in the exception's `ex-data`.
  Re-throws non-matching exceptions.

  The catch clause has the syntax
  (CATCH-SYM EXCEPTION-BINDING keyword EX-DATA-BINDING & body)
  
  You can use 'catch-exact (`=` comparison) or 'catch (`isa?` comparison)
  as CATCH-SYM in the catch clause.

  Example:
  (derive :api/authentication :api/all)
  
  (try*
    (throw (ex-info \"Something went wrong\" {:tag :api/authentication :user-id user-id}))
    (catch ex :api/all data
      (log \"API error\" data)))
  "
  [& body]
  (apply -try-tagged body))


(comment
  (try*
   (throw (ex-info "boom!" {:x 1 :tag :foo/bar}))
   (catch-exact ex :foo/bar data
                (assoc data :additional-info :YES)))

  (try*
   (throw (ex-info "boom!" {:x 1 :tag :foo/bar}))
   (catch ex :foo/bar data
          (assoc data :additional-info :YES)))
  
  (try-tagged-exact
   (throw (ex-info "boom!" {:x 1 :tag :foo/bar}))
   (catch-exact ex :foo/bar data
                (assoc data :additional-info :YES)))

  (try-tagged
   (throw (ex-info "boom!" {:x 1 :tag :foo/child}))
   (catch-tagged ex :foo/parent data
                 (assoc data :additional-info :YES)))

  )