Keeping track of which exceptions have and haven't been handled

EIO.hs

-- a continuation of https://gist.github.com/gelisam/137effb33d2777328d366dcb563d8d13
{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses #-}
module EIO where

import Control.Monad
import Data.Void
import Test.DocTest
import qualified Control.Exception as E


-- In my previous gist, I used the 'Either' monad to propagate errors, and I used typeclasses to
-- grow and shrink the set of errors have and haven't been handled. The original "The trouble with
-- Typed Errors" article also used 'Either' for most of its examples, and then ended mentioning that
-- it would be better to use a bifunctor IO type like @newtype BIO err a = BIO (IO a)@ which throws
-- and catches exceptions instead of 'Left's.
--
-- This gist implements such an API, but I call it @EIO@ instead, because I think the important part
-- is that this is a version of IO which tracks errors, not the fact that this is a version of IO
-- which has a Bifunctor instance. In fact, my version does not have a bifunctor instance, because
-- the way to change the first type parameter is not by fmapping it using a pure function, but by
-- throwing and catching exceptions.

newtype EIO e a = UnsafeEIO { unsafeRunEIO :: IO a }
  deriving (Functor, Applicative, Monad)

-- Since 'e' is a phantom type parameter, values of type 'e' are never manipulated, so our typeclass
-- doesn't need any methods anymore!
class E.Exception a => CouldBe a e

-- In particular, we don't inject the 'a' into an 'e' before throwing it, we throw the 'a' directly.
throw :: CouldBe a e
      => a -> EIO e r
throw = UnsafeEIO . E.throwIO

-- As before, we specialize @forall e. (CouldBe E1 e, CouldBe E2 e) => e@ to
-- @forall e'. CouldBe E1 e' => Either E1 e'@ in order to eliminate @CouldBe E1@ from the set of
-- constraints. This time, however, we are not pattern-matching on the @Either E1 e'@, instead we
-- pattern-match on the @Either E1 r@ returned by 'try'. We can still turn the @EIO (Either a e) r@
-- into an @EIO e r@, because it's a phantom type parameter so we can turn it into whatever we want.
handle :: E.Exception a
       => (a -> EIO e r)
       -> EIO (Either a e) r
       -> EIO e r
handle handler body = UnsafeEIO $ E.try (unsafeRunEIO body) >>= \case
  Left a  -> unsafeRunEIO (handler a)
  Right r -> pure r

-- If we know that all the errors have been handled, we don't even need to use 'try' to pretend
-- catching a 'Void' and then using 'absurd' to show that the branch can never happen; if we are
-- confident that there are no errors, we can just run the underlying IO computation without
-- catching anything. Again, it's a phantom type parameter, we can do anything.
runEIO :: EIO Void a -> IO a
runEIO = unsafeRunEIO

-- There is one aspect of exceptions which this approach doesn't track at all: subtyping. If you
-- throw a 'Timeout' exception, you can either 'catch' it as an exception of type 'Timeout' (or at
-- least you could if that type was exported), of type 'SomeAsyncException', or of type
-- 'SomeException'. But if you have a @CouldBe Timeout e@ constraint, you can only discharge it by
-- catching a 'Timeout', it won't get discharged if you catch a 'SomeAsyncException'. At the very
-- least, we can make a special case for 'SomeException' by writing a version of 'handle' which
-- handles everything.
handleSomeException :: (E.SomeException -> EIO e r)
                    -> EIO E.SomeException r
                    -> EIO e r
handleSomeException handler body = UnsafeEIO $ E.try (unsafeRunEIO body) >>= \case
  Left someException -> unsafeRunEIO (handler someException)
  Right r            -> pure r


-- Let's implement the same example as in the previous gist.

data E1 = E1 deriving Show
data E2 = E2 deriving Show
data E3 = E3 deriving Show

-- One minor difference is that our error types must now have Exception instances.
instance E.Exception E1
instance E.Exception E2
instance E.Exception E3

head1 :: CouldBe E1 e
      => [a] -> EIO e a
head1 []    = throw E1
head1 (x:_) = pure x

head2 :: CouldBe E2 e
      => [a] -> EIO e a
head2 []    = throw E2
head2 (x:_) = pure x

head3 :: CouldBe E3 e
      => [a] -> EIO e a
head3 []    = throw E3
head3 (x:_) = pure x

-- |
-- >>> runEIO $ handleSomeException (pure . Left) $ Right <$> throwalot []
-- Left E1
-- >>> runEIO $ handleSomeException (pure . Left) $ Right <$> throwalot [[]]
-- Left E2
-- >>> runEIO $ handleSomeException (pure . Left) $ Right <$> throwalot [[[]]]
-- Left E3
-- >>> runEIO $ handleSomeException (pure . Left) $ Right <$> throwalot [[[[]]]]
-- Left E1
-- >>> runEIO $ handleSomeException (pure . Left) $ Right <$> throwalot [[[[0]]]]
-- Right 0
throwalot :: (CouldBe E1 e, CouldBe E2 e, CouldBe E3 e)
          => [[[[a]]]] -> EIO e a
throwalot = head1 >=> head2 >=> head3 >=> head1

-- |
-- >>> runEIO $ handleSomeException (pure . Left) $ Right <$> handleSome 1 3 []
-- Right 1
-- >>> runEIO $ handleSomeException (pure . Left) $ Right <$> handleSome 1 3 [[]]
-- Left E2
-- >>> runEIO $ handleSomeException (pure . Left) $ Right <$> handleSome 1 3 [[[]]]
-- Right 3
-- >>> runEIO $ handleSomeException (pure . Left) $ Right <$> handleSome 1 3 [[[[]]]]
-- Right 1
-- >>> runEIO $ handleSomeException (pure . Left) $ Right <$> handleSome 1 3 [[[[0]]]]
-- Right 0
handleSome :: CouldBe E2 e
           => a -> a
           -> [[[[a]]]] -> EIO e a
handleSome a1 a3 = handle (\E1 -> pure a1)
                 . handle (\E3 -> pure a3)
                 . throwalot

-- |
-- >>> handleAll 1 2 3 []
-- 1
-- >>> handleAll 1 2 3 [[]]
-- 2
-- >>> handleAll 1 2 3 [[[]]]
-- 3
-- >>> handleAll 1 2 3 [[[[]]]]
-- 1
-- >>> handleAll 1 2 3 [[[[0]]]]
-- 0
handleAll :: a -> a -> a
          -> [[[[a]]]] -> IO a
handleAll a1 a2 a3 = runEIO
                   . handle (\E2 -> pure a2)
                   . handleSome a1 a3


-- The instances are also the same as before, except of course there are no methods to implement
-- anymore.

instance {-# OVERLAPPABLE #-} CouldBe a e => CouldBe a (Either Void e)

instance CouldBe E1 (Either E1 e)
instance {-# OVERLAPPABLE #-} CouldBe a e => CouldBe a (Either E1 e)

instance CouldBe E2 (Either E2 e)
instance {-# OVERLAPPABLE #-} CouldBe a e => CouldBe a (Either E2 e)

instance CouldBe E3 (Either E3 e)
instance {-# OVERLAPPABLE #-} CouldBe a e => CouldBe a (Either E3 e)

-- We need a special instance for 'SomeException' which discharges all the 'CouldBe' constraints.
instance E.Exception a => CouldBe a E.SomeException


main :: IO ()
main = doctest ["-XFlexibleContexts", "EIO.hs"]