Monad Transformers
Mirrored from the Haskell section of FP Complete’s site: original URL (offline), Wayback Machine copy.
Monads are a convenient way to to sequence computation with effects. Different monads can provide different kinds of effects:
IOallows world-changing side effectsIdentityis a “fake” monad: it allows no side effectsReaderlets you access some environment valueStatemocks a mutable variableMaybeallows for early exitEitherallows for early exit with a value
This has nothing to do with a monad transformer, just review. Let’s talk about something totally different.
Folds with early termination
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]
Using Either as a monad
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!
How about State?
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.
The StateEither monad
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:
ReaderStateEitherIO
Have fun :)
(Just kidding.)
Reformulating 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.
Just State?
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.
Helper functions
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
Statemonad in this case. We call this lifting the action. - Cause a
Leftvalue 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.
Generalizing 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.
Generalizing modify’
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.
mtl style typeclasses
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.
State is a transformer
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.
No IO transformer
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 negative position. For example:
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
MonadUnliftIOhasMonadIOas a superclass. We can build this subclassing hierarchies, just like we do withFunctor/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
MonadUnliftIOforEitherT, or a (valid) one forStateT. 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.
Exercises
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
Exercise 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
Exercise 2
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.
Exercise 3
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
Exercise 4
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 the RIO monad.
Exercise 5
Implement a properly strict WriterT, including a MonadWriter instance, which internally looks like a StateT.
Solutions
Exercise 1
#!/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
Exercise 2
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.
Exercise 3
ageInYear :: IO (Maybe Int)
ageInYear = runMaybeT $ do
birthYear <- MaybeT $ prompt "Birth year"
futureYear <- MaybeT $ prompt "Future year"
return $ futureYear - birthYear
Exercise 4
#!/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"
Exercise 5
#!/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 ()