This is the first of a couple of posts about Free Applicative Functors. They’re shaping up to be a tool I use often. All this code is in my effects repo here.
A couple of posts ago, I showed a simple DSL to produce XML using the Free Monad. The function to create a tag looked like this
(defn tag [name]
(fn [attr & contents]
(let [contents (reduce (fn [ev next]
(flat-map ev (fn [_] next)))
contents)]
(Free. (Tag. name attr contents (Pure. nil))))))
The thing you should notice is that in the call to flat-map, the anonymous function ignores the parameter it’s given (that’s the _). Whenever you see that pattern, it’s a clue that you could use an Applicative Functor instead.
The protocol for an Applicative is
(defprotocol Applicative
(wrap [x v])
(fapply* [wrapped-f args]))
There are two functions, wrap which takes any value and wraps in the Applicative structure. And fapply*, which takes a function wrapped in the applicative type, and a list of wrapped argument values. The argument values and function are extracted, and then the function is applied to the arguments. The result is then wrapped in the Applicative type to provide the value returned by fapply*
A couple of interesting points. All monads are also applicative functors. That is, fapply* can be written in terms of flat-map.
Also, while not every monad can be composed with other monads to produce a monad, all applicatives can be composed with other applicatives to produce a new applicative.
So what does the Free Applicative Functor look like and how is it related to the Free Monad. While it is true that fapply* could be written in term of flat-map for the Free Monad, this really doesn’t give you anything new. It’s just a different way of saying the same thing.
What the Free Monad gives us is a DSL to build a data structure from expressions. All we have to specify are the primitives of the language as Functor values and the Free Monad does the rest.
So to be useful, the Free Applicative should allow us to create a DSL just like the Free Monad. But where the Free Monad requires that the language elements nest recursively in order to provide sequencing, there’s no such restriction for the Free Applicative.
To illustrate, let’s re-implement our XML DSL. Here’s the simplest record that holds the information we’re interested in
(deftype Tag [name attr contents])
And a helper function to wrap it in the Free record type we saw before.
(defn tag [name]
(fn [attr & contents]
(let [contents (map (fn [v]
(if (= (type v) Free)
v
(pure v)))
contents)]
(free (Tag. name attr (fapply* (pure list) contents))))))
First, a minor point. mapping that anonymous function over the contents is just a niceity so that we don’t have wrap all the literal values in pure when we’re using our DSL.
The second point is the reason for this post. The contents value is a (possibly empty) list of values. If we just stick that list in the Tag record, it becomes a source of pain and complexity later on. So the question is, what do we do with it?
The answer, though not obvious, is to wrap it in a Free structure. But we saw up at the top that the Free Monad is unnecesarily rigid. So we use the Free Applicative by calling fapply* with the list function wrapped in a pure record.
In the first post on the Free Monad, we saw that all it does is create a data structure. The Free Applicative does the same thing. Realize that fapply* is a protocol function that dispatches on the type of the first argument. In this case, it’s of type Pure
(deftype Pure [v]
FreeProto
(evaluate [_ eval-pure _]
(eval-pure v))
EndoFunctor
(fmap [_ f]
(Pure. (f v) nil))
Applicative
(wrap [_ v]
(Pure. v nil))
(fapply* [f args]
(free-app f args)))
(defn pure [v]
(Pure. v))
This is the same definition of Pure from before except we’ve added an implementation of the protocol function fapply*. Which is just a call to free-app.
(deftype FreeA [f args]
FreeProto
(evaluate [_ eval-pure eval-endo]
(fapply* (evaluate f eval-pure eval-endo)
(map #(evaluate % eval-pure eval-endo) args)))
EndoFunctor
(fmap [_ pure-f]
(FreeA. (fmap f #(comp pure-f %)) args))
Applicative
(wrap [_ v]
(pure v))
(fapply* [f args]
(FreeA. f args)))
(defn free-app [f x]
(FreeA. f x))
All FreeA is, is a record that holds the values for f and args. f is a function that is wrapped in a Pure record and args is a list of Free, FreeA or Pure values. And that’s it.
FreeA does implement some protocol functions, but we’ll come back to those as needed. The only thing to note is that the evaluate function just evaluates the wrapped function and each of the args, then calls fapply* with the results. This means that in the case of the Free Applicative, evaluate must return a value that implements the Applicative protocol.
So how to use this in our XML DSL? Nothing could be easier. First, we define some simple HTML tags
(def html (tag "html"))
(def head (tag "head"))
(def title (tag "title"))
(def body (tag "body"))
(def p (tag "p"))
Then we use those to create a simple page.
(def page (html {}
(head {}
(title {} "This Is The Title"))
(body {}
(p {} "first paragraph")
(p {} "second paragraph")
(p {} "third paragraph"))))
page is now a Free value just waiting to be evaluated. And the obvious thing to do is generate an XML string from it. Recall up above we saw that fapply*’s evaluate function needed to return an Applicative value. So let’s create one.
First we need to create a protocol for the xml function. This will be implemented later by the Tag record to produce an XML string.
(defprotocol XML
(xml [v]))
Then we need a record type that implements fapply*.
(deftype XMLStr [s]
Applicative
(fapply* [_ args]
(XMLStr. (apply s (map #(.s %) args)))))
This record just wraps the value s. If fapply* is called for this value, then s is a function, so it’s applied to all the s values in the args list. Simple.
Now we can write the function that actually creates the XML and extracts the string from the XMLStr record.
(defn make-xml [free-tag]
(.s (evaluate free-tag
(fn [v]
(XMLStr. v))
(fn [tag]
(XMLStr. (xml tag))))))
This just calls evaluate with two functions and the free tag value to be evaluated. The first function converts a value that was previously wrapped in a Pure record into an XMLStr value. The second function converts a Tag record into an XML string using xml and then wraps it in an XMLStr record.
Finally, we have to extend the Tag record to generate an XML string.
(extend-type Tag
XML
(xml [t]
;; ignoring the attributes for now
;; easy to add later
(str "<" (.name t) ">\n"
(make-xml (fmap contents #(apply str %)))
"\n</" (.name t) ">\n")))
The code for this XML DSL is here you should be able to grab the whole repo and go to town. As you can see, it’s only about 20 lines of code and it’s pretty close to being a complete XML generating library. But this only scratches the surface. Next time we’ll get into some seriously cool stuff that’ll keep you up at night. At least it does me.
Jim Duey 08 June 2014