-
-
Save abp/1722706 to your computer and use it in GitHub Desktop.
A ridiculous proxy macro which delegates calls to methods which have not been explicitly implemented to a specified object.
This file contains 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
;;; Written when pondering | |
;;; http://stackoverflow.com/questions/9086926/create-a-proxy-for-an-specific-instance-of-an-object-in-clojure | |
(defmacro delegating-proxy [o class-and-ifaces ctor-args & impls] | |
(let [oname (gensym)] | |
(letfn [(delegating-impls [^java.lang.reflect.Method ms] | |
(let [mname (symbol (.getName ^java.lang.reflect.Method (first ms))) | |
arity-groups (partition-by #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms) | |
max-arity (max-key #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms)] | |
`(~mname | |
~@(remove | |
nil? | |
(map (fn [agroup] | |
(let [param-types (.getParameterTypes ^java.lang.reflect.Method (first agroup)) | |
vararg? (and (seq param-types) (or (.isArray ^Class (last param-types)) (<= 20 (count param-types)))) | |
arity ((if vararg? dec identity) (count param-types)) | |
params (vec (repeatedly arity gensym)) | |
params (if vararg? (conj params '& (gensym)) params)] | |
(when-not (and vararg? (not= arity max-arity)) | |
(list params `(. ~oname (~mname ~@params)))))) | |
arity-groups))))) | |
(combine-impls [eimpls dimpls] | |
(map (fn [e d] | |
(let [e (if (vector? (second e)) | |
(list (first e) (next e)) | |
e)] | |
(list* (first e) (concat (next e) (next d))))) | |
eimpls | |
dimpls))] | |
(let [klass (resolve (first class-and-ifaces)) | |
methods (->> class-and-ifaces | |
(map resolve) | |
(mapcat #(.getDeclaredMethods ^Class %))) | |
eimpl-specs (set (map (juxt first (comp count second)) impls)) | |
rm-fn (fn rm-fn [^java.lang.reflect.Method m] | |
(contains? eimpl-specs [(symbol (.getName m)) (count (.getParameterTypes m))])) | |
dimpls (->> methods | |
(remove rm-fn) | |
(remove #(let [mods (.getModifiers ^java.lang.reflect.Method %)] | |
(or (java.lang.reflect.Modifier/isPrivate mods) | |
(java.lang.reflect.Modifier/isProtected mods)))) | |
(sort-by #(.getName ^java.lang.reflect.Method %)) | |
(partition-by #(.getName ^java.lang.reflect.Method %)) | |
(map delegating-impls)) | |
dimpl-names (set (map first dimpls)) | |
eimpl-names (set (map first eimpl-specs)) | |
{eonly false eboth true} (group-by (comp boolean dimpl-names first) impls) | |
{donly false dboth true} (group-by (comp boolean eimpl-names first) dimpls) | |
all-impls (concat eonly donly (combine-impls eboth dboth))] | |
`(let [~oname ~o] | |
(proxy ~class-and-ifaces ~ctor-args | |
~@all-impls)))))) | |
(comment | |
((delegating-proxy (fn [& args] :foo) [clojure.lang.IFn] [] (invoke [x] :bar)) 1) | |
; => :bar | |
((delegating-proxy (fn [& args] :foo) [clojure.lang.IFn] [] (invoke [x] :bar)) 1 2) | |
; => :foo | |
) | |
;;; a version delegating all methods, for use with update-proxy | |
(defmacro delegating-proxy [o class-and-ifaces ctor-args] | |
(let [oname (gensym) | |
impls (->> class-and-ifaces | |
(map resolve) | |
(mapcat #(.getDeclaredMethods ^Class %)) | |
(group-by #(.getName ^java.lang.reflect.Method %)) | |
(vals) | |
(map (fn delegating-impls [^java.lang.reflect.Method ms] | |
(let [mname (symbol (.getName ^java.lang.reflect.Method (first ms))) | |
arity-groups (partition-by #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms) | |
max-arity (max-key #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms)] | |
`(~mname | |
~@(remove | |
nil? | |
(map (fn [agroup] | |
(let [param-types (.getParameterTypes ^java.lang.reflect.Method (first agroup)) | |
vararg? (and (seq param-types) (or (.isArray ^Class (last param-types)) (<= 20 (count param-types)))) | |
arity ((if vararg? dec identity) (count param-types)) | |
params (vec (repeatedly arity gensym)) | |
params (if vararg? (conj params '& (gensym)) params)] | |
(when-not (and vararg? (not= arity max-arity)) | |
(list params `(. ~oname (~mname ~@params)))))) | |
arity-groups)))))))] | |
`(let [~oname ~o] | |
(proxy ~class-and-ifaces ~ctor-args ~@impls)))) | |
(comment | |
(def p (delegating-proxy (fn [& args] :foo) [clojure.lang.IFn] [])) | |
; => #'user/p | |
(update-proxy p {"applyTo" (fn [& args] :bar)}) | |
; => #<Object$IFn$4c646ebb user.proxy$java.lang.Object$IFn$4c646ebb@28ee1c42> | |
(.invoke p 1) | |
; Reflection warning, NO_SOURCE_FILE:1 - call to invoke can't be resolved. | |
; => :foo | |
(.applyTo p (seq [1])) | |
; Reflection warning, NO_SOURCE_FILE:1 - call to applyTo can't be resolved. | |
; => :bar | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment