Last active
October 15, 2021 13:59
-
-
Save holyjak/81c6e439192da00c8106cc3ce960b8f0 to your computer and use it in GitHub Desktop.
Macro to create a decorator (wrapper) for a objects implementing a Java interface
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; 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))) |
the same method with the same number arguments but different types
That's what I meant
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
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.)