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

Does Clojure have an efficient, idiomatic approach for decorators?

在 Clojure(script) 中,您可以使用 deftypedefrecord 定义编程结构。我们希望我们的构造每个都有一个特定的、定义明确的目的。我们选择分离职责,而不是将任何一个构造发展成一个整体的全功能事物。装饰器(例如包装其他数据结构的数据结构)对此很有用。

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

如果我们的记录器实现了 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))))