強制執行嚴格哈斯克爾

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

該函數預期異常和IO動作的類型的代表。問題是，大部分時間我都沒有得到拋出的異常，即使我應該這樣做，因爲懶惰。通常fun的失敗部分實際上從來沒有在這裏評估過。

爲了彌補這一點，我試圖用(seq fun $ assertFailure msg)替換(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 ... 

但是，要小心，因爲assertFailureis 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