Enforcing strictness in Haskell
While doing some TTDs 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 representation of the type of the expected exception and an IO action. The problem is that most of the time I don't get the exception, even though I should have been out of laziness. The often missing parts fun
are never actually graded here.
To fix this, I tried replacing (fun >> assertFailure msg)
with (seq fun $ assertFailure msg)
. I also tried to enable the BangPatterns extension and put the binding before binding fun
, but none of them helped. So how can I get Haskell to evaluate strictly fun
?
source to share
You must distinguish between:
- Type value evaluation
IO a
- Performing the action it presents, which may have side effects and return a value of type
a
, and - Evaluating the result of a type
a
(or parts of it).
It always happens in that order, but not all of it. Code
foo1 :: IO a -> IO ()
foo1 f = do
seq f (putStrLn "done")
will only do the first, but
foo2 :: IO a -> IO ()
foo2 f = do
f -- equivalent to _ <- f
putStrLn "done"
also performs the second and finally
foo3 :: IO a -> IO ()
foo3 f = do
x <- f
seq x $ putStrLn "done"
also the third one (but the usual caveats on seq
complex data types like lists apply).
Try these arguments and note that foo1
, foo2
and foo3
handle 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"))}
source to share
You probably need to force the value into its normal form, not just its faint head normal form. For example, evaluating Just (error "foo")
in WHNF will not throw an exception, it will just evaluate Just
. I would use a combination of evaluate
(which allows for proper ordering of the forced score with actions IO
) and rnf
(or force
if you need a 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 it is assertFailure
implemented using exceptions, so it can also be wrapped in a block catch
. So I suggest evaluating the computation with try
and calling assertFailure
outside the block try
:
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
source to share