# Free, take 2

- Magnus Therning

The other day I read a blog post on monads and stuff after which I felt rather silly about my earlier posts on Free.

I think this is probably the post I should have written instead :)

I’ll use three pieces of code, each one builds on the one before:

`Free1.hs`

- Uses a free monad for a single algebra/API (full code here).`Free2.hs`

- Uses a free monad for a two algebras/APIs, where one decorates the other (full code here).`Free3.hs`

- Uses a free monad for a three algebras/APIs, where two are used in the program and the remaing one decorates the other two (full code here).

### The first - one algebra

I’m re-using the algebras from my previous posts, but I believe it makes it easier to follow along if the amount of jumping between posts is minimized so here is the first one once again:

```
data SimpleFileF a
= LoadFile FilePath (String -> a)
| SaveFile FilePath String a
deriving(Functor)
type SimpleFileAPI = Free SimpleFileF
loadFile :: FilePath -> SimpleFileAPI String
loadFile fp = liftF $ LoadFile fp id
saveFile :: FilePath -> String -> SimpleFileAPI ()
saveFile fp d = liftF $ SaveFile fp d ()
```

It’s a ridiculously small one, but I believe it’s good enough to work with. In the previous posts I implemented the `Functor`

instances manually. I couldn’t be bothered this time around; I think I pretty much know how to do that for this kind of types now.

Having a type for the algebra, `SimpleFileAPI`

, is convenient already now, even more so in the other examples.

The two convenience functions on the end makes it straight forward to write functions using the algebra:

```
withSimpleFile :: (String -> String) -> FilePath -> SimpleFileAPI ()
withSimpleFile f fp = do
d <- loadFile fp
let result = f d
saveFile (fp ++ "_new") result
```

This is simple, straight forward monadic code. Easy to read and work with. Of course it doesn’t actually do anything at all yet. For that I need need an interpreter, something that translates (reduces) the algebra, the API, the commands, call them what you will, into the (side-)effects I want. For `Free`

that is `foldFree`

together with a suitable function `f :: SimpleFileF a -> IO a`

.

I want `LoadFile`

to translate to a file being read and `SaveFile`

to some data being saved to a file. That makes it pretty obvious how that `f`

needs to be written:

```
runSimpleFile :: SimpleFileAPI a -> IO a
runSimpleFile = foldFree f
where
f (LoadFile fp f') = f' <$> readFile fp
f (SaveFile fp d r) = writeFile fp d >> return r
```

At this point it might be good to explain the constructors of `SimpleFileF`

a bit more. At first I thought they looked a bit funny. I mean, why does `SaveFile`

have an `a`

at all since it obviously always should result in `()`

? And what’s up with that function in `Loadfile`

?

It did become a little clearer to me after some thought and having a look at `Free`

:

`data Free f a = Pure a | Free (f (Free f a))`

I personally find the latter constructor a bit mind-bending. I can handle recursive functions fairly well, but recursive types have a tendency to confuse me. From what I understand one can think of `Free`

as similar to a list. `Pure`

ends the list (`Nil`

) and `Free`

one instance of `f`

to the rest of the list (`Cons`

). Since `Free f a`

is a monad one can think of `a`

as the result of the command.

If I were to write `saveFile`

explicitly it’d look like this

`saveFile fp d = Free (SaveFile fp d (Pure ()))`

and for `loadFile`

:

`loadFile fp = Free (LoadFile fp (\ s -> Pure s))`

But let’s get back to the type and why ‘a’ occurs like it does in the two constructors. As Gabriel G shows in his post Why free monads matter a constructor without `a`

would result in termination. In other words, if `SaveFile`

didn’t hold an `a`

I’d not be able to write, in a natural way, a function that saves two files.

Another limiting factor is that `foldFree`

of the `Free`

implementation I’m using has the type `Monad m => (forall x. f x -> m x) -> Free f a -> m a`

. This sets a requirement on what the function translating from my API into effects may look like, i.e. what `f`

in `runSimpleFile`

may look like. If `SaveFile`

had no `a`

to return what would `f (SaveFile {})`

return, how could it ever satisfy the required type?

The reason for `LoadFile`

having a function `String -> a`

is simply that there is no data yet, but I still want to be able to manipulate it. Using a function and function composition is the ticket then.

I think that’s all there is to say about to the first piece of code. To run it take a look at the comment at the end of the file and then play with it. If you want to turn all characters of a file `foo`

into upper case you can use

`runSimpleFile $ withSimpleFile (map toUpper) "foo"`

### The second - two algebras, one decorating the other

The second piece of code almost only adds to the first one. There is one exception though, the function `runSimpleFile`

is removed. Instead I’ve taken the transformation function, which used to be called `f`

and was internal to `runSimpleFile`

and moved it out. It’s called `stepSimpleFile`

:

```
stepSimpleFile :: SimpleFileF a -> IO a
stepSimpleFile (LoadFile fp f') = f' <$> readFile fp
stepSimpleFile (SaveFile fp d r) = writeFile fp d >> return r
```

The logging API, `LogAPI`

, follows the same pattern as `SimpleFileAPI`

and I’m counting on the description above being clear enough to not have to repeat myself. For completeness I include the code:

```
data LogF a = Log String a
deriving(Functor)
type LogAPI = Free LogF
stepLog :: LogF a -> IO a
stepLog (Log s r) = putStrLn s >> return r
```

I intend the `LogAPI`

to be used as embellishments on the `SimpleFileAPI`

, in other words I somehow have to turn an operation of `SimpleFileAPI`

into an operation of `LogAPI`

, i.e. I need a transformation. I called it `logSimpleFileT`

and let it turn operations in `SimpleFileF`

(i.e. not exactly `SimpleFileAPI`

) into `LogAPI`

(if you are wondering about my choice of type I hope it’ll become clear below, just trust me for now that this is a good choice):

```
logSimpleFileT :: SimpleFileF a -> LogAPI ()
logSimpleFileT (LoadFile fp _) = liftF $ Log ("** load file " ++ fp) ()
logSimpleFileT (SaveFile fp _ _) = liftF $ Log ("** save file " ++ fp) ()
```

So far everything is hopefully very straight forward and unsurprising. Now I need to combine the two APIs, I need to add them, in other words, I need a sum type:

```
data S a1 a2 t = A1 (a1 t) | A2 (a2 t)
deriving(Functor)
type SumAPI = Free (S LogF SimpleFileF)
```

The next question is how to turn my two original APIs, `SimpleFileAPI`

and `LogAPI`

, into `SumAPI`

. Luckily that’s already solved by the function `hoistFree`

:

`hoistFree :: Functor g => (forall a. f a -> g a) -> Free f b -> Free g b `

With this and `logSimpleFileT`

from above I can use `foldFree`

to decorate each operation with a logging operation like this:

```
logSimpleFile :: SimpleFileAPI a -> SumAPI a
logSimpleFile = foldFree f
where
f op = hoistFree A1 (logSimpleFileT op) *> hoistFree A2 (liftF op)
```

This is where the type of `logSimpleFileT`

hopefully makes sense!

Just as in the first section of this post, I need an interpreter for my API (`SumAPI`

this time). Once again it’s written using `foldFree`

, but this time I provide the interpreters for the sub-algegras (what I’ve chosen to call step functions):

```
runSum :: Monad m => (forall a. LogF a -> m a) -> (forall a. SimpleFileF a -> m a) -> SumAPI b -> m b
runSum f1 f2 = foldFree f
where
f (A1 op) = f1 op
f (A2 op) = f2 op
```

The file has a comment at the end for how to run it. The same example as in the previous section, but now with logging, looks like this

`runSum stepLog stepSimpleFile $ logSimpleFile $ withSimpleFile (map toUpper) "foo"`

### The third - three algebras, one decorating the other two

To combine three algebras I simply take what’s in the previous section and extend it, i.e. a sum type with three constructors:

```
data S a1 a2 a3 t = A1 (a1 t) | A2 (a2 t) | A3 (a3 t)
deriving(Functor)
type SumAPI = Free (S LogF SimpleFileF StdIoF)
runSum :: Monad m => (forall a. LogF a -> m a)
-> (forall a. SimpleFileF a -> m a)
-> (forall a. StdIoF a -> m a)
-> SumAPI b -> m b
runSum f1 f2 f3 = foldFree f
where
f (A1 op) = f1 op
f (A2 op) = f2 op
f (A3 op) = f3 op
```

With this I’ve already revealed that my three APIs are the two from previous sections, `LogAPI`

(for decorating the other APIs), `SimpleFileAPI`

and a new one, `StdIoAPI`

.

I want to combine them in such a wat that I can write functions using both APIs at the same time. Then I modify `withSimpleFile`

into

```
withSimpleFile :: (String -> String) -> FilePath -> SumAPI ()
withSimpleFile f fp = do
d <- loadFile fp
let result = f d
saveFile (fp ++ "_new") result
```

and I can add another function that uses it with `StdIoAPI`

:

```
prog :: FilePath -> SumAPI ()
prog fn = do
stdioPut "About to start"
withSimpleFile (map toUpper) fn
stdioPut "Done!"
```

The way to allow the APIs to be combined this way is to bake in `S`

already in the convenience functions. This means the code for `SimpleFileAPI`

has to change slightly (note the use of `A2`

in `loadFile`

and `saveFile`

):

```
data SimpleFileF a
= LoadFile FilePath (String -> a)
| SaveFile FilePath String a
deriving(Functor)
loadFile :: FilePath -> SumAPI String
loadFile fp = liftF $ A2 $ LoadFile fp id
saveFile :: FilePath -> String -> SumAPI ()
saveFile fp d = liftF $ A2 $ SaveFile fp d ()
stepSimpleFile :: SimpleFileF a -> IO a
stepSimpleFile (LoadFile fp f') = f' <$> readFile fp
stepSimpleFile (SaveFile fp d r) = writeFile fp d >> return r
```

The new API, `StdIoAPI`

, has only one operation:

```
data StdIoF a = PutStrLn String a
deriving(Functor)
stdioPut :: String -> SumAPI ()
stdioPut s = liftF $ A3 $ PutStrLn s ()
stepStdIo :: StdIoF b -> IO b
stepStdIo (PutStrLn s a) = putStrLn s >> return a
```

The logging API, `LogAPI`

, looks exactly the same but I now need two transformation functions, one for `SimpleFileAPI`

and one for `StdIoAPI`

.

```
data LogF a = Log String a
deriving(Functor)
type LogAPI = Free LogF
stepLog :: LogF a -> IO a
stepLog (Log s r) = putStrLn s >> return r
logSimpleFileT :: SimpleFileF a -> LogAPI ()
logSimpleFileT (LoadFile fp _) = liftF $ Log ("** load file " ++ fp) ()
logSimpleFileT (SaveFile fp _ _) = liftF $ Log ("** save file " ++ fp) ()
logStdIoT :: StdIoF a -> LogAPI ()
logStdIoT (PutStrLn s _) = liftF $ Log ("** on stdio " ++ s) ()
```

The new version of `logT`

needs to operate on `S`

in order to decorate both APIs.

```
logT :: SumAPI a -> SumAPI a
logT = foldFree f
where
f (A2 op) = hoistFree A1 (logSimpleFileT op) *> hoistFree A2 (liftF op)
f (A3 op) = hoistFree A1 (logStdIoT op) *> hoistFree A3 (liftF op)
f a@(A1 _) = liftF a
```

This file also has comments on how to run it at the end. This time there are two examples, one on how to run it without logging

`runSum undefined stepSimpleFile stepStdIo $ prog "foo"`

and one with logging

`runSum stepLog stepSimpleFile stepStdIo (logT $ prog "foo")`