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. map
ping 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 evaluate
d. 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