Macro to create a decorator (wrapper) for a objects implementing a Java interface

defdecorator.clj

;; A macro to create a decorator (wrapper) for a objects implementing a Java interface
;; Disclaimer: The code most certainly is not perfect and does not handle some corner cases
;; License: The Unlicense http://unlicense.org/
(require '[clojure.string :as str])

(defn type->tag [parameter-type]
  (let [array? (-> parameter-type name (str/ends-with? "<>"))
        primitive? '#{int long float double short boolean byte char}
        type   (if array?
                 (-> parameter-type name (str/replace #"<>$" "") symbol)
                 parameter-type)]
    (cond
      ;; handle ints, bytes etc:
      (and array? (primitive? type))
      (-> type name (str "s") symbol)

      array?
      (str "[L" type ";")

      :else
      (with-meta type nil))))

(defn type-hint
  [sym type]
  (vary-meta sym assoc :tag (type->tag type)))

(defn wrap-method [target-sym ^clojure.reflect.Method {:keys [name return-type parameter-types flags ::typehint?]}]
  (let [args (vec (map #(symbol (str "arg" %)) (range (count parameter-types))))]
    (list ;; name
          (if typehint?
            (type-hint name return-type)
            name)
          ;; args
          (into ['_]
                (if typehint?
                  (mapv type-hint args parameter-types)
                  args))
          ;; body
          (concat (list '. target-sym name) args))))

(defn wrap-methods [target-sym members]
  (let [methods (filter #(instance? clojure.reflect.Method %) members)
        overloaded-arity-methods (->> methods
                                      (group-by (juxt :name (comp count :parameter-types)))
                                      (mapcat (fn [[_ vals]] (when (next vals) vals)))
                                      (remove nil?)
                                      (into #{}))]
    (->> methods
         (sort-by :name)
         (map #(cond-> %
                       (overloaded-arity-methods %) (assoc ::typehint? true)))
         (map #(wrap-method target-sym %)))))

(defn wrap-interface
  "Return a map from interface to wrapped methods (delegating all calls to the provided `target-sym`"
  [target-sym interface]
  (let [{:keys [bases flags members]}
        (clojure.reflect/type-reflect interface)]
    ;; NOTE: I could (clojure.reflect/type-reflect java.sql.Connection :ancestors true) =>
    ;; `members` would include all methods incl. inherited => easier to find such duplicated;
    ;; I could then group-by `:declaring-class`
    (assert (and (:interface flags) (:public flags)) "must be a public interface")
    (into {(with-meta interface nil) (wrap-methods target-sym members)}
           (map #(wrap-interface target-sym %) bases))))

(defmacro defdecorator
  "Create a [Decorator](https://refactoring.guru/design-patterns/decorator) for the given interface,
  delegating all calls to a target object. The decorator is a `deftype` and expects one constructor argument,
  the target object.

  Parent interfaces are included.

  Ex.: `(do (defdecorator WrappedConn java.sql.Connection) (.close (WrappedConn. original-connection)))`

  You typically want to use it to generate the code to copy-paste into your source code (since you likely want to
  modify the code by changing some of the generated method bodies). To do that:

  ```
  (binding [*print-meta* true] ; so that type hints are included
    (prn (macroexpand-1 '(defdecorator WrappedConnection java.sql.Connection))))
  ```
  
  which, after some formatting (e.g. with cljstyle) will produce something like

  ```
  (deftype WrappedConnection [^java.sql.Connection target]
    java.sql.Connection
    (abort [_ arg0] (. target abort arg0))
    (beginRequest [_] (. target beginRequest))
    ...
    ;; the following are type hinted due to overloaded arities:
    (^java.sql.PreparedStatement prepareStatement [_ ^java.lang.String arg0 ^int arg1] (. target prepareStatement arg0 arg1))
    (^java.sql.PreparedStatement prepareStatement [_ ^java.lang.String arg0 ^ints arg1] (. target prepareStatement arg0 arg1))
    (^java.sql.PreparedStatement prepareStatement [_ ^java.lang.String arg0 ^\"[Ljava.lang.String;\" arg1] (. target prepareStatement arg0 arg1))
    ...
    java.sql.Wrapper
    (isWrapperFor [_ arg0] (. target isWrapperFor arg0))
    (unwrap [_ arg0] (. target unwrap arg0)))
  ```
  
  You could also use dfdecorator directly in your code, but what is the point, if it just passes all calls
  through as-is?

  ### LIMITATIONS

  * If an interface and an ancestor interface declare the same method then an implementation will be provided twice
    (example: java.sql.Connection/close and AutoCloseable/close)"
  [typename interface]
  (let [specs-map (wrap-interface 'target interface)
        specs-list (mapcat (fn [[iface methods]]
                             (into [iface] methods))
                           specs-map)]
    `(deftype ~typename [~(with-meta 'target {:tag interface})]
       ~@specs-list)))

May not want to throw away all type hints, you might stumble across ambiguous interfaces which can take (U u, V v) and (U u, T t), stuff like that

Hi, thank you! I am not sure what you mean, I already handle that, see the prepareStatement example above. Or do you mean the case where a parent and a child interface both have the same method with the same number arguments but different types? That indeed is not handled. (But the solution is good enough for my current needs, so I am happy with it as is, imperfections and all.)

the same method with the same number arguments but different types

That's what I meant