module GHC.Stack.Annotation.UnliftIO
  (
  -- * Push stack frame annotations in 'MonadUnliftIO' code.
  --
  annotateStackIO,
  annotateStackStringIO,
  annotateStackShowIO,
  annotateCallStackIO,
  ) where

import qualified GHC.Stack.Annotation as Annotation
import Data.Typeable (Typeable)
import Control.Monad.IO.Unlift (MonadUnliftIO(..))
import GHC.Stack.Types (HasCallStack)

annotateStackIO :: (Typeable a, Annotation.StackAnnotation a, MonadUnliftIO m) => a -> m b -> m b
annotateStackIO :: forall a (m :: * -> *) b.
(Typeable a, StackAnnotation a, MonadUnliftIO m) =>
a -> m b -> m b
annotateStackIO a
anno m b
action =
  ((forall a. m a -> IO a) -> IO b) -> m b
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 b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> a -> IO b -> IO b
forall a b.
(HasCallStack, Typeable a, StackAnnotation a) =>
a -> IO b -> IO b
Annotation.annotateStackIO a
anno (m b -> IO b
forall a. m a -> IO a
runInIO m b
action)

annotateStackStringIO :: MonadUnliftIO m => String -> m b -> m b
annotateStackStringIO :: forall (m :: * -> *) b. MonadUnliftIO m => String -> m b -> m b
annotateStackStringIO String
msg m b
action =
  ((forall a. m a -> IO a) -> IO b) -> m b
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 b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> String -> IO b -> IO b
forall b. HasCallStack => String -> IO b -> IO b
Annotation.annotateStackStringIO String
msg (m b -> IO b
forall a. m a -> IO a
runInIO m b
action)

annotateStackShowIO :: (Show a, MonadUnliftIO m) => a -> m b -> m b
annotateStackShowIO :: forall a (m :: * -> *) b.
(Show a, MonadUnliftIO m) =>
a -> m b -> m b
annotateStackShowIO a
value m b
action =
  ((forall a. m a -> IO a) -> IO b) -> m b
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 b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> a -> IO b -> IO b
forall a b. (HasCallStack, Show a) => a -> IO b -> IO b
Annotation.annotateStackShowIO a
value (m b -> IO b
forall a. m a -> IO a
runInIO m b
action)

annotateCallStackIO :: (HasCallStack, MonadUnliftIO m) => m b -> m b
annotateCallStackIO :: forall (m :: * -> *) b.
(HasCallStack, MonadUnliftIO m) =>
m b -> m b
annotateCallStackIO m b
action =
  ((forall a. m a -> IO a) -> IO b) -> m b
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 b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> IO b -> IO b
forall a. HasCallStack => IO a -> IO a
Annotation.annotateCallStackIO (m b -> IO b
forall a. m a -> IO a
runInIO m b
action)