Как ленивость и исключения работают вместе в Haskell?

Вопрос аналогичен этому вопросу. Однако здесь речь идет об исключениях, а не о ленивом вводе-выводе.

Вот тест:

{-# 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строгую, также есть два теста 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и это пугает.

У меня два вопроса:

1. Можно ли быть уверенным, что функция catchвсегда перехватывает все исключения, независимо от природы ее первого аргумента?
2. Если нет, то есть ли известный способ решения подобных проблем? Что-то вроде функции catchStrictподойдет?

ОБНОВЛЕНИЕ 1.

Это улучшенная версия функции catchStrictот nanothief:

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всегда перехватит любое исключение. Так что нужно использовать его осторожно.

Несколько советов по решению связанных проблем:

1. Используйте ($!)с return, используйте forceMдля первого аргумента . ] catch, используйте функцию catchStrict.
2. Я также заметил, что иногда люди добавляют некоторую строгостьк экземплярам своих преобразователей.

Вот пример:

{-# 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