{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE IncoherentInstances #-}
#endif
module Hackage.Security.Util.Checked (
Throws
, unthrow
, throwChecked
, catchChecked
, handleChecked
, tryChecked
, checkIO
, throwUnchecked
, internalError
) where
import Control.Exception (Exception, IOException)
import qualified Control.Exception as Base
#if __GLASGOW_HASKELL__ >= 708
import GHC.Prim (coerce)
#else
import Unsafe.Coerce (unsafeCoerce)
#endif
class Throws e where
#if __GLASGOW_HASKELL__ >= 708
type role Throws representational
#endif
unthrow :: forall a e proxy . proxy e -> (Throws e => a) -> a
unthrow _ x = unWrap (coerceWrap (Wrap x :: Wrap e a))
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)
handleChecked :: Exception e => (e -> IO a) -> (Throws e => IO a) -> IO a
handleChecked act handler = catchChecked handler act
tryChecked :: Exception e => (Throws e => IO a) -> IO (Either e a)
tryChecked act = catchChecked (Right <$> act) (return . Left)
checkIO :: Throws IOException => IO a -> IO a
checkIO = Base.handle $ \(ex :: IOException) -> throwChecked ex
throwUnchecked :: Exception e => e -> IO a
throwUnchecked = Base.throwIO
internalError :: String -> IO a
internalError = throwUnchecked . userError
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