Permalink
Browse files

Make sure to put the right :arglists metadata on vars created with de…

…fn-wrapping
  • Loading branch information...
1 parent e010b91 commit 0d1dc24eed875b6100338bf88651ceee4a18bfd3 @amalloy amalloy committed Aug 2, 2011
Showing with 28 additions and 15 deletions.
  1. +20 −14 src/useful/experimental.clj
  2. +8 −1 test/useful/experimental_test.clj
@@ -2,6 +2,7 @@
(:use [useful.utils :only [split-vec]]
[useful.seq :only [alternates]]
[useful.map :only [keyed]]
+ [useful.macro :only [name-with-attributes]]
[useful.fn :only [any]]))
(defn comp-partial
@@ -180,20 +181,25 @@
Note the order of the wrapping: when called with 10 as an argument, the former
will return -40, and the latter 0."
- [name wrappers-var doc args & body]
- `(let [impl# (fn ~args ~@body)]
- (defn ~name ~doc [& args#]
- (let [wrappers# (not-empty @~wrappers-var)]
- (if-not wrappers#
- (apply impl# args#)
- (with-bindings {~wrappers-var
- (vary-meta wrappers# assoc
- ::call-data {:fn-name '~name})}
- (apply (reduce (fn [f# wrapper#]
- (wrapper# f#))
- impl#
- wrappers#)
- args#)))))))
+ [name wrappers-var & defn-args]
+ (let [[name macro-args] (name-with-attributes name defn-args)
+ fake-defn-name (gensym 'tmp)]
+ `(let [impl# (fn ~@macro-args)
+ fake-defn-var# (defn ~fake-defn-name ~@macro-args)
+ arglists# (-> fake-defn-var# meta :arglists)]
+ (ns-unmap *ns* '~fake-defn-name)
+ (defn ~name {:arglists arglists#} [& args#]
+ (let [wrappers# (not-empty @~wrappers-var)]
+ (if-not wrappers#
+ (apply impl# args#)
+ (with-bindings {~wrappers-var
+ (vary-meta wrappers# assoc
+ ::call-data {:fn-name '~name})}
+ (apply (reduce (fn [f# wrapper#]
+ (wrapper# f#))
+ impl#
+ wrappers#)
+ args#))))))))
(defmacro with-wrappers
"Dynamically bind some additional wrappers to the specified wrapper-var
@@ -105,4 +105,11 @@
(with-wrapper vec-wrapper (prepend 'baz)
(is (= "foobaz123bar" (vec-str 1 2 3))))))
(with-wrappers cons-wrapper [(prepend 'foo) (append 'bar) (prepend 'baz)]
- (is (= "bazfoo123bar" (cons-str 1 2 3))))))))
+ (is (= "bazfoo123bar" (cons-str 1 2 3)))))))
+
+ (testing "Metadata is applied properly"
+ (defn-wrapping myfn nil "re-implement clojure.core/first." [[x]]
+ x)
+ (let [meta (meta #'myfn)]
+ (is (= '([[x]]) (:arglists meta)))
+ (is (= "re-implement clojure.core/first." (:doc meta))))))

0 comments on commit 0d1dc24

Please sign in to comment.