Lightweight checked exceptions in Haskell without `unsafeCoerce`

CheckedRevisited.hs

{-# OPTIONS_GHC -Wall -fno-warn-unused-binds #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}

#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations     #-}
#endif

module Checked (
    Throws -- opaque
    -- ** base
  , throwChecked
  , catchChecked
    -- ** exceptions
  , throwCheckedM
  , catchCheckedM
    -- ** lifted-base
  , throwCheckedL
  , catchCheckedL
  ) where

import Control.Exception (Exception)
import Control.Monad.Base (MonadBase)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Catch (MonadThrow, MonadCatch)
import qualified Control.Exception        as Base
import qualified Control.Exception.Lifted as Lifted
import qualified Control.Monad.Catch      as Exceptions

#if __GLASGOW_HASKELL__ >= 708
import GHC.Prim (coerce)
#else
import Unsafe.Coerce (unsafeCoerce)
#endif

{-------------------------------------------------------------------------------
  Basic infrastructure
-------------------------------------------------------------------------------}

class Throws e where

#if __GLASGOW_HASKELL__ >= 708
type role Throws representational
#endif

unthrow :: proxy e -> (Throws e => a) -> a
unthrow _ = unWrap . coerceWrap . Wrap

{-------------------------------------------------------------------------------
  Base exceptions
-------------------------------------------------------------------------------}

throwChecked :: (Exception e, Throws e) => e -> IO a
throwChecked = Base.throwIO

catchChecked :: forall a e. Exception e
             => (Throws e => IO a) -> (e -> IO a) -> IO a
catchChecked act = Base.catch (unthrow (Proxy :: Proxy e) act)

{-------------------------------------------------------------------------------
  Using the 'exceptions' library

  This should be an independent library so that we don't pull in an
  unnecessary dependency
-------------------------------------------------------------------------------}

throwCheckedM :: (Exception e, Throws e, MonadThrow m) => e -> m a
throwCheckedM = Exceptions.throwM

catchCheckedM :: forall a e m. (Exception e, MonadCatch m)
              => (Throws e => m a) -> (e -> m a) -> m a
catchCheckedM act = Exceptions.catch (unthrow (Proxy :: Proxy e) act)

{-------------------------------------------------------------------------------
  Using the 'lifted-base' library

  As above, should be an independent library
-------------------------------------------------------------------------------}

throwCheckedL :: (Exception e, Throws e, MonadBase IO m) => e -> m a
throwCheckedL = Lifted.throw

catchCheckedL :: forall a e m. (Exception e, MonadBaseControl IO m)
              => (Throws e => m a) -> (e -> m a) -> m a
catchCheckedL act = Lifted.catch (unthrow (Proxy :: Proxy e) act)

{-------------------------------------------------------------------------------
  Auxiliary definitions (not exported)
-------------------------------------------------------------------------------}

newtype Wrap e a = Wrap { unWrap :: Throws e => a }

coerceWrap :: Wrap e a -> Wrap (Catch e) a
#if __GLASGOW_HASKELL__ >= 708
coerceWrap = coerce
#else
coerceWrap = unsafeCoerce
#endif

data Proxy a = Proxy

newtype Catch a = Catch a
instance Throws (Catch e) where