Free Transformers

(This post will run long because of all the code. But it’s not very dense and you should be able to copy and paste the code into a repl.)

If you want to follow along with your own REPL, you need to get my effects repo from here. Once you’ve cloned it, do

lein repl

in the repo root directory and you should be good to go.

Continuing on

We left off last time with a chunk of code that implemented a small DSL to write HTML tags. In developing that, I glossed over some issues. The biggest one is the need to extend the java.lang.String type to implement the XML protocol.

If you ever wanted to use anything besides strings as the contents for an XML tag, you’d have to extend them as well. This happens because in the xml function for the Tag deftype, it passes the contents to a call to xml. And so any values that appear in the contents have to implement the XML protocol. There are two ways to correct this. One is to change xml so that it tests the type in the contents before calling xml with it. The other is to change tag to check the type of the contents value and wrap anything that’s not a Free type in a Pure type. For reasons I’ll show later, I chose the second.

So here’s the new version.

(require '[effects :refer :all]
         '[effects.free :refer :all])
(import '[effects.free Free Pure])

(defprotocol XML
  (xml [v]))

(deftype Tag [name attr contents next]
  EndoFunctor
  (fmap [t f]
    (Tag. (.name t) (.attr t) (.contents t) (f (.next t)))))

(defn tag [name]
  (fn [attr & contents]
    (let [contents (reduce (fn [ev next]
                             (flat-map ev (fn [_] next)))
                           contents)
          contents (if (= Free (type contents))
                     contents
                     (Pure. contents))]
      (Free. (Tag. name attr contents (Pure. nil))))))

(extend-type Tag
  XML
  (xml [t]
    (let [contents (xml (.contents t))
          next (xml (.next t))]
      (str "<" (.name t) ">\n" contents "\n</" (.name t) ">"
           (str \newline next)))))

(extend-type Pure
  XML
  (xml [ev]
    (str (extract ev))))

(extend-type Free
  XML
  (xml [ev]
    (xml (extract ev))))

(def html (tag "html"))
(def head (tag "head"))
(def title (tag "title"))
(def body (tag "body"))
(def p (tag "p"))

(def page (html {}
                (head {}
                      (title {} "This Is The Title"))
                (body {}
                      (p {} "first paragraph")
                      (p {} "second paragraph")
                      (p {} "third paragraph"))))

(println (xml page))
(println)

Easily amazed

It might just be me, but when I got what I’m about to explain, it totally amazed and delighted me. Also, I’m venturing into an area where I couldn’t find many other sources of explanation. And for those I did find, I couldn’t penetrate the Haskellese. (I know, I should just go ahead and learn Haskell.) Regardless, I’m putting this explanation out there. If I’m wrong in my understanding, I’d love to be corrected.

Here’s what I found. Monads don’t generally compose. This fact gives rise to monad transformers, which I’ve written about before.

To recap, a normal monad is a datatype (or a set of values, if you prefer) that implements a wrap function and a flat-map function. In Clojure, a monad is expressed as a function that takes any kind of value and wraps it in a value that implements wrap and flat-map.

The Free monad cannot take just any value to wrap. It can only wrap values that implement fmap. These values can be composed using flat-map, just like any normal monad. The difference is that in the Free monad case, the result is a data structure. For example, a nested Tag data structure that encodes XML.

A normal monad transformer is a function that takes a monad function as an argument and returns a monad function. The new monad function will take any value and wrap it so that it’s wrap and flat-map functions combine the behaviors of both monads.

So what does a Free Monad Transformer do? This is a little complicated, so pay close attention. Given a value that implements fmap, instead of wrapping it with Free, you first wrap it in another monad (using that particular monad function). Then you pass that wrapped value to FreeT.

So a value of the Free monad composed with the vector monad would be

(import 'effects.free.FreeT)
(FreeT. (vector 4))
=> #<FreeT [4]>

Remember that the Free monad is used to build a data structure using monadic notation. It doesn’t actually do anything. Using a Free monad transformer lets you create a monadic value in an arbitrary monad that contains the data structure. Here’s a simple example.

Internals

You may think the code for the FreeT flat-map is hideously complicated. Well, it kind of is, but not really. (don’t paste this into your repl)

(deftype FreeT [mv]
  Applicative
  (wrap [_ v]
    (FreeT. (wrap mv v)))

  Monad
  (flat-map [_ f]
    (FreeT. (flat-map mv (fn [x]
                           (wrap mv (fmap x (fn [ev]
                                              (flat-map ev f))))))))

  MonadZero
  (zero [_]
    (FreeT. (zero (wrap mv :nil))))
  (plus* [mv mvs]
    (FreeT. (->> (cons mv mvs)
                 (map extract)
                 (apply plus))))

  Comonad
  (extract [_] mv))

wrap is very straight forward. flat-map, not so much but if you pay attention to the types it’s not so bad. First, realize that mv is a monadic value in some monad. And f is a function that takes a plain value and returns Free Transformer value (which wraps a monadic value which wraps a plain value. whew).

Contrast FreeT’s flat-map with that of Free.

(deftype Free [v]
  Monad
  (flat-map [_ f]
    (Free. (fmap v #(flat-map % f))))

They’re similar in form, except the FreeT version has an extra layer of unwrapping/wrapping to deal with the monadic character of mv.

The functions zero and plus* just enable FreeT to handle the cases where the base monad of mv has those functions implemented as well.

Alternatives

So what can you do with this? Consider this function and compare it to the tag function above

(require '[effects.vector :refer :all])
(defn multi-tag [name]
  (fn [attr & contents]
    (let [contents (reduce (fn [ev next]
                             (flat-map ev (fn [_] next)))
                           contents)
          contents (if (= FreeT (type contents))
                     contents
                     (Pure. (vector contents)))]
      (FreeT. (vector (Tag. name attr contents (Pure. (vector nil))))))))

It looks almost the same except we use FreeT instead of Free along with extra calls to vector. Using it is the same as before

(def html (multi-tag "html"))
(def head (multi-tag "head"))
(def title (multi-tag "title"))
(def body (multi-tag "body"))
(def p (multi-tag "p"))

Now add one more little function

(defn alt [& alternatives]
  (FreeT. (vec alternatives)))

And we can do something like this

(def page (html {}
                (head {}
                      (alt (title {} "This Is The Title")
                           (title {} "Alternate Title")))
                (body {}
                      (p {} "first paragraph")
                      (p {} "second paragraph")
                      (p {} "third paragraph"))))

We do need new definitions of the xml function for Tag, Pure and FreeT. But the only difference for the Tag version is to change the let to for.

(extend-type Tag
  XML
  (xml [t]
    (for [contents (xml (.contents t))
          next (xml (.next t))]
      (str "<" (.name t) ">\n" contents "\n</" (.name t) ">"
           (str \newline next)))))

(extend-type Pure
  XML
  (xml [ev]
    (fmap (extract ev) str)))

(extend-type FreeT
  XML
  (xml [ev]
    (flat-map (extract ev) xml)))

And now to see what we’ve wrought

(xml page)
=> <a vector of two strings>

So, we now have a DSL that lets us write HTML code and specify alternate contents. Not terribly useful, probably, but I think it’s kind of neat.

Inserting

But the really amazing stuff is when you choose a different monad. Remember that you can choose any monad you want, there’s a lot of different combinations. So let’s use the reader monad.

(require '[effects.reader :refer :all])
(defn template-tag [name]
  (fn [attr & contents]
    (let [contents (reduce (fn [ev next]
                             (flat-map ev (fn [_] next)))
                           contents)
          contents (if (= FreeT (type contents))
                     contents
                     (Pure. (reader contents)))]
      (FreeT. (reader (Tag. name attr contents (Pure. (reader nil))))))))

(def html (template-tag "html"))
(def head (template-tag "head"))
(def title (template-tag "title"))
(def body (template-tag "body"))
(def p (template-tag "p"))

And add a new function

(defn insert [k]
  (FreeT. (fmap (read-val k) #(Pure. (reader %)))))

(def page (html {}
                (head {}
                      (title {} (insert :title)))
                (body {}
                      (p {} "first paragraph")
                      (p {} (insert :second-para))
                      (p {} "third paragraph"))))

Now, when we do

(xml page)

What we get is a data structure wrapped in a reader monad value. Values in the reader monad are functions that take an environment to read from. Let’s give it one

(println ((xml page) {:title "This Is The Title"
                      :second-para "second paragraph"}))
=>
<html>
<head>
<title>
This Is The Title
</title>

</head>
<body>
<p>
first paragraph
</p>
<p>
second paragraph
</p>
<p>
third paragraph
</p>

</body>

</html>

So page is kind of an HTML template that reads content from the given environment and generates the final HTML with it. Pretty slick, huh? Try it with other values for :title and :second-para.

More fun

Since you can use any monad with FreeT, you could use one that queried a database and inserted the results into the HTML. Or, if you had a monad like the one used in core.logic, you could generate HTML using logic programming. So there you go, Free Monad Transformers.

Jim Duey 07 May 2014
blog comments powered by Disqus