### Building free arrows from components

**Introduction**

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)An element of

`Compose f g d c`is just a pair of heteromorphisms, one from each of the profunctors,

`f`and

`g`, 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. The

`Compose`type 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 using

`mappend`but 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 that

`(:)`is used to pair elements and lists.

**Free Arrows**

Here's some code:

> {-# OPTIONS -W #-} > {-# LANGUAGE ExistentialQuantification #-} > {-# LANGUAGE Arrows #-} > {-# LANGUAGE RankNTypes #-} > {-# LANGUAGE TypeOperators #-} > {-# LANGUAGE FlexibleInstances #-}First look at the second line of the definition of

> 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`. It says that a

`FreeA p a b`might be a pair consisting of a head heteromorphism whose output matches the input of another

`FreeA`. There's also the

`PureP`case which is acting like the empty list

`[]`. The reason we use this is that for our composition,

`(->)`acts a lot like the identity. In particular

`Composition (->) p a b`is isomorphic to

`p a b`(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 function

`a -> x`and a heteromorphism

`p x b`for some type

`x`we don't get to see. We can't project back out either of these items without information about the type of

`x`escaping. So the only thing we can possibly do is use

`lmap`to apply the function to the heteromorphism giving us an element of

`p a b`.

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

> nil :: Profunctor p => FreeA p a a > nil = PureP idSo an element of

`FreeA`is a sequence of heteromorphisms. If heteromorphisms are thought of as operations of some sort, then an element of

`FreeA`is 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)We also get a strong profunctor by applying

`first'`all 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)Note that it's slightly different to what you might have expected compared to

`(++)`because we tend to write composition of functions "backwards". Additionally, there is another definition of

`FreeA`we 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] -> bIn

`foldr f e`we can think of

`f`as saying how

`(:)`should be interpreted and

`e`as saying how

`[]`should 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 fGiven a natural transformation from

`f`to

`m`,

`foldFree`extends it to all of

`Free f`.

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 gIt'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) | ExitSuccessWe use

`GetLine`to read a string, and yet the type of

`GetLine k`could be

`TeletypeF a`for any

`a`. The reason is that free monads work with continuations. Instead of

`GetLine`returning 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 function

`foldFree`can 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)The

`Component`only knows about the data passing through, of type

`a`and

`b`. 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 for

`Inc`to increment a register. But as it doesn't know anything about registers nothing in the type of

`Inc`refers 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 the

`Component`and 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)And now we can implement individual components. First a completely "pure" component:

> 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)

> 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) :- nilFinally we can tie it all together in a complete function using arrow notation:

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

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

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

> returnA -< ()

`test`object 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) }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 the

> 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`operation:

> 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)Here's a completely different interpreter that is going to make

*you*do the work of maintaining the state used by the resgisters. You'll be told what to do! We'll use the

`Kleisli IO`arrow 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 aThe 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 }Note that we can't assign non-trivial values to "pure" operations.

> 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)

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

**Various thoughts**

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.

People typically think of functors as containers.
So in a free monad, each element is a container of possible futures.
In a free arrow the relationship between the current heteromorphism and its "future" (and "past") is a bit more symmetrical.
For example, for some definitions of `P`, a heteromorphism `P a b` can act on some `a`s to give us some `b`s.
But some definitions of `P` can run "backwards" and act on elements of `b -> r` to give us elements of `a -> r`.
So when I use the words "input" and "output" above, you might not want to take them too literally.

## 10 Comments:

This comment has been removed by the author.

I don't see how specialising to Star profunctors makes your code closer to the one on StackOverflow? The big difference between your version and theirs, is that they use a binary tree where you use a cons list. (your :- is a combination of Effect and Seq) And they have a Par constructor, where you require `Strong p`. (Which I think means your free functor is adjoint to a forgetful functor that forgets less.)

I don't see how specializing to Star profunctors makes your code closer to the one on StackOverflow? The big difference between your version and theirs, is that they use a binary tree where you use a cons list. (your :- is a combination of Effect and Seq) And they have a Par constructor, where you require `Strong p`. (Which I think means your free functor is adjoint to a forgetful functor that forgets less.)

Would you gain anything by using something like Pastro/Tambara or FreeStrong instead of manually providing an instance of Strong?

This comment has been removed by the author.

Alexander Gryzlov ,

One step at a time. My goal here was just to set up the analogy with free monads with the simplest vaguely useful example I could.

Sjoerd,

You're right. It's not closer. I misread that code.

Hi Dan,

Thank you for this great post - It's exciting to see interest picking up in free arrows. A few months ago I found a Stack Overflow answer by Sjoerd describing these, and ended up writing a little paper about using the idea for probabilistic programming:

http://pps2017.soic.indiana.edu/2017/01/15/an-exponential-family-basis-for-probabilistic-programming/

I'll be presenting it tomorrow; I'd love any comments you might have!

And I apologize for the public spam - wasn't sure how to contact you directly for more appropriate private spam :)

This is indeed very helpful, very nice!

This comment has been removed by a blog administrator.

Post a Comment

## Links to this post:

Create a Link

<< Home