Clojure 是否有一种高效、惯用的装饰器方法？

Question

在 Clojure(script) 中，您使用 deftype 和 defrecord 定义编程结构。我们希望我们的构造每个都有一个特定的、明确定义的目的。我们没有将任何一个构造演变成一个单一的功能齐全的东西，而是选择分离职责。装饰器（例如包装其他数据结构的数据结构）对此很有用。

例如，您有一个记录器构造。您可以使用装饰器添加时间戳作为功能。您稍后添加警报支持人员蜂鸣器作为另一个装饰器。理论上，我们可以通过这种方式对任意数量的特征进行分层。我们的配置文件清楚地确定了包含哪些功能。

如果我们的 logger 实现了一个 3 方法 Logging 协议并且每个装饰器只增加一个，那么您仍然必须在每个装饰器上实现其他两个方法来维护合同 API。这些无添加的实现只是将消息传递到链中。这有点尴尬。

构造的 api 越丰富，问题就越严重。考虑一个实现了一些协议的构造，以及装饰处理 12 个左右方法的东西所需的工作。

您是否发现了一种机制、宏或技术来克服这个问题？

Answer 1

一种选择是使用extend 来合并默认委托功能和覆盖实现的组合。

例如，使用如下记录器协议：

(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))))

您可以编写一个创建装饰器实现的函数，如下所示：

(defn decorate-fn
  "Creates a decorator function
   given the implementation accessor and the called function."
  [impl f]
  (fn [decorator & args]
    (apply f (impl decorator) args)))

(defn gen-decorators
  "Creates a map of decorator functions."
  [impl fs]
  (into {} (for [[k f] fs]
             [k (decorate-fn impl f)])))

(defn decorate-logger
  "Creates a logger decorator with functions
   passing through to the implementation by default."
  [impl overrides]
  (merge (gen-decorators impl
                         {:info info
                          :warn warn
                          :debug debug})
         overrides))

然后使用它轻松创建装饰器：

(defrecord CapslockWarningLogger [impl])

(extend CapslockWarningLogger
  Logger
  (decorate-logger :impl
                   {:warn (fn [{:keys [impl]} s]
                            (warn impl (clojure.string/upper-case s)))}))

(defrecord SelectiveDebugLogger [ignored impl])

(extend SelectiveDebugLogger
  Logger
  (decorate-logger :impl
                   {:debug (fn [{:keys [impl ignored]} s]
                             (when-not (ignored s)
                               (debug impl s)))}))

(def logger
  (->SelectiveDebugLogger #{"ignored"}
                          (->CapslockWarningLogger
                            println-logger)))

(info logger "something")
; Info: something
; => nil

(warn logger "something else")
; Warn: SOMETHING ELSE
; => nil

(debug logger "ignored")
; => nil

Answer 2

作为与使用 extend 完全不同的方法，定义一个 defdecorator 宏并不难，该宏将通过委托给修饰的实现来提供任何缺少的协议定义。

再次，从如下协议开始：

(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))))

您可以编写一些机制来创建协议定义，方法是检查协议以获取其所有功能，然后为缺少的任何功能创建委托实现：

(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)))))))

然后您可以编写一个宏来获取定义并创建一个扩展给定协议的记录，使用get-decorator-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)))

并使用它来创建新的装饰器：

(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))))