在Clojure(script)中，您可以使用deftype和defrecord定义编程结构。 我们希望我们的每个构造都有一个特定的、定义明确的目的。 我们没有将任何一个结构演变成一个单一的全功能的东西，而是选择分离责任。 装饰器(例如包装其他数据结构的数据结构)对此有好处。
例如，您有一个记录器构造。 将时间戳添加为带有装饰器的功能。 稍后，您将警报支持人员蜂鸣器添加为另一个装饰器。 从理论上讲，我们可以通过这种方式对任意数量的特征进行分层。 我们的配置文件清楚地确定了包含哪些功能。
如果我们的记录器实现了 3 种方法的日志记录协议，而每个装饰器只增加了一个，您仍然必须在每个装饰器上实现其他两种方法来维护合同 API。 这些无添加的实现只是将消息沿链向下传递。 这是尴尬的一点。
构造的 API 越丰富，问题就越严重。 考虑一个实现一些协议的构造，以及装饰处理 12 个左右方法的东西所需的工作。
您是否发现了克服这一点的机制、宏或技术？
一种选择是使用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
作为一种与使用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))))