Scala/Kotlin developer learning Haskell - Part 2 - Monad Transformers

9 minute read

In the previous article learning haskell part 1 I walked through the steps I took to get a very simple and basic REST endpoint up and running. All that went suprisingly well and during that simple exercise I learned a lot about the syntax of Haskell, and for the first actually felt part of the language click. Based on that positive experience I decided to go ahead and dive deeper into how Scotty (the REST framework I used) actually worked. More specifically, what is this ScottyM thing I have to pass in, to get the server up and running:

scotty :: Port -> ScottyM () -> IO ()
-- where ScottyM is
type ScottyM = ScottyT Text IO
-- and ScottyT is
newtype ScottyT e m a = ScottyT { runS :: State (ScottyState e m) a }
    deriving ( Functor, Applicative, Monad )
-- and ScottyState
data ScottyState e m =
    ScottyState { middlewares :: [Wai.Middleware]
                , routes :: [Middleware m]
                , handler :: ErrorHandler e m
                }

I guess ScottyState is where Scotty keeps track of how it is configured. So when adding routes, they’re probably added to the ScottyState managed by the State monad. Since that part seemed to be more part of the Scotty internals, I decided not to follow that part, but focus on this newtype construct since that apparently is how you define new types in haskell. Looking through some examples online, using newtype is often used to define a stack of monad transformers. I’ve used monad transformers here and there in my scala projects, but doing that in Scala always felt a bit convoluted and required quite a bit of boilerplate code to get the desired effect. So as an exercise I decided to see how that works in Haskell, since that also allows me to look into some of the standard monads in Haskell.

Reader and Writer monads

Most functional languages come with a Reader and a Writer monad. Basically a Reader monad allows you to run your functions within a specific context (e.g pass in an environment, with some configuration), where we Writer monad allows you to provide some output when running this monad (e.g write logs, collect metrics). I’ve used both in Scala. The first problem I had was, how can I test working with Reader and Writer. But in Haskell the monad class is defined like this:

class Monad m where
  (>>=)  :: m a -> (  a -> m b) -> m b
  (>>)   :: m a ->  m b         -> m b
  return ::   a                 -> m a
  fail   :: String -> m a

Which, I guess, means that with the return function we can create a Monad from a value. And (>>) seems to be the some sequencing function, where we pass in a m a, then a m b and return the m b. And (>>=) looks like flatMap, where we pass in a function from a to m b and return that m b.

*Main Lib> data Environment = Environment {foo :: String}
*Main Lib> let a1 = return "Some string" :: Reader Environment Int
*Main Lib> let a1 = return "Some string" :: Reader Environment String
*Main Lib> :t a1
a1 :: Reader Environment String

And that works! Now, if we can use return to create the monad, we can probably also use that in a do notation and access the environment as well.

data Environment = Environment {foo :: String}
env1 = Environment "Hello"

withdo :: Reader Environment String
withdo = do
    config <- ask
    return $ "Value from config: " <> foo config

*Main Lib>  runReader withdo env1
"a valueHello"

In this code fragment we access the environment using ask: ask :: m r, which allows us access to the passed in environment. The foo value from this passed in environment is concatenated to a string, and returned in a monad again. To run the monad with a passed in environment we need to call the runReader function: runReader :: Reader r a -> r -> a. This one takes our monad as first argument, the environment as the second one, and returns the boxed value.

So far, so good. Using the reader monad directly is really trivial, and the writer monad probably isn’t that much more complex:

writer1 :: Int -> Writer [String] Int
writer1 i = do
  _ <- tell ["A first message"]
  _ <- tell ["A second message"]
  return i

*Main Lib> let w = writer1 1
*Main Lib> execWriter w
["A first message","A second message"]

Here we define a function which takes an Int uses the writer monad to add two messages to the [String] (which adds them to the list automatically!). So using and creating the monads in themselves is very straightforward. Using the >>= flatmap kind of thingy also works as expected!

reader1 :: Reader Environment String
reader1 = do
    config <- ask
    return $ "The first step: " <> foo config

reader2 :: String -> Reader Environment String
reader2 s = do
    config <- ask
    return $ s <> "The second step" <> foo config

let m = (reader1) >>= (\p -> (reader2 p))
*Main Lib> runReader m env1
"The first step: HelloThe second stepHello"

Where we can rewrite the lambda thingy (lambdas in Haskell start with a \) to this: let m = reader1 >>= reader2

Combining a Reader, Writer and IO monad

So far, I’m getting the hang of the Haskell syntax a bit, now let’s look at how we do monad transformers in Haskell.

What I want to have is an:

  • IO monad to which I can do a putStrLn
  • a Writer monad to write some logging
  • a Reader monad to pass in some environment

In Haskell for most of the standard monads we can get the Monad transformer variant by just adding a T. So we’ve got a ReaderT, and a Writer T. The IO monad is a special one, and apparently needs to be the most inner one.

Using monad transformers in haskell can be done by just defining them as the return type. So in our case that’d be something like that: ReaderT Environment (WriterT String IO) ().

And the code to use this would be this:

wlog :: Show w => w -> ReaderT Environment (WriterT String IO) ()
wlog w = do
  p <- ask
  tell ("INFO (env:  " <> (foo p) <> ") - " <> show w)

actions :: ReaderT Environment (WriterT String IO) ()
actions = do
  localEnv <- ask
  _ <- wlog "Running action"
  liftIO $ putStrLn ("Doing IO with env: " <> foo localEnv)

main = execWriterT (runReaderT (actions) env1) >>= putStrLn 
*Main Lib> main
Doing IO with env: Hello
INFO (env:  Hello) - "Running action"

While this works, it is kind of annoying. We have to specify the type in each of our functions, and if we want to add another transformer to the stack we’d have to change the signature of all the functions.

Haskell allows us, luckily, to define new types. This is also what happens in the Scotty type configuration we saw in the beginning:

newtype ScottyT e m a = ScottyT { runS :: State (ScottyState e m) a }
    deriving ( Functor, Applicative, Monad )

So with this, in Haskell we define a new type called ScottyT, which wraps a State monad. This new type takes 3 type parameters e, m and a. If we want to do something similar for the ReaderT Environment (WriterT String IO) () type, we get something like this:

newtype App a = App {runApp :: ReaderT Environment (WriterT String IO) a} deriving
                (Functor, Applicative, Monad, MonadIO, MonadWriter String, MonadReader Environment)

In this case we’ve created a new type called App. And through the deriving clause at the end, all the provided type classes are automatically implemented by this new type. With this type we can now change the signature of our functions to this:

-- helper function which returns the current environment, wrapped in our custom stack
env :: App Environment
env = ask

-- simple very basic logger, which
wlog :: Show w => w -> App ()
wlog w = do
  p <- ask
  tell ("INFO (env:  " <> (foo p) <> ") - " <> show w)

-- runs a number of steps all inside our custom transformer stack. This
-- would normally be your complete application
actions :: App ()
actions = do
  localEnv <- env
  _ <- wlog "Running action"
  liftIO $ putStrLn ("Doing IO with env: " <> foo localEnv)

While this cleans up the signatures, we now do have to change how we can run this monad. We first have to call runApp to create this stack of monad transformers.

*Main Lib> let mt = runApp actions
*Main Lib> :type mt
mt :: ReaderT Environment (WriterT String IO) ()

Now that we have this stack, we can do the normal runReaderT and execWriter stuff again. So the resulting call looks like this:

main = execWriterT (runReaderT ( runApp actions) env1) >>= putStrLn

*Main Lib> main
Doing IO with env: Hello
INFO (env:  Hello) - "Running action"

So defining a newtype which returns a stack of monadtransformers is really easy. It took some time for me to get this far, though. But with what I know now, it shouldn’t be too difficult to add more monads to this stack.

Adding a State monad to the stack

To add a state transformer, we first create a new newtype:

newtype App2 a = App2 {runApp2 :: StateT LocalState (ReaderT Environment (WriterT [String] IO)) a} deriving
                (Functor, Applicative, Monad, MonadIO, MonadWriter [String], MonadReader Environment)

To use a state we’ve got the following two functions:

get :: m s
put :: s -> m ()

We’ve a get function to get the current state and with put we can replace the current state. So let’s add this to a log function, so we keep track of how many time it has been called.

wlogs :: Show w => w -> App2 ()
wlogs w = do
  p <- ask
  s <- get
  _ <- put $ LocalState $ count s + 1
  u <- get
  tell (["INFO (env:  " <> (foo p) <> ") - " <> (show $ count u) <> " - " <> show w ])

There are probably better ways to do this, but in this log function, we again log the environment, and also log the localstate whose count we increase by 1. We can make this part of our main do flow:

actions :: App2 ()
actions = do
  localEnv <- env
  _ <- wlogs "Doing something"
  _ <- wlogs "And doing some more"
  liftIO $ putStrLn ("Doing IO with env: " <> foo localEnv)

And run it like this (I’ve also ):

main = execWriterT (runReaderT (runStateT ( runApp2 actions) state1) env1) >>= mapM_ putStrLn

*Main Lib> main
Doing IO with env: Hello
INFO (env:  Hello) - 1 - "Doing something"
INFO (env:  Hello) - 2 - "And doing some more"

I’ve also changed the writer to use an array of Strings, so we can separate the output on each line. And this just works, which is really cool. At least for me that is.

Conclusion

My initial goal was to also append the standard Scotty monad to use this kind of logging and passing in of an environment, but for me getting this working was enough for this part.

In the end though, I feel like I’m progressing quite nicely. I now understand the monad transformers a bit more and like the way how you can just define new types to clean up the signatures. In the next part I’ll come back to scotty and start looking into connecting databases and adding some logging.

Updated: