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

Question

在Clojure(script)中，您可以使用deftype和defrecord来定义编程构造。我们希望每个构造都有一个特定且明确定义的目的。与其将任何一个构造演变成为一个庞大的全功能工具，我们选择分离职责。装饰器（例如包装其他数据结构的数据结构）非常适合这样做。

例如，您有一个日志记录器构造。您可以使用装饰器添加时间戳作为一项功能。稍后，您又可以添加支持响铃提示的警报支持人员作为另一个装饰器。理论上，我们可以通过这种方式添加任意数量的功能。我们的配置文件清晰地确定了包含哪些功能。

如果我们的记录器实现了一个三方法记录协议，而每个装饰器仅增强其中一个方法，则仍然必须在每个装饰器上实现另外两个方法以维护契约api。这些没有添加任何内容的实现只是将消息向下传递。这是让人感到尴尬的部分。

构造的api越丰富，问题就越严重。考虑一个实现几个协议的构造并处理12个或更多方法所需的工作。

您是否找到一种机制、宏或技术来解决这个问题？

- Mario

---

一种用于将数据结构包装在其他数据结构中，或者将函数与其他函数包装在一起的技术称为“中间件”。通常人们会在Ring中遇到它：https://github.com/ring-clojure/ring/wiki/Concepts。 - Chris Murphy

中间件很棒，但从我的经验来看，它是为函数设计的（例如仅处理一种消息的合同）。当您拥有一个可能具有多个方法的结构（例如协议）时，就会出现我提到的复杂性。问题是：如何为支持多个方法的结构构建中间件，而无需在每个层次上详细说明每个方法？ - Mario

中间件就是装饰器模式应用于函数的一种形式。这个问题是关于如何将它应用于“一组”多个函数的。 - amalloy

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

- Beyamor

---

聪明。它确实做了我要求的事情，但需要一开始就采用这种方法。正如我所怀疑的那样，这不是语言努力解决的一流问题（例如defdecorator）。感谢您周到的回复。 - Mario

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

- Beyamor

---

不可思议。感谢你的努力。我将不得不进一步调查。 - Mario