Skip to content
Browse files

Merge branch 'r/0.5.5'

  • Loading branch information...
2 parents 4ed475b + 91fcf46 commit af42d16de76cb9c0471993b5f0798eafc06484ae @amalloy amalloy committed Aug 5, 2011
Showing with 126 additions and 69 deletions.
  1. +1 −1 project.clj
  2. +27 −18 src/useful/experimental.clj
  3. +13 −0 src/useful/fn.clj
  4. +7 −0 src/useful/macro.clj
  5. +1 −2 src/useful/utils.clj
  6. +68 −47 test/useful/experimental_test.clj
  7. +9 −1 test/useful/macro_test.clj
View
2 project.clj
@@ -1,4 +1,4 @@
-(defproject useful "0.5.4"
+(defproject useful "0.5.5"
:description "A collection of generally-useful Clojure utility functions"
:dependencies [[clojure "1.2.0"]
[org.clojure/tools.macro "0.1.1"]]
View
45 src/useful/experimental.clj
@@ -130,6 +130,30 @@
(extend ~name
~@(apply concat proto-fns))))))
+(defn wrap-with [f wrapper-var & [name]]
+ (with-meta
+ (fn [& args]
+ (let [wrappers (not-empty @wrapper-var)]
+ (if-not wrappers
+ (apply f args)
+ (with-bindings {wrapper-var
+ (vary-meta wrappers assoc
+ ::call-data {:fn-name name})}
+ (apply (reduce (fn [f wrapper]
+ (wrapper f))
+ f
+ wrappers)
+ args)))))
+ (meta f)))
+
+(defn make-wrappable! [fn-var wrappers-var & [name]]
+ (alter-var-root fn-var wrap-with wrappers-var name))
+
+(defmacro wrap-multiple [wrappers-var & fn-syms]
+ (cons `do
+ (for [f fn-syms]
+ `(make-wrappable! #'~f ~wrappers-var '~f))))
+
(defmacro defn-wrapping
"Define a function as with defn, which checks the contents of wrappers-var
whenever it is called. If that var is empty, the underlying defn is called
@@ -155,24 +179,9 @@
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 & 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#))))))))
+ (let [[name macro-args] (name-with-attributes name defn-args)]
+ `(doto (defn ~name ~@macro-args)
+ (make-wrappable! ~wrappers-var '~name))))
(defmacro with-wrappers
"Dynamically bind some additional wrappers to the specified wrapper-var
View
13 src/useful/fn.clj
@@ -79,3 +79,16 @@
([a b & more]
(when-let [items (seq (remove nil? (list* a b more)))]
(apply f items)))))
+
+(defn key-comparator
+ "Given a transformation function (and optionally a direction), return a
+ comparator which does its work by comparing the values of (transform x) and
+ (transform y)."
+ ([modifier]
+ (fn [a b]
+ (- (modifier a) (modifier b))))
+ ([direction modifier]
+ (let [f (comparator modifier)]
+ (condp #(% %2) direction
+ #{:desc :descending -} (comp - f)
+ #{:asc :ascending +} f))))
View
7 src/useful/macro.clj
@@ -85,3 +85,10 @@ myconst 10)."
(conj (meta name) attr)
attr)]
[(with-meta name attr) macro-args]))
+
+(defmacro with-altered-var
+ "Binds var-name to the result of (f current-value args) for the dynamic
+ scope of body. Basically like swap! or alter, but for vars."
+ [[var-name f & args] & body]
+ `(binding [~var-name (~f ~var-name ~@args)]
+ ~@body))
View
3 src/useful/utils.clj
@@ -12,7 +12,7 @@
"Raise exception unless test returns true."
[test exception]
`(when-not ~test
- (throw (fix ~exception string? #(Exception. %)))))
+ (throw (fix ~exception string? #(Exception. ^String %)))))
(def ^{:doc "The minimium value of vals, ignoring nils."
:arglists '([& args])}
@@ -153,4 +153,3 @@
(apply f val args))
args)
(var-get prev)))
-
View
115 test/useful/experimental_test.clj
@@ -65,51 +65,72 @@
(is (= {:f 'lookup :args [1] :ret :not-found} @call-log)))))
(deftest wrapper-test
- (testing "Wrapping respects manually-established bindings"
- (with-local-vars [wrappers ()]
- (defn-wrapping my-inc wrappers "add one" [x]
- (+ 1 x))
- (is (= 2 (my-inc 1)))
- (let [start-num 1]
- (is (= (* 2 (inc (+ 10 start-num)))
- (with-bindings {wrappers (list (fn [f] ;; outermost wrapper
- (fn [x]
- (* 2 (f x))))
- (fn [f] ;; innermost wrapper
- (fn [x]
- (f (+ 10 x)))))}
- (my-inc start-num)))))
- (let [call-log (atom nil)]
- (is (= 2 (with-bindings {wrappers (list (fn [f]
+ (with-local-vars [dummy-wrapper ()]
+ (testing "Wrapping respects manually-established bindings"
+ (with-local-vars [wrappers ()]
+ (defn-wrapping my-inc wrappers "add one" [x]
+ (+ 1 x))
+ (is (= 2 (my-inc 1)))
+ (let [start-num 1]
+ (is (= (* 2 (inc (+ 10 start-num)))
+ (with-bindings {wrappers (list (fn [f] ;; outermost wrapper
(fn [x]
- (let [ret (f x)]
- (reset! call-log [(-> wrappers deref meta :useful.experimental/call-data :fn-name) x ret])
- ret))))}
- (my-inc 1))))
- (testing "Wrapping-related metadata bound correctly"
- (is (= ['my-inc 1 2] @call-log))))))
-
- (testing "with-wrapper(s) works"
- (let [prepend (fn [item] (fn [f] (fn [& args] (apply f item args))))
- append (fn [item] (fn [f] (fn [& args] (apply f (concat args [item])))))]
- (with-local-vars [vec-wrapper []
- cons-wrapper ()]
- (defn-wrapping vec-str vec-wrapper "Make stuff a string" [& args]
- (apply str args))
- (defn-wrapping cons-str cons-wrapper "Make stuff a string" [& args]
- (apply str args))
- (with-wrapper vec-wrapper (prepend 'foo)
- (is (= "foo123" (vec-str 1 2 3)))
- (with-wrapper vec-wrapper (append 'bar)
- (is (= "foo123bar" (vec-str 1 2 3)))
- (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)))))))
-
- (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))))))
+ (* 2 (f x))))
+ (fn [f] ;; innermost wrapper
+ (fn [x]
+ (f (+ 10 x)))))}
+ (my-inc start-num)))))
+ (let [call-log (atom nil)]
+ (is (= 2 (with-bindings {wrappers (list (fn [f]
+ (fn [x]
+ (let [ret (f x)]
+ (reset! call-log [(-> wrappers deref meta :useful.experimental/call-data :fn-name) x ret])
+ ret))))}
+ (my-inc 1))))
+ (testing "Wrapping-related metadata bound correctly"
+ (is (= ['my-inc 1 2] @call-log))))))
+
+ (testing "with-wrapper(s) works"
+ (let [prepend (fn [item] (fn [f] (fn [& args] (apply f item args))))
+ append (fn [item] (fn [f] (fn [& args] (apply f (concat args [item])))))]
+ (with-local-vars [vec-wrapper []
+ cons-wrapper ()]
+ (defn-wrapping vec-str vec-wrapper "Make stuff a string" [& args]
+ (apply str args))
+ (defn-wrapping cons-str cons-wrapper "Make stuff a string" [& args]
+ (apply str args))
+ (with-wrapper vec-wrapper (prepend 'foo)
+ (is (= "foo123" (vec-str 1 2 3)))
+ (with-wrapper vec-wrapper (append 'bar)
+ (is (= "foo123bar" (vec-str 1 2 3)))
+ (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)))))))
+
+ (testing "Metadata is applied properly"
+ (defn-wrapping myfn dummy-wrapper "re-implement clojure.core/first." [[x]]
+ x)
+ (let [meta (meta #'myfn)]
+ (is (= '([[x]]) (:arglists meta)))
+ (is (= "re-implement clojure.core/first." (:doc meta))))
+
+ (testing "Docstring is optional"
+ (defn-wrapping testfn dummy-wrapper [x]
+ (inc x))
+ (is (= 1 (testfn 0)))))
+
+ (let [inc-fn (fn [f] (comp inc f))]
+ (testing "Wrapper can be added after function is defined"
+ (defn frizzle [x] (inc x))
+ (make-wrappable! #'frizzle dummy-wrapper)
+ (is (= 3 (with-wrapper dummy-wrapper inc-fn
+ (frizzle 1)))))
+
+ (testing "wrap-multiple"
+ (defn frazzle [x] (inc x))
+ (defn zazzle [x] (inc x))
+ (wrap-multiple dummy-wrapper frazzle zazzle)
+ (are [f] (= 3 (with-wrapper dummy-wrapper inc-fn
+ (f 1)))
+ frazzle zazzle)))))
View
10 test/useful/macro_test.clj
@@ -19,4 +19,12 @@
(with-out-str
(macro-do [x] `(print '~x)
123
- abc))))))
+ abc))))))
+
+(def *value* 1)
+
+(deftest test-alter-var
+ (let [get-value (fn [] *value*)]
+ (is (= 1 *value*))
+ (is (= 4 (with-altered-var [*value* + 3]
+ (get-value))))))

0 comments on commit af42d16

Please sign in to comment.
Something went wrong with that request. Please try again.