Skip to content

Instantly share code, notes, and snippets.

@edsko
Last active November 3, 2021 08:35
Show Gist options
  • Star 8 You must be signed in to star a gist
  • Fork 3 You must be signed in to fork a gist
  • Save edsko/f1f566f77422398fba7d to your computer and use it in GitHub Desktop.
Save edsko/f1f566f77422398fba7d to your computer and use it in GitHub Desktop.
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
@vagarenko
Copy link

Any chance you turn this into a library?

@mitchellwrosen
Copy link

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