Skip to content

An Example

So let's see whether we can use MaybeT to clean up the implementation of our little display program. As a starting point, here is what we have so far:

display.hs
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Reader
import System.Environment
import System.IO
import System.Process

data Config = Cfg
    { fileName :: String
    , usePager :: Bool
    }

main :: IO ()
main = do
    cfg <- mkCfg <$> getArgs
    case cfg of
        Just c  -> runReaderT realMain c
        Nothing -> putStrLn "USAGE: display [-p] <file>"

mkCfg :: [String] -> Maybe Config
mkCfg [fileName]       = Just $ Cfg fileName False
mkCfg ["-p", fileName] = Just $ Cfg fileName True
mkCfg _                = Nothing

type Prog = ReaderT Config IO

realMain :: Prog ()
realMain = do
    txt <- loadFile
    case txt of
        Nothing -> return ()
        Just t  -> display t

loadFile :: Prog (Maybe String)
loadFile = do
    file <- asks fileName
    txt  <- lift $ try $ readFile file
    case txt of
        Left (_ :: IOException) -> do
            lift $ putStrLn $ "ERROR: Unable to read file '" ++ file ++ "'!"
            return Nothing
        Right t -> return $ Just t

display :: String -> Prog ()
display txt = do
    usePgr <- asks usePager
    lift $ if usePgr then do
        let pagerInfo = (shell "less") { std_in = CreatePipe }
        (Just h, _, _, pager) <- createProcess pagerInfo
        hPutStr h txt
        hFlush h
        hClose h
        void $ waitForProcess pager
    else
        putStr txt

If we want to add Maybe's ability to abort a program to this, we need a monad that stacks both MaybeT and ReaderT on top of IO. As soon as we have multiple monad transformers, we need to figure out in which order to arrange them in the stack of transformers. We could define

type Prog = ReaderT Config (MaybeT IO)

or

type Prog = MaybeT (ReaderT Config IO)

The first definition wraps IO in MaybeT and then wraps this monad in ReaderT. The second definition wraps IO in ReaderT and then wraps this monad in MaybeT. With ReaderT and MaybeT, the order doesn't really matter. It will be slightly more convenient to choose ReaderT as the outer monad, so we define

display.hs (Edit)
type Prog = ReaderT Config (MaybeT IO)

For other combinations of monad transformers, different stacking orders can produce monads that behave dramatically differently. We'll revisit this briefly once we have discussed the transformer version of the State monad, StateT.

For now, let's not use our MaybeT transformer yet. At the moment our code does not compile because we changed the definition of Prog, but our code so far was based on the definition of Prog as ReaderT Config IO. Here are the changes that are necessary to make our code compile again:

display.hs (Edit)
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import System.Environment
import System.IO
import System.Process

data Config = Cfg
    { fileName :: String
    , usePager :: Bool
    }

main :: IO ()
main = do
    cfg <- mkCfg <$> getArgs
    case cfg of
        Just c  -> void $ runMaybeT $ runReaderT realMain c
        Nothing -> putStrLn "USAGE: display [-p] <file>"

mkCfg :: [String] -> Maybe Config
mkCfg [fileName]       = Just $ Cfg fileName False
mkCfg ["-p", fileName] = Just $ Cfg fileName True
mkCfg _                = Nothing

type Prog = ReaderT Config (MaybeT IO)

realMain :: Prog ()
realMain = do
    txt <- loadFile
    case txt of
        Nothing -> return ()
        Just t  -> display t

loadFile :: Prog (Maybe String)
loadFile = do
    file <- asks fileName
    txt  <- lift $ lift $ try $ readFile file
    case txt of
        Left (_ :: IOException) -> do
            lift $ lift $ putStrLn $ "ERROR: Unable to read file '" ++ file ++ "'!"
            return Nothing
        Right t -> return $ Just t

display :: String -> Prog ()
display txt = do
    usePgr <- asks usePager
    lift $ lift $ if usePgr then do
        let pagerInfo = (shell "less") { std_in = CreatePipe }
        (Just h, _, _, pager) <- createProcess pagerInfo
        hPutStr h txt
        hFlush h
        hClose h
        void $ waitForProcess pager
    else
        putStr txt

Each of the lines that lift an IO action into Prog now need to do so using two applications of lift. The inner lift lifts the IO action into MaybeT IO. The outer lift lifts it further into ReaderT Config (MaybeT IO).

Next, realMain has type Prog (), that is, ReaderT Config (MaybeT IO) (). What we need in the Just-branch of our main function is a computation of type IO (). runReaderT realMain c is an action of type MaybeT IO (). It peels of the ReaderT layer of our monad and reveals the underlying monad. runMaybeT removes the MaybeT layer and reveals the underlying action of type IO (Maybe ()). At least we have something in the IO monad now, but the return type isn't right. We have Maybe () but want (). void to the rescue, because it throws away the return value of the computation it wraps.

Since MaybeT and runMaybeT are part of the Control.Monad.Trans.Maybe module, we needed to import it.

So far our code has become worse: We've added more imports and added some boilerplate, but the logic is eactly the same. Now let's put MaybeT to work to actually gain some benefits. Let's start with the interaction between realMain and loadFile. Currently loadFile returns Just txt on success or Nothing on failure, and realMain pattern matches on the return value. We can implement this more elegantly using the behaviour of our MaybeT monad transformer. We change loadFile to return simply a String. If loadFile fails, then we encode this by using failure in our MaybeT monad transformer:

display.hs (Edit)
loadFile :: Prog String
loadFile = do
    file <- asks fileName
    lift $ do
        txt  <- lift $ try $ readFile file
        case txt of
            Left (_ :: IOException) -> do
                lift $ putStrLn $ "ERROR: Unable to read file '" ++ file ++ "'!"
                fail ""
            Right t -> return t

Once again, we start by asking for the file name to be read. The remainder of the function is an inner do-block, which we lift once. Thus, this do-block lives in the MaybeT IO monad. We read the next file using try $ readFile file as before, and we're back to lifting this only once because, inside the inner do-block, we only need to lift from IO into MaybeT IO. For the same reason, the putStrLn is lifted only once now. That's mainly cosmetics, but it's nice to clean up the clutter of double-lifting a little bit. The significant changes are in the last two lines. If reading the file succeeds—the Right t branch—, we simply return t. No more wrapping in Just. If reading the file fails, the Left branch, we still print an error message, but instead of returning Nothing to indicate failure, we now use fail "" to make the computation fail.

fail is a function that is available in every monad that can express failure. Those are monads in the MonadFail subclass of Monad. The argument of fail is an error message that is ignored by some monads and not by others. Maybe and MaybeT are both instances of MonadFail. Both ignore the error message. That's why I provided simply an empty string here. The implementations of fail for Maybe and MaybeT are

instance MonadFail Maybe where
    fail = const Nothing

instance Monad m => MonadFail (MaybeT m) where
    fail = const $ MaybeT $ return Nothing

Both return Nothing, one as a pure value, the other using the return action of the underlying monad m. In both cases, this Nothing ensures that the remainder of the computation does not happen.

With this change in the implementation of loadFile, realMain becomes really easy:

display.hs (Edit)
realMain :: Prog ()
realMain = do
    txt <- loadFile
    display txt

Instead of pattern matching on the return value of loadFile, we now pass this value on to display without inspecting it. That's the right thing to do now. If loadFile fails, display never runs. Otherwise, loadFile returns a string, not Just a string, so we can simply pass this string to display.

This is one of the few examples where I feel that do-notation only adds clutter and using (>>=) explicitly leads to more readable code, because it shows that all we do is pass the return value of loadFile to display:

display.hs (Edit)
realMain :: Prog ()
realMain = loadFile >>= display

Once again, we have a program that compiles. You should try it out to see that it still behaves as expected.

The implementation of loadFile, display or realMain cannot be simplified further. realMain is as simple as it gets. loadFile needs to deal with the tedium of converting an exception thrown by readFile into success or failure in the MaybeT monad transformer. And display merely does a whole lot of low-level I/O to print the text it was given or communicate with the pager.

Where there is room for improvement is in the handling of errors returned by mkCfg. To prepare for this, let's move the do-block of our Main function into the MaybeT IO monad:

display.hs (Edit)
main :: IO ()
main = void $ runMaybeT $ do
    cfg <- mkCfg <$> lift getArgs
    case cfg of
        Just c  -> runReaderT realMain c
        Nothing -> lift $ putStrLn "USAGE: display [-p] <file>"

The main function runs the do-block using runMaybeT and then discards the result using void. Thus, the do-block has the type Maybe IO a, for some type a. This type is in fact (), but this is not important because we don't care about the return value anyway. For now, this made our code worse because it means that we need to lift both getArgs and putStrLn because they are IO actions. We no longer have to apply void . runMaybeT to runReaderT realMain c, but that's not a real gain because we're applying this function to the whole do-block instead now.

Now let's reap the benefit of this change. We want to convert mkCfg <$> lift getArgs, which currently doesn't fail and returns a value of type Maybe Config into an action that simply returns a Config but fails if the command line arguments aren't what we expect. It's actually quite easy to build this. Note that the MaybeT monad transformer represents failure as a value MaybeT f, where f is an action in the underlying monad that returns Nothing. Success is a value MaybeT f, where f is an action that returns Just some value. Well, mkCfg <$> getArgs has type IO (Maybe Config) and the return value is Nothing on failure and Just a config on success. It exactly fits the bill. Thus, we can simplify our main function as follows:

display.hs (Edit)
main :: IO ()
main = void $ runMaybeT $ do
    cfg <- MaybeT (mkCfg <$> getArgs)
    runReaderT realMain cfg

Once again, since we're simply passing the result of the first action on to the second action, it is more succinct to use (>>=) instead of do-notation here:

display.hs (Edit)
main :: IO ()
main = void . runMaybeT
     $ MaybeT (mkCfg <$> getArgs) >>= runReaderT realMain

There's a problem with this simplification though. We've lost some functionality. With the correct command line arguments, our program still behaves as expected. When the command line arguments are wrong, on the other hand, our program exits silently, without printing an error message.

That's where things get a little hairy. We have three options:

  • We can revert these changes and leave the original version that pattern-matched on the result of mkCfg. That's probably the most pragmatic solution. For the purpose of this example, I simply wanted to demonstrate how much of the code can be simplified by using the MaybeT monad transformer.

  • We can turn mkCfg into an action in the IO monad. This gives it the ability to print an error message before returning Just a config or Nothing. You should always think twice, really hard, before turning a pure function into an action in some monad. Is this really necessary. Here, it would be a sign of insufficient separation of concerns. The task of mkCfg is to try to construct a Config from the command line arguments. Printing an error message when that fails is a completely separate task. Indeed, even the name mkCfg (make config) says nothing about mkCfg printing some error message.

  • We can implement a catch function for the MaybeT monad transformer as we did for the Maybe monad and use it to add exception handling to our code. Alas, this function does not exist as part of the standard library, so this adds some boilerplate to our code. In our little example, implementing catch will undo most of the gains in succinctness we have made by adding the MaybeT transformer. In a larger program, it may be worthwhile because we need to implement catch only once, and then we can use the succinct expression of exception handling provided by the MaybeT monad throughout our program. So let's do this here, for illustration.

Here's the catch function we implemented for the Maybe monad before:

catch :: Maybe a -> Maybe a -> Maybe a
Nothing `catch` handler = handler
x       `catch` _       = x

This is easy to translate so it works for MaybeT:

display.hs (Edit)
display :: String -> Prog ()
display txt = do
    usePgr <- asks usePager
    lift $ lift $ if usePgr then do
        let pagerInfo = (shell "less") { std_in = CreatePipe }
        (Just h, _, _, pager) <- createProcess pagerInfo
        hPutStr h txt
        hFlush h
        hClose h
        void $ waitForProcess pager
    else
        putStr txt

catch :: Monad m => Maybe T m a -> Maybe T m a -> Maybe T m a
x `catch` handler = MaybeT $ do
    result <- runMaybeT x
    case result of
        Nothing -> runMaybeT handler
        r       -> return r

With this, we can bring our error message back when mkCfg fails to produce a Config:

display.hs (Edit)
main :: IO ()
main = void $ runMaybeT $ do
    cfg <- MaybeT (mkCfg <$> getArgs) `catch` do
        lift $ putStrLn "USAGE: display [-p] <file>"
        fail ""
    runReaderT realMain cfg

Our exception handler prints an error message when mkCfg fails to produce a configuration and then makes sure that the computation still fails by calling fail "".

If you try to compile this now, you'll get an error message that the compiler doesn't know which catch you mean. We have the catch function we defined ourselves, and there's a catch function for real exceptions defined in Control.Exception. Since we currently import all the functions defined in Control.Exeption, this leads to a name clash. To fix this, we need to hide the catch function imported from Control.Exception:

display.hs (Edit)
import Control.Exception hiding (catch)

We'll talk about defining modules and importing and exporting modules in the next chapter. With this final change, we have a working program again:

Shell
$ stack ghc -- display.hs
[1 of 1] Compiling Main             ( display.hs, display.o )
Linking display ...
$ ./display display.hs
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Exception hiding (catch)
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import System.Environment
import System.IO
import System.Process

data Config = Cfg
    { fileName :: String
    , usePager :: Bool
    }

main :: IO ()
main = void $ runMaybeT $ do
    cfg <- MaybeT (mkCfg <$> getArgs) `catch` do
        lift $ putStrLn "USAGE: display [-p] <file>"
        fail ""
    runReaderT realMain cfg

mkCfg :: [String] -> Maybe Config
mkCfg [fileName]       = Just $ Cfg fileName False
mkCfg ["-p", fileName] = Just $ Cfg fileName True
mkCfg _                = Nothing

type Prog = ReaderT Config (MaybeT IO)

realMain :: Prog ()
realMain = loadFile >>= display

loadFile :: Prog String
loadFile = do
    file <- asks fileName
    lift $ do
        txt  <- lift $ try $ readFile file
        case txt of
            Left (_ :: IOException) -> do
                lift $ putStrLn $ "ERROR: Unable to read file '" ++ file ++ "'!"
                fail ""
            Right t -> return t

display :: String -> Prog ()
display txt = do
    usePgr <- asks usePager
    lift $ lift $ if usePgr then do
        let pagerInfo = (shell "less") { std_in = CreatePipe }
        (Just h, _, _, pager) <- createProcess pagerInfo
        hPutStr h txt
        hFlush h
        hClose h
        void $ waitForProcess pager
    else
        putStr txt

catch :: Monad m => MaybeT m a -> MaybeT m a -> MaybeT m a
x `catch` handler = MaybeT $ do
    result <- runMaybeT x
    case result of
        Nothing -> runMaybeT handler
        r       -> return r