How do I combine IOError exceptions with locally relevant exceptions?

Question

I am building a Haskell application and trying to figure out how I am going to build the error handling mechanism. In the real application, I'm doing a bunch of work with Mongo. But, for this, I'm going to simplify by working with basic IO operations on a file.

So, for this test application, I want to read in a file and verify that it contains a proper fibonnacci sequence, with each value separated by a space:

1 1 2 3 5 8 13 21

Now, when reading the file, any number of things could actually be wrong, and I am going to call all of those exceptions in the Haskell usage of the word.

data FibException = FileUnreadable IOError
                  | FormatError String String
                  | InvalidValue Integer
                  | Unknown String

instance Error FibException where
    noMsg = Unknown "No error message"
    strMsg = Unknown

Writing a pure function that verifies the sequence and throws an error in the case that the sequence is invalid is easy (though I could probably do better):

verifySequence :: String -> (Integer, Integer) -> Either FibException ()
verifySequence "" (prev1, prev2) = return ()
verifySequence s (prev1, prev2) =
    let readInt = reads :: ReadS Integer
        res = readInt s in
    case res of
        [] -> throwError $ FormatError s
        (val, rest):[] -> case (prev1, prev2, val) of
            (0, 0, 1) -> verifySequence rest (0, 1)
            (p1, p2, val') -> (if p1 + p2 /= val'
                then throwError $ InvalidValue val'
                else verifySequence rest (p2, val))
            _ -> throwError $ InvalidValue val

After that, I want the function that reads the file and verifies the sequence:

type FibIOMonad = ErrorT FibException IO

verifyFibFile :: FilePath -> FibIOMonad ()
verifyFibFile path = do
    sequenceStr <- liftIO $ readFile path
    case (verifySequence sequenceStr (0, 0)) of
        Right res -> return res
        Left err -> throwError err

This function does exactly what I want if the file is in the invalid format (it returns Left (FormatError "something")) or if the file has a number out of sequence (Left (InvalidValue 15)). But it throws an error if the file specified does not exist.

How do I catch the IO errors that readFile may produce so that I can transform them into the FileUnreadable error?

As a side question, is this even the best way to do it? I see the advantage that the caller of verifyFibFile does not have to set up two different exception handling mechanisms and can instead catch just one exception type.

Answer 1

@Savanni D'Gerinel: you are on the right track. Let's extract your error-catching code from verifyFibFile to make it more generic, and modify it slightly so that it works directly in ErrorT:

catchError' :: ErrorT e IO a -> (IOError -> ErrorT e IO a) -> ErrorT e IO a
catchError' m f =
    ErrorT $ catchError (runErrorT m) (fmap runErrorT f)

verifyFibFile can now be written as:

verifyFibFile' :: FilePath -> FibIOMonad ()
verifyFibFile' path = do
    sequenceStr <- catchError' (liftIO $ readFile path) (throwError . FileUnReadable)
    ErrorT . return $ verifySequence sequenceStr' (0, 0) 

Notice what we have done in catchError'. We have stripped the ErrorT constructor from the ErrorT e IO a action, and also from the return value of the error-handling function, knowing than we can reconstruct them afterwards by wrapping the result of the control operation in ErrorT again.

Turns out that this is a common pattern, and it can be done with monad transformers other than ErrorT. It can get tricky though (how to do this with ReaderT for example?). Luckily, the monad-control packgage already provides this functionality for many common transformers.

The type signatures in monad-control can seem scary at first. Start by looking at just one function: control. It has the type:

control :: MonadBaseControl b m => (RunInBase m b -> b (StM m a)) -> m a

Let's make it more specific by making b be IO:

control :: MonadBaseControl IO m => (RunInBase m IO -> IO (StM m a)) -> m a

m is a monad stack built on top of IO. In your case, it would be ErrorT IO.

RunInBase m IO is a type alias for a magical function, that takes a value of type m a and returns a value of type IO *something*, something being some complex magic that encodes the state of the whole monad stack inside IO and lets you reconstruct the m a value afterwards, once you have "fooled" the control operation that only accepts IO values. control provides you with that function, and also handles the reconstruction for you.

Applying this to your problem, we rewrite verifyFibFile once more as:

import Control.Monad.Trans.Control (control)
import Control.Exception (catch)


verifyFibFile'' :: FilePath -> FibIOMonad ()
verifyFibFile'' path = do
    sequenceStr <- control $ \run -> catch (run . liftIO $ readFile path) 
                                           (run . throwError . FileUnreadable)     
    ErrorT . return $ verifySequence sequenceStr' (0, 0) 

Keep in mind that this only works when the proper instance of MonadBaseControl b m exists.

Here is a nice introduction to monad-control.

Answer 2

You might consider EitherT and the errors package in general. http://hackage.haskell.org/packages/archive/errors/1.3.1/doc/html/Control-Error-Util.html has a utility tryIO for catching IOError in EitherT and you could use fmapLT to map error values to your custom type.

Specifically:

type FibIOMonad = EitherT FibException IO

verifyFibFile :: FilePath -> FibIOMonad ()
verifyFibFile path = do
    sequenceStr <- fmapLT FileUnreadable (tryIO $ readFile path)
    hoistEither $ verifySequence sequenceStr (0, 0)

Answer 3

So, here's an answer that I have developed. It centers around getting readFile wrapped into the proper catchError statement, and then lifted.

verifyFibFile :: FilePath -> FibIOMonad ()
verifyFibFile path = do
    contents <- liftIO $ catchError (readFile path >>= return . Right) (return . Left . FileUnreadable)
    case contents of
        Right sequenceStr' -> case (verifySequence sequenceStr' (0, 0)) of
            Right res -> return res
            Left err -> throwError err
        Left err -> throwError err

So, verifyFibFile gets a little more nested in this solution.

readFile path has type IO String, obviously. In this context, the type for catchError will be:

catchError :: IO String -> (IOError -> IO String) -> IO String

So, my strategy was to catch the error and turn it into the left side of an Either, and turn the successful value into the right side, changing my data type to this:

catchError :: IO (Either FibException String) -> (IOError -> IO (Either FibException String)) -> IO (Either FibException String)

I do this by, in the first parameter, simply wrapping the result into Right. I figure that I won't actually execute the return . Right branch of the code unless readFile path was successful. In the other parameter to catch, I start with an IOError, wrap it in Left, and then return it back into the IO context. After that, no matter what the result is, I lift the IO value up into the FibIOMonad context.

I'm bothered by the fact that the code gets even more nested. I have Left values, and all of those Left values get thrown. I'm basically in an Either context, and I had thought that one of the benefits Either's implementation of the Monad class was that Left values would simply be passed along through the binding operations and that no further code in that context would be executed. I would love some elucidation on this, or to see how the nesting can be removed from this function.

Maybe it can't. It does seem that the caller, however, can call verifyFibFile repeatedly and execution basically stops the first time verifyFibFile returns an error. This works:

runTest = do
    res <- verifyFibFile "goodfib.txt"
    liftIO $ putStrLn "goodfib.txt"
    --liftIO $ printResult "goodfib.txt" res

    res <- verifyFibFile "invalidValue.txt"
    liftIO $ putStrLn "invalidValue.txt"

    res <- verifyFibFile "formatError.txt"
    liftIO $ putStrLn "formatError.txt"

Main> runErrorT $ runTest
goodfib.txt
Left (InvalidValue 17)

Given the files that I have created, both invalidValue.txt and formatError.txt cause errors, but this function returns Left (InvalidValue ...) for me.

That's okay, but I still feel like I've missed something with my solution. And I have no idea whether I'll be able to translate this into something that makes MongoDB access more robust.