Refactoring to a Monad Transformer Stack

Command-line interfaces, or CLIs, often tend to follow a few patterns:

  • they use flags to modify behavior
  • they trigger failures at various points
  • they may read from at least one file

Within Haskell, these aspects break down into a few different high-level concepts: configuration, exceptions and exception handling, and I/O. As programs grow, options become unwieldy, manual exception handling muddies business logic, and it’s hard to organize grouped concepts effectively.

Let’s look at a fake CLI application, file-fun, which demonstrates some of these concepts.

Initial CLI Behavior

Let’s try this out in the console:

$ file-fun
This is fun!

$ file-fun --excited
ZOMG This is fun!

$ file-fun --excited --capitalize
ZOMG THIS IS FUN!

$ echo "hi there" | file-fun --stdin --capitalize
HI THERE

$ file-fun --file Setup.hs --capitalize
IMPORT DISTRIBUTION.SIMPLE
MAIN = DEFAULTMAIN

$ file-fun --file nonexistent
nonexistent: openFile: does not exist (No such file or directory)

I’m using Stack to build this package:

$ stack new file-fun

First, update file-fun.cabal to include optparse-applicative, a package which allows us to parse options passed to our CLI in an applicative style.

Next, let’s build out the CLI app:

-- app/Main.hs

module Main where

import qualified Control.Exception as E
import qualified Data.Bifunctor as BF
import qualified Data.Bool as B
import qualified Data.Char as C
import           Options.Applicative

-- types

data Options = Options
    { oCapitalize :: Bool
    , oExcited :: Bool
    , oStdIn :: Bool
    , oFileToRead :: Maybe String
    }

-- program

main :: IO ()
main = runProgram =<< parseCLI

runProgram :: Options -> IO ()
runProgram o =
    putStr =<< (handleExcitedness o . handleCapitalization o <$> getSource o)

-- data retrieval and transformation

getSource :: Options -> IO String
getSource o = B.bool (either id id <$> loadContents o) getContents $ oStdIn o

handleCapitalization :: Options -> String -> String
handleCapitalization o = B.bool id (map C.toUpper) $ oCapitalize o

handleExcitedness :: Options -> String -> String
handleExcitedness o = B.bool id ("ZOMG " ++) $ oExcited o

loadContents :: Options -> IO (Either String String)
loadContents o =
    maybe defaultResponse readFileFromOptions $ oFileToRead o
  where
    readFileFromOptions f = BF.first show <$> safeReadFile f
    defaultResponse = return $ Right "This is fun!"

-- CLI parsing

parseCLI :: IO Options
parseCLI = execParser (withInfo parseOptions "File Fun")
  where
    withInfo opts h = info (helper <*> opts) $ header h

parseOptions :: Parser Options
parseOptions = Options
    <$> (switch $ long "capitalize")
    <*> (switch $ long "excited")
    <*> (switch $ long "stdin")
    <*> (optional $ strOption $ long "file")

-- safer reading of files

safeReadFile :: FilePath -> IO (Either E.IOException String)
safeReadFile = E.try . readFile

Identifying Patterns

Let’s look at some of the types here to see if there are patterns we can extrapolate:

handleCapitalization :: Options -> String -> String
handleExcitedness :: Options -> String -> String
getSource :: Options -> IO String
loadContents :: Options -> IO (Either String String)
  • handleCapitalization and handleExcitedness transform a value to another value, based on configuration set somewhere else (Options)
  • getSource retrieves a base value or reads from STDIN (based on configuration set externally), and handles a failure case from loadContents
  • loadContents uses the same configuration (provided by getSource this time) to determine if (and which file) should be read; it’s able to signify to the application that a failure occurred when loading a non-existent file.

Dissecting the Monad Transformers

mtl, the “monad transformer library”, is a library providing typeclasses (MonadReader, MonadError) and instances for combinations of concrete implementations of various monads (Reader, ReaderT, Except, ExceptT). Here, we’ll be focusing on two transformers, ReaderT and ExceptT, to clean up our read-only environment passing (Options) and failure cases when things go wrong.

ReaderT

Let’s continue with the previously mentioned pattern of Options; this shared context can be handled by the Reader monad. More specifically, ReaderT - the “reader transformer” - is used to stack the Reader monad together with other monads (e.g. IO). Retrieval of the configuration is accessible via asks, which returns the ReaderT with the appropriate wrapped value.

asks :: Monad m => (r -> a) -> ReaderT r m a

The Reader monad is perfect for passing read-only context to a function. In this case, the context is the set of Options provided by the user running the program.

ExceptT

The concept of failure, with context, is often expressed with Either e a, where e encapsulates the error: String, Control.Exception.IOException, you name it. ExceptT takes this further by allowing the developer to throwError; when using bind, if the monad throws an error, it will halt further execution.

Why is this important?

Imagine a CLI that reads two files, independently, where the reading of the second occurs only when the first is read successfully. Once both are read, the program can continue.

Let’s look at a solution without ExceptT:

module Main where

import qualified Control.Exception as E

main :: IO ()
main = do
    file1 <- safeReadFile "file1"         -- attempt to read file1
    case file1 of
        Left e -> renderError e           -- handle when reading file1 fails
        Right file1' -> do
            file2 <- safeReadFile "file2" -- attempt to read file2
            case file2 of
                Left e -> renderError e   -- handle when reading file1 fails
                Right file2' -> processResult file1' file2'

renderError :: Show e => e -> IO ()
renderError e = putStrLn $ "Error: " ++ show e

processResult :: String -> String -> IO ()
processResult s s' = putStrLn $ "Result: \n" ++ s ++ s'

safeReadFile :: FilePath -> IO (Either E.IOException String)
safeReadFile = E.try . readFile

This nested chain is already unwieldy, and we’re only reading from two files.

module Main where

import qualified Control.Exception as E
import           Control.Monad.Except

main :: IO ()
main = either renderError return =<< runExceptT runMain
  where
    runMain :: ExceptT E.IOException IO ()
    runMain = do
        file1 <- readFileWithFailure "file1"
        file2 <- readFileWithFailure "file2"
        liftIO $ processResult file1 file2
    readFileWithFailure :: FilePath -> ExceptT E.IOException IO String
    readFileWithFailure s = either throwError return =<< liftIO (safeReadFile s)

renderError :: Show e => e -> IO ()
renderError e = putStrLn $ "Error: " ++ show e

processResult :: String -> String -> IO ()
processResult s s' = putStrLn $ "Result: \n" ++ s ++ s'

safeReadFile :: FilePath -> IO (Either E.IOException String)
safeReadFile = E.try . readFile

In the same vein, loadContents, using Either String String to represent possible failure (e.g. a file path is provided but the file doesn’t exist), is a perfect candidate for refactoring to use ExceptT. This also means we can let the program handle the error higher up, instead of having getSource handle both cases.

Refactoring

AppConfig

Let’s add mtl to the list of dependencies in our cabal file and then start working on app/Main.hs:

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

-- other imports
import Control.Monad.Reader

type AppConfig = MonadReader Options

The ConstraintKinds extension allows for using MonadReader providing the reader type but not the underlying monad; coupled with FlexibleContexts, AppConfig can use parametric polymorphism like so:

handleCapitalization :: AppConfig m => String -> m String
handleCapitalization s = B.bool s (map C.toUpper s) <$> asks oCapitalize

handleExcitedness :: AppConfig m => String -> m String
handleExcitedness s = B.bool s ("ZOMG " ++ s) <$> asks oExcited

The AppConfig m typeclass constraint ensures the result is wrapped in the appropriate type. Because AppConfig is a MonadReader, we have access to both oExcited (as it’s of type Options -> Bool) and asks, since we’re in the monad.

App

AppConfig is only a small chunk of our larger type, App, which needs to fulfill all the previous requirements:

  • Monad (as well as a Functor and Applicative)
  • IO
  • Reader
  • Except

First, let’s define our sum type for errors (we’ll only start with one, handling the non-existent file) and import the correct module from mtl:

module Main where

-- other imports
import Control.Monad.Except

data AppError
    = IOError E.IOException

We can use one final language extension to derive from monads encapsulating each of these behaviors to build out a large newtype:

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

newtype App a = App {
    runApp :: ReaderT Options (ExceptT AppError IO) a
} deriving (Monad, Functor, Applicative, AppConfig, MonadIO, MonadError AppError)

Although it’s “only” four lines of code, there’s a lot here. Let’s break it apart.

First, we have our language extension. It’s what allows us to derive from Monad and the rest of the lot.

Next, we see our newtype App a, with the type describing runApp. ReaderT has access to Options within its shared read-only state, as well as its accompanying monad (ExceptT AppError IO) and the polymorphic return type. We’d previously outlined that AppError is a sum type, and since its “success” includes IO, it means the entire stack has access to IO.

Finally, the list of monads it’s deriving; it includes the usual suspects (Monad, Applicative, and Functor), as well as Reader (in the form of AppConfig), Except (in the form MonadError AppError), and IO (with MonadIO).

getSource

-- old
getSource :: Options -> IO String
getSource o = B.bool (either id id <$> loadContents o) getContents $ oStdIn o

-- new
getSource :: App String
getSource = B.bool loadContents (liftIO getContents) =<< asks oStdIn

Nice; App encapsulates passing around Options and performing IO.

Here, we switch from managing exception handling at the getSource level down to where it can occur, in loadContents. The other interesting aspect is getContents :: IO String needs to be lifted with liftIO :: IO a -> m a, where m is our App. This ensures allows IO operations to be run, but wrapped in the appropriate monad.

The nice change here is that we don’t have any options to pass around, to any level, and there’s the bonus of not having to manage Either cases to better handle when loadContents fails.

loadContents

-- old
loadContents :: Options -> IO (Either String String)
loadContents o =
    maybe defaultResponse readFileFromOptions $ oFileToRead o
  where
    readFileFromOptions f = BF.first show <$> safeReadFile f
    defaultResponse = return $ Right "This is fun!"

-- new
loadContents :: App String
loadContents =
    maybe defaultResponse readFileFromOptions =<< asks oFileToRead
  where
    readFileFromOptions f = either throwError return =<< BF.first IOError <$> liftIO (safeReadFile f)
    defaultResponse = return "This is fun!"

In addition to App encapsulating passing Options and performing IO, it also wraps up failure previously managed by Either.

We continue to handle both Just filename and Nothing cases from oFileToRead; however, our “default response” now doesn’t care about wrapping its value in Right (since any result at any level, when not coming from throwError, is considered successful).

Speaking of throwError, we continue to handle when reading the file fails, but this time, we’re using our IOError data constructor to bubble that error up. When reading the file succeeds, all that’s needed is us wrapping it in the monad (with return).

Running the program and error handling

Almost done! Let’s start with run (which we’ve added) and runProgram:

-- old
runProgram :: Options -> IO ()
runProgram o =
    putStr =<< handleExcitedness o <$> handleCapitalization o <$> getSource o

-- new
runProgram :: Options -> IO ()
runProgram o = either renderError return =<< runExceptT (runReaderT (runApp run) o)

run :: App ()
run = liftIO . putStr
    =<< handleExcitedness
    =<< handleCapitalization
    =<< getSource

run now performs the meat of what runProgram previously managed - specifically, writing out the result to IO, and transforming the data from the source through handleCapitalization and handleExcitedness. The types line up such that we can use =<< throughout the process:

getSource :: App String                                   -- m a
handleCapitalization :: AppConfig m => String -> m String -- a -> m b
handleExcitedness :: AppConfig m => String -> m String    -- a -> m b

We also have to compose liftIO and putStr to lift our IO operation up to the App monad. We use the void type to notate that run has no usable result.

The new version of runProgram is doing much more for us; it runs the application, with all its varying layers, in one spot, and takes the result handling both success and failure.

The right half of bind, runExceptT (runReaderT (runApp run) o), runs our App in the reverse order it was declared, inside-out. Recall the type of runApp:

runApp :: ReaderT Options (ExceptT AppError IO) a

First, we have to process ExceptT, then move outward to ReaderT. The nesting is also important here, since we want to handle failure; the result type of the right-hand side is IO (Either AppError ()).

The left-hand side (either renderError return) handles the success case by returning the value (in this situation, void) or by calling renderError, applying our AppError. Since the type for both success and failure is IO (), the type signature and body for renderError should make sense:

renderError :: AppError -> IO ()
renderError (IOError e) = do
    putStrLn "There was an error:"
    putStrLn $ "  " ++ show e

We now see the benefit of the AppError sum type; it allows for custom messages based on the context of failure.

Results

The final result of the refactoring:

-- app/Main.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

import qualified Control.Exception as E
import           Control.Monad.Reader
import           Control.Monad.Except
import qualified Data.Bifunctor as BF
import qualified Data.Bool as B
import qualified Data.Char as C
import           Options.Applicative

-- types

data Options = Options
    { oCapitalize :: Bool
    , oExcited :: Bool
    , oStdIn :: Bool
    , oFileToRead :: Maybe String
    }

type AppConfig = MonadReader Options
data AppError
    = IOError E.IOException

newtype App a = App {
    runApp :: ReaderT Options (ExceptT AppError IO) a
} deriving (Monad, Functor, Applicative, AppConfig, MonadIO, MonadError AppError)

-- program

main :: IO ()
main = runProgram =<< parseCLI

runProgram :: Options -> IO ()
runProgram o = either renderError return =<< runExceptT (runReaderT (runApp run) o)

renderError :: AppError -> IO ()
renderError (IOError e) = do
    putStrLn "There was an error:"
    putStrLn $ "  " ++ show e

run :: App ()
run = liftIO . putStr
    =<< handleExcitedness
    =<< handleCapitalization
    =<< getSource

-- data retrieval and transformation

getSource :: App String
getSource = B.bool loadContents (liftIO getContents) =<< asks oStdIn

handleCapitalization :: AppConfig m => String -> m String
handleCapitalization s = B.bool s (map C.toUpper s) <$> asks oCapitalize

handleExcitedness :: AppConfig m => String -> m String
handleExcitedness s = B.bool s ("ZOMG " ++ s) <$> asks oExcited

loadContents :: App String
loadContents =
    maybe defaultResponse readFileFromOptions =<< asks oFileToRead
  where
    readFileFromOptions f = either throwError return =<< BF.first IOError <$> liftIO (safeReadFile f)
    defaultResponse = return "This is fun!"

-- CLI parsing

parseCLI :: IO Options
parseCLI = execParser (withInfo parseOptions "File Fun")
  where
    withInfo opts h = info (helper <*> opts) $ header h

parseOptions :: Parser Options
parseOptions = Options
    <$> (switch $ long "capitalize")
    <*> (switch $ long "excited")
    <*> (switch $ long "stdin")
    <*> (optional $ strOption $ long "file")

-- safer reading of files

safeReadFile :: FilePath -> IO (Either E.IOException String)
safeReadFile = E.try . readFile

While the underlying structure feels mostly unchanged (still performing IO, still transforming strings in the same manner), the refactoring impacts how the code feels.

Instead of passing Options around, there’s now a built-in way to interact with that read-only state. Instead of using Either to pass around failure, everything operating inside App a now has an opportunity to trigger failures, without having to modify type signatures at the level (and every level up). It also seems fairly trivial to introduce additional functionality into App, since it’d require updating the typeclasses App a derives and ensuring run unwraps things correctly.

You can view the working source code from this post here.