ekmett / exceptions

mtl friendly exceptions
Other
49 stars 32 forks source link

MonadCatch instance for ContT #85

Open Mathnerd314 opened 2 years ago

Mathnerd314 commented 2 years ago

The comment says

-- I don't believe any valid of MonadCatch exists for ContT.

Well, what about this?

instance MonadCatch m => MonadCatch (ContT r m) where
  catch a handler = ContT $ \c ->
    runContT a c `catch` \e -> runContT (handler e) c

> runContT (catch (throwM (TestException "foo") >> error "test" :: ContT r IO a) (\(e :: TestException) -> (lift $ putStrLn "handler") >> (lift $ print e))) (const $ return ())
handler
TestException "foo"

I think I can also write mask:

instance MonadMask m => MonadMask (ContT r m) where
  mask f = ContT $ \c ->
    mask $ \restore ->
      runContT (f (q restore)) c
    where
      q :: (forall a. m a -> m a) -> ContT r m a -> ContT r m a
      q r x = ContT $ \c -> r $ runContT x c

  uninterruptibleMask f = ContT $ \c ->
    uninterruptibleMask $ \restore ->
      runContT (f (q restore)) c
    where
      q :: (forall a. m a -> m a) -> ContT r m a -> ContT r m a
      q r x = ContT $ \c -> r $ runContT x c

These are useful in combination with resetT to limit the scope of the mask/catch.

generalBracket seems elusive, however. I guess the IO implementation in terms of mask and catch could be used.

RyanGlScott commented 2 years ago

ContT is deliberately not given a MonadCatch instance because in general, it is not possible to know how many times the continuation inside of a ContT is called. It could be called once, never, or multiple times. In the latter two scenarios, trying to catch an exception leads to extremely unusual behavior. For example, here is an example of the kinds of disaster that can occur when catching an exception in a ContT computation that runs its continuation multiple times:

{-# LANGUAGE RankNTypes #-}
module Bug where

import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Trans.Cont

instance MonadCatch m => MonadCatch (ContT r m) where
  catch a handler = ContT $ \c ->
    runContT a c `catch` \e -> runContT (handler e) c

bracket_' :: MonadCatch m
          => m a  -- ^ computation to run first (\"acquire resource\")
          -> m b  -- ^ computation to run last when successful (\"release resource\")
          -> m b  -- ^ computation to run last when an exception occurs
          -> m c  -- ^ computation to run in-between
          -> m c  -- returns the value from the in-between computation
bracket_' before after afterEx thing = do
   _ <- before
   r <- thing `onException` afterEx
   _ <- after
   return r

f :: ContT (Either String String) IO String
f = do
     bracket_' (say "acquired") (say "released-successful") (say "released-exception") (say "executed")
     say "Hello!"
     () <- error "error"
     return "success"
   where
     say = liftIO . putStrLn

main :: IO ()
main = flip runContT (return . Right) f >>= print

When run, this will output:

acquired
executed
released-successful
Hello!
released-exception
*** Exception: error
CallStack (from HasCallStack):
  error, called at Bug.hs:28:12 in fake-package-0-inplace:Bug

Notice that the exception handler is run twice, once after a successful computation within bracket_', and once again for error, even though the call to error doesn't occur within a bracket_' at all! This is a consequence of the MonadCatch instance proposed for ContT, which runs its continuation twice. There are similar problems that would arise if ContT were given a MonadMask instance.

The comment could be expanded to make this point clearer, I think, but we don't provide such instances for good reasons.

Mathnerd314 commented 2 years ago

My point is that with resetT this multiple running is not an issue.

f :: ContT () IO String
f = do
     resetT $ bracket_' (say "acquired") (say "released-successful") (say "released-exception") (say "executed")
     say "Hello!"
     () <- error "error"
     return "success"
   where
     say = liftIO . putStrLn

main = runContT f print

outputs

acquired
executed
released-successful
Hello!
*** Exception: error
CallStack (from HasCallStack):
  error, called at Exception.hs:48:12 in main:Main

as desired.

resetT cannot be part of the MonadCatch / MonadMask implementation though due to the types. Although it is hard to think of a use for catch not guarded with resetT, there is probably some advanced control construct where it would be handy.