A small module that allows threads to return their result

Question

I have the following that works similar to forkIO, but returns a blocking "channel" that lets you receive the result of a forked IO computation. My main concern is its handling of exceptions. It will return Nothing if something is raised, but can't supply any more information then that.

I tried using try inside of wrapAction, which returns an (Either Exception a), but I couldn't figure out what exception type to use. I tried SomeException thinking it would catch everything, and supply a message, but it doesn't. Running a computation that divides by 0 resulted in Right being returned, but threw a "divide by 0" exception when I tried inspecting the result. Surely in a generic situation like this I can't specifically catch every possible exception (given a user could create their own). How should I set up the exception handling so that a Leftcan be returned with an exception message?

import Control.Concurrent
import Control.Exception

data RThread a = RThread (IO a) (MVar (Maybe a))

newReturn :: IO a -> IO (RThread a)
newReturn act = newEmptyMVar >>= return . RThread act

wrapAction :: RThread a -> IO ()
wrapAction (RThread act chan) = onException (act >>= putMVar chan . Just) (putMVar chan Nothing)

returnFork :: IO a -> IO (RThread a)
returnFork act = do
    nR <- newReturn act
    forkIO $ wrapAction nR
    return nR

waitForResult :: RThread a -> IO (Maybe a)
waitForResult (RThread _ chan) = takeMVar chan

Any critique would be appreciated

Simple usage:

import System.Random
import Control.Monad

testFn :: IO [Int]
testFn = returnFork (replicateM 100 $ randomRIO (1,100) >>=
    waitForResult

Although realistically you would pass the result of waitForResult somewhere else to wait.

Answer 1

What you are experiencing is a common problem that occurs with threads and lazy evaluation. What happens is that the thread creates only an unevaluated thunk, which is passed through RThread to the main thread, and evaluated only then, and the exception is thrown there. This is also a very good example why using exceptions in pure values is a bad idea (but of course if you're making a library like this you have to take this possibility into account).

The solution is to fully evaluate a value inside the try block, so that any exception that might occur is thrown there. For this we need a combination of two functions: evaluate and force. The former creates an IO action that forces the evaluation, the latter one performs deep evaluation (to a normal form, not just to a weak head normal form).

Also you might also want to separate the return value from the thread action. If you're not going to operate on thread actions, you can even omit them from the data type, as once you start an action, all you need is the MVar channel.

An updated solution could look like this:

import Control.Applicative
import Control.Concurrent
import Control.DeepSeq
import Control.Exception

newtype RValue a = RValue (MVar (Either SomeException a))

returnFork :: (NFData a) => IO a -> IO (RValue a)
returnFork act = do
    chan <- newEmptyMVar
    forkIO $ try (act >>= evaluate . force) >>= putMVar chan
    return $ RValue chan

waitForResult :: RValue a -> IO (Either SomeException a)
waitForResult (RValue chan) = takeMVar chan

main = returnFork (return $ Just (1 `div` 0 :: Int)) >>= waitForResult >>= print