Exception handling in GHC - ThrowCatch.hs (1/1)

[Ashley Yakeley]

In article <KEENLCALKCMDEPDMNCDOCENDEFAA.sarah@telergy.com>,
 "Sarah Thompson" <sarah@telergy.com> wrote:

> I've noticed some interesting behaviour:
> 
> Prelude Control.Exception> try (return (error "e"))
> Prelude Control.Exception> it
> Right *** Exception: e
> 
> It would appear that when the result of this function is evaluated, the
> exception fires during evaluation, after the try is out of scope. I suppose
> it makes some kind of twisted sense due to lazy evaluation going on, but it
> is certainly a gotcha.

You might be interested in this program to investigate what catches 
what. Your example corresponds to the line

    Control.Exception.catch MISSED return error

Here's is the full output:

>> CAUGHT return
>> CAUGHT return undefined
>> CAUGHT return Control.Exception.throw
>> CAUGHT return error
>> MISSED fail
>> MISSED error
>> MISSED Control.Exception.throw
>> MISSED ioError ErrorCall
>> MISSED ioError IOException
>> MISSED undefined
Prelude.catch MISSED return
Prelude.catch MISSED return undefined
Prelude.catch MISSED return Control.Exception.throw
Prelude.catch MISSED return error
Prelude.catch CAUGHT fail
Prelude.catch MISSED error
Prelude.catch MISSED Control.Exception.throw
Prelude.catch MISSED ioError ErrorCall
Prelude.catch CAUGHT ioError IOException
Prelude.catch MISSED undefined
Control.Exception.catch MISSED return
Control.Exception.catch MISSED return undefined
Control.Exception.catch MISSED return Control.Exception.throw
Control.Exception.catch MISSED return error
Control.Exception.catch CAUGHT fail
Control.Exception.catch CAUGHT error
Control.Exception.catch CAUGHT Control.Exception.throw
Control.Exception.catch CAUGHT ioError ErrorCall
Control.Exception.catch CAUGHT ioError IOException
Control.Exception.catch CAUGHT undefined
Control.Exception.finally CAUGHT return
Control.Exception.finally CAUGHT return undefined
Control.Exception.finally CAUGHT return Control.Exception.throw
Control.Exception.finally CAUGHT return error
Control.Exception.finally CAUGHT fail
Control.Exception.finally CAUGHT error
Control.Exception.finally CAUGHT Control.Exception.throw
Control.Exception.finally CAUGHT ioError ErrorCall
Control.Exception.finally CAUGHT ioError IOException
Control.Exception.finally CAUGHT undefined

-- 
Ashley Yakeley, Seattle WA
-- ghc ThrowCatch.hs -o ThrowCatch && ./ThrowCatch
module Main where
	{
	import qualified Control.Exception;
	import Data.IORef;
	import Prelude;

	safeCatch :: IO () -> IO ();
	safeCatch f = Control.Exception.catch f (\_ -> return ());

	type Thrower = IO Bool;

	type Catcher = IO Bool -> IO () -> IO ();

	checkCatch :: Catcher -> Thrower -> IO Bool;
	checkCatch catcher thrower = do
		{
		ref <- newIORef False;
		safeCatch (catcher thrower (writeIORef ref True));
		readIORef ref;
		};

	data Named a = MkNamed String a;

	checkNamedCatch :: Named Catcher -> Named Thrower -> IO ();
	checkNamedCatch (MkNamed cname catcher) (MkNamed tname thrower) = do
		{
		didCatch <- checkCatch catcher thrower;
		putStrLn (cname ++ (if didCatch then " CAUGHT " else " MISSED ") ++ tname);
		};

	checkNamedCatches :: [Named Catcher] -> [Named Thrower] -> IO ();
	checkNamedCatches [] _ = return ();
	checkNamedCatches _ [] = return ();
	checkNamedCatches [c] (t:tr) = do
		{
		checkNamedCatch c t;
		checkNamedCatches [c] tr;
		};
	checkNamedCatches (c:cr) ts = do
		{
		checkNamedCatches [c] ts;
		checkNamedCatches cr ts
		};


	-- throwers

	returnThrower :: Named Thrower;
	returnThrower = MkNamed "return" (return True);

	returnUndefinedThrower :: Named Thrower;
	returnUndefinedThrower = MkNamed "return undefined" (return undefined);

	returnErrorThrower :: Named Thrower;
	returnErrorThrower = MkNamed "return error" (return (error "some error"));

	undefinedThrower :: Named Thrower;
	undefinedThrower = MkNamed "undefined" undefined;

	failThrower :: Named Thrower;
	failThrower = MkNamed "fail" (fail "some failure");

	errorThrower :: Named Thrower;
	errorThrower = MkNamed "error" (error "some error");

	throwThrower :: Named Thrower;
	throwThrower = MkNamed "Control.Exception.throw"
	 (Control.Exception.throw (Control.Exception.ErrorCall "throw error"));

	ioErrorErrorCallThrower :: Named Thrower;
	ioErrorErrorCallThrower = MkNamed "ioError ErrorCall"
	 (ioError (Control.Exception.ErrorCall "throw error"));

	ioErrorIOExceptionThrower :: Named Thrower;
	ioErrorIOExceptionThrower = MkNamed "ioError IOException"
	 (ioError (Control.Exception.IOException undefined));

	returnThrowThrower :: Named Thrower;
	returnThrowThrower = MkNamed "return Control.Exception.throw"
	 (return (Control.Exception.throw (Control.Exception.ErrorCall "throw error")));


	-- catchers

	bindCatcher :: Named Catcher;
	bindCatcher = MkNamed ">>" (>>);

	preludeCatchCatcher :: Named Catcher;
	preludeCatchCatcher = MkNamed "Prelude.catch"
	 (\f cc -> Prelude.catch (f >> (return ())) (const cc));

	ceCatchCatcher :: Named Catcher;
	ceCatchCatcher = MkNamed "Control.Exception.catch"
	 (\f cc -> Control.Exception.catch (f >> (return ())) (const cc));

	finallyCatcher :: Named Catcher;
	finallyCatcher = MkNamed "Control.Exception.finally"
	 (\f cc -> Control.Exception.finally (f >> (return ())) cc);

	main = checkNamedCatches
		[bindCatcher,preludeCatchCatcher,ceCatchCatcher,finallyCatcher]
		[returnThrower,returnUndefinedThrower,returnThrowThrower,returnErrorThrower,failThrower,
		errorThrower,throwThrower,ioErrorErrorCallThrower,ioErrorIOExceptionThrower,undefinedThrower];

	}