# 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`

:

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

and for `loadFile`

:

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

### 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:

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`

:

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

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

and one with logging