Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
A ridiculous proxy macro which delegates calls to methods which have not been explicitly implemented to a specified object.
;;; 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
You can’t perform that action at this time.