{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

module CheckedIO.Core (
  -- * IOE: Checked IO with exceptions
  IOE (UnsafeIOE),
  MonadRunIOE (..),
  MonadRunAsIOE (..),

  -- * IO convenience type
  IO,
  MonadRunIO,
  MonadRunAsIO,
  runIO,
  withRunAsIO,

  -- * UIO convenience type
  UIO,
  MonadRunUIO,
  MonadRunAsUIO,
  runUIO,
  withRunAsUIO,
  fromUIO,
  fromUIOWith,
  uioToIO,

  -- * Exception handling
  throw,
  throwTo,
  throwImprecise,
  catch,
  catchAny,
  try,
  mapExceptionM,
  liftE,
  evaluate,

  -- * Cleanup (no recovery)
  bracket,
  bracket_,
  bracketOnError,
  bracketOnError_,
  finally,
  onException,
  withException,

  -- * Masking
  mask,
  uninterruptibleMask,
  mask_,
  uninterruptibleMask_,

  -- * Lifted exception handling
  MonadCatchIO (..),
  tryM,
  bracketM,
  bracketM_,
  bracketOnErrorM,
  bracketOnErrorM_,
  finallyM,
  onExceptionM,
  withExceptionM,
  maskM,
  uninterruptibleMaskM,
  maskM_,
  uninterruptibleMaskM_,

  -- * Interop with unchecked IO
  Main,
  UnsafeIO,
  checkIO,
  checkIOWith,
  checkUIOWith,
  unsafeCheckIO,
  unsafeCheckUIO,
  uncheckIOE,
  uncheckUIO,

  -- * Exceptions in checked IO actions
  AnyException (..),
  SomeSyncException (..),
) where

import Control.Concurrent (ThreadId)
import Control.Exception (Exception (..), SomeException (..))
import qualified Control.Exception as GHC
import qualified Control.Exception.Base as GHC
import Data.Foldable (asum)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import Data.Typeable (cast, typeOf, typeRep)
import Data.Void (Void)
import GHC.Stack (HasCallStack, withFrozenCallStack)
import qualified System.IO as GHC

import CheckedIO.Prelude.NoIO

-- | An alias for the normal unsafe 'GHC.IO' type.
type UnsafeIO = GHC.IO

-- | A checked IO action that can only throw synchronous exceptions
-- of the given type.
--
-- Morally equivalent to @UIO (Either e a)@, but implemented without
-- the `Either` for performance.
newtype IOE e a = UnsafeIOE {forall e a. IOE e a -> UnsafeIO a
unIOE :: UnsafeIO a}
  deriving ((forall a b. (a -> b) -> IOE e a -> IOE e b)
-> (forall a b. a -> IOE e b -> IOE e a) -> Functor (IOE e)
forall a b. a -> IOE e b -> IOE e a
forall a b. (a -> b) -> IOE e a -> IOE e b
forall e a b. a -> IOE e b -> IOE e a
forall e a b. (a -> b) -> IOE e a -> IOE e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e a b. (a -> b) -> IOE e a -> IOE e b
fmap :: forall a b. (a -> b) -> IOE e a -> IOE e b
$c<$ :: forall e a b. a -> IOE e b -> IOE e a
<$ :: forall a b. a -> IOE e b -> IOE e a
Functor, Functor (IOE e)
Functor (IOE e)
-> (forall a. a -> IOE e a)
-> (forall a b. IOE e (a -> b) -> IOE e a -> IOE e b)
-> (forall a b c. (a -> b -> c) -> IOE e a -> IOE e b -> IOE e c)
-> (forall a b. IOE e a -> IOE e b -> IOE e b)
-> (forall a b. IOE e a -> IOE e b -> IOE e a)
-> Applicative (IOE e)
forall e. Functor (IOE e)
forall a. a -> IOE e a
forall e a. a -> IOE e a
forall a b. IOE e a -> IOE e b -> IOE e a
forall a b. IOE e a -> IOE e b -> IOE e b
forall a b. IOE e (a -> b) -> IOE e a -> IOE e b
forall e a b. IOE e a -> IOE e b -> IOE e a
forall e a b. IOE e a -> IOE e b -> IOE e b
forall e a b. IOE e (a -> b) -> IOE e a -> IOE e b
forall a b c. (a -> b -> c) -> IOE e a -> IOE e b -> IOE e c
forall e a b c. (a -> b -> c) -> IOE e a -> IOE e b -> IOE e c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall e a. a -> IOE e a
pure :: forall a. a -> IOE e a
$c<*> :: forall e a b. IOE e (a -> b) -> IOE e a -> IOE e b
<*> :: forall a b. IOE e (a -> b) -> IOE e a -> IOE e b
$cliftA2 :: forall e a b c. (a -> b -> c) -> IOE e a -> IOE e b -> IOE e c
liftA2 :: forall a b c. (a -> b -> c) -> IOE e a -> IOE e b -> IOE e c
$c*> :: forall e a b. IOE e a -> IOE e b -> IOE e b
*> :: forall a b. IOE e a -> IOE e b -> IOE e b
$c<* :: forall e a b. IOE e a -> IOE e b -> IOE e a
<* :: forall a b. IOE e a -> IOE e b -> IOE e a
Applicative, Applicative (IOE e)
Applicative (IOE e)
-> (forall a b. IOE e a -> (a -> IOE e b) -> IOE e b)
-> (forall a b. IOE e a -> IOE e b -> IOE e b)
-> (forall a. a -> IOE e a)
-> Monad (IOE e)
forall e. Applicative (IOE e)
forall a. a -> IOE e a
forall e a. a -> IOE e a
forall a b. IOE e a -> IOE e b -> IOE e b
forall a b. IOE e a -> (a -> IOE e b) -> IOE e b
forall e a b. IOE e a -> IOE e b -> IOE e b
forall e a b. IOE e a -> (a -> IOE e b) -> IOE e b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall e a b. IOE e a -> (a -> IOE e b) -> IOE e b
>>= :: forall a b. IOE e a -> (a -> IOE e b) -> IOE e b
$c>> :: forall e a b. IOE e a -> IOE e b -> IOE e b
>> :: forall a b. IOE e a -> IOE e b -> IOE e b
$creturn :: forall e a. a -> IOE e a
return :: forall a. a -> IOE e a
Monad)

-- | Run an 'IOE' action in the given monad.
--
-- e.g. to convert an 'IOE' action to an 'ExceptT' stack on top of 'UIO':
--
-- @
-- newtype ExceptT e m a = ExceptT { unExceptT :: m (Either e a) }
--   deriving (Functor, Applicative, Monad)
--
-- instance MonadRunUIO m => MonadRunIOE e (ExceptT e m) where
--   runIOE = ExceptT . try
-- @
class (Monad m, Exception e) => MonadRunIOE e m | m -> e where
  runIOE :: IOE e a -> m a

instance Exception e => MonadRunIOE e (IOE e) where
  runIOE :: forall a. IOE e a -> IOE e a
runIOE = IOE e a -> IOE e a
forall a. a -> a
id

-- | Provide a function for running an action in the given monad in 'IOE'.
--
-- Instances must satisfy the following laws:
--
-- [Identity] @withRunAsIOE (\\run -> run m) === m@
-- [Inverse]  @withRunAsIOE (\\_ -> m) === runIOE m@
class MonadRunIOE e m => MonadRunAsIOE e m | m -> e where
  withRunAsIOE :: ((forall a. m a -> IOE e a) -> IOE e b) -> m b

instance Exception e => MonadRunAsIOE e (IOE e) where
  withRunAsIOE :: forall b. ((forall a. IOE e a -> IOE e a) -> IOE e b) -> IOE e b
withRunAsIOE (forall a. IOE e a -> IOE e a) -> IOE e b
f = (forall a. IOE e a -> IOE e a) -> IOE e b
f IOE e a -> IOE e a
forall a. a -> a
forall a. IOE e a -> IOE e a
id

{----- IO convenience type -----}

-- | A helper containing any synchronous exception.
type IO = IOE SomeSyncException

-- | 'MonadRunIOE' specialized to 'IO'
type MonadRunIO = MonadRunIOE SomeSyncException

-- | 'MonadRunAsIOE' specialized to 'IO'
type MonadRunAsIO = MonadRunAsIOE SomeSyncException

-- | 'runIOE' specialized to 'IO'
runIO :: MonadRunIO m => IO a -> m a
runIO :: forall (m :: * -> *) a. MonadRunIO m => IO a -> m a
runIO = IOE SomeSyncException a -> m a
forall a. IOE SomeSyncException a -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => IOE e a -> m a
runIOE

-- | 'withRunAsIOE' specialized to 'IO'
withRunAsIO :: MonadRunAsIO m => ((forall a. m a -> IO a) -> IO b) -> m b
withRunAsIO :: forall (m :: * -> *) b.
MonadRunAsIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunAsIO = ((forall a. m a -> IOE SomeSyncException a)
 -> IOE SomeSyncException b)
-> m b
forall b.
((forall a. m a -> IOE SomeSyncException a)
 -> IOE SomeSyncException b)
-> m b
forall e (m :: * -> *) b.
MonadRunAsIOE e m =>
((forall a. m a -> IOE e a) -> IOE e b) -> m b
withRunAsIOE

{----- UIO convenience type -----}

-- | A checked IO action that cannot throw /any/ (synchronous) exceptions.
type UIO = IOE Void

type MonadRunUIO = MonadRunIOE Void

type MonadRunAsUIO = MonadRunAsIOE Void

unUIO :: UIO a -> UnsafeIO a
unUIO :: forall a. UIO a -> UnsafeIO a
unUIO = IOE Void a -> UnsafeIO a
forall e a. IOE e a -> UnsafeIO a
unIOE

runUIO :: MonadRunIOE e m => UIO a -> m a
runUIO :: forall e (m :: * -> *) a. MonadRunIOE e m => UIO a -> m a
runUIO = IOE e a -> m a
forall a. IOE e a -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => IOE e a -> m a
runIOE (IOE e a -> m a) -> (UIO a -> IOE e a) -> UIO a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UIO a -> IOE e a
forall {e} {a} {e}. IOE e a -> IOE e a
castIOE
  where
    -- assuming that IOE doesn't have a Void exception floating around, this
    -- should be equivalent to `fmap (either absurd id) . try`, but this is
    -- more performant, as it doesn't have to catch async or imprecise
    -- exceptions
    castIOE :: IOE e a -> IOE e a
castIOE = UnsafeIO a -> IOE e a
forall e a. UnsafeIO a -> IOE e a
UnsafeIOE (UnsafeIO a -> IOE e a)
-> (IOE e a -> UnsafeIO a) -> IOE e a -> IOE e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOE e a -> UnsafeIO a
forall e a. IOE e a -> UnsafeIO a
unIOE

withRunAsUIO :: MonadRunAsUIO m => ((forall a. m a -> UIO a) -> UIO b) -> m b
withRunAsUIO :: forall (m :: * -> *) b.
MonadRunAsUIO m =>
((forall a. m a -> UIO a) -> UIO b) -> m b
withRunAsUIO = ((forall a. m a -> IOE Void a) -> IOE Void b) -> m b
forall b. ((forall a. m a -> IOE Void a) -> IOE Void b) -> m b
forall e (m :: * -> *) b.
MonadRunAsIOE e m =>
((forall a. m a -> IOE e a) -> IOE e b) -> m b
withRunAsIOE

-- | Convert @UIO (Either e a)@ to @IOE e a@ (or any other monad
-- with a @MonadRunIOE@ instance).
--
-- > fromUIO m = runUIO m >>= either throw pure
fromUIO ::
  forall e m a.
  MonadRunIOE e m =>
  UIO (Either e a)
  -> m a
fromUIO :: forall e (m :: * -> *) a.
MonadRunIOE e m =>
UIO (Either e a) -> m a
fromUIO = (e -> e) -> UIO (Either e a) -> m a
forall e1 e2 (m :: * -> *) a.
MonadRunIOE e2 m =>
(e1 -> e2) -> UIO (Either e1 a) -> m a
fromUIOWith e -> e
forall a. a -> a
id

-- | Convert @UIO (Either e1 a)@ to @IOE e2 a@ (or any other monad
-- with a @MonadRunIOE@ instance) with the given
-- transformation function.
--
-- Same as @mapExceptionM f . fromUIO@, but more performant.
fromUIOWith ::
  forall e1 e2 m a.
  MonadRunIOE e2 m =>
  (e1 -> e2)
  -> UIO (Either e1 a)
  -> m a
fromUIOWith :: forall e1 e2 (m :: * -> *) a.
MonadRunIOE e2 m =>
(e1 -> e2) -> UIO (Either e1 a) -> m a
fromUIOWith e1 -> e2
f UIO (Either e1 a)
m = UIO (Either e1 a) -> m (Either e1 a)
forall e (m :: * -> *) a. MonadRunIOE e m => UIO a -> m a
runUIO UIO (Either e1 a)
m m (Either e1 a) -> (Either e1 a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e1 -> m a) -> (a -> m a) -> Either e1 a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e2 -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => e -> m a
throw (e2 -> m a) -> (e1 -> e2) -> e1 -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Convert @UIO (Either e a)@ action to @IO a@ (or any other monad
-- with a @MonadRunIO@ instance).
--
-- Same as @liftE . fromUIO@, but more performant.
uioToIO :: (Exception e, MonadRunIO m) => UIO (Either e a) -> m a
uioToIO :: forall e (m :: * -> *) a.
(Exception e, MonadRunIO m) =>
UIO (Either e a) -> m a
uioToIO = (e -> SomeSyncException) -> UIO (Either e a) -> m a
forall e1 e2 (m :: * -> *) a.
MonadRunIOE e2 m =>
(e1 -> e2) -> UIO (Either e1 a) -> m a
fromUIOWith e -> SomeSyncException
forall e. Exception e => e -> SomeSyncException
SomeSyncException

{----- Exception handling -----}

-- | Throw the given exception.
throw :: MonadRunIOE e m => e -> m a
throw :: forall e (m :: * -> *) a. MonadRunIOE e m => e -> m a
throw = IOE e a -> m a
forall a. IOE e a -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => IOE e a -> m a
runIOE (IOE e a -> m a) -> (e -> IOE e a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsafeIO a -> IOE e a
forall e a. UnsafeIO a -> IOE e a
UnsafeIOE (UnsafeIO a -> IOE e a) -> (e -> UnsafeIO a) -> e -> IOE e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyException SomeException -> UnsafeIO a
forall e a. Exception e => e -> IO a
GHC.throwIO (AnyException SomeException -> UnsafeIO a)
-> (e -> AnyException SomeException) -> e -> UnsafeIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> AnyException SomeException
forall e. e -> AnyException e
AnySyncException (SomeException -> AnyException SomeException)
-> (e -> SomeException) -> e -> AnyException SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
SomeException

-- | Throw the given exception as an asynchronous exception to the given thread.
throwTo :: (Exception e, MonadRunIOE e' m) => ThreadId -> e -> m ()
throwTo :: forall e e' (m :: * -> *).
(Exception e, MonadRunIOE e' m) =>
ThreadId -> e -> m ()
throwTo ThreadId
tid = IOE e' () -> m ()
forall a. IOE e' a -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => IOE e a -> m a
runIOE (IOE e' () -> m ()) -> (e -> IOE e' ()) -> e -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsafeIO () -> IOE e' ()
forall e a. UnsafeIO a -> IOE e a
UnsafeIOE (UnsafeIO () -> IOE e' ()) -> (e -> UnsafeIO ()) -> e -> IOE e' ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> AnyException SomeException -> UnsafeIO ()
forall e. Exception e => ThreadId -> e -> UnsafeIO ()
GHC.throwTo ThreadId
tid (AnyException SomeException -> UnsafeIO ())
-> (e -> AnyException SomeException) -> e -> UnsafeIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. SomeException -> AnyException e
AnyAsyncException @SomeException (SomeException -> AnyException SomeException)
-> (e -> SomeException) -> e -> AnyException SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
SomeException

-- | Throw an imprecise exception in a pure context.
--
-- __Warning__: Because the exception isn't tracked at the type level, this
-- should be reserved for unrecoverable errors that aren't expected to be
-- handled. Also, if this value is not evaluated before 'uncheckIOE'  is
-- called, it'll remain wrapped in 'AnyException'.
throwImprecise :: Exception e => e -> a
throwImprecise :: forall e a. Exception e => e -> a
throwImprecise = AnyException SomeException -> a
forall a e. Exception e => e -> a
GHC.throw (AnyException SomeException -> a)
-> (e -> AnyException SomeException) -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. SomeException -> AnyException e
AnyImpreciseException @SomeException (SomeException -> AnyException SomeException)
-> (e -> SomeException) -> e -> AnyException SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
SomeException

-- | Handle the exception tracked in 'IOE' if one is thrown.
catch :: forall e1 e2 a. (Exception e1, Exception e2) => IOE e1 a -> (e1 -> IOE e2 a) -> IOE e2 a
catch :: forall e1 e2 a.
(Exception e1, Exception e2) =>
IOE e1 a -> (e1 -> IOE e2 a) -> IOE e2 a
catch = IOE e1 a -> (e1 -> IOE e2 a) -> IOE e2 a
forall e (m :: * -> *) e' (m' :: * -> *) a.
(MonadCatchIO e m, MonadRunAsIOE e' m') =>
m a -> (e -> m' a) -> m' a
forall e' (m' :: * -> *) a.
MonadRunAsIOE e' m' =>
IOE e1 a -> (e1 -> m' a) -> m' a
catchM

-- | Handle /all/ exceptions in the given 'IOE' action, including non-synchronous
-- exceptions.
--
-- __Warning__: You probably want 'catch' instead; if you catch an
-- async exception, you /must/ be careful to rethrow it after.
--
-- More information:
--
--   * https://www.fpcomplete.com/blog/2018/04/async-exception-handling-haskell/
--   * https://www.tweag.io/blog/2020-04-16-exceptions-in-haskell/
catchAny :: forall e1 e2 a. (Exception e1, Exception e2) => IOE e1 a -> (AnyException e1 -> IOE e2 a) -> IOE e2 a
catchAny :: forall e1 e2 a.
(Exception e1, Exception e2) =>
IOE e1 a -> (AnyException e1 -> IOE e2 a) -> IOE e2 a
catchAny = IOE e1 a -> (AnyException e1 -> IOE e2 a) -> IOE e2 a
forall e (m :: * -> *) e' (m' :: * -> *) a.
(MonadCatchIO e m, MonadRunAsIOE e' m') =>
m a -> (AnyException e -> m' a) -> m' a
forall e' (m' :: * -> *) a.
MonadRunAsIOE e' m' =>
IOE e1 a -> (AnyException e1 -> m' a) -> m' a
catchAnyM

-- | Get an @Either@ containing either the result or the exception thrown.
try :: forall e1 e2 a. (Exception e1, Exception e2) => IOE e1 a -> IOE e2 (Either e1 a)
try :: forall e1 e2 a.
(Exception e1, Exception e2) =>
IOE e1 a -> IOE e2 (Either e1 a)
try = IOE e1 a -> IOE e2 (Either e1 a)
forall e (m1 :: * -> *) e' (m2 :: * -> *) a.
(MonadCatchIO e m1, MonadRunIOE e' m2) =>
m1 a -> m2 (Either e a)
tryM

mapExceptionM ::
  forall e1 e2 m1 m2 a.
  (MonadCatchIO e1 m1, MonadRunAsIOE e2 m2) =>
  (e1 -> e2)
  -> m1 a
  -> m2 a
mapExceptionM :: forall e1 e2 (m1 :: * -> *) (m2 :: * -> *) a.
(MonadCatchIO e1 m1, MonadRunAsIOE e2 m2) =>
(e1 -> e2) -> m1 a -> m2 a
mapExceptionM e1 -> e2
f m1 a
m = m1 a
m m1 a -> (e1 -> m2 a) -> m2 a
forall e (m :: * -> *) e' (m' :: * -> *) a.
(MonadCatchIO e m, MonadRunAsIOE e' m') =>
m a -> (e -> m' a) -> m' a
forall e' (m' :: * -> *) a.
MonadRunAsIOE e' m' =>
m1 a -> (e1 -> m' a) -> m' a
`catchM` (e2 -> m2 a
forall e (m :: * -> *) a. MonadRunIOE e m => e -> m a
throw (e2 -> m2 a) -> (e1 -> e2) -> e1 -> m2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f)

-- | Lift an exception to 'SomeSyncException', useful for converting to 'IO'.
--
-- > liftE = mapExceptionM SomeSyncException
--
-- === __Example__
--
-- @
-- foo :: String -> IOE MyException Int
--
-- bar :: IO Int
-- bar = liftE $ foo "hello world"
-- @
liftE ::
  forall e m1 m2 a.
  (MonadCatchIO e m1, MonadRunAsIO m2) =>
  m1 a
  -> m2 a
liftE :: forall e (m1 :: * -> *) (m2 :: * -> *) a.
(MonadCatchIO e m1, MonadRunAsIO m2) =>
m1 a -> m2 a
liftE = (e -> SomeSyncException) -> m1 a -> m2 a
forall e1 e2 (m1 :: * -> *) (m2 :: * -> *) a.
(MonadCatchIO e1 m1, MonadRunAsIOE e2 m2) =>
(e1 -> e2) -> m1 a -> m2 a
mapExceptionM e -> SomeSyncException
forall e. Exception e => e -> SomeSyncException
SomeSyncException

evaluate :: MonadRunIOE e m => a -> m a
evaluate :: forall e (m :: * -> *) a. MonadRunIOE e m => a -> m a
evaluate = IOE e a -> m a
forall a. IOE e a -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => IOE e a -> m a
runIOE (IOE e a -> m a) -> (a -> IOE e a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsafeIO a -> IOE e a
forall e a. UnsafeIO a -> IOE e a
UnsafeIOE (UnsafeIO a -> IOE e a) -> (a -> UnsafeIO a) -> a -> IOE e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UnsafeIO a
forall a. a -> IO a
GHC.evaluate

{----- Cleanup (no recovery) -----}

-- | Allocate and clean up a resource safely.
--
-- Runs the clean up in an uninterruptible mask. For more information:
--
--   * https://hackage.haskell.org/package/unliftio-0.2.23.0/docs/UnliftIO-Exception.html#v:bracket
--   * https://hackage.haskell.org/package/base-4.17.0.0/docs/Control-Exception-Base.html#v:bracket
bracket :: Exception e => IOE e a -> (a -> IOE e b) -> (a -> IOE e c) -> IOE e c
bracket :: forall e a b c.
Exception e =>
IOE e a -> (a -> IOE e b) -> (a -> IOE e c) -> IOE e c
bracket = IOE e a -> (a -> IOE e b) -> (a -> IOE e c) -> IOE e c
forall e (m :: * -> *) a b c.
MonadCatchIO e m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketM

-- | Same as 'bracket', except without passing the result of the acquire action to the
-- release or run actions.
bracket_ :: Exception e => IOE e a -> IOE e b -> IOE e c -> IOE e c
bracket_ :: forall e a b c.
Exception e =>
IOE e a -> IOE e b -> IOE e c -> IOE e c
bracket_ = IOE e a -> IOE e b -> IOE e c -> IOE e c
forall e (m :: * -> *) a b c.
MonadCatchIO e m =>
m a -> m b -> m c -> m c
bracketM_

-- | Same as 'bracket', but only perform the cleanup if an exception is thrown.
bracketOnError ::
  (Exception e, Exception e') =>
  IOE e a
  -> (a -> IOE e' b)
  -> (a -> IOE e c)
  -> IOE e c
bracketOnError :: forall e e' a b c.
(Exception e, Exception e') =>
IOE e a -> (a -> IOE e' b) -> (a -> IOE e c) -> IOE e c
bracketOnError = IOE e a -> (a -> IOE e' b) -> (a -> IOE e c) -> IOE e c
forall e (m :: * -> *) e' (m' :: * -> *) a b c.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a -> (a -> m' b) -> (a -> m c) -> m c
bracketOnErrorM

-- | Same as 'bracket_', but only perform the cleanup if an exception is thrown.
bracketOnError_ ::
  (Exception e, Exception e') =>
  IOE e a
  -> IOE e' b
  -> IOE e c
  -> IOE e c
bracketOnError_ :: forall e e' a b c.
(Exception e, Exception e') =>
IOE e a -> IOE e' b -> IOE e c -> IOE e c
bracketOnError_ = IOE e a -> IOE e' b -> IOE e c -> IOE e c
forall e (m :: * -> *) e' (m' :: * -> *) a b c.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a -> m' b -> m c -> m c
bracketOnErrorM_

-- | A specialized variant of 'bracket' that just runs a computation afterward.
finally :: Exception e => IOE e a -> IOE e b -> IOE e a
finally :: forall e a b. Exception e => IOE e a -> IOE e b -> IOE e a
finally = IOE e a -> IOE e b -> IOE e a
forall e (m :: * -> *) a b. MonadCatchIO e m => m a -> m b -> m a
finallyM

-- | Like 'finally', except only runs the cleanup if an exception occurs.
onException :: (Exception e, Exception e') => IOE e a -> IOE e' b -> IOE e a
onException :: forall e e' a b.
(Exception e, Exception e') =>
IOE e a -> IOE e' b -> IOE e a
onException = IOE e a -> IOE e' b -> IOE e a
forall e (m :: * -> *) e' (m' :: * -> *) a b.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a -> m' b -> m a
onExceptionM

-- | Like 'onException', except passing the exception to the cleanup function.
--
-- Unlike 'catchAny', you /don't/ need to worry about rethrowing async exceptions
-- because 'withException' always rethrows the exception after running the cleanup.
withException :: (Exception e, Exception e') => IOE e a -> (AnyException e -> IOE e' b) -> IOE e a
withException :: forall e e' a b.
(Exception e, Exception e') =>
IOE e a -> (AnyException e -> IOE e' b) -> IOE e a
withException = IOE e a -> (AnyException e -> IOE e' b) -> IOE e a
forall e (m :: * -> *) e' (m' :: * -> *) a b.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a -> (AnyException e -> m' b) -> m a
withExceptionM

{----- Masking -----}

-- | Execute an IO action with asynchronous exceptions masked.
--
-- https://hackage.haskell.org/package/base-4.17.0.0/docs/GHC-IO.html#v:mask
mask ::
  Exception e =>
  ((forall e' a. Exception e' => IOE e' a -> IOE e' a) -> IOE e b)
  -> IOE e b
mask :: forall e b.
Exception e =>
((forall e' a. Exception e' => IOE e' a -> IOE e' a) -> IOE e b)
-> IOE e b
mask = ((forall e' a. Exception e' => IOE e' a -> IOE e' a) -> IOE e b)
-> IOE e b
((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> IOE e b)
-> IOE e b
forall e (m :: * -> *) b.
MonadCatchIO e m =>
((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> m b)
-> m b
maskM

-- | Like 'mask', but the masked computation is not interruptible.
--
-- __Warning__: Use with great care, as a thread running with 'uninterruptibleMask' will
-- be unresponsive and unkillable if it blocks at all.
--
-- https://hackage.haskell.org/package/base-4.17.0.0/docs/GHC-IO.html#v:uninterruptibleMask
uninterruptibleMask ::
  Exception e =>
  ((forall e' a. Exception e' => IOE e' a -> IOE e' a) -> IOE e b)
  -> IOE e b
uninterruptibleMask :: forall e b.
Exception e =>
((forall e' a. Exception e' => IOE e' a -> IOE e' a) -> IOE e b)
-> IOE e b
uninterruptibleMask = ((forall e' a. Exception e' => IOE e' a -> IOE e' a) -> IOE e b)
-> IOE e b
((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> IOE e b)
-> IOE e b
forall e (m :: * -> *) b.
MonadCatchIO e m =>
((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> m b)
-> m b
uninterruptibleMaskM

-- | Like 'mask', but does not pass a @restore@ action to the argument.
mask_ :: Exception e => IOE e a -> IOE e a
mask_ :: forall e' a. Exception e' => IOE e' a -> IOE e' a
mask_ = IOE e a -> IOE e a
forall e (m :: * -> *) a. MonadCatchIO e m => m a -> m a
maskM_

-- | Like 'uninterruptibleMask', but does not pass a @restore@ action to the argument.
uninterruptibleMask_ :: Exception e => IOE e a -> IOE e a
uninterruptibleMask_ :: forall e' a. Exception e' => IOE e' a -> IOE e' a
uninterruptibleMask_ = IOE e a -> IOE e a
forall e (m :: * -> *) a. MonadCatchIO e m => m a -> m a
uninterruptibleMaskM_

{----- Lifted exception handling -----}

class (MonadRunAsIOE e m, Exception e) => MonadCatchIO e m | m -> e where
  {-# MINIMAL catchAnyM #-}

  -- | 'catch' generalized to any 'MonadCatchIO' + 'MonadRunAsIOE'
  catchM :: MonadRunAsIOE e' m' => m a -> (e -> m' a) -> m' a
  catchM m a
m e -> m' a
f =
    m a
m m a -> (AnyException e -> m' a) -> m' a
forall e (m :: * -> *) e' (m' :: * -> *) a.
(MonadCatchIO e m, MonadRunAsIOE e' m') =>
m a -> (AnyException e -> m' a) -> m' a
forall e' (m' :: * -> *) a.
MonadRunAsIOE e' m' =>
m a -> (AnyException e -> m' a) -> m' a
`catchAnyM` \case
      AnySyncException e
e -> e -> m' a
f e
e
      AnyAsyncException SomeException
e -> AnyException e' -> m' a
forall e (m :: * -> *) a. MonadRunIOE e m => AnyException e -> m a
rethrow (SomeException -> AnyException e'
forall e. SomeException -> AnyException e
AnyAsyncException SomeException
e)
      AnyImpreciseException SomeException
e -> AnyException e' -> m' a
forall e (m :: * -> *) a. MonadRunIOE e m => AnyException e -> m a
rethrow (SomeException -> AnyException e'
forall e. SomeException -> AnyException e
AnyImpreciseException SomeException
e)

  -- | 'catchAny' generalized to any 'MonadCatchIO' + 'MonadRunAsIOE'
  catchAnyM :: MonadRunAsIOE e' m' => m a -> (AnyException e -> m' a) -> m' a

instance Exception e => MonadCatchIO e (IOE e) where
  catchAnyM :: forall e' (m' :: * -> *) a.
MonadRunAsIOE e' m' =>
IOE e a -> (AnyException e -> m' a) -> m' a
catchAnyM (UnsafeIOE UnsafeIO a
m) AnyException e -> m' a
f =
    ((forall a. m' a -> IOE e' a) -> IOE e' a) -> m' a
forall b. ((forall a. m' a -> IOE e' a) -> IOE e' b) -> m' b
forall e (m :: * -> *) b.
MonadRunAsIOE e m =>
((forall a. m a -> IOE e a) -> IOE e b) -> m b
withRunAsIOE (((forall a. m' a -> IOE e' a) -> IOE e' a) -> m' a)
-> ((forall a. m' a -> IOE e' a) -> IOE e' a) -> m' a
forall a b. (a -> b) -> a -> b
$ \forall a. m' a -> IOE e' a
run ->
      UnsafeIO a -> IOE e' a
forall e a. UnsafeIO a -> IOE e a
UnsafeIOE (UnsafeIO a -> IOE e' a) -> UnsafeIO a -> IOE e' a
forall a b. (a -> b) -> a -> b
$ UnsafeIO a
m UnsafeIO a
-> (AnyException SomeException -> UnsafeIO a) -> UnsafeIO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`GHC.catch` (IOE e' a -> UnsafeIO a
forall e a. IOE e a -> UnsafeIO a
unIOE (IOE e' a -> UnsafeIO a)
-> (AnyException SomeException -> IOE e' a)
-> AnyException SomeException
-> UnsafeIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m' a -> IOE e' a
forall a. m' a -> IOE e' a
run (m' a -> IOE e' a)
-> (AnyException SomeException -> m' a)
-> AnyException SomeException
-> IOE e' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyException e -> m' a
f (AnyException e -> m' a)
-> (AnyException SomeException -> AnyException e)
-> AnyException SomeException
-> m' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyException SomeException -> AnyException e
forall e.
Exception e =>
AnyException SomeException -> AnyException e
castAnyException)

-- | 'try' generalized to any 'MonadCatchIO' + 'MonadRunIOE'
tryM :: (MonadCatchIO e m1, MonadRunIOE e' m2) => m1 a -> m2 (Either e a)
tryM :: forall e (m1 :: * -> *) e' (m2 :: * -> *) a.
(MonadCatchIO e m1, MonadRunIOE e' m2) =>
m1 a -> m2 (Either e a)
tryM m1 a
m = IOE e' (Either e a) -> m2 (Either e a)
forall a. IOE e' a -> m2 a
forall e (m :: * -> *) a. MonadRunIOE e m => IOE e a -> m a
runIOE (IOE e' (Either e a) -> m2 (Either e a))
-> IOE e' (Either e a) -> m2 (Either e a)
forall a b. (a -> b) -> a -> b
$ (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> m1 a -> m1 (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m1 a
m) m1 (Either e a)
-> (e -> IOE e' (Either e a)) -> IOE e' (Either e a)
forall e (m :: * -> *) e' (m' :: * -> *) a.
(MonadCatchIO e m, MonadRunAsIOE e' m') =>
m a -> (e -> m' a) -> m' a
forall e' (m' :: * -> *) a.
MonadRunAsIOE e' m' =>
m1 a -> (e -> m' a) -> m' a
`catchM` (Either e a -> IOE e' (Either e a)
forall a. a -> IOE e' a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> IOE e' (Either e a))
-> (e -> Either e a) -> e -> IOE e' (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)

bracketM' ::
  (MonadCatchIO e m, MonadCatchIO e' m') =>
  m a -- ^ acquire
  -> (a -> m b1) -- ^ release on success
  -> (AnyException e -> a -> m' b2) -- ^ release on error
  -> (a -> m c) -- ^ action
  -> m c
bracketM' :: forall e (m :: * -> *) e' (m' :: * -> *) a b1 b2 c.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a
-> (a -> m b1)
-> (AnyException e -> a -> m' b2)
-> (a -> m c)
-> m c
bracketM' m a
acquire a -> m b1
releaseOnSuccess AnyException e -> a -> m' b2
releaseOnError a -> m c
action =
  ((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> m c)
-> m c
forall e (m :: * -> *) b.
MonadCatchIO e m =>
((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> m b)
-> m b
maskM (((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
  -> m c)
 -> m c)
-> ((forall (m' :: * -> *) e' a.
     MonadCatchIO e' m' =>
     m' a -> m' a)
    -> m c)
-> m c
forall a b. (a -> b) -> a -> b
$ \forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a
restore -> do
    a
x <- m a
acquire
    m c -> m (Either (AnyException e) c)
forall {e} {m :: * -> *} {m' :: * -> *} {e'} {a}.
(MonadCatchIO e m, MonadRunAsIOE e' m') =>
m a -> m' (Either (AnyException e) a)
tryAny (m c -> m c
forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a
restore (m c -> m c) -> m c -> m c
forall a b. (a -> b) -> a -> b
$ a -> m c
action a
x) m (Either (AnyException e) c)
-> (Either (AnyException e) c -> m c) -> m c
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right c
y -> do
        b1
_ <- m b1 -> m b1
forall e (m :: * -> *) a. MonadCatchIO e m => m a -> m a
uninterruptibleMaskM_ (a -> m b1
releaseOnSuccess a
x)
        c -> m c
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
y
      Left AnyException e
e -> do
        -- explicitly ignore synchronous exceptions
        Either e' b2
_ <- m' b2 -> m (Either e' b2)
forall e (m1 :: * -> *) e' (m2 :: * -> *) a.
(MonadCatchIO e m1, MonadRunIOE e' m2) =>
m1 a -> m2 (Either e a)
tryM (m' b2 -> m (Either e' b2)) -> m' b2 -> m (Either e' b2)
forall a b. (a -> b) -> a -> b
$ m' b2 -> m' b2
forall e (m :: * -> *) a. MonadCatchIO e m => m a -> m a
uninterruptibleMaskM_ (AnyException e -> a -> m' b2
releaseOnError AnyException e
e a
x)
        AnyException e -> m c
forall e (m :: * -> *) a. MonadRunIOE e m => AnyException e -> m a
rethrow AnyException e
e
  where
    tryAny :: m a -> m' (Either (AnyException e) a)
tryAny m a
m = (a -> Either (AnyException e) a
forall a b. b -> Either a b
Right (a -> Either (AnyException e) a)
-> m a -> m (Either (AnyException e) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m) m (Either (AnyException e) a)
-> (AnyException e -> m' (Either (AnyException e) a))
-> m' (Either (AnyException e) a)
forall e (m :: * -> *) e' (m' :: * -> *) a.
(MonadCatchIO e m, MonadRunAsIOE e' m') =>
m a -> (AnyException e -> m' a) -> m' a
forall e' (m' :: * -> *) a.
MonadRunAsIOE e' m' =>
m a -> (AnyException e -> m' a) -> m' a
`catchAnyM` (Either (AnyException e) a -> m' (Either (AnyException e) a)
forall a. a -> m' a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (AnyException e) a -> m' (Either (AnyException e) a))
-> (AnyException e -> Either (AnyException e) a)
-> AnyException e
-> m' (Either (AnyException e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyException e -> Either (AnyException e) a
forall a b. a -> Either a b
Left)

-- | 'bracket' generalized to any 'MonadCatchIO'
bracketM ::
  MonadCatchIO e m =>
  m a
  -> (a -> m b)
  -> (a -> m c)
  -> m c
bracketM :: forall e (m :: * -> *) a b c.
MonadCatchIO e m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketM m a
acquire a -> m b
release a -> m c
action = m a
-> (a -> m b) -> (AnyException e -> a -> m b) -> (a -> m c) -> m c
forall e (m :: * -> *) e' (m' :: * -> *) a b1 b2 c.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a
-> (a -> m b1)
-> (AnyException e -> a -> m' b2)
-> (a -> m c)
-> m c
bracketM' m a
acquire a -> m b
release (\AnyException e
_ -> a -> m b
release) a -> m c
action

-- | 'bracket_' generalized to any 'MonadCatchIO'
bracketM_ :: MonadCatchIO e m => m a -> m b -> m c -> m c
bracketM_ :: forall e (m :: * -> *) a b c.
MonadCatchIO e m =>
m a -> m b -> m c -> m c
bracketM_ m a
acquire m b
release m c
action = m a -> (a -> m b) -> (a -> m c) -> m c
forall e (m :: * -> *) a b c.
MonadCatchIO e m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketM m a
acquire (m b -> a -> m b
forall a b. a -> b -> a
const m b
release) (m c -> a -> m c
forall a b. a -> b -> a
const m c
action)

-- | 'bracketOnError' generalized to any 'MonadCatchIO'
bracketOnErrorM ::
  (MonadCatchIO e m, MonadCatchIO e' m') =>
  m a
  -> (a -> m' b)
  -> (a -> m c)
  -> m c
bracketOnErrorM :: forall e (m :: * -> *) e' (m' :: * -> *) a b c.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a -> (a -> m' b) -> (a -> m c) -> m c
bracketOnErrorM m a
acquire a -> m' b
release a -> m c
action = m a
-> (a -> m ())
-> (AnyException e -> a -> m' b)
-> (a -> m c)
-> m c
forall e (m :: * -> *) e' (m' :: * -> *) a b1 b2 c.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a
-> (a -> m b1)
-> (AnyException e -> a -> m' b2)
-> (a -> m c)
-> m c
bracketM' m a
acquire (\a
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\AnyException e
_ -> a -> m' b
release) a -> m c
action

-- | 'bracketOnError_' generalized to any 'MonadCatchIO'
bracketOnErrorM_ ::
  (MonadCatchIO e m, MonadCatchIO e' m') =>
  m a
  -> m' b
  -> m c
  -> m c
bracketOnErrorM_ :: forall e (m :: * -> *) e' (m' :: * -> *) a b c.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a -> m' b -> m c -> m c
bracketOnErrorM_ m a
acquire m' b
releaseOnError m c
action = m a -> (a -> m' b) -> (a -> m c) -> m c
forall e (m :: * -> *) e' (m' :: * -> *) a b c.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a -> (a -> m' b) -> (a -> m c) -> m c
bracketOnErrorM m a
acquire (m' b -> a -> m' b
forall a b. a -> b -> a
const m' b
releaseOnError) (m c -> a -> m c
forall a b. a -> b -> a
const m c
action)

-- | 'finally' generalized to any 'MonadCatchIO'
finallyM :: MonadCatchIO e m => m a -> m b -> m a
finallyM :: forall e (m :: * -> *) a b. MonadCatchIO e m => m a -> m b -> m a
finallyM m a
action m b
cleanup = m () -> m b -> m a -> m a
forall e (m :: * -> *) a b c.
MonadCatchIO e m =>
m a -> m b -> m c -> m c
bracketM_ (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m b
cleanup m a
action

-- | 'onException' generalized to any 'MonadCatchIO'
onExceptionM :: (MonadCatchIO e m, MonadCatchIO e' m') => m a -> m' b -> m a
onExceptionM :: forall e (m :: * -> *) e' (m' :: * -> *) a b.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a -> m' b -> m a
onExceptionM m a
action m' b
after = m a -> (AnyException e -> m' b) -> m a
forall e (m :: * -> *) e' (m' :: * -> *) a b.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a -> (AnyException e -> m' b) -> m a
withExceptionM m a
action (\AnyException e
_ -> m' b
after)

-- | 'withException' generalized to any 'MonadCatchIO'
withExceptionM :: (MonadCatchIO e m, MonadCatchIO e' m') => m a -> (AnyException e -> m' b) -> m a
withExceptionM :: forall e (m :: * -> *) e' (m' :: * -> *) a b.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a -> (AnyException e -> m' b) -> m a
withExceptionM m a
action AnyException e -> m' b
after =
  m ()
-> (() -> m ())
-> (AnyException e -> () -> m' b)
-> (() -> m a)
-> m a
forall e (m :: * -> *) e' (m' :: * -> *) a b1 b2 c.
(MonadCatchIO e m, MonadCatchIO e' m') =>
m a
-> (a -> m b1)
-> (AnyException e -> a -> m' b2)
-> (a -> m c)
-> m c
bracketM'
    (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    (\()
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    (\AnyException e
e ()
_ -> AnyException e -> m' b
after AnyException e
e)
    (\()
_ -> m a
action)

maskM' ::
  MonadCatchIO e m =>
  (forall b'. ((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b') -> UnsafeIO b')
  -> ((forall m' e' a. MonadCatchIO e' m' => m' a -> m' a) -> m b)
  -> m b
maskM' :: forall e (m :: * -> *) b.
MonadCatchIO e m =>
(forall b'.
 ((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b')
 -> UnsafeIO b')
-> ((forall (m' :: * -> *) e' a.
     MonadCatchIO e' m' =>
     m' a -> m' a)
    -> m b)
-> m b
maskM' forall b'.
((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b')
-> UnsafeIO b'
unsafeMask (forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
-> m b
f =
  ((forall a. m a -> IOE e a) -> IOE e b) -> m b
forall b. ((forall a. m a -> IOE e a) -> IOE e b) -> m b
forall e (m :: * -> *) b.
MonadRunAsIOE e m =>
((forall a. m a -> IOE e a) -> IOE e b) -> m b
withRunAsIOE (((forall a. m a -> IOE e a) -> IOE e b) -> m b)
-> ((forall a. m a -> IOE e a) -> IOE e b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IOE e a
run ->
    UIO (Either e b) -> IOE e b
forall e (m :: * -> *) a.
MonadRunIOE e m =>
UIO (Either e a) -> m a
fromUIO (UIO (Either e b) -> IOE e b) -> UIO (Either e b) -> IOE e b
forall a b. (a -> b) -> a -> b
$ ((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO (Either e b))
-> UIO (Either e b)
forall e (m :: * -> *) b.
MonadRunIOE e m =>
((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b) -> m b
maskIOE (((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO (Either e b))
 -> UIO (Either e b))
-> ((forall a'. UnsafeIO a' -> UnsafeIO a')
    -> UnsafeIO (Either e b))
-> UIO (Either e b)
forall a b. (a -> b) -> a -> b
$ \forall a'. UnsafeIO a' -> UnsafeIO a'
restore -> do
      let restoreIOE :: m1 a -> m a
restoreIOE m1 a
m =
            UIO (Either e a) -> m a
forall e (m :: * -> *) a.
MonadRunIOE e m =>
UIO (Either e a) -> m a
fromUIO (UIO (Either e a) -> m a) -> UIO (Either e a) -> m a
forall a b. (a -> b) -> a -> b
$
              (SomeException -> Void)
-> UnsafeIO (Either e a) -> UIO (Either e a)
forall e (m :: * -> *) a.
MonadRunIOE e m =>
(SomeException -> e) -> UnsafeIO a -> m a
checkIOWith
                (\SomeException
e -> [Char] -> Void
forall a. HasCallStack => [Char] -> a
error ([Char] -> Void) -> [Char] -> Void
forall a b. (a -> b) -> a -> b
$ [Char]
"restore unexpectedly threw an error: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)
                (UnsafeIO (Either e a) -> UnsafeIO (Either e a)
forall a'. UnsafeIO a' -> UnsafeIO a'
restore (UnsafeIO (Either e a) -> UnsafeIO (Either e a))
-> UnsafeIO (Either e a) -> UnsafeIO (Either e a)
forall a b. (a -> b) -> a -> b
$ UIO (Either e a) -> UnsafeIO (Either e a)
forall a. UIO a -> UnsafeIO a
unUIO (m1 a -> UIO (Either e a)
forall e (m1 :: * -> *) e' (m2 :: * -> *) a.
(MonadCatchIO e m1, MonadRunIOE e' m2) =>
m1 a -> m2 (Either e a)
tryM m1 a
m))
      UIO (Either e b) -> UnsafeIO (Either e b)
forall a. UIO a -> UnsafeIO a
unUIO (UIO (Either e b) -> UnsafeIO (Either e b))
-> UIO (Either e b) -> UnsafeIO (Either e b)
forall a b. (a -> b) -> a -> b
$ IOE e b -> UIO (Either e b)
forall e1 e2 a.
(Exception e1, Exception e2) =>
IOE e1 a -> IOE e2 (Either e1 a)
try (IOE e b -> UIO (Either e b)) -> IOE e b -> UIO (Either e b)
forall a b. (a -> b) -> a -> b
$ m b -> IOE e b
forall a. m a -> IOE e a
run (m b -> IOE e b) -> m b -> IOE e b
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
-> m b
f m' a -> m' a
forall {e} {m1 :: * -> *} {m :: * -> *} {a}.
(MonadCatchIO e m1, MonadRunIOE e m) =>
m1 a -> m a
forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a
restoreIOE
  where
    maskIOE :: MonadRunIOE e m => ((forall a. UnsafeIO a -> UnsafeIO a) -> UnsafeIO b) -> m b
    maskIOE :: forall e (m :: * -> *) b.
MonadRunIOE e m =>
((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b) -> m b
maskIOE (forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b
f' = (SomeException -> e) -> UnsafeIO b -> m b
forall e (m :: * -> *) a.
MonadRunIOE e m =>
(SomeException -> e) -> UnsafeIO a -> m a
checkIOWith (\SomeException
e -> [Char] -> e
forall a. HasCallStack => [Char] -> a
error ([Char] -> e) -> [Char] -> e
forall a b. (a -> b) -> a -> b
$ [Char]
"mask unexpectedly threw an error: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e) (((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b)
-> UnsafeIO b
forall b'.
((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b')
-> UnsafeIO b'
unsafeMask (forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b
f')

-- | 'mask' generalized to any 'MonadCatchIO'
maskM ::
  MonadCatchIO e m =>
  ((forall m' e' a. MonadCatchIO e' m' => m' a -> m' a) -> m b)
  -> m b
maskM :: forall e (m :: * -> *) b.
MonadCatchIO e m =>
((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> m b)
-> m b
maskM = (forall b'.
 ((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b')
 -> UnsafeIO b')
-> ((forall (m' :: * -> *) e' a.
     MonadCatchIO e' m' =>
     m' a -> m' a)
    -> m b)
-> m b
forall e (m :: * -> *) b.
MonadCatchIO e m =>
(forall b'.
 ((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b')
 -> UnsafeIO b')
-> ((forall (m' :: * -> *) e' a.
     MonadCatchIO e' m' =>
     m' a -> m' a)
    -> m b)
-> m b
maskM' ((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b')
-> UnsafeIO b'
forall b'.
((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b')
-> UnsafeIO b'
GHC.mask

-- | 'uninterruptibleMask' generalized to any 'MonadCatchIO'
uninterruptibleMaskM ::
  MonadCatchIO e m =>
  ((forall m' e' a. MonadCatchIO e' m' => m' a -> m' a) -> m b)
  -> m b
uninterruptibleMaskM :: forall e (m :: * -> *) b.
MonadCatchIO e m =>
((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> m b)
-> m b
uninterruptibleMaskM = (forall b'.
 ((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b')
 -> UnsafeIO b')
-> ((forall (m' :: * -> *) e' a.
     MonadCatchIO e' m' =>
     m' a -> m' a)
    -> m b)
-> m b
forall e (m :: * -> *) b.
MonadCatchIO e m =>
(forall b'.
 ((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b')
 -> UnsafeIO b')
-> ((forall (m' :: * -> *) e' a.
     MonadCatchIO e' m' =>
     m' a -> m' a)
    -> m b)
-> m b
maskM' ((forall a'. UnsafeIO a' -> UnsafeIO a') -> IO b') -> IO b'
forall b'.
((forall a'. UnsafeIO a' -> UnsafeIO a') -> UnsafeIO b')
-> UnsafeIO b'
GHC.uninterruptibleMask

-- | 'mask_' generalized to any 'MonadCatchIO'
maskM_ :: MonadCatchIO e m => m a -> m a
maskM_ :: forall e (m :: * -> *) a. MonadCatchIO e m => m a -> m a
maskM_ m a
action = ((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> m a)
-> m a
forall e (m :: * -> *) b.
MonadCatchIO e m =>
((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> m b)
-> m b
maskM (\forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a
_ -> m a
action)

-- | 'uninterruptibleMask_' generalized to any 'MonadCatchIO'
uninterruptibleMaskM_ :: MonadCatchIO e m => m a -> m a
uninterruptibleMaskM_ :: forall e (m :: * -> *) a. MonadCatchIO e m => m a -> m a
uninterruptibleMaskM_ m a
action = ((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> m a)
-> m a
forall e (m :: * -> *) b.
MonadCatchIO e m =>
((forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a)
 -> m b)
-> m b
uninterruptibleMaskM (\forall (m' :: * -> *) e' a. MonadCatchIO e' m' => m' a -> m' a
_ -> m a
action)

{----- Interop with unchecked IO -----}

-- | A convenient alias for 'main' functions
type Main = UnsafeIO ()

-- | Convert an unchecked IO action into a checked IO action.
checkIO :: MonadRunIO m => UnsafeIO a -> m a
checkIO :: forall (m :: * -> *) a. MonadRunIO m => UnsafeIO a -> m a
checkIO = (SomeException -> SomeSyncException) -> UnsafeIO a -> m a
forall e (m :: * -> *) a.
MonadRunIOE e m =>
(SomeException -> e) -> UnsafeIO a -> m a
checkIOWith (\(SomeException e
e) -> e -> SomeSyncException
forall e. Exception e => e -> SomeSyncException
SomeSyncException e
e)

-- | Same as 'checkIO' except converting a synchronous exception with the given function.
--
-- Equivalent to @mapExceptionM f . checkIO@, except more performant.
checkIOWith :: (MonadRunIOE e m) => (SomeException -> e) -> UnsafeIO a -> m a
checkIOWith :: forall e (m :: * -> *) a.
MonadRunIOE e m =>
(SomeException -> e) -> UnsafeIO a -> m a
checkIOWith SomeException -> e
f UnsafeIO a
m = (SomeException -> e) -> UnsafeIO a -> m (Either e a)
forall e' (m :: * -> *) e a.
MonadRunIOE e' m =>
(SomeException -> e) -> UnsafeIO a -> m (Either e a)
checkUIOWith SomeException -> e
f UnsafeIO a
m m (Either e a) -> (Either e a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => e -> m a
throw a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Same as 'checkIOWith' except returning the exception as an @Either@ instead of
-- throwing it.
checkUIOWith :: MonadRunIOE e' m => (SomeException -> e) -> UnsafeIO a -> m (Either e a)
checkUIOWith :: forall e' (m :: * -> *) e a.
MonadRunIOE e' m =>
(SomeException -> e) -> UnsafeIO a -> m (Either e a)
checkUIOWith SomeException -> e
f UnsafeIO a
m =
  IOE e' (Either e a) -> m (Either e a)
forall a. IOE e' a -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => IOE e a -> m a
runIOE (IOE e' (Either e a) -> m (Either e a))
-> (UnsafeIO (Either e a) -> IOE e' (Either e a))
-> UnsafeIO (Either e a)
-> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsafeIO (Either e a) -> IOE e' (Either e a)
forall e a. UnsafeIO a -> IOE e a
UnsafeIOE (UnsafeIO (Either e a) -> m (Either e a))
-> UnsafeIO (Either e a) -> m (Either e a)
forall a b. (a -> b) -> a -> b
$
    UnsafeIO a -> IO (Either (AnyException SomeException) a)
forall e a. Exception e => IO a -> IO (Either e a)
GHC.try UnsafeIO a
m IO (Either (AnyException SomeException) a)
-> (Either (AnyException SomeException) a -> UnsafeIO (Either e a))
-> UnsafeIO (Either e a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right a
x -> Either e a -> UnsafeIO (Either e a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> UnsafeIO (Either e a))
-> Either e a -> UnsafeIO (Either e a)
forall a b. (a -> b) -> a -> b
$ a -> Either e a
forall a b. b -> Either a b
Right a
x
      Left (AnySyncException SomeException
e) -> Either e a -> UnsafeIO (Either e a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> UnsafeIO (Either e a))
-> Either e a -> UnsafeIO (Either e a)
forall a b. (a -> b) -> a -> b
$ e -> Either e a
forall a b. a -> Either a b
Left (SomeException -> e
f SomeException
e)
      Left AnyException SomeException
e -> AnyException SomeException -> UnsafeIO (Either e a)
forall e a. Exception e => e -> IO a
GHC.throwIO AnyException SomeException
e

-- | Convert an unchecked IO action into a checked IO action that can throw
-- the given exception type.
--
-- __Warning__: If the IO action threw a different synchronous exception,
-- this function will error. Prefer using 'checkIOWith' and calling 'error'
-- yourself with a better error message.
unsafeCheckIO :: (HasCallStack, MonadRunIOE e m) => UnsafeIO a -> m a
unsafeCheckIO :: forall e (m :: * -> *) a.
(HasCallStack, MonadRunIOE e m) =>
UnsafeIO a -> m a
unsafeCheckIO = IOE e a -> m a
forall a. IOE e a -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => IOE e a -> m a
runIOE (IOE e a -> m a) -> (UnsafeIO a -> IOE e a) -> UnsafeIO a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeSyncException -> e) -> IOE SomeSyncException a -> IOE e a
forall e1 e2 (m1 :: * -> *) (m2 :: * -> *) a.
(MonadCatchIO e1 m1, MonadRunAsIOE e2 m2) =>
(e1 -> e2) -> m1 a -> m2 a
mapExceptionM SomeSyncException -> e
forall {p}. Typeable p => SomeSyncException -> p
convert (IOE SomeSyncException a -> IOE e a)
-> (UnsafeIO a -> IOE SomeSyncException a) -> UnsafeIO a -> IOE e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadRunIO m => UnsafeIO a -> m a
checkIO @IO
  where
    convert :: SomeSyncException -> p
convert (SomeSyncException e
e) =
      case e -> Maybe p
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e of
        Just p
e' -> p
e'
        Maybe p
Nothing ->
          p -> p
(HasCallStack => p) -> p
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (p -> p) -> ([Char] -> p) -> [Char] -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> p
forall a. HasCallStack => [Char] -> a
error ([Char] -> p) -> [Char] -> p
forall a b. (a -> b) -> a -> b
$
            [Char]
"unsafeCheckIO was called on an action that threw an unexpected error: "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ e -> [Char]
forall a. Show a => a -> [Char]
show e
e

-- | Same as 'unsafeCheckIO', except expects /no/ exceptions to be thrown.
unsafeCheckUIO :: (HasCallStack, MonadRunIOE e m) => UnsafeIO a -> m a
unsafeCheckUIO :: forall e (m :: * -> *) a.
(HasCallStack, MonadRunIOE e m) =>
UnsafeIO a -> m a
unsafeCheckUIO = m a -> m a
(HasCallStack => m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (m a -> m a) -> (UnsafeIO a -> m a) -> UnsafeIO a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UIO a -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => UIO a -> m a
runUIO (UIO a -> m a) -> (UnsafeIO a -> UIO a) -> UnsafeIO a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsafeIO a -> UIO a
forall e (m :: * -> *) a.
(HasCallStack, MonadRunIOE e m) =>
UnsafeIO a -> m a
unsafeCheckIO

-- | Unchecks an 'IOE' action back into the normal 'GHC.IO' monad.
--
-- __Warning__: Imprecise exceptions might be wrapped in 'AnyException'
-- after converting to 'UnsafeIO'. See 'throwImprecise' for more details.
uncheckIOE :: forall e a. Exception e => IOE e a -> UnsafeIO a
uncheckIOE :: forall e a. Exception e => IOE e a -> UnsafeIO a
uncheckIOE IOE e a
m =
  let UnsafeIOE UnsafeIO (Either (AnyException e) a)
m' = (a -> Either (AnyException e) a
forall a b. b -> Either a b
Right (a -> Either (AnyException e) a)
-> IOE e a -> IOE e (Either (AnyException e) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOE e a
m IOE e (Either (AnyException e) a)
-> (Either (AnyException e) a -> IOE e (Either (AnyException e) a))
-> IOE e (Either (AnyException e) a)
forall a b. IOE e a -> (a -> IOE e b) -> IOE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (AnyException e) a -> IOE e (Either (AnyException e) a)
forall e (m :: * -> *) a. MonadRunIOE e m => a -> m a
evaluate) IOE e (Either (AnyException e) a)
-> (AnyException e -> IOE Void (Either (AnyException e) a))
-> IOE Void (Either (AnyException e) a)
forall e1 e2 a.
(Exception e1, Exception e2) =>
IOE e1 a -> (AnyException e1 -> IOE e2 a) -> IOE e2 a
`catchAny` (forall (f :: * -> *) a. Applicative f => a -> f a
pure @UIO (Either (AnyException e) a -> IOE Void (Either (AnyException e) a))
-> (AnyException e -> Either (AnyException e) a)
-> AnyException e
-> IOE Void (Either (AnyException e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyException e -> Either (AnyException e) a
forall a b. a -> Either a b
Left)
  in  UnsafeIO (Either (AnyException e) a)
m' UnsafeIO (Either (AnyException e) a)
-> (Either (AnyException e) a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right a
a -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        Left (AnySyncException e
e) ->
          case e -> Maybe SomeSyncException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e of
            Just (SomeSyncException e
e') -> e -> IO a
forall e a. Exception e => e -> IO a
GHC.throwIO e
e'
            Maybe SomeSyncException
Nothing -> e -> IO a
forall e a. Exception e => e -> IO a
GHC.throwIO e
e
        Left (AnyAsyncException (SomeException e
e)) -> SomeAsyncException -> IO a
forall e a. Exception e => e -> IO a
GHC.throwIO (e -> SomeAsyncException
forall e. Exception e => e -> SomeAsyncException
GHC.SomeAsyncException e
e)
        Left (AnyImpreciseException SomeException
e) -> SomeException -> IO a
forall e a. Exception e => e -> IO a
GHC.throwIO SomeException
e

-- | 'uncheckIOE' specialized to UIO.
uncheckUIO :: UIO a -> UnsafeIO a
uncheckUIO :: forall a. UIO a -> UnsafeIO a
uncheckUIO = IOE Void a -> UnsafeIO a
forall e a. Exception e => IOE e a -> UnsafeIO a
uncheckIOE

-- | Internal-only function to rethrow an 'AnyException' caught by 'catchAnyM'.
rethrow :: MonadRunIOE e m => AnyException e -> m a
rethrow :: forall e (m :: * -> *) a. MonadRunIOE e m => AnyException e -> m a
rethrow = IOE e a -> m a
forall a. IOE e a -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => IOE e a -> m a
runIOE (IOE e a -> m a)
-> (AnyException e -> IOE e a) -> AnyException e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsafeIO a -> IOE e a
forall e a. UnsafeIO a -> IOE e a
UnsafeIOE (UnsafeIO a -> IOE e a)
-> (AnyException e -> UnsafeIO a) -> AnyException e -> IOE e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyException SomeException -> UnsafeIO a
forall e a. Exception e => e -> IO a
GHC.throwIO (AnyException SomeException -> UnsafeIO a)
-> (AnyException e -> AnyException SomeException)
-> AnyException e
-> UnsafeIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> SomeException)
-> AnyException e -> AnyException SomeException
forall a b. (a -> b) -> AnyException a -> AnyException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> SomeException
forall e. Exception e => e -> SomeException
SomeException

{----- Exceptions in IOE -----}

-- | All exceptions floating around 'IOE' (synchronous
-- or otherwise) will be an @AnyException SomeException@.
data AnyException e
  = AnySyncException e
  | AnyAsyncException SomeException
  | AnyImpreciseException SomeException
  -- TODO: should ExitCode be handled specially?
  deriving ((forall a b. (a -> b) -> AnyException a -> AnyException b)
-> (forall a b. a -> AnyException b -> AnyException a)
-> Functor AnyException
forall a b. a -> AnyException b -> AnyException a
forall a b. (a -> b) -> AnyException a -> AnyException b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AnyException a -> AnyException b
fmap :: forall a b. (a -> b) -> AnyException a -> AnyException b
$c<$ :: forall a b. a -> AnyException b -> AnyException a
<$ :: forall a b. a -> AnyException b -> AnyException a
Functor)

deriving instance Show e => Show (AnyException e)

instance Exception (AnyException SomeException) where
  fromException :: SomeException -> Maybe (AnyException SomeException)
fromException = AnyException SomeException -> Maybe (AnyException SomeException)
forall a. a -> Maybe a
Just (AnyException SomeException -> Maybe (AnyException SomeException))
-> (SomeException -> AnyException SomeException)
-> SomeException
-> Maybe (AnyException SomeException)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> AnyException SomeException
toAnyException

toAnyException :: SomeException -> AnyException SomeException
toAnyException :: SomeException -> AnyException SomeException
toAnyException someE :: SomeException
someE@(SomeException e
e) =
  AnyException SomeException
-> Maybe (AnyException SomeException) -> AnyException SomeException
forall a. a -> Maybe a -> a
fromMaybe (SomeException -> AnyException SomeException
asSync SomeException
someE) (Maybe (AnyException SomeException) -> AnyException SomeException)
-> ([Maybe (AnyException SomeException)]
    -> Maybe (AnyException SomeException))
-> [Maybe (AnyException SomeException)]
-> AnyException SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (AnyException SomeException)]
-> Maybe (AnyException SomeException)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe (AnyException SomeException)]
 -> AnyException SomeException)
-> [Maybe (AnyException SomeException)]
-> AnyException SomeException
forall a b. (a -> b) -> a -> b
$
    [ e -> Maybe (AnyException SomeException)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
    , ErrorCall -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (ErrorCall -> AnyException SomeException)
-> Maybe ErrorCall -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.ErrorCall
    , TypeError -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (TypeError -> AnyException SomeException)
-> Maybe TypeError -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.TypeError
    , ArithException -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (ArithException -> AnyException SomeException)
-> Maybe ArithException -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.ArithException
    , ArrayException -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (ArrayException -> AnyException SomeException)
-> Maybe ArrayException -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.ArrayException
    , AssertionFailed -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (AssertionFailed -> AnyException SomeException)
-> Maybe AssertionFailed -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.AssertionFailed
    , NestedAtomically -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (NestedAtomically -> AnyException SomeException)
-> Maybe NestedAtomically -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.NestedAtomically
    , NoMethodError -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (NoMethodError -> AnyException SomeException)
-> Maybe NoMethodError -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.NoMethodError
    , PatternMatchFail -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (PatternMatchFail -> AnyException SomeException)
-> Maybe PatternMatchFail -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.PatternMatchFail
    , RecConError -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (RecConError -> AnyException SomeException)
-> Maybe RecConError -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.RecConError
    , RecSelError -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (RecSelError -> AnyException SomeException)
-> Maybe RecSelError -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.RecSelError
    , RecUpdError -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asImprecise (RecUpdError -> AnyException SomeException)
-> Maybe RecUpdError -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.RecUpdError
    , AsyncException -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asAsync (AsyncException -> AnyException SomeException)
-> Maybe AsyncException -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.AsyncException
    , CompactionFailed -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asAsync (CompactionFailed -> AnyException SomeException)
-> Maybe CompactionFailed -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.CompactionFailed
    , FixIOException -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asAsync (FixIOException -> AnyException SomeException)
-> Maybe FixIOException -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.FixIOException
    , AsyncException -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asAsync (AsyncException -> AnyException SomeException)
-> Maybe AsyncException -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.AsyncException
    , BlockedIndefinitelyOnSTM -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asAsync (BlockedIndefinitelyOnSTM -> AnyException SomeException)
-> Maybe BlockedIndefinitelyOnSTM
-> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.BlockedIndefinitelyOnSTM
    , BlockedIndefinitelyOnMVar -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asAsync (BlockedIndefinitelyOnMVar -> AnyException SomeException)
-> Maybe BlockedIndefinitelyOnMVar
-> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.BlockedIndefinitelyOnMVar
    , Deadlock -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asAsync (Deadlock -> AnyException SomeException)
-> Maybe Deadlock -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.Deadlock
    , NonTermination -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asAsync (NonTermination -> AnyException SomeException)
-> Maybe NonTermination -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Exception e => Maybe e
castE @GHC.NonTermination
    , (\(GHC.SomeAsyncException e
e') -> e -> AnyException SomeException
forall e. Exception e => e -> AnyException SomeException
asAsync e
e') (SomeAsyncException -> AnyException SomeException)
-> Maybe SomeAsyncException -> Maybe (AnyException SomeException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SomeAsyncException
forall e. Exception e => Maybe e
castE
    ]
  where
    asSync :: SomeException -> AnyException SomeException
    asSync :: SomeException -> AnyException SomeException
asSync = SomeException -> AnyException SomeException
forall e. e -> AnyException e
AnySyncException

    asAsync :: Exception e => e -> AnyException SomeException
    asAsync :: forall e. Exception e => e -> AnyException SomeException
asAsync = SomeException -> AnyException SomeException
forall e. SomeException -> AnyException e
AnyAsyncException (SomeException -> AnyException SomeException)
-> (e -> SomeException) -> e -> AnyException SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
SomeException

    asImprecise :: Exception e => e -> AnyException SomeException
    asImprecise :: forall e. Exception e => e -> AnyException SomeException
asImprecise = SomeException -> AnyException SomeException
forall e. SomeException -> AnyException e
AnyImpreciseException (SomeException -> AnyException SomeException)
-> (e -> SomeException) -> e -> AnyException SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
SomeException

    castE :: forall e. Exception e => Maybe e
    castE :: forall e. Exception e => Maybe e
castE = SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
someE

castAnyException :: forall e. Exception e => AnyException SomeException -> AnyException e
castAnyException :: forall e.
Exception e =>
AnyException SomeException -> AnyException e
castAnyException = (SomeException -> e)
-> AnyException SomeException -> AnyException e
forall a b. (a -> b) -> AnyException a -> AnyException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeException -> e
forall {p}. Typeable p => SomeException -> p
castExpected
  where
    castExpected :: SomeException -> p
castExpected (SomeException e
eActual) =
      case e -> Maybe p
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
eActual of
        Just p
e -> p
e
        Maybe p
Nothing ->
          [Char] -> p
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> p) -> ([[Char]] -> [Char]) -> [[Char]] -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unwords ([[Char]] -> p) -> [[Char]] -> p
forall a b. (a -> b) -> a -> b
$
            [ [Char]
"checked-io invariant violation:"
            , [Char]
"IOE contained an unexpected synchronous exception:"
            , [Char]
"Expected `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep -> [Char]
forall a. Show a => a -> [Char]
show (Proxy e -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy e -> TypeRep) -> Proxy e -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"`,"
            , [Char]
"got `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep -> [Char]
forall a. Show a => a -> [Char]
show (e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
eActual) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"`."
            , e -> [Char]
forall a. Show a => a -> [Char]
show e
eActual
            ]

data SomeSyncException = forall e. Exception e => SomeSyncException e

instance Show SomeSyncException where
  showsPrec :: Int -> SomeSyncException -> [Char] -> [Char]
showsPrec Int
p (SomeSyncException e
e) = Int -> e -> [Char] -> [Char]
forall a. Show a => Int -> a -> [Char] -> [Char]
showsPrec Int
p e
e

instance Exception SomeSyncException