An Example

Let's get a little adventurous here. We want to implement a little program display. display foo.txt simply displays the contents of foo.txt on the screen. If we call display -p foo.txt, then display uses a pager so we can scroll through the pages and pages of text in foo.txt.

We'll use this to illustrate the use of the ReaderT monad. In particular, we want to equip our program, which uses the IO monad to read the given file and print it on screen, with a configuration that we thread through the entire program. Let's build this up slowly.

First, we need a config type to represent the program configuration. This configuration stores which file we want to display and whether we want to use a pager:

display.hs

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

To thread this configuration through most of our program, we use the ReaderT Config monad transformer. Since most of our program needs to perform IO, we need IO as the underlying monad. So the monad type we need to implement our program is ReaderT Config IO. That's a mouthful. We better introduce a type alias to declutter our type signatures:

display.hs (Edit)

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

type Prog = ReaderT Config IO

The entry point of our program is main :: IO ():

display.hs (Edit)

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 = undefined

type Prog = ReaderT Config IO

realMain :: Prog ()
realMain = undefined

Our main function reads the command line arguments using getArgs and then converts them into a configuration using a helper function mkCfg. This may fail if the command line arguments aren't what we expect. We only accept a single file name or the flag -p to use a pager and a file name. Thus, the return type of mkCfg is Maybe Cfg. It returns Nothing if we provided the wrong command line arguments. If mkCfg returns Nothing, then we print an error message telling the user what the command line arguments should be and exit. Otherwise, we call the function realMain, which implements the business logic of our program. It uses the Prog monad so we can make its behaviour depend on the configuration options represented by our Config type. We use runRaderT to run this program using the configuration generated by mkCfg.

The getArgs function is provided by the System.Environment module. putStrLn is provided by the System.IO module. ReaderT and runReaderT are defined in the Control.Monad.Trans.Reader module. To make our code compile, we better import these modules:

display.hs (Edit)

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

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

At this point, mkCfg and realMain are just stubs. These are the two functions we need to implement next. First mkCfg, because it's easy:

display.hs (Edit)

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

If we're given a single command line argument, we expect it to be the file name. In this case, there is no option to use the pager. Thus, our configuration becomes Cfg fileName False. If we're given two command line arguments and the first one is -p, then we are expected to use a pager. The second command line argument is the file name to display. So our configuration becomes Cfg fileName True. Any other set of command line arguments is invalid, either because there are the wrong number of arguments or because we are given two arguments and the first argument isn't -p.

Now realMain. We split it into two parts: loading the file to be displayed and displaying it:

display.hs (Edit)

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

loadFile :: Prog (Maybe String)
loadFile = undefined

display :: String -> Prog ()
display txt = undefined

loadFile takes care of loading the file. If this succeeds, the result is Just the contents of the file. If it fails, for example because the file does not exist, then loadFile returns Nothing. If the result is Nothing, realMain simply exits. Otherwise, it calls display on the contents t of the file. display takes care of displaying the given string.

Now the type signature of loadFile looks a little funny. It doesn't take any arguments. How does it know which file to load? Our configuration of course. The first thing that loadFile does is to ask the configuration for the file name, and then it does what it needs to do to read this file:

display.hs (Edit)

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

Let's unpack this. The first line uses asks fileName to retrieve only the fileName component of our Config. Then it uses readFile file to read this file, only the line isn't txt <- readFile file but txt <- lift $ try $ readFile file. Why is that?

Let's pretend for a second that our monad isn't Prog (a.k.a. ReaderT Config IO) but just IO. In this case, txt <- readFile file would work perfectly fine ... until the file we're trying to read doesn't exist or maybe we don't have the permissions to read it. Any error trying to read the file causes readFile to throw an exception, which makes our program abort unless we catch the exception. This isn't just an exception a la Maybe or Either e. This is a real exception thrown by the Haskell runtime system. Haskell offers us many ways to catch such exceptions. The one I opted for here is to use

try :: Exception e => IO a -> IO (Either e a)

If f is an action of type IO a that may throw some exception of type e, then try f catches exceptions of type e. If f does not throw any exception, the result is whatever f returns, wrapped in Right. If f throws an exception, the result is this exception, wrapped in Left. Our case statement that follows our attempt to read the given file deals with these two possible outcomes. So that explains why we have try $ readFile file instead of simply readFile file. Now lift.

Our function loadFile uses the Prog monad. This means that all statements in the do-block we use to implement loadFile must also have return values decorated using Prog. However, try $ readFile file has the type IO (Either IOError String). We want Prog (Either IOError String), a different type. If f has the type IO a, then lift f has the type Prog a. More generally, If f has the type m a and t is a monad transformer that we apply to m as its underlying monad, then lift f has the type t m a. It lifts an action from the underlying monad into the wrapping monad. lift doesn't really do anything. You should think about it as a wrinkle that is necessary to keep the type checker happy, because for a monad transformer t, m a and t m a are different types.

The case expression would make perfect sense if it were

    case txt of
        Left _ -> do
            lift $ putStrLn $ "ERROR: Unable to read file '" ++ file ++ "'!"
            return Nothing
        Right t -> return $ Just t

This says that if reading the file failed, that is, if the result of lift $ try $ readFile file is Left e, we don't really care what the error was. We simply print an error message and then return Nothing. Printing the error message uses putStrLn, an action in the IO monad. So we have to lift it into the Prog monad using lift again. If reading the file succeeded, the result is Right t, where t is the string storing the contents of the file. In this case, we return Just t.

Unfortunately, this definition doesn't quite work. And the culprit is actually the application of try when trying to read the file. Here's the problem. There are many types of exceptions that a function can throw. This is a little like the exception hierarchy in Java or C++. We have to tell try which types of exceptions we want to catch. Otherwise, it doesn't know which exceptions to catch and which ones to pass along. If the Left branch of our case expression did something with the thrown exception, there would be a good chance that GHC's type inference would be able to figure out what type of exceptions we want to catch here. But we explicitly ignore the exception value by using a wildcard. So GHC has no clue what type of exception to catch. To fix this, we specify that the exception value we don't care about should have type IOException, using an explicit type signature.

Now this creates another wrinkle. These types of local type signatures aren't allowed in standard Haskell. To make this valid Haskell code, we need to enable the ScopedTypeVariables language extension in GHC:

display.hs (Edit)

{-# LANGUAGE ScopedTypeVariables #-}

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

try is provided by the Control.Exception module. And lift is provided by the Control.Monad.Trans module. Thus, to make our code compile, we need to add them to our list of imports:

display.hs (Edit)

{-# LANGUAGE ScopedTypeVariables #-}

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

Now the last part:

display.hs (Edit)

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

display txt starts by asking the config whether to use a pager. If not, then we simply call putStr txt to print the entire string on screen. If we are expected to use a pager, things become a bit more complex. We could try to implement our own pager, but writing a robust pager that works for any possible type of terminal is non-trivial. Better to piggyback on the work of the good people who implemented less. What we do is to start a subprocess that runs less. We create a pipe to send text to be displayed to the standard input of less. We write the whole file contents to this pipe and then wait for less to finish before returning.

I won't discuss this in great detail. Here's the quick rundown. shell "less" constructs a process configuration that starts the program less in a shell, without any command line arguments. A process created using this configuration launches a new shell and then runs less within this shell. By default, this process has the same stdin, stdout, and stderr as our current process. That's not what we want. We want the stdin of less to be connected to a pipe that we can write to to send text to less. We achieve this by setting the std_in component of the process configuration returned by shell "less" to CreatePipe. None of this creates any subprocesses yet. It only constructs a data structure that createProcess uses to actually create the process. So that's what we do next. We call createProcess pagerInfo to create our subprocess running less. createProcess returns a tuple with four components: the stdin of the created process, the stdout of the created process, the stderr of the created process, and a process ID for this process. For technical reasons, the first three components are wrapped in Maybe. When launching the process using std_in = CreatePipe, the first component of the tuple will always be Just a file handle for the created pipe. So the pattern match against Just h cannot fail here. Next we use hPutStr h txt to write the text to be displayed to the pipe h, that is, to the stdin of less. Since Haskell's I/O buffers just as the I/O systems of many other languages, hPutStr h txt by itself doesn't do anything. We need to flush the I/O buffer by calling hFlush h. That forces all of the text to be sent to less. This done, we can close our end of the pipe using hClose h, to tell less that no more text is coming. Finally, we wait for less to exit. If we don't, then display returns right away and our program exits shortly after. less being a subprocess of our program, this kills less. What we want is for the user to interact with less as usual, so we need to wait until the user exits less. The return type of waitForProcess is the exit code of the subprocess we're waiting for. The return type of display is (). Thus, we have a type mismatch. To rectify this, we wrap waitForProcess pager in void, which discards the return value of waitForProcess pager and simply returns ().

Again, we need some more imports to make all this compile. The functions to manipulate subprocesses are part of the System.Process module. void is part of the Control.Monad module:

display.hs (Edit)

{-# 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

If you followed all this, then congratulations. Here is the whole program we have developed:

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

Let's compile it and try it out:

Shell

$ stack ghc -- display.hs
[1 of 1] Compiling Main             ( display.hs, display.o )
Linking display ...
$ ./display 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
            liftIO $ 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

The effect of running display -p display.hs is a little hard to visualize in static text. Try it out yourself to verify that the program fires up a pager as expected.