Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Lightweight checked exceptions in Haskell without `unsafeCoerce`
{-# 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

Any chance you turn this into a library?

I put the exceptions variant (safe-exceptions, actually) up on Hackage at https://hackage.haskell.org/package/safe-exceptions-checked.

@edsko I hope you don't mind that I put you as an author in the cabal file, as I ripped the impl. directly from this gist. Let me know if you'd like to be removed, or credited in some other way. Thanks!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment