How can you make a record forward a protocol?

Question

I want to attach a different protocol to each instance of a record. What's a clean, non-repetitious way to do that in Clojure?

Specifically, I've got a protocol something like this:

(defprotocol LinkPolicy
  (lp-boost [dock g to])
  (lp-reduce-to-uncommitted [dock g to])
  (lp-reciprocate-commitment [dock g from])
  (lp-reciprocate-no-commitment [dock g from])
  (lp-normalize-after-add [dock g to weight])
  (lp-committed? [dock g to])
  . . .) ; more methods than this, even

And I want to define a record something like this:

(defrecord Dock [nodeid name link-policy]
  LinkPolicy
  (forward all methods to link-policy))

I suppose I could implement forwarding something like this:

(defrecord Dock [nodeid name link-policy]
  LinkPolicy
  (lp-boost [dock g to]
    (lp-boost link-policy dock g to))
  (lp-reduce-to-uncommitted [dock g from]
    (lp-reduce-to-uncommitted link-policy dock g from))
  (lp-reciprocate-commitment [dock g from]
    (lp-reciprocate-commitment link-policy dock g from))
  ; lots more forwarding methods here . . .
  . . .)))

but that seems somewhat less elegant than what I've come to expect is possible in Clojure. Also, every time I redefine LinkPolicy, I'm going to have to modify Dock, too. (And aren't there name-clashes between the methods inside Dock and the link-policy methods?)

What's a better way?

Answer 1

Update

By accident I have found a macro that allows to define a protocol with delegating all method calls to another object in useful library: delegating-defrecord. It's under experimental namespace, but you might find it... useful :).

---

This is not a direct answer for your answer, but I thought I would share some ideas how you could approach your problem.

I am not sure how your implementations of LinkPolicy protocol look like but from the included snippet it seems the protocol contains a lot of methods. That might be a sign of violating the Interface Segregation Principle from SOLID. Also I don't know if/how your implementations are different one from another - do you have some implementations having exactly the same implementations for some of the protocol methods?

If that is the case, I would consider using multimethods. That would give you the flexibility to have a separate dispatch logic for each of the methods and have various objects to be dispatched to the same implementation.

You could instead define a separate multimethod for each protocol method:

(defmulti lp-boost
  ;; dispatch function
  (fn [g to]
    (cond
      (some-cond-1 ...) :dispatch-value-1))

(defmulti lp-reduce-to-uncommitted
  (fn [g to] ...))

;; and so on for remaining functions

Your dispatch function could return a simple keyword or even a vector or keywords so you could dispatch for example using a type of the object and some other properties (e.g. for Dock you could have [:dock :lp-boost-impl-1] or [:dock :lp-boost-impl-2] etc.)

Then you could define your implementations for your dispatch values:

(defmethod lp-boost :dispatch-value-1
  [g to]
  ...)

Using multimethods won't have some of the nice properties protocol give you (all the behaviour is grouped, if a type implements a protocol then all the methods will be defined for it, better dispatch performance etc.) but you would gain a lot of flexibility in how you choose implementation of methods.

Answer 2

Automatically define record types, one per protocol

The trick is to programmatically define a separate record type corresponding to each distinct protocol. That is, the program defines a new record each time it comes up with a distinct method-map that you want to "stick" on your original record type. Obviously, this only works if the number of distinct protocols is small enough that you don't swamp memory with these different artificial record types. Also, you couldn't use this trick to assign different link protocols to different keywords (see below).

The following function defines a record type for a given "dockclass", which is a map containing both a name and a method-map for the link protocol. It returns the constructor.

(def ^:dynamic link-policy-for-eval)

(defn make-dock-maker [dockclass]
  (binding [link-policy-for-eval (:link-policy dockclass)]
    (let [dockclass-name (name (:name dockclass))
          record-sym (symbol (str "Dock-" dockclass-name))
          ctor-sym (symbol (str "->Dock-" dockclass-name))]
      (eval `(defrecord ~record-sym ~'[nodeid dock-name]))
      (eval `(extend ~record-sym
                     ~'fargish.links/LinkPolicy
                     link-policy-for-eval))
      ctor-sym))))

For example, if you have a dockclass named :input, make-dock-maker will define a record called Dock-input and return its constructor ->Dock-input.

I store that constructor in a place where it can be retrieved by a function called dock, which calls it to construct a new dock:

(defn dock [node dock-name]
  (let [maker (get-in node [:dock dock-name :dockclass :maker])]
    (maker (:nodeid node) dock-name)))

So, there is a single function to call to make whatever dock is appropriate to the node, with the appropriate linking protocol. Nowhere in the code do you need to refer to any of the generated record types or constructors by name.

There is one main non-obvious thing to note, which cost me a lot of effort to figure out:

• Generated code, as in an eval or a macro, cannot contain function objects. The var link-policy-for-eval provides a place to hold the method-map (whose values are all functions) where eval can see it.

Why forwarding by polymorphism is so good

When the objects being linked satisfy LinkPolicy, rather than providing a way to get a LinkPolicy, the calling code is wonderfully simple. For example, here's some code that makes use of automatic dispatching on docks with different link protocols:

(defn make-reciprocal-edits-for [g {:keys [from to]}]
  (if (lp-committed? from g to)
      (lp-reciprocate-commitment to g from)
      (lp-reciprocate-no-commitment to g from))))

The code doesn't become enormously complicated if I have to extract a link policy from every dock before doing anything with it, but it definitely adds some clutter everywhere and obscures the main ideas.

To write a simple unit test, I wanted to use keywords for docks instead of constructing records that refer to all the stuff needed when the whole program is running. extend made that easy:

(deftest test-exclusive-linking
  (extend clojure.lang.Keyword LinkPolicy (merge vanilla exclusive-linking))
  (->/do (uber/digraph :a :b :c)
    (do-action (Boost. :a :b))
    (->is (= <> (uber/digraph :c [:a :b 1.0])))
    (do-action (Boost. :a :c))
    (->is (= <> (uber/digraph :b [:a :c 1.0])))))

That only works as long as it's OK for every keyword to have the same link policy. If you wanted to give different link policies to different keywords, then you'd have to use a more general approach like what is shown in the other answers.

Answer 3

if you really need it (which i really doubt about), there is a way:

let's say we have a protocol StuffDoer:

(defprotocol StuffDoer
  (do-important-stuff [this x])
  (do-other-important-stuff [this x y]))

In fact this protocol is just a map defining protocol's behaviour:

user> StuffDoer
{:on user.StuffDoer, :on-interface user.StuffDoer, 
 :sigs {:do-important-stuff {:name do-important-stuff, :arglists ([this x]), :doc nil}, :do-other-important-stuff {:name do-other-important-stuff, :arglists ([this x y]), :doc nil}}, 
 :var #'user/StuffDoer, :method-map {:do-important-stuff :do-important-stuff, :do-other-important-stuff :do-other-important-stuff}, 
 :method-builders {#'user/do-other-important-stuff #function[user/eval20549/fn--20550], 
                   #'user/do-important-stuff #function[user/eval20549/fn--20565]}}

so we have all the methods' definitions, to use them inside extend. Let's make this custom extend function:

(defn extend-forwarding [t p fwd-to]
  (extend
      t p
      (into {} (map (fn [[method-var _]]
                      [(keyword (.sym method-var))
                       (fn [this & args]
                         (apply method-var (fwd-to this) args))])
                    (:method-builders p)))))

it dynamically builds a map for extend, getting all the methods of protocol and generating proxy function for every method.

let's test it:

(defrecord ConcreteDoer [v]
  StuffDoer
  (do-important-stuff [this x]
    (println "doing stuff:" v x))
  (do-other-important-stuff [this x y]
    (println "doing other stuff:" v x y)))

(defrecord ConcreteDoerWithForwarding [fwd-inst])

in repl:

user> (extend-forwarding ConcreteDoerWithForwarding StuffDoer :fwd-inst)
nil

user> (do-important-stuff
       (ConcreteDoerWithForwarding. (ConcreteDoer. :aaa))
       10)
doing stuff: :aaa 10
nil

user> (do-other-important-stuff
       (ConcreteDoerWithForwarding. (ConcreteDoer. :aaa))
       10 20)
doing other stuff: :aaa 10 20
nil