Luminescent Dreams

Haskell Application Monad

January 01, 0001

We want to get productive in Haskell very quickly. Most non-trivial applications will have configuration, connections to the outside world, can hit exceptional conditions, and benefit from having their operations logged. If your application has sensible logs at both high an low levels of detail, your devops team will thank you and your life of debugging a production application will be a happier one.

I want to get all of these things at once, and so it would be nice to provide a nearly boilerplate application stack that provides them all. I define the “application stack” as a group of attributes that contain the context and all of the common behaviors for an application. In Haskell, you do that with a monad stack, though work on extensible effects shows a great deal of promise and has been used to great effect in Purescript.

That said, I use monads and monad transformers, and I’ll not explain either of them today. I feel that the best explanation is a non-trivial example implementation, which I will do in a future article, or refer you to a better tutorial.

While most of this article explains the process, the final result is this application stack, which may be all you need if you are already familiar with building monad transformer stacks.

data Context = Context { contextRoot :: FilePath } deriving Show

data AppError = AppError deriving Show

newtype AppM a = AppM (LoggingT (ReaderT Context (ExceptT AppError IO)) a)
    deriving ( Functor, Applicative, Monad, MonadIO
             , MonadError AppError, MonadReader Context, MonadLogger)

runAppM :: Context -> AppM a -> IO (Either AppError a)
runAppM ctx (AppM act) = runExceptT (runReaderT (runStderrLoggingT act) ctx)

The most basic stack

Almost every application needs IO. In Haskell it is difficult to do IO on top of anything (see MonadBaseControl for way), so I always put it at the bottom of the monad stack. A trivial application stack would look like this:

newtype AppM a = AppM (IO a) deriving (Functor, Applicative, Monad, MonadIO)

This is so trivial you will likely never do it, though it can be helpful in that it prevents confusion between your functions and system IO functions. Still, let’s build out what you need to make this work.

First of all, you do want AppM to be a monad, and you will need MonadIO in order to actually run IO operations. The primary use that I have for Monads in an application is to eliminate the boilerplate involved with a lot of threading context through a series of function calls. More to the point, though, you cannot get MonadExcept, MonadReader, or MonadLogger into this stack without having Monad to begin with.

newtype AppM a = AppM (IO a)
    deriving (Functor, Applicative, Monad, MonadIO)

runAppM :: AppM a -> IO a
runAppM (AppM act) = act

runAppM is the function that connects your application stack to the Haskell IO stack. This is everything you need in order to create a stack: the stack itself and the runner. Now let’s see it in action:

data Image = Image deriving Show

loadImage :: FilePath -> AppM Image
loadImage path = do 
    liftIO $ putStrLn $ "loadImage: " <> path
    pure Image
     

main :: IO ()
main = do
    res <- runAppM $ do
        img1 <- loadImage "image.png"
        img2 <- loadImage "image2.png"
        pure (img1, img2)
    print res

Injecting your context

IO a is too simple to make much sense. The whole point of having a stack is to unify a lot of effects within a common framework of behavior and with a common context. So, next we load and add a context.

In almost every circumstance, your context is read-only. This points us directly to ReaderT, since you will want to be able to ask for the context but never write back to it. Application state would seem like a thing that you would want to include, if your application stores state. I have generally found that it is easier to keep application state in something that is strictly IO, such as an IORef or a TVar. For now, we shall skip that.

So, change your stack to look like this:

data Context = Context { root :: FilePath } deriving Show

newtype AppM a = AppM (ReaderT Context IO a)
    deriving (Functor, Applicative, Monad, MonadIO, MonadReader Context)

runAppM :: Context -> AppM a -> IO a
runAppM ctx (AppM act) = runReaderT act ctx

The addition of MonadReader means that now you can call ask within your function to get back the context, and you don’t have to explicitely pass the context in. The remaining functions get updated like so:

loadImage :: FilePath -> AppM Image
loadImage path = do
    Context{..} <- ask
    liftIO $ putStrLn $ "loadImage: " <> (contextRoot </> path)
    pure Image

loadContext :: IO Context
loadContext = pure $ Context { contextRoot = "/home/savanni/Pictures/" }

main :: IO ()
main = do
    ctx <- loadContext
    res <- runAppM ctx $ do
        img1 <- loadImage "image.png"
        img2 <- loadImage "image2.png"
        pure (img1, img2)
    print res

Suddenly, everything in Context is available to every function that runs in AppM. You get the local effect of global parameters while still getting to isolate them, potentially calling the same functions with different contexts within the same application.

Add exception handling and logging

Exceptions happen. The Haskell community is split between what I call explicit vs. implicit exceptions. In short, implicit exceptions are not declared in the type signature, can happen from any function, and can only be caught in IO code. Explicit exceptions are explicitely stated in the type signature and can be caught just about anywhere. I prefer them for all of my application errors. I’ll give exception handling further treatment in a future article, and will show the use of explicit exceptions here.

Logging is almost always helpful for any application that is not of trivial size. And, once present, it can replace print for debugging, allowing debugging lines to remain present in the code for those cases when something starts going wrong in production.

First, the new application stack:

data AppError = AppError deriving Show

newtype AppM a = AppM (LoggingT (ReaderT Context (ExceptT AppError IO)) a)
    deriving ( Functor, Applicative, Monad, MonadIO
             , MonadError AppError, MonadReader Context, MonadLogger)

runAppM :: Context -> AppM a -> IO (Either AppError a)
runAppM ctx (AppM act) = runExceptT (runReaderT (runStderrLoggingT act) ctx)

This gets quite a bit more complicated with both the Logging and Exceptions being added. Remember that I use the term “stack” here, and each monad transformer involved represents another layer in the stack. When running the stack, you must peel off each layer in reverse order. I will illustrate with some types:

*Json> :t loadImage "img.png"
loadImage "img.png" :: AppM Image

*Json> :t unAppM $ loadImage "img.png"
unAppM $ loadImage "img.png"
  :: LoggingT (ReaderT Context (ExceptT AppError IO)) Image

*Json> :t runStderrLoggingT $ unAppM $ loadImage "img.png"
runStderrLoggingT $ unAppM $ loadImage "img.png"
  :: ReaderT Context (ExceptT AppError IO) Image

*Json> :t runReaderT (runStderrLoggingT $ unAppM $ loadImage "img.png") ctx
runReaderT (runStderrLoggingT $ unAppM $ loadImage "img.png") ctx
  :: ExceptT AppError IO Image

*Json> :t runExceptT $ runReaderT (runStderrLoggingT $ unAppM $ loadImage "img.png") ctx
runExceptT $ runReaderT (runStderrLoggingT $ unAppM $ loadImage "img.png") ctx
  :: IO (Either AppError Image)

The point of this is that in runAppM, the type of act is the entire stack, and the first thing to be called to begin unwrapping is runStderrLoggingT, then runReaderT, and finally runExceptT.

Notice, also, that the final type of runAppM has changed to IO (Either AppError a). runAppM will now return whatever exception gets thrown from within the context it is running, no matter where that exception is thrown, if that exception is thrown with throwException. Exceptions thrown with throw end up being the implicit exceptions I referred to, and those require some extra handling.

So, here is the rest of the code. In the places where I used to print output, I am now logging output. Note that the loggers require TemplateHaskell and have slightly odd syntax, but are otherwise nearly identical to print.

data Image = Image deriving Show

loadImage :: FilePath -> AppM Image
loadImage path = do
    Context{..} <- ask
    $(logInfo) (T.pack $ "loadImage: " <> (contextRoot </> path))
    pure Image

loadContext :: IO Context
loadContext = pure $ Context { contextRoot = "/home/savanni/Pictures/" }

main :: IO ()
main = do
    ctx <- loadContext
    do  res <- runAppM ctx $ do
            img1 <- loadImage "image.png"
            img2 <- loadImage "image2.png"
            pure (img1, img2)
        print res

    do  res <- runAppM ctx $ do
            img1 <- loadImage "image.png"
            throwError AppError
            img2 <- loadImage "image2.png"
            pure (img1, img2)
        print res 

This is the output from running main:

*Json> main
[Info] loadImage: /home/savanni/Pictures/image.png @(main:Json /home/savanni/src/haskell/src/Json.hs:76:7)
[Info] loadImage: /home/savanni/Pictures/image2.png @(main:Json /home/savanni/src/haskell/src/Json.hs:76:7)
Right (Image,Image)
[Info] loadImage: /home/savanni/Pictures/image.png @(main:Json /home/savanni/src/haskell/src/Json.hs:76:7)
Left AppError
*Json> 

So, the first block starting with do res <- runAppM runs to completion, returnin two images. The second block, runs loadImage for the first image, but then hits throwError and returns Left AppError, discarding the first image and not loading the second image at all.


This is nearly a application stack that I have used for more applications than I can count. Even if you need only one feature, such as exceptions, starting with a small stack hidden behind an application monad makes it very easy to add additional features as you need them, without needing to change the rest of your code. This pattern is trivial to extend, or contract, as needed, and so I think it starts every application on a good path.

Creative Commons License
Haskell Application Monad by Savanni D’Gerinel is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International License.