Enforcing strictness in Haskell - haskell

Question

While doing some TTD in Haskell, I recently developed the following function:
import Test.HUnit
import Data.Typeable
import Control.Exception
assertException :: (Show a) => TypeRep -> IO a -> Assertion
assertException errType fun = catch (fun >> assertFailure msg) handle
where
msg = show errType ++ " exception was not raised!"
handle (SomeException e) [...]
The function takes a Type representation of an expected exception and an IO action. The problem is that most of the time I don't get the exception thrown even though I should have been, because of laziness. Often failing parts of fun are actually never evaluated here.
To remedy this i tried to replace (fun >> assertFailure msg) with (seq fun $ assertFailure msg). I also tried to enable BangPatterns extension and put a bang before fun binding, but none of it helped. So how can I really force Haskell to evaluate fun strictly?

Answer 1

You have to distinguish between:
Evaluating the value of type IO a
Running the action represented by it, which may have side effects and returns a value of type a, and
Evaluating the result of type a (or parts of it).
These always happen in that order, but not necessarily all of it. The code
foo1 :: IO a -> IO ()
foo1 f = do
seq f (putStrLn "done")
will do only the first, while
foo2 :: IO a -> IO ()
foo2 f = do
f -- equivalent to _ <- f
putStrLn "done"
also does the second and finally
foo3 :: IO a -> IO ()
foo3 f = do
x <- f
seq x $ putStrLn "done"
also does the third (but the usual caveats of using seq on a complex data type like lists apply).
Try these arguments and observe that foo1, foo2 and foo3 treat them differently.
f1 = error "I am not a value"
f2 = fix id -- neither am I
f3 = do {putStrLn "Something is printed"; return 42}
f4 = do {putStrLn "Something is printed"; return (error "x has been evaluated")}
f5 = do {putStrLn "Something is printed"; return (Just (error "x has been deeply evaluated"))}

Answer 2

You probably need to force the value to its normal form, not just its weak head normal form. For example, evaluating Just (error "foo") to WHNF won't trigger the exception, it'll just evaluate Just. I'd use the combination of evaluate (which allows to properly sequence forced evaluation with IO actions) and rnf (or force if you'd need the value for something):
assertException :: (Show a) => TypeRep -> IO a -> Assertion
assertException errType fun =
catch (fun >>= evaluate . rnf >> assertFailure msg) handle
where ...
However, be careful, as assertFailure is implemented using exceptions, so wrapping into the catch block might catch it as well. So I'd suggest to evaluate the computation using try and call assertFailure outside the try block:
import Test.HUnit
import Data.Typeable
import Control.DeepSeq
import Control.Exception
assertException :: (NFData a, Show a) => TypeRep -> IO a -> Assertion
assertException errType fun =
(try (fun >>= evaluate . rnf) :: IO (Either SomeException ())) >>= check
where
check (Right _) =
assertFailure $ show errType ++ " exception was not raised!"
check (Left (SomeException ex))
| typeOf ex == errType = return () -- the expected exception
| otherwise = assertFailure
$ show ex ++ " is not " ++ show errType