Question

在Haskell中做一些TTD时，我最近开发了以下功能：

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) [...]

该函数采用Type表示预期异常和IO操作。问题是，大部分时间我都没有抛出异常，即使我本来应该抛弃，因为懒惰。通常，fun的失败部分通常不会在这里进行评估。

要解决此问题，我尝试将(fun >> assertFailure msg)替换为(seq fun $ assertFailure msg)。我还尝试启用BangPatterns扩展并在fun绑定之前发出爆炸声，但没有一个帮助。那么我怎样才能真正强迫Haskell严格评估fun？

Answer 1

您必须区分：

评估类型IO a
运行由其表示的操作，可能有副作用并返回a类型的值，
评估类型a（或部分内容）的结果。

这些总是按顺序发生，但不一定全部发生。代码

foo1 :: IO a -> IO ()
foo1 f = do
   seq f (putStrLn "done")

只会执行第一次，而

foo2 :: IO a -> IO ()
foo2 f = do
   f -- equivalent to _ <- f
   putStrLn "done"

也做了第二次，最后

foo3 :: IO a -> IO ()
foo3 f = do
   x <- f 
   seq x $ putStrLn "done"

也是第三个（但在列表等复杂数据类型上使用seq的常见注意事项）。

尝试这些参数并观察foo1，foo2和foo3对它们的区别对待。

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

您可能需要将值强制为其正常形式，而不仅仅是其弱头正常形式。例如，评估Just (error "foo")到WHNF不会触发异常，它只会评估Just。我会使用evaluate（允许使用IO操作正确排序强制评估）和rnf（或force的组合，如果您需要某些值的值）：

assertException :: (Show a) => TypeRep -> IO a -> Assertion
assertException errType fun =
    catch (fun >>= evaluate . rnf >> assertFailure msg) handle
  where ...

但是，请注意，assertFailure is implemented使用异常，因此包装到catch块也可能会捕获它。所以我建议使用try评估计算，并在assertFailure块之外调用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

在Haskell中强制执行

2 个答案: