# Free play, part two

- Magnus Therning

This post on `Free`

play builds on my previous one. It was John A De Goes’ post that finally got me started on playing with `Free`

and his post contian the following:

And a little bit later he offers a few types and some details, but not *all* details. How could something like that look in Haskell?

Starting from the code in the previous post I first created a new type for a logging action

`data LogF a = Log String a`

This type has to be a `Functor`

```
instance Functor LogF where
fmap f (Log s a) = Log s (f a)
```

The logging should basically decorate a `SimpleFileF a`

action, so I need a function to map one into a `Free LogF a`

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

Now I needed a `Coproduct`

for `Functor`

. Searching hackage only offered up one for `Monoid`

(in monoid-extras) so I first translated one from PureScript, but later I got some help via Twitter and was pointed to two in Haskell, `Data.Functor.Coproduct`

from comonad and `Data.Functor.Sum`

from transformers, I decided on the one from transformers because of its shorter name and the fact that it was very different from my translated-from-PureScript version.

Following John’s example I use `Applicative`

to combine the logging with the file action

```
loggingSimpleFileI :: SimpleFileF a -> Free (Sum LogF SimpleFileF) a
= toLeft (logSimpleFileI op) *> toRight (liftF op) loggingSimpleFileI op
```

with `toLeft`

and `toRight`

defined like this

```
toLeft :: (Functor f, Functor g) => Free f a -> Free (Sum f g) a
= hoistFree InL
toLeft toRight :: (Functor f, Functor g) => Free g a -> Free (Sum f g) a
= hoistFree InR toRight
```

With all of this in place I can decorate the program from the last post like this `foldFree loggingSimpleFileI (withSimpleF toUpper "FreePlay.hs")`

. What’s left is a way to run it. The function for that is a natural extension of `runsimpleFile`

```
runLogging :: Free (Sum LogF SimpleFileF) a -> IO a
= foldFree f
runLogging where
f :: (Sum LogF SimpleFileF) a -> IO a
InL op) = g op
f (InR op) = h op
f (
g :: LogF a -> IO a
Log s a)= putStrLn s >> return a
g (
h :: SimpleFileF a -> IO a
LoadFile fp f') = liftM f' $ readFile fp
h (SaveFile fp d r) = writeFile fp d >> return r h (
```

Running the decorated program

`$ foldFree loggingSimpleFileI (withSimpleF toUpper "FreePlay.hs") runLogging `

does indeed result in the expected output

```
** load file FreePlay.hs
** save file FreePlay.hs_new
```

and the file `FreePlay.hs_new`

contains only uppercase letters.

### My thoughts

This ability to decorate actions (or compose algebras) is very nice. There’s probably value in the “multiple interpreters for a program” in some domains, but I have a feeling that it could be a hard sell. However, combining it with this kind of composability adds quite a bit of value in my opinion. I must say I don’t think *my* code scales very well for adding more decorators (composing more algebras), but hopefully some type wizard can show me a way to improve on that.

The code above is rather crude though, and I have another version that cleans it up quite a bit. That’ll be in the next post.