Gabriel Gonzalez has written quite a bit about the practical applications of free monads. And "haoformayor" wrote a great stackoverflow post on how arrows are related to strong profunctors. So I thought I'd combine these and apply them to arrows built from profunctors: free arrows. What you get is a way to use arrow notation to build programs, but defer the interpretation of those programs until later.





Heteromorphisms

Using the notation here I'm going to call an element of a type P a b , where P is a profunctor, a heteromorphism.





A product that isn't much of a product

As I described a while back you can compose profunctors. Take a look at the code I used, and also Data.Functor.Composition.





data Compose f g d c = forall a. Compose (f d a) (g a c)



Compose f g d c

f

g

Compose

mappend

(:)

An element ofis just a pair of heteromorphisms, one from each of the profunctors,and, with the proviso that the "output" type of one is compatible with the "input" type of the other. As products go it's pretty weak in the sense that no composition happens beyond the two objects being stored with each other. And that's the basis of what I'm going to talk about. Thetype is just a placeholder for pairs of heteromorphisms whose actual "multiplication" is being deferred until later. This is similar to the situation with the free monoid, otherwise known as a list. We can "multiply" two lists together usingbut all that really does is combine the elements into a bigger list. The elements themselves aren't touched in any way. That suggests the idea of using profunctor composition in the same way thatis used to pair elements and lists.





Free Arrows

Here's some code:





> {-# OPTIONS -W #-} > {-# LANGUAGE ExistentialQuantification #-} > {-# LANGUAGE Arrows #-} > {-# LANGUAGE RankNTypes #-} > {-# LANGUAGE TypeOperators #-} > {-# LANGUAGE FlexibleInstances #-}

> import Prelude hiding ((.), id) > import Control.Arrow > import Control.Category > import Data.Profunctor > import Data.Monoid

> infixr :-

> data FreeA p a b = PureP (a -> b) > | forall x. p a x :- FreeA p x b



FreeA

FreeA p a b

FreeA

PureP

[]

(->)

Composition (->) p a b

p a b

a -> x

p x b

x

x

lmap

p a b

First look at the second line of the definition of. It says that amight be a pair consisting of a head heteromorphism whose output matches the input of another. There's also thecase which is acting like the empty list. The reason we use this is that for our composition,acts a lot like the identity. In particularis isomorphic to(modulo all the usual stuff about non-terminating computations and so on). This is because an element of this type is a pair consisting of a functionand a heteromorphismfor some typewe don't get to see. We can't project back out either of these items without information about the type ofescaping. So the only thing we can possibly do is useto apply the function to the heteromorphism giving us an element of



Here is a special case of PureP we'll use later:





> nil :: Profunctor p => FreeA p a a > nil = PureP id



FreeA

FreeA

So an element ofis a sequence of heteromorphisms. If heteromorphisms are thought of as operations of some sort, then an element ofis a sequence of operations waiting to be composed together into a program that does something. And that's just like the situation with free monads. Once we've build a free monad structure we apply an interpreter to it to evaluate it. This allows us to separate the "pure" structure representing what we want to do from the code that actually does it.



The first thing to note is our new type is also a profunctor. We can apply lmap and rmap to a PureP function straightforwardly. We apply lmap directly to the head of the list and we use recursion to apply rmap to the PureP at the end:





> instance Profunctor b => Profunctor (FreeA b) where > lmap f (PureP g) = PureP (g . f) > lmap f (g :- h) = (lmap f g) :- h > rmap f (PureP g) = PureP (f . g) > rmap f (g :- h) = g :- (rmap f h)



first'

We also get a strong profunctor by applyingall the way down the list:





> instance Strong p => Strong (FreeA p) where > first' (PureP f) = PureP (first' f) > first' (f :- g) = (first' f) :- (first' g)



(++)

We can now concatenate our lists of heteromorphisms using code that looks a lot like the typical implementation of





> instance Profunctor p => Category (FreeA p) where > id = PureP id > g . PureP f = lmap f g > k . (g :- h) = g :- (k . h)



(++)

FreeA

Note that it's slightly different to what you might have expected compared tobecause we tend to write composition of functions "backwards". Additionally, there is another definition ofwe could have used that's analogous to using snoc lists instead of cons lists.



And now we have an arrow. I'll leave the proofs that the arrow laws are obeyed as an exercise :-)





> instance (Profunctor p, Strong p) => Arrow (FreeA p) where > arr = PureP > first = first'



The important thing about free things is that we can apply interpreters to them. For lists we have folds:





foldr :: (a -> b -> b) -> b -> [a] -> b



foldr f e

f

(:)

e

[]

Inwe can think ofas saying howshould be interpreted andas saying howshould be interpreted.



Analogously, in Control.Monad.Free in the free package we have:





foldFree :: Monad m => (forall x . f x -> m x) -> Free f a -> m a foldFree _ (Pure a) = return a foldFree f (Free as) = f as >>= foldFree f



f

m

foldFree

Free f

Given a natural transformation fromtoextends it to all of



Now we need a fold for free arrows:





> foldFreeA :: (Profunctor p, Arrow a) => > (forall b c.p b c -> a b c) -> FreeA p b c -> a b c > foldFreeA _ (PureP g) = arr g > foldFreeA f (g :- h) = foldFreeA f h . f g



It's a lot like an ordinary fold but uses the arrow composition law to combine the interpretation of the head with the interpretation of the tail.





"Electronic" components

Let me revisit the example from my previous article. I'm going to remove things I won't need so my definition of Circuit is less general here. Free arrows are going to allow us to define individual components for a circuit, but defer exactly how those components are interpreted until later.



I'll use four components this time: a register we can read from, one we can write from and a register incrementer, as well as a "pure" component. But before that, let's revisit Gabriel's article that gives some clues about how components should be built. In particular, look at the definition of TeletypeF :





data TeletypeF x = PutStrLn String x | GetLine (String -> x) | ExitSuccess



GetLine

GetLine k

TeletypeF a

a

GetLine

foldFree

We useto read a string, and yet the type ofcould befor any. The reason is that free monads work with continuations. Instead ofreturning a string to us, it's a holder for a function that says what we'd like to do with the string once we have it. That means we can leave open the question of where the string comes from. The functioncan be used to provide the actual string getter.



Free arrows are like "two-sided" free monads. We don't just provide a continuation saying what we'd like to do to our output. We also get to say how we prepare our data for input.



There's also some burden put on us. Free arrows need strong profunctors. Strong profunctors need to be able to convey extra data alongside the data we care about - that's what first' is all about. This means that even though Load is functionally similar to GetLine , it can't simply ignore its input. So we don't have Load (Int -> b) , and instead have Load ((a, Int) -> b . Here is our component type:





> data Component a b = Load ((a, Int) -> b) > | Store (a -> (b, Int)) > | Inc (a -> b)



Component

a

b

Inc

Inc

Component

Theonly knows about the data passing through, of typeand. It doesn't know anything about how the data in the registers is stored. That's the part that will be deferred to later. We intend forto increment a register. But as it doesn't know anything about registers nothing in the type ofrefers to that. (It took a bit of experimentation for me to figure this out and there may be other ways of doing things. Often with code guided by category theory you can just "follow your nose" as there's one way that works and type checks. Here I found a certain amount of flexibility in how much you store in theand how much is deferred to the interpreter.)



I could implement the strong profunctor instances using various combinators but I think it might be easiest to understand when written explicitly with lambdas:





> instance Profunctor Component where > lmap f (Load g) = Load $ \(a, s) -> g (f a, s) > lmap f (Store g) = Store (g . f) > lmap f (Inc g) = Inc (g . f)

> rmap f (Load g) = Load (f . g) > rmap f (Store g) = Store $ \a -> let (b, t) = g a > in (f b, t) > rmap f (Inc g) = Inc (f . g)

> instance Strong Component where > first' (Load g) = Load $ \((a, x), s) -> (g (a, s), x) > first' (Store g) = Store $ \(a, x) -> let (b, t) = g a > in ((b, x), t) > first' (Inc g) = Inc (first' g)



And now we can implement individual components. First a completely "pure" component:





> add :: Num a => FreeA Component (a, a) a > add = PureP $ uncurry (+)



And now the load and store operations.





> load :: FreeA Component () Int > load = Load (\(_, a) -> a) :- nil

> store :: FreeA Component Int () > store = Store (\a -> ((), a)) :- nil

> inc :: FreeA Component a a > inc = Inc id :- nil



Finally we can tie it all together in a complete function using arrow notation:





> test = proc () -> do > () <- inc -< () > a <- load -< () > b <- load -< () > c <- add -< (a, b) > () <- store -< c

> returnA -< ()



test

At this point, theobject is just a list of operations waiting to be executed. Now I'll give three examples of semantics we could provide. The first uses a state arrow type similar to the previous article:





> newtype Circuit s a b = C { runC :: (a, s) -> (b, s) }

> instance Category (Circuit s) where > id = C id > C f . C g = C (f . g)

> instance Arrow (Circuit s) where > arr f = C $ \(a, s) -> (f a, s) > first (C g) = C $ \((a, x), s) -> let (b, t) = g (a, s) > in ((b, x), t)



Inc

Here is an interpreter that interprets each of our components as an arrow. Note that this is where, among other things, we provide the meaning of theoperation:





> exec :: Component a b -> Circuit Int a b > exec (Load g) = C $ \(a, s) -> (g (a, s), s) > exec (Store g) = C $ \(a, _) -> g a > exec (Inc g) = C $ \(a, s) -> (g a, s+1)



Kleisli IO

Here's a completely different interpreter that is going to makedo the work of maintaining the state used by the resgisters. You'll be told what to do! We'll use thearrow to do the I/O.





> exec' :: Component a b -> Kleisli IO a b > exec' (Load g) = Kleisli $ \a -> do > putStrLn "What is your number now?" > s <- fmap read getLine > return $ g (a, s) > exec' (Store g) = Kleisli $ \a -> do > let (b, t) = g a > putStrLn $ "Your number is now " ++ show t ++ "." > return b > exec' (Inc g) = Kleisli $ \a -> do > putStrLn "Increment your number." > return $ g a



The last interpreter is simply going to sum values associated to various components. They could be costs in dollars, time to execute, or even strings representing some kind of simple execution trace.





> newtype Labelled m a b = Labelled { unLabelled :: m }

> instance Monoid m => Category (Labelled m) where > id = Labelled mempty > Labelled a . Labelled b = Labelled (a `mappend` b)

> instance Monoid m => Arrow (Labelled m) where > arr _ = Labelled mempty > first (Labelled m) = Labelled m

> exec'' (Load _) = Labelled (Sum 1) > exec'' (Store _) = Labelled (Sum 1) > exec'' (Inc _) = Labelled (Sum 2)



Note that we can't assign non-trivial values to "pure" operations.



And now we execute all three:





> main = do > print $ runC (foldFreeA exec test) ((), 10) > putStrLn "Your number is 10." >> runKleisli (foldFreeA exec' test) () > print $ getSum $ unLabelled $ foldFreeA exec'' test



I don't know if free arrows are anywhere near as useful as free monads, but I hope I've successfully illustrated one application. Note that because arrow composition is essentially list concatenation it may be more efficient to use a version of Hughes lists. This is what the Cayley representation is about in the monoid notions paper. But it's easier to see the naive list version first. Something missing from here that is essential for electronics simulation is the possibility of using loops. I haven't yet thought too much about what it means to build instances of ArrowLoop freely.



Profunctors have been described as decategorised matrices in the sense that p a b , with p a profunctor, is similar to the matrix . Or, if you're working in a context where you distinguish between co- and contravariant vectors, it's similar to . The Composition operation is a lot like the definition of matrix product. From this perspective, the FreeA operation is a lot like the function on matrices that takes to . To work with ArrowLoop we need a trace-like operation.



One nice application of free monads is in writing plugin APIs. Users can write plugins that link to a small library based on a free monad. These can then be dynamically loaded and interpreted by an application at runtime, completely insulating the plugin-writer from the details of the application. You can think of it as a Haskell version of the PIMPL idiom. Free arrows might give a nice way to write plugins for dataflow applications.