This site is still a work-in-progress, thank you for your understanding.

Monads are a convenient way to to sequence computation with effects. Different monads can provide different kinds of effects:

`IO`

allows world-changing side effects`Identity`

is a “fake” monad: it allows no side effects`Reader`

lets you access some environment value`State`

mocks a mutable variable`Maybe`

allows for early exit`Either`

allows for early exit with a value

This has nothing to do with a monad transformer, just review. Let’s talk about something totally different.

The typical left fold we’ve seen requires you to consume the entire
list. However, in some cases, we may want to stop computation
early. As a made up example: let’s write a `sum`

function that adds up
all numbers until the first negative value:

```
{-# LANGUAGE BangPatterns #-}
sumTillNegative :: [Int] -> Int
sumTillNegative =
go 0
where
go !total rest =
case rest of
[] -> total
x:xs
| x < 0 -> total
| otherwise -> go (total + x) xs
main :: IO ()
main = print $ sumTillNegative [1, 2, 3, -1, 4]
```

This works, but it violates all of our engineering principles of non
code duplication. If we had to write a `productTillNegative`

, the body
would be almost exactly the same. We should instead factor our some
helper function.

```
{-# LANGUAGE BangPatterns #-}
foldTerminate :: (b -> a -> Either b b) -> b -> [a] -> b
foldTerminate f =
go
where
go !accum rest =
case rest of
[] -> accum
x:xs ->
case f accum x of
Left accum' -> accum' -- early termination
Right accum' -> go accum' xs
sumTillNegative :: [Int] -> Int
sumTillNegative =
foldTerminate go 0
where
go total x
| x < 0 = Left total
| otherwise = Right (total + x)
main :: IO ()
main = print $ sumTillNegative [1, 2, 3, -1, 4]
```

Our implementation internally uses the `Either`

data type, and does
explicit pattern matching on it. But we can take advantage of
`Either`

’s monad instance, using `do`

-notation, and come up with
something arguably slicker:

```
foldTerminate :: (b -> a -> Either b b) -> b -> [a] -> b
foldTerminate f accum0 list0 =
either id id (go accum0 list0)
where
go !accum rest = do
(x, xs) <-
case rest of
[] -> Left accum
x:xs -> Right (x, xs)
accum' <- f accum x
go accum' xs
```

We no longer have to explicitly deal with an exit case: binding with a
`Left`

value automatically terminates the loop. Cool!

Previously, we saw that you could implement a left fold using a
`State`

monad. This was the non-terminating variety of left fold. It
looked like this:

```
foldState :: (b -> a -> b) -> b -> [a] -> b
foldState f accum0 list0 =
execState (mapM_ go list0) accum0
where
go x = modify' (\accum -> f accum x)
```

We’ve seen a way to clean up a left fold using `State`

, and a way to
clean up terminating loop with `Either`

. Can we do both at the same
time? Try as we might, we won’t be able to come up with a way to do
this elegantly. The two monads simply don’t compose nicely together.

We can fix this problem though! Let’s define a new monad,
`StateEither`

, which combines the functionality of both `State`

and
`Either`

together. We can define the type pretty easily:

```
newtype StateEither s e a = StateEither
{ runStateEither :: s -> (s, Either e a)
}
deriving Functor
```

This says we take an initial state value, and return an updated state
value, plus an `Either`

result value. The expected functionality is
that, when the result is `Left`

, we stop processing. But when the
result is `Right`

, we continue. Let’s write our `Applicative`

and
`Monad`

instances:

```
instance Applicative (StateEither s e) where
pure a = StateEither (\s -> (s, Right a))
StateEither ff <*> StateEither fa = StateEither $ \s0 ->
case ff s0 of
(s1, Left e) -> (s1, Left e)
(s1, Right f) ->
case fa s1 of
(s2, Left e) -> (s2, Left e)
(s2, Right a) -> (s2, Right (f a))
instance Monad (StateEither s e) where
return = pure
StateEither f >>= g = StateEither $ \s0 ->
case f s0 of
(s1, Left e) -> (s1, Left e)
(s1, Right x) -> runStateEither (g x) s1
```

Plus some helper functions we were using from `State`

before:

```
execStateEither :: StateEither s e a -> s -> s
execStateEither m = fst . runStateEither m
modify' :: (s -> Either e s) -> StateEither s e ()
modify' f = StateEither $ \s0 ->
case f s0 of
Left e -> (s0, Left e)
Right !s1 -> (s1, Right ())
```

With all of tha work in place, it becomes almost trivial to write our terminating fold:

```
foldTerminate :: (b -> a -> Either b b) -> b -> [a] -> b
foldTerminate f accum0 list0 =
execStateEither (mapM_ go list0) accum0
where
go x = modify' (\accum -> f accum x)
```

We’ve established three things:

- Monads can make it easier to implement some functions
- Composing monads isn’t possible
- But manually defining the compositions
*is*possible

Besides the tediousness of it all, this works great. Homework exercise: go implement all possible combinations of:

`Reader`

`State`

`Either`

`IO`

Have fun :)

(Just kidding.)

`StateEither`

Let’s play a little rewrite game. Remember, Haskell is a pure language, so you can always substitue expressions. Turns out you can also play this game at the type level, using type synonyms. Let’s start with our original type, stripped down a bit:

```
newtype StateEither s e a = StateEither (s -> (s, Either e a))
```

Let’s also remember the type of `State`

:

```
newtype State s a = State (s -> (s, a))
```

If you stare at those a bit, you’ll see that they’re *almost*
identical, except we replace `a`

with `Either e a`

in
`StateEither`

. In fact, we can get away with this small rewrite:

```
newtype StateEither s e a = StateEither (State s (Either e a))
```

You should convince yourself that this definition is *isomorphic* to
the previous definition of `StateEither`

. Now we’re going to
reimplement our previous example, but we’re going to get to take a few
shortcuts. Let’s start with the data type and the `Applicative`

instance:

```
newtype StateEither s e a = StateEither
{ unStateEither :: State s (Either e a)
}
deriving Functor
instance Applicative (StateEither s e) where
pure a = StateEither $ return $ Right a
StateEither ff <*> StateEither fa = StateEither $ do
ef <- ff
case ef of
Left e -> return $ Left e
Right f -> do
ea <- fa
case ea of
Left e -> return $ Left e
Right a -> return $ Right $ f a
```

Notice how we *never touch the state value*. Instead, we reuse the
underlying `State`

‘s `Monad`

instance via `do`

-notation and `return`

to implement our `Applicative`

instance. All we worry about here is
implementing the `Either`

shortcut logic. Let’s see if this translates
into the `Monad`

instance as well:

```
instance Monad (StateEither s e) where
return = pure
StateEither f >>= g = StateEither $ do
ex <- f
case ex of
Left e -> return $ Left e
Right x -> unStateEither $ g x
```

Sure enough it does! Finally, we get some help when implementing our
`execStateEither`

and `modify'`

helper functions:

```
execStateEither :: StateEither s e a -> s -> s
execStateEither (StateEither m) s = execState m s
modify' :: (s -> Either e s) -> StateEither s e ()
modify' f = StateEither $ do
s0 <- get
case f s0 of
Left e -> return $ Left e
Right s1 -> do
put $! s1
return $ Right ()
```

And our program works exactly as it did before. Sweet.

I’ll repeat: in our instances above, we never made direct reference to
the fact that we were using the `State`

monad in particular. We just
needed *some* monad instance. And then our `StateEither`

thing comes
along and transforms it into something with a bit more power: the
ability to short-circuit. So… we have a monad… and then we
transform it. I wonder what we’ll call this thing…

I know! A monad transformer! We just invented something which
transforms an existing monad (`State`

for now) with the `Either`

monad’s functionality.

Again, let’s look at our data type:

```
newtype StateEither s e a = StateEither
(State s (Either e a))
```

And instead of hardcoding `State`

and `s`

, let’s take a type variable,
called `m`

, to represent whatever monad we’re transforming:

```
newtype EitherT e m a = EitherT
m (Either e a)
```

Convince yourself that, if you replace `m`

with `State s`

, these two
types are isomorphic. We’ve called this `EitherT`

because it’s the
either transformer. (NOTE: for hysterical raisins, in the actual
libraries this is called `ExceptT`

, which is a terrible name. Sorry
about that.)

We can still keep our special helper function `execStateEither`

:

```
execStateEither :: EitherT e (State s) a -> s -> s
execStateEither (EitherT m) s = execState m s
```

We can also implement our `modify'`

function:

```
modify' :: (s -> Either e s) -> EitherT e (State s) ()
modify' f = EitherT $ do
s0 <- get
case f s0 of
Left e -> return $ Left e
Right s1 -> do
put $! s1
return $ Right ()
```

**NOTE** When we get to mtl, we’ll see that we didn’t actual need to
write this function, but never mind that for now.

And now, besides changing the type name, our `Applicative`

and `Monad`

instances are the same as before, thanks to only using the `Monad`

interface of `State`

.

```
instance Monad m => Applicative (EitherT e m) where
pure a = EitherT $ return $ Right a
EitherT ff <*> EitherT fa = EitherT $ do
ef <- ff
case ef of
Left e -> return $ Left e
Right f -> do
ea <- fa
case ea of
Left e -> return $ Left e
Right a -> return $ Right $ f a
instance Monad m => Monad (EitherT e m) where
return = pure
EitherT f >>= g = EitherT $ do
ex <- f
case ex of
Left e -> return $ Left e
Right x -> runEitherT $ g x
```

In `EitherT e m a`

, we call the `m`

parameter the *base monad*. For
very good reasons we’ll get to later, we always make the base monad
type variable (`m`

) the second-to-last variable in defining our
type. We consider `EitherT`

a transformer which is layered on top of
the base monad.

Our previous implementation of `modify'`

involved explicitly wrapping
things up with the `EitherT`

data constructor. That’s not a pleasant
way of interacting with transformers. Instead, we’ll want to provide
helper functions. There are two things we need to be able to do for
implementing `modify'`

:

- Perform actions from the base monad, namely the
`State`

monad in this case. We call this*lifting*the action. - Cause a
`Left`

value to be returned, triggering an early exit.

We can easily write such helper functions:

```
exitEarly :: Monad m => e -> EitherT e m a
exitEarly e = EitherT $ return $ Left e
lift :: Monad m => m a -> EitherT e m a
lift action = EitherT $ fmap Right $ action
```

Then our `modify'`

function turns into:

```
modify' :: (s -> Either e s) -> EitherT e (State s) ()
modify' f = do
s0 <- lift get
case f s0 of
Left e -> exitEarly e
Right s1 -> lift $ put $! s1
```

Which is significantly simpler.

`lift`

As you’ve probably guessed, we’re going to ultimately implement more
transformers than just `EitherT`

. Since lifting actions is the basic
operation of all monad transformers, we want an easy way to do this
across *all* transformers. To make this work, we’re going to define a
typeclass, `MonadTrans`

, which provides the `lift`

method:

```
class MonadTrans t where
lift :: Monad m => m a -> t m a
instance MonadTrans (EitherT e) where
-- lift :: Monad m => m a -> EitherT e m a
lift action = EitherT $ fmap Right $ action
```

Our definition of `lift`

for `EitherT`

remains unchanged. All we’ve
done is generalize the type signature by replacing the concrete
`EitherT e`

with a type variable `t`

. This is also why we always keep
the last type variable the result type, and the second-to-last the
base monad: it allows us to define this helper typeclass.

The `MonadTrans`

typeclass is defined in `Control.Monad.Trans.Class`

,
in the `transformers`

package.

Obviously the `modify'`

function needs to know about the `State`

monad, since it’s explicitly using `get`

and `put`

actions. And
currently, it’s explicitly taking advantage of `EitherT`

functionality
as well. But let’s try to generalize anyway, and get into the “type
astronaut” world that quickly occurs when overusing monad
transformers.

The monad instance of `EitherT`

already handles the short-circuit
logic we’re building into our `modify'`

. We can generalize by, instead
of returning an `Either e s`

value from the provided helper function,
letting the helper function simply run a monadic action. Let’s see the
implementation I have in mind first:

```
modifyM f = do
s0 <- lift get
s1 <- f s0
lift $ put $! s1
```

Very elegant: we lift our base monad actions, and allow `f`

to perform
actions of its own. Now let’s look at the crazy type signature:

```
modifyM
:: (MonadTrans t, Monad (t (State s)))
=> (s -> t (State s) s)
-> t (State s) ()
```

In order to use the `lift`

function, we need to ensure that the `t`

is, in fact, a monad transformer. Therefore, we say `MonadTrans t`

. In
order to use `do`

-notation, we need to ensure that our transformer on
top of our base monad (specifically `State`

here) is a monad, so we
say `Monad (t (State s))`

. And then `t (State s)`

in the rest of the
signature is simply how we reference our monad.

Then, in our call site, we replace `modify'`

with `modifyM`

, and
instead of just an `Either`

value, we wrap it up into an `EitherT`

value. We’ll define a helper function for that wrapping up:

```
liftEither :: Monad m => Either e a -> EitherT e m a
liftEither = EitherT . return
```

And then rewrite `foldTerminate`

to:

```
foldTerminate :: (b -> a -> Either b b) -> b -> [a] -> b
foldTerminate f accum0 list0 =
execStateEither (mapM_ go list0) accum0
where
go x = modifyM (\accum -> liftEither $ f accum x)
```

This certainly shows how powerful and general monad transformers can be. It’s also starting to show some cognitive overhead. So let’s make it one step more general.

We’ve established that not only can the `State`

monad itself perform
`get`

and `put`

actions, but any transformer layered on top of it can
do so as well. The monad transformer library, or mtl, has a philosophy
around generalizing this idea using typeclasses. Let’s define a
typeclass, called `MonadState`

, for monad *stacks* which can perform
state-like actions:

```
class Monad m => MonadState s m | m -> s where
get :: m s
put :: s -> m ()
```

This uses a new language extension we haven’t seen before, called
*functional dependencies*. This means that the type of the monad, `m`

,
determines the type of the state, `s`

. We use this so that type
inference continues to work nicely, and so that we can’t define crazy
things like “this monad allows you to get and put both type `A`

and
type `B`

.”

Anyway, defining an instance for `State`

itself is trivial:

```
instance MonadState s (State s) where
get = State.get
put = State.put
```

But we can also define an instance for `EitherT`

over `State`

:

```
instance MonadState s (EitherT e (State s)) where
get = lift State.get
put = lift . State.put
```

Or, we can be even more general, and define an instance for `EitherT`

over any monad which is, itself, a `MonadState`

:

```
instance MonadState s m => MonadState s (EitherT e m) where
get = lift get
put = lift . put
```

With this typeclass and these instances in hand, we can now simplify
our `modifyM`

function significantly:

```
modifyM :: MonadState s m => (s -> m s) -> m ()
modifyM f = do
s0 <- get
s1 <- f s0
put $! s1
```

Sweet! Also, as you can probably guess, the `MonadState`

typeclass is
already defined for us, in `Control.Monad.State.Class`

from the `mtl`

library.

Well, sort of. The `State`

monad we’ve been working with until now is,
under the surface, defined as:

```
type State s = StateT s Identity
```

By defining all of our concrete, pure monads in terms of transformers
over the `Identity`

monad, we get to implement the functionality only
once.

This is also why the `EitherT`

transformer is instead called
`ExceptT`

. The author of the library was concerned that it would be
confusing that `type State s = StateT s Identity`

, `type Reader r = ReaderT r Identity`

, but the same didn’t apply for `Either`

.

Unlike most (if not all) of the other monads we’ve talked about, `IO`

does not have a transformer variant. It must always be the base monad,
with other capabilities layered on top of it. For example, `ReaderT AppConfig IO`

is a common way to structure an application: you can
perform `IO`

actions, and you can get access to some app-wide config
value.

There is an mtl-style typeclass for `IO`

, called creatively
`MonadIO`

. It’s used quite a bit in the ecosystem, and looks like:

```
class Monad m => MonadIO m where
liftIO :: IO a -> m a
instance MonadIO IO where
liftIO = id
instance MonadIO m => MonadIO (EitherT e m) where
liftIO = lift . liftIO
```

You can generalize many `IO`

-specific functions to `MonadIO`

, e.g.:

```
readFileGeneral :: MonadIO m => FilePath -> m B.ByteString
readFileGeneral = liftIO . B.readFile
```

`MonadIO`

is defined in the `transformers`

package in
`Control.Monad.IO.Class`

.

**WARNING** Next topic is significantly more advanced.

One thing you *can’t* automatically lift using `MonadIO`

is functions
that take an `IO`

action as *input*, also known as *contravariant on
IO* or having

`IO`

in ```
catchAny :: IO a -> (SomeException -> IO a) -> IO a
```

This function cannot be generalized using `MonadIO`

. Instead,
something more powerful needs to come into play. This is a more
advanced topic, but an example of this more powerful entity is
`MonadUnliftIO`

, which simplified looks like:

```
class MonadIO m => MonadUnliftIO m where
askRunInIO :: m (m a -> IO a)
```

This says “I’m going to ask for a function which can convert an action
in this monad stack into a simple `IO`

action.” Then I can use that to
“knock down” the stacked actions to simple `IO`

actions. This is why
it’s called *unlifting*: it does the opposite of the lift action. A
simple implementation of `IO`

is:

```
instance MonadUnliftIO IO where
askRunInIO = return id
```

Then we can generalize our `catchAny`

function:

```
catchAnyGeneral :: MonadUnliftIO m => m a -> (SomeException -> m a) -> m a
catchAnyGeneral action onExc = do
run <- askRunInIO
liftIO $ run action `catchAny` \e -> run (onExc e)
```

Two things to point out:

- Notice how
`MonadUnliftIO`

has`MonadIO`

as a superclass. We can build this subclassing hierarchies, just like we do with`Functor`

/`Applicative`

/`Monad`

, where we continuously add more restrictions and get more power. - Try as you might, you won’t be able to define an instance of
`MonadUnliftIO`

for`EitherT`

, or a (valid) one for`StateT`

. It’s extremely limited in what it allows, by design. For a long explanation: slides and video.

`MonadUnliftIO`

is defined in the `unliftio-core`

package in
`Control.Monad.IO.Unlift`

. The sister package `unliftio`

provides an
`UnliftIO`

module with *lots* of built in functionality, like
exception handling, concurrency, and STM, all already generalized to
either `MonadIO`

or `MonadUnliftIO`

.

You’ll want to refer to the documentation for transformers and mtl for these exercises:

- https://www.stackage.org/lts-12.21/package/transformers-0.5.2.0
- https://www.stackage.org/lts-12.21/package/mtl-2.2.1

Define a monad transformer `ReaderT`

, such that the following works:

```
-- Does not compile
#!/usr/bin/env stack
-- stack --resolver lts-12.21 script
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Data.Functor.Identity
type Reader r = ReaderT r Identity
runReader :: Reader r a -> r -> a
runReader r = runIdentity . runReaderT r
ask :: Monad m => ReaderT r m r
ask = _
main :: IO ()
main = runReaderT main' "Hello World"
main' :: ReaderT String IO ()
main' = do
lift $ putStrLn "I'm going to tell you a message"
liftIO $ putStrLn "The message is:"
message <- ask
lift $ putStrLn message
```

Create a terminating, *monadic* fold, which allows you to perform
effects while stepping through the list. There are many different ways
to do this, both with and without monad transformers.

```
#!/usr/bin/env stack
-- stack --resolver lts-12.21 script
foldTerminateM :: Monad m => (b -> a -> m (Either b b)) -> b -> [a] -> m b
foldTerminateM = _
loudSumPositive :: [Int] -> IO Int
loudSumPositive =
foldTerminateM go 0
where
go total x
| x < 0 = do
putStrLn "Found a negative, stopping"
return $ Left total
| otherwise = do
putStrLn "Non-negative, continuing"
let total' = total + x
putStrLn $ "New total: " ++ show total'
return $ Right total'
main :: IO ()
main = do
res <- loudSumPositive [1, 2, 3, -1, 5]
putStrLn $ "Result: " ++ show res
```

The output should be:

```
Non-negative, continuing
New total: 1
Non-negative, continuing
New total: 3
Non-negative, continuing
New total: 6
Found a negative, stopping
Result: 6
```

**NOTE** Don’t be surprised if this exercise is difficult to implement
with transformers. It’s a tricky problem.

The implementation of `ageInYear`

below is unpleasant. Use `MaybeT`

to
clean it up.

```
#!/usr/bin/env stack
-- stack --resolver lts-12.21 script
import Control.Monad.Trans.Maybe
import Text.Read (readMaybe)
import System.IO
prompt :: Read a => String -> IO (Maybe a)
prompt question = do
putStr question
putStr ": "
hFlush stdout
answer <- getLine
return $ readMaybe answer
ageInYear :: IO (Maybe Int)
ageInYear = do
mbirthYear <- prompt "Birth year"
case mbirthYear of
Nothing -> return Nothing
Just birthYear -> do
mfutureYear <- prompt "Future year"
case mfutureYear of
Nothing -> return Nothing
Just futureYear -> return $ Just $ futureYear - birthYear
main :: IO ()
main = do
mage <- ageInYear
case mage of
Nothing -> putStrLn $ "Some problem with input, sorry"
Just age -> putStrLn $ "In that year, age will be: " ++ show age
```

This example ties together the `ReaderT`

+`IO`

concept with the lenses
we learned last week. Fix up the following program so that it
compiles.

```
-- Does not compile
#!/usr/bin/env stack
-- stack --resolver lts-12.21 script
import Control.Monad.Reader
import Lens.Micro
import Lens.Micro.Mtl (view) -- hint :)
data LogLevel = Debug | Info
data Verbosity = Quiet | Verbose
logFunction :: Verbosity -> LogLevel -> String -> IO ()
logFunction Quiet Debug _ = return ()
logFunction _ _ str = putStrLn str
class HasVerbosity env where
verbosityL :: Lens' env Verbosity
logDebug :: HasVerbosity env => String -> ReaderT env IO ()
logDebug msg = do
verbosity <- _
logFunction verbosity Debug msg
logInfo :: HasVerbosity env => String -> ReaderT env IO ()
logInfo = _
main :: IO ()
main = do
putStrLn "===\nQuiet\n===\n"
_ inner Quiet
putStrLn "\n\n===\nVerbose\n===\n"
_ inner Verbose
inner :: _
inner = do
logDebug "This is debug level output"
logInfo "This is info level output"
```

This is the core idea behind `RIO`

, which you can read more about at
https://www.fpcomplete.com/blog/2017/07/the-rio-monad.

Implement a properly strict `WriterT`

, including a `MonadWriter`

instance, which internally looks like a `StateT`

.

```
#!/usr/bin/env stack
-- stack --resolver lts-12.21 script
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Data.Functor.Identity
newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }
deriving Functor
instance Monad m => Applicative (ReaderT r m) where
pure x = ReaderT $ \_ -> pure x
ReaderT ff <*> ReaderT fa = ReaderT $ \r -> ff r <*> fa r
instance Monad m => Monad (ReaderT r m) where
return = pure
ReaderT f >>= g = ReaderT $ \r -> f r >>= flip runReaderT r . g
instance MonadTrans (ReaderT r) where
lift action = ReaderT $ \_ -> action
instance MonadIO m => MonadIO (ReaderT r m) where
liftIO = lift . liftIO
type Reader r = ReaderT r Identity
runReader :: Reader r a -> r -> a
runReader r = runIdentity . runReaderT r
ask :: Monad m => ReaderT r m r
ask = ReaderT pure
main :: IO ()
main = runReaderT main' "Hello World"
main' :: ReaderT String IO ()
main' = do
lift $ putStrLn "I'm going to tell you a message"
liftIO $ putStrLn "The message is:"
message <- ask
lift $ putStrLn message
```

One solution: use `MaybeT`

to terminate early, and keep the
accumulator in a `StateT`

:

```
import Control.Monad.State.Strict
import Control.Monad.Trans.Maybe
foldTerminateM :: Monad m => (b -> a -> m (Either b b)) -> b -> [a] -> m b
foldTerminateM f accum0 list0 =
execStateT (runMaybeT $ mapM_ go list0) accum0
where
go a = do
accum0 <- get
res <- lift $ lift $ f accum0 a
case res of
Left accum -> do
put $! accum
MaybeT $ return Nothing
Right accum -> put $! accum
```

Another possibility: use `ExceptT`

and put the early terminate value
in the `Left`

value via `throwError`

:

```
foldTerminateM :: Monad m => (b -> a -> m (Either b b)) -> b -> [a] -> m b
foldTerminateM f accum0 list0 =
fmap (either id id) $ runExceptT $ execStateT (mapM_ go list0) accum0
where
go a = do
accum0 <- get
res <- lift $ lift $ f accum0 a
case res of
Left accum -> throwError accum
Right accum -> put $! accum
```

Or, of course, just implement it without transformers at all:

```
foldTerminateM :: Monad m => (b -> a -> m (Either b b)) -> b -> [a] -> m b
foldTerminateM f =
go
where
go !accum [] = return accum
go !accum (a:as) = do
res <- f accum a
case res of
Left accum' -> return accum'
Right accum' -> go accum' as
```

Moral of the story: transformers don’t always make life easier.

```
ageInYear :: IO (Maybe Int)
ageInYear = runMaybeT $ do
birthYear <- MaybeT $ prompt "Birth year"
futureYear <- MaybeT $ prompt "Future year"
return $ futureYear - birthYear
```

```
#!/usr/bin/env stack
-- stack --resolver lts-12.21 script
import Control.Monad.Reader
import Lens.Micro
import Lens.Micro.Mtl
data LogLevel = Debug | Info
data Verbosity = Quiet | Verbose
logFunction :: Verbosity -> LogLevel -> String -> IO ()
logFunction Quiet Debug _ = return ()
logFunction _ _ str = putStrLn str
class HasVerbosity env where
verbosityL :: Lens' env Verbosity
instance HasVerbosity Verbosity where
verbosityL = id
logDebug :: HasVerbosity env => String -> ReaderT env IO ()
logDebug msg = do
verbosity <- view verbosityL
liftIO $ logFunction verbosity Debug msg
logInfo :: HasVerbosity env => String -> ReaderT env IO ()
logInfo msg = do
verbosity <- view verbosityL
liftIO $ logFunction verbosity Info msg
main :: IO ()
main = do
putStrLn "===\nQuiet\n===\n"
runReaderT inner Quiet
putStrLn "\n\n===\nVerbose\n===\n"
runReaderT inner Verbose
inner :: ReaderT Verbosity IO ()
inner = do
logDebug "This is debug level output"
logInfo "This is info level output"
```

```
#!/usr/bin/env stack
-- stack --resolver lts-12.21 script
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Writer.Class
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
newtype WriterT w m a = WriterT (w -> m (a, w))
deriving Functor
instance Monad m => Applicative (WriterT w m) where
pure x = WriterT $ \w -> pure (x, w)
WriterT f <*> WriterT x = WriterT $ \w0 -> do
(f', w1) <- f w0
(x', w2) <- x w1
pure (f' x', w2)
instance Monad m => Monad (WriterT w m) where
return = pure
WriterT x >>= f = WriterT $ \w0 -> do
(x', w1) <- x w0
let WriterT f' = f x'
f' w1
instance MonadTrans (WriterT w) where
lift f = WriterT $ \w -> do
x <- f
pure (x, w)
instance MonadIO m => MonadIO (WriterT w m) where
liftIO = lift . liftIO
instance (Monad m, Monoid w) => MonadWriter w (WriterT w m) where
tell w2 = WriterT $ \w1 -> pure ((), w1 `mappend` w2)
pass (WriterT f) = WriterT $ \w0 -> do
((a, f), w1) <- f w0
pure (a, f w1)
listen (WriterT m) = WriterT $ \w0 -> do
(a, w) <- m mempty
pure ((a, w), w0 `mappend` w)
runWriterT :: (Monad m, Monoid w) => WriterT w m a -> m (a, w)
runWriterT (WriterT f) = f mempty
main :: IO ()
main = pure ()
```