質問はこの質問に似ています。ただし、これは例外に関するものであり、遅延I/Oに関するものではありません。
これがテストです：
{-# LANGUAGE ScopedTypeVariables #-}
import Prelude hiding ( catch )
import Control.Exception
fooLazy :: Int -> IO Int
fooLazy m = return $ 1 `div` m
fooStrict :: Int -> IO Int
fooStrict m = return $! 1 `div` m
test :: (Int -> IO Int) -> IO ()
test f = print =<< f 0 `catch` \(_ :: SomeException) -> return 42
testLazy :: Int -> IO Int
testLazy m = (return $ 1 `div` m) `catch` \(_ :: SomeException) -> return 42
testStrict :: Int -> IO Int
testStrict m = (return $! 1 `div` m) `catch` \(_ :: SomeException) -> return 42
そこでfooLazy、怠惰でfooStrict厳密な2つの関数を作成しました。また、2つのテストがtestLazyありtestStrict、ゼロ除算をキャッチしようとします。
> test fooLazy
*** Exception: divide by zero
> test fooStrict
42
> testLazy 0
*** Exception: divide by zero
> testStrict 0
42
怠惰な場合は失敗します。
最初に頭に浮かぶのはcatch、最初の引数で評価を強制する関数のバージョンを作成することです。
{-# LANGUAGE ScopedTypeVariables #-}
import Prelude hiding ( catch )
import Control.DeepSeq
import Control.Exception
import System.IO.Unsafe
fooLazy :: Int -> IO Int
fooLazy m = return $ 1 `div` m
fooStrict :: Int -> IO Int
fooStrict m = return $! 1 `div` m
instance NFData a => NFData (IO a) where
rnf = rnf . unsafePerformIO
catchStrict :: (Exception e, NFData a) => IO a -> (e -> IO a) -> IO a
catchStrict = catch . force
test :: (Int -> IO Int) -> IO ()
test f = print =<< f 0 `catchStrict` \(_ :: SomeException) -> return 42
testLazy :: Int -> IO Int
testLazy m = (return $ 1 `div` m) `catchStrict` \(_ :: SomeException) -> return 42
testStrict :: Int -> IO Int
testStrict m = (return $! 1 `div` m) `catchStrict` \(_ :: SomeException) -> return 42
それはうまくいくようです：
> test fooLazy
42
> test fooStrict
42
> testLazy 0
42
> testStrict 0
42
unsafePerformIOでもここで関数を使っているので怖いです。
2つの質問があります：
catch最初の引数の性質に関係なく、関数が常にすべての例外をキャッチすることを確認できますか？- そうでない場合、この種の問題に対処するためのよく知られた方法はありますか？関数のようなもの
catchStrictが適していますか？
更新1。
これは、nanothiefcatchStrictによる関数のより良いバージョンです：
forceM :: (Monad m, NFData a) => m a -> m a
forceM m = m >>= (return $!) . force
catchStrict :: (Exception e, NFData a) => IO a -> (e -> IO a) -> IO a
catchStrict expr = (forceM expr `catch`)
更新2。
別の「悪い」例を次に示します。
main :: IO ()
main = do
args <- getArgs
res <- return ((+ 1) $ read $ head args) `catch` \(_ :: SomeException) -> return 0
print res
次のように書き直す必要があります。
main :: IO ()
main = do
args <- getArgs
print ((+ 1) $ read $ head args) `catch` \(_ :: SomeException) -> print 0
-- or
--
-- res <- return ((+ 1) $ read $ head args) `catchStrict` \(_ :: SomeException) -> return 0
-- print res
--
-- or
--
-- res <- returnStrcit ((+ 1) $ read $ head args) `catch` \(_ :: SomeException) -> return 0
-- print res
--
-- where
returnStrict :: Monad m => a -> m a
returnStrict = (return $!)
更新3。
nanothiefが気付いたように、catch関数が常に例外をキャッチするという保証はありません。したがって、慎重に使用する必要があります。
関連する問題を解決する方法に関するいくつかのヒント：
- で使用
($!)しreturn、forceMの最初の引数でcatch使用し、catchStrict関数を使用します。 - また、トランスフォーマーのインスタンスに厳密さを加えることがあることにも気づきました。
次に例を示します。
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances
, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables #-}
import System.Environment
import Prelude hiding ( IO )
import qualified Prelude as P ( IO )
import qualified Control.Exception as E
import Data.Foldable
import Data.Traversable
import Control.Applicative
import Control.Monad.Trans
import Control.Monad.Error
newtype StrictT m a = StrictT { runStrictT :: m a } deriving
( Foldable, Traversable, Functor, Applicative, Alternative, MonadPlus, MonadFix
, MonadIO
)
instance Monad m => Monad (StrictT m) where
return = StrictT . (return $!)
m >>= k = StrictT $ runStrictT m >>= runStrictT . k
fail = StrictT . fail
instance MonadTrans StrictT where
lift = StrictT
type IO = StrictT P.IO
instance E.Exception e => MonadError e IO where
throwError = StrictT . E.throwIO
catchError m h = StrictT $ runStrictT m `E.catch` (runStrictT . h)
io :: StrictT P.IO a -> P.IO a
io = runStrictT
これは本質的にアイデンティティモナド変換子ですが、厳密にreturn：
foo :: Int -> IO Int
foo m = return $ 1 `div` m
fooReadLn :: Int -> IO Int
fooReadLn x = liftM (`div` x) $ liftIO readLn
test :: (Int -> IO Int) -> P.IO ()
test f = io $ liftIO . print =<< f 0 `catchError` \(_ :: E.SomeException) -> return 42
main :: P.IO ()
main = io $ do
args <- liftIO getArgs
res <- return ((+ 1) $ read $ head args) `catchError` \(_ :: E.SomeException) -> return 0
liftIO $ print res
-- > test foo
-- 42
-- > test fooReadLn
-- 1
-- 42
-- ./main
-- 0