(ns robert.hooke
  "Hooke your functions!")

(defn- compose-hooks [f1 f2]
  (fn [& args]
    (apply f2 f1 args)))

(defn- join-hooks [original hooks]
  (reduce compose-hooks original hooks))

(defn- run-hooks [hooked original args]
  (apply (join-hooks original @(::hooks (meta hooked))) args))

(defn- prepare-for-hooks [v]
  (when-not (::hooks (meta @v))
    (alter-var-root v (fn [original]
                        (with-meta
                          (fn runner [& args]
                            (run-hooks runner original args))
                          (assoc (meta original) ::hooks (atom ())))))))

(defn add-hook
  "Add a hook function f to target-var. Hook functions are passed the
  target function and all their arguments and must apply the target to
  the args if they wish to continue execution."
  [target-var f]
  (prepare-for-hooks target-var)
  (swap! (::hooks (meta @target-var)) conj f))

(defn remove-hook
  "Remove hook function f from target-var."
  [target-var f]
  (when (::hooks (meta @target-var))
    (swap! (::hooks (meta @target-var)) remove f)))

Generated by Phil Hagelberg using scpaste at Thu Jun 10 21:34:04 2010. PDT. (raw)