{-# LANGUAGE ExplicitForAll #-}

-- | This module presents the same interface as
-- "Control.Exception.Annotated", but uses 'MonadUnliftIO' instead of
-- 'Control.Monad.Catch.MonadCatch' or 'Control.Monad.Catch.MonadThrow'.
--
-- @since 0.1.2.0
module Control.Exception.Annotated.UnliftIO
    ( -- * The Main Type
      AnnotatedException(..)
    , exceptionWithCallStack
    , throwWithCallStack
    -- * Annotating Exceptions
    , checkpoint
    , checkpointMany
    , checkpointCallStack
    , checkpointCallStackWith
    -- * Handling Exceptions
    , catch
    , catches
    , tryAnnotated
    , try

    -- * Manipulating Annotated Exceptions
    , check
    , hide
    , annotatedExceptionCallStack
    , addCallStackToException

    -- * Re-exports from "Data.Annotation"
    , Annotation(..)
    , CallStackAnnotation(..)
    -- * Re-exports from "Control.Exception.Safe"
    , Exception(..)
    , Safe.SomeException(..)
    , throw
    , Handler (..)
    , MonadIO(..)
    , MonadUnliftIO(..)
    ) where

import Control.Exception.Annotated
       ( AnnotatedException(..)
       , Annotation(..)
       , CallStackAnnotation(..)
       , Exception(..)
       , Handler(..)
       , addCallStackToException
       , annotatedExceptionCallStack
       , check
       , exceptionWithCallStack
       , hide
       )
import qualified Control.Exception.Annotated as Catch
import qualified Control.Exception.Safe as Safe
import Control.Monad.IO.Unlift
import GHC.Stack

-- | Like 'Catch.throwWithCallStack', but uses 'MonadIO' instead of
-- 'Control.Monad.Catch.MonadThrow'.
--
-- @since 0.1.2.0
throwWithCallStack
    :: forall e m a. (MonadIO m, Exception e, HasCallStack)
    => e -> m a
throwWithCallStack :: forall e (m :: * -> *) a.
(MonadIO m, Exception e, HasCallStack) =>
e -> m a
throwWithCallStack = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (e -> IO a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => e -> IO a) -> e -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack e -> IO a
HasCallStack => e -> IO a
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
Catch.throwWithCallStack

-- | Like 'Catch.throw', but uses 'MonadIO' instead of 'Control.Monad.Catch.MonadThrow'.
--
-- @since 0.1.2.0
throw :: forall e m a. (MonadIO m, Exception e, HasCallStack) => e -> m a
throw :: forall e (m :: * -> *) a.
(MonadIO m, Exception e, HasCallStack) =>
e -> m a
throw = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (e -> IO a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => e -> IO a) -> e -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack e -> IO a
HasCallStack => e -> IO a
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
Catch.throw

-- | Like 'Catch.checkpoint', but uses 'MonadUnliftIO' instead of 'Control.Monad.Catch.MonadCatch'.
--
-- @since 0.1.2.0
checkpoint :: forall m a. (MonadUnliftIO m, HasCallStack) => Annotation -> m a -> m a
checkpoint :: forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
Annotation -> m a -> m a
checkpoint Annotation
ann m a
action = ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
    IO a -> IO a
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ (HasCallStack => IO a -> IO a) -> IO a -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (Annotation -> IO a -> IO a
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
Annotation -> m a -> m a
Catch.checkpoint Annotation
ann) (m a -> IO a
forall a. m a -> IO a
runInIO m a
action)

-- | Like 'Catch.checkpointCallStack', but uses 'MonadUnliftIO' instead of
-- 'Control.Monad.Catch.MonadCatch'.
--
-- @since 0.2.0.2
checkpointCallStack
    :: forall m a. (MonadUnliftIO m, HasCallStack)
    => m a
    -> m a
checkpointCallStack :: forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
m a -> m a
checkpointCallStack m a
action =
    ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
        (HasCallStack => IO a -> IO a) -> IO a -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => IO a -> IO a
IO a -> IO a
forall (m :: * -> *) a. (MonadCatch m, HasCallStack) => m a -> m a
Catch.checkpointCallStack (m a -> IO a
forall a. m a -> IO a
runInIO m a
action)

-- | Like 'Catch.checkpointMany', but uses 'MonadUnliftIO' instead of
-- 'Control.Monad.Catch.MonadCatch'.
--
-- @since 0.1.2.0
checkpointMany :: forall m a. (MonadUnliftIO m, HasCallStack) => [Annotation] -> m a -> m a
checkpointMany :: forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
[Annotation] -> m a -> m a
checkpointMany [Annotation]
anns m a
action =
    ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
        IO a -> IO a
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ (HasCallStack => [Annotation] -> IO a -> IO a)
-> [Annotation] -> IO a -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => [Annotation] -> IO a -> IO a
[Annotation] -> IO a -> IO a
forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
[Annotation] -> m a -> m a
Catch.checkpointMany [Annotation]
anns (m a -> IO a
forall a. m a -> IO a
runInIO m a
action)

-- | Like 'Catch.checkpointCallStackWith', but uses 'MonadUnliftIO' instead of
-- 'Control.Monad.Catch.MonadCatch'.
--
-- Deprecated in 0.2.0.0 as it is now an alias for 'checkpointMany'.
--
-- @since 0.1.2.0
checkpointCallStackWith
    :: forall m a. (MonadUnliftIO m, HasCallStack)
    => [Annotation] -> m a -> m a
checkpointCallStackWith :: forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
[Annotation] -> m a -> m a
checkpointCallStackWith [Annotation]
anns m a
action =
    ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
        IO a -> IO a
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ (HasCallStack => [Annotation] -> IO a -> IO a)
-> [Annotation] -> IO a -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => [Annotation] -> IO a -> IO a
[Annotation] -> IO a -> IO a
forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
[Annotation] -> m a -> m a
Catch.checkpointCallStackWith [Annotation]
anns (m a -> IO a
forall a. m a -> IO a
runInIO m a
action)

{-# DEPRECATED checkpointCallStackWith "As of annotated-exception-0.2.0.0, this is an alias for checkpointMany" #-}

-- | Like 'Catch.catch', but uses 'MonadUnliftIO' instead of 'Control.Monad.Catch.MonadCatch'.
--
-- @since 0.1.2.0
catch
    :: forall e m a. (MonadUnliftIO m, Exception e, HasCallStack)
    => m a
    -> (e -> m a)
    -> m a
catch :: forall e (m :: * -> *) a.
(MonadUnliftIO m, Exception e, HasCallStack) =>
m a -> (e -> m a) -> m a
catch m a
action e -> m a
handler =
    ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
        IO a -> IO a
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ (HasCallStack => IO a -> (e -> IO a) -> IO a)
-> IO a -> (e -> IO a) -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => IO a -> (e -> IO a) -> IO a
IO a -> (e -> IO a) -> IO a
forall e (m :: * -> *) a.
(HasCallStack, Exception e, MonadCatch m) =>
m a -> (e -> m a) -> m a
Catch.catch (m a -> IO a
forall a. m a -> IO a
runInIO m a
action) (\e
e -> m a -> IO a
forall a. m a -> IO a
runInIO (m a -> IO a) -> m a -> IO a
forall a b. (a -> b) -> a -> b
$ e -> m a
handler e
e)

-- | Like 'Catch.tryAnnotated' but uses 'MonadUnliftIO' instead of 'Control.Monad.Catch.MonadCatch'.
--
-- @since 0.1.2.0
tryAnnotated
    :: forall e m a. (MonadUnliftIO m, Exception e)
    => m a
    -> m (Either (AnnotatedException e) a)
tryAnnotated :: forall e (m :: * -> *) a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either (AnnotatedException e) a)
tryAnnotated m a
action =
    ((forall a. m a -> IO a) -> IO (Either (AnnotatedException e) a))
-> m (Either (AnnotatedException e) a)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Either (AnnotatedException e) a))
 -> m (Either (AnnotatedException e) a))
-> ((forall a. m a -> IO a)
    -> IO (Either (AnnotatedException e) a))
-> m (Either (AnnotatedException e) a)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
        IO (Either (AnnotatedException e) a)
-> IO (Either (AnnotatedException e) a)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (AnnotatedException e) a)
 -> IO (Either (AnnotatedException e) a))
-> IO (Either (AnnotatedException e) a)
-> IO (Either (AnnotatedException e) a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either (AnnotatedException e) a)
forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
m a -> m (Either (AnnotatedException e) a)
Catch.tryAnnotated (m a -> IO a
forall a. m a -> IO a
runInIO m a
action)

-- | Like 'Catch.try' but uses 'MonadUnliftIO' instead of 'Control.Monad.Catch.MonadCatch'.
--
-- @since 0.1.2.0
try
    :: forall e m a. (MonadUnliftIO m, Exception e)
    => m a
    -> m (Either e a)
try :: forall e (m :: * -> *) a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try m a
action =
    ((forall a. m a -> IO a) -> IO (Either e a)) -> m (Either e a)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Either e a)) -> m (Either e a))
-> ((forall a. m a -> IO a) -> IO (Either e a)) -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
        IO (Either e a) -> IO (Either e a)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either e a) -> IO (Either e a))
-> IO (Either e a) -> IO (Either e a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either e a)
forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
m a -> m (Either e a)
Catch.try (m a -> IO a
forall a. m a -> IO a
runInIO m a
action)

-- | Like 'Catch.catches', bt uses 'MonadUnliftIO' instead of 'Control.Monad.Catch.MonadCatch'.
--
-- @since 0.1.2.0
catches
    :: forall m a. (MonadUnliftIO m, HasCallStack)
    => m a
    -> [Handler m a]
    -> m a
catches :: forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
m a -> [Handler m a] -> m a
catches m a
action [Handler m a]
handlers =
    ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> do
        let f :: Handler m a -> Handler IO a
f (Handler e -> m a
k) = (e -> IO a) -> Handler IO a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\e
e -> m a -> IO a
forall a. m a -> IO a
runInIO (e -> m a
k e
e))
        IO a -> IO a
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ (HasCallStack => IO a -> [Handler IO a] -> IO a)
-> IO a -> [Handler IO a] -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => IO a -> [Handler IO a] -> IO a
IO a -> [Handler IO a] -> IO a
forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
m a -> [Handler m a] -> m a
Catch.catches (m a -> IO a
forall a. m a -> IO a
runInIO m a
action) ((Handler m a -> Handler IO a) -> [Handler m a] -> [Handler IO a]
forall a b. (a -> b) -> [a] -> [b]
map Handler m a -> Handler IO a
forall {a}. Handler m a -> Handler IO a
f [Handler m a]
handlers)