“MTL style” and “free monad style” are competing ways of implementing
classes of effectful operations in Haskell programs. When we use MTL
style we specify a type class of monadic operations and give various
instances which interpret the operations in different monads. When we
use free monad style we specify a `Functor`

which encodes the monadic
operations and we implement various interpretations of that functor
in different monads.

After reading an excellent article by Matt Parsons (which advocated the MTL style) I realised that you can have the best of both worlds! The base functor that defines the free monad also gives rise to an MTL style type class.

Inspired by Matthew’s article on the three layer cake pattern in Haskell, we might have the interfaces

```
class MonadTime m where
getCurrentTime :: m UTCTime
class MonadLock m where
acquireLock :: NominalDiffTime -> Key -> m (Maybe Lock)
renewLock :: NominalDiffTime -> Lock -> m (Maybe Lock)
releaseLock :: Lock -> m ()
```

and give them interpretations which can be either effectful or pure mocked versions

```
acquireLockIO :: NominalDiffTime -> Key -> IO (Maybe Lock)
renewLockIO :: NominalDiffTime -> Lock -> IO (Maybe Lock)
releaseLockIO :: Lock -> IO ()
instance MonadTime ((->) UTCTime) where
= id
getCurrentTime
instance MonadTime IO where
= Data.Time.getCurrentTime
getCurrentTime
instance MonadLock IO where
= acquireLockIO
acquireLock = renewLockIO
renewLock = releaseLockIO releaseLock
```

Instead of defining different classes for different sets of operations
let’s define a class once and for all parameterized by a `Functor`

which carries the operations.

```
class Monad_ f m where
interpret :: forall r. f r -> m r
```

Then instead of `MonadTime`

we have `Monad_ Time_`

and instead of
`MonadLock`

we have `Monad_ Lock_`

, where

```
data Time_ a = GetCurrentTime (UTCTime -> a)
data Lock_ a = AcquireLock (Maybe Lock -> a) NominalDiffTime Key
| RenewLock (Maybe Lock -> a) NominalDiffTime Lock
| ReleaseLock (() -> a) Lock
```

The way that we write a functor for a class of monadic operations is that we take our collection of operations of the form

```
class MonadOperations where
operation1 :: arg1 -> ... -> argN -> m result
...
```

and convert it to a sum type of the form

```
data Operations_ a = Operation1 (result -> a) arg1 ... argN
| ...
```

We can go ahead and give instance definitions for our classes

```
instance Monad_ Time_ ((->) UTCTime) where
= \case
interpret GetCurrentTime f -> k0 id f
instance Monad_ Time_ IO where
= \case
interpret GetCurrentTime f -> k0 Data.Time.getCurrentTime f
instance Monad_ Lock_ IO where
= \case
interpret AcquireLock f t k -> k2 acquireLockIO f t k
RenewLock f t l -> k2 renewLockIO f t l
ReleaseLock f l -> k1 releaseLockIO f l
```

For each constructor we give its interpretation in the target monad.
`k0`

, `k1`

and `k2`

are somewhat uninteresting combinators for making
this look cleaner.

```
= fmap f op
k0 op f = fmap f (op a)
k1 op f a = fmap f (op a b) k2 op f a b
```

The downside of this new style is that if we want to use direct function calls for our operations we have to wrap them:

```
-- All these types are inferrable
-- with NoMonomorphismRestriction
getCurrentTime :: Monad_ Time_ m
=> m UTCTime
= j0 GetCurrentTime
getCurrentTime
acquireLock :: Monad_ Lock_ m
=> NominalDiffTime
-> Key
-> m (Maybe Lock)
= j2 AcquireLock
acquireLock
renewLock :: Monad_ Lock_ m
=> NominalDiffTime
-> Lock
-> m (Maybe Lock)
= j2 RenewLock
renewLock
releaseLock :: Monad_ Lock_ m
=> Lock
-> m ()
= j1 ReleaseLock releaseLock
```

`j0`

, `j1`

, and `j2`

are combinators for implementing operations
conveniently

```
= interpret (op id)
j0 op = interpret (op id a)
j1 op a = interpret (op id a b) j2 op a b
```

Or we could use `j0 GetCurrentTime`

, `j2 AcquireLock`

etc. directly,
but that looks rather bizarre.

`Free`

for freeThe benefit we get is automatic interaction with free monads. The
functor of operations that we defined is exactly the base functor of
the corresponding free monad. There is a function `freely`

which
interprets `Free f`

in the MTL style `Monad_ f m`

```
freely :: (Functor f, Monad m, Monad_ f m)
=> Free f a -> m a
= foldFree interpret f freely f
```

The inverse to `freely`

is `liftF`

(which is also the `interpret`

of
the `Monad_ f (Free f)`

instance).

```
instance Functor f => Monad_ f (Free f) where
= liftF interpret
```

I haven’t measured the performance of this but with a suitable
combination of inlining plus `RULE`

s it feels like it should perform
equally well to the MTL style.

This approach doesn’t provide support for non-algebraic operations
such as `Reader.local`

, `Writer.listen`

and `Writer.pass`

, but perhaps
that’s a good thing.

Implemention of classes of operations in MTL style contains a common pattern parametrized by a functor. Using the parametrized style gives you automatic interchange between MTL style and free monad style so you can have the best of both worlds for free!

I’m probably not the first person to notice this. If anyone knows any prior references please let me know and I’ll add a reference.