Does Clojure have an efficient, idiomatic approach for decorators?

Question

In Clojure(script) you define programming constructs with deftype and defrecord. We want our constructs to each have a specific, well-defined purpose. Rather than evolve any one construct into a monolithic full-featured thing, we choose to segregate responsibilities. Decorators (e.g. data structures that wrap other data structures) are good for this.

For example, you have a logger construct. You add timestamping as a feature with a decorator. You later add alerting support staff beepers as another decorator. We can, in theory, layer on any number of features this way. Our config file cleanly determines which features get included.

If our logger implements a 3-method Logging protocol and each decorator only augments one, you still have to implement the other two methods on each decorator to uphold the contractual api. These add-nothing implementations simply pass the message down the chain. This is the awkward bit.

The richer a construct's api, the worse the problem. Consider a construct that implements a few protocols and the work necessary to decorate something that handles 12 or so methods.

Is there a mechanism, macro, or technique that you've found to overcomes this?

Answer 1

As a wildly different approach from using extend, it's not too hard to define a defdecorator macro that'll supply any missing protocol definitions by delegating to the decorated implementation.

Again, starting with a protocol like:

(defprotocol Logger
  (info [logger s])
  (warn [logger s])
  (debug [logger s]))

(def println-logger
  (reify Logger
    (info [_ s]
      (println "Info:" s))
    (warn [_ s]
      (println "Warn:" s))
    (debug [_ s]
      (println "Debug:" s))))

You can write some machinery to create protocol definitions by inspecting the protocol to get all of its functions, then creating delegating implementations for any that're missing:

(defn protocol-fn-matches?
  "Returns the protocol function definition
   if it matches the desired name and arglist."
  [[name arglist :as def] desired-name desired-arglist]
  (when (and (= name desired-name)
             (= (count arglist) (count desired-arglist)))
    def))

(defn genarglist
  "Takes an arglist and generates a new one with unique symbol names."
  [arglist]
  (mapv (fn [arg]
          (gensym (str arg)))
        arglist))

(defn get-decorator-definitions
  "Generates the protocol functions for a decorator,
   defaulting to forwarding to the implementation if
   a function is not overwritten."
  [protocol-symbol impl fs]
  (let [protocol-var (or (resolve protocol-symbol)
                         (throw (Exception. (str "Unable to resolve protocol: " protocol-symbol))))
        protocol-ns (-> protocol-var meta :ns)
        protocol (var-get protocol-var)]
    (for [{:keys [name arglists]} (vals (:sigs protocol))
          arglist arglists]
      (or (some #(protocol-fn-matches? % name arglist) fs)
          (let [arglist (genarglist arglist) ; Generate unique names to avoid collision
                forwarded-args (rest arglist) ; Drop the "this" arg
                f (symbol (str protocol-ns) (str name))] ; Get the function in the protocol namespace
            `(~name ~arglist
               (~f ~impl ~@forwarded-args)))))))

You can then write a macro that takes the definitions and creates a record extending the given protocols, using get-decorator-definitions to supply any missing definitions:

(defmacro defdecorator
  [type-symbol fields impl & body]
  (let [provided-protocols-and-defs (->> body
                                         (partition-by symbol?)
                                         (partition-all 2))
        protocols-and-defs (mapcat (fn [[[protocol] fs]]
                                     (cons protocol
                                           (get-decorator-definitions protocol impl fs)))
                                   provided-protocols-and-defs)]
    `(defrecord ~type-symbol ~fields
       ~@protocols-and-defs)))

And use it to create new decorators:

(defdecorator CapslockWarningLogger
              [impl] impl
              Logger
              (warn [_ s]
                    (warn impl (clojure.string/upper-case s))))

(defdecorator SelectiveDebugLogger
              [ignored impl] impl
              Logger
              (debug [_ s]
                     (when-not (ignored s)
                       (debug impl s))))