-- | Functions and types for safely working with 'Async's in 'Scoped' blocks
module Control.Monad.Scoped.Async
  ( -- * Scoped 'Control.Concurrent.Async.Async'
    ScopedAsync

    -- * Allocating a new 'ScopedAsync' in a 'Scoped' block
  , async
  , asyncBound

    -- * Waiting for a 'ScopedAsync' to finish
  , wait
  , waitCatch

    -- * Waiting for a 'ScopedAsync' to finish as part of the handlers of the 'Scoped' block
  , waitScoped
  , waitCatchScoped
  )
where

import Control.Concurrent.Async (Async)
import Control.Exception (SomeException)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Scoped.Internal (Scoped (UnsafeMkScoped), ScopedResource (UnsafeMkScopedResource, unsafeUnwrapScopedResource), registerHandler, (:<))
import UnliftIO (MonadUnliftIO)
import UnliftIO.Async (withAsync, withAsyncBound)
import UnliftIO.Async qualified as Async

-- | Just like 'Async' but bound to a 'Scoped' block
type ScopedAsync s a = ScopedResource s (Async a)

-- | Run an 'IO' action asynchronously in a Scoped block. When the 'Scoped' block ends, the 'Async' is 'Control.Concurrent.Async.cancel'led
async :: MonadUnliftIO m => m a -> Scoped (s : ss) m (ScopedAsync s a)
async :: forall (m :: Type -> Type) a s (ss :: [Type]).
MonadUnliftIO m =>
m a -> Scoped (s : ss) m (ScopedAsync s a)
async m a
act = (forall b. (ScopedAsync s a -> m b) -> m b)
-> Scoped (s : ss) m (ScopedAsync s a)
forall {k} (s :: [Type]) (m :: k -> Type) a.
(forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
UnsafeMkScoped \ScopedAsync s a -> m b
k -> m a -> (Async a -> m b) -> m b
forall (m :: Type -> Type) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync m a
act (ScopedAsync s a -> m b
k (ScopedAsync s a -> m b)
-> (Async a -> ScopedAsync s a) -> Async a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> ScopedAsync s a
forall s a. a -> ScopedResource s a
UnsafeMkScopedResource)

-- | Like 'async' but uses 'Control.Concurrent.forkOS' internally
asyncBound :: MonadUnliftIO m => m a -> Scoped (s : ss) m (ScopedAsync s a)
asyncBound :: forall (m :: Type -> Type) a s (ss :: [Type]).
MonadUnliftIO m =>
m a -> Scoped (s : ss) m (ScopedAsync s a)
asyncBound m a
act = (forall b. (ScopedAsync s a -> m b) -> m b)
-> Scoped (s : ss) m (ScopedAsync s a)
forall {k} (s :: [Type]) (m :: k -> Type) a.
(forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
UnsafeMkScoped \ScopedAsync s a -> m b
k -> m a -> (Async a -> m b) -> m b
forall (m :: Type -> Type) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsyncBound m a
act (ScopedAsync s a -> m b
k (ScopedAsync s a -> m b)
-> (Async a -> ScopedAsync s a) -> Async a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> ScopedAsync s a
forall s a. a -> ScopedResource s a
UnsafeMkScopedResource)

-- | Wait for the 'ScopedAsync' to finish immediately
wait :: (MonadIO m, s :< ss) => ScopedAsync s a -> Scoped ss m a
wait :: forall (m :: Type -> Type) s (ss :: [Type]) a.
(MonadIO m, s :< ss) =>
ScopedAsync s a -> Scoped ss m a
wait = Async a -> Scoped ss m a
forall (m :: Type -> Type) a. MonadIO m => Async a -> m a
Async.wait (Async a -> Scoped ss m a)
-> (ScopedAsync s a -> Async a) -> ScopedAsync s a -> Scoped ss m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedAsync s a -> Async a
forall s a. ScopedResource s a -> a
unsafeUnwrapScopedResource

-- | Like 'wait' but return either @'Left' 'SomeException'@ or @'Right' a@
waitCatch :: (MonadIO m, s :< ss) => ScopedAsync s a -> Scoped ss m (Either SomeException a)
waitCatch :: forall (m :: Type -> Type) s (ss :: [Type]) a.
(MonadIO m, s :< ss) =>
ScopedAsync s a -> Scoped ss m (Either SomeException a)
waitCatch = Async a -> Scoped ss m (Either SomeException a)
forall (m :: Type -> Type) a.
MonadIO m =>
Async a -> m (Either SomeException a)
Async.waitCatch (Async a -> Scoped ss m (Either SomeException a))
-> (ScopedAsync s a -> Async a)
-> ScopedAsync s a
-> Scoped ss m (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedAsync s a -> Async a
forall s a. ScopedResource s a -> a
unsafeUnwrapScopedResource

-- | Like 'wait' but wait as part of the handlers of the 'Scoped' block
waitScoped :: (MonadUnliftIO m, s :< ss) => ScopedAsync s a -> Scoped ss m ()
waitScoped :: forall (m :: Type -> Type) s (ss :: [Type]) a.
(MonadUnliftIO m, s :< ss) =>
ScopedAsync s a -> Scoped ss m ()
waitScoped ScopedAsync s a
a = m a -> Scoped ss m ()
forall (m :: Type -> Type) a (ss :: [Type]).
MonadUnliftIO m =>
m a -> Scoped ss m ()
registerHandler (Async a -> m a
forall (m :: Type -> Type) a. MonadIO m => Async a -> m a
Async.wait (Async a -> m a) -> Async a -> m a
forall a b. (a -> b) -> a -> b
$ ScopedAsync s a -> Async a
forall s a. ScopedResource s a -> a
unsafeUnwrapScopedResource ScopedAsync s a
a)

-- | Like 'waitCatch' but wait as part of the handlers of the 'Scoped' block
waitCatchScoped :: (MonadUnliftIO m, s :< ss) => ScopedAsync s a -> Scoped ss m ()
waitCatchScoped :: forall (m :: Type -> Type) s (ss :: [Type]) a.
(MonadUnliftIO m, s :< ss) =>
ScopedAsync s a -> Scoped ss m ()
waitCatchScoped ScopedAsync s a
a = m (Either SomeException a) -> Scoped ss m ()
forall (m :: Type -> Type) a (ss :: [Type]).
MonadUnliftIO m =>
m a -> Scoped ss m ()
registerHandler (Async a -> m (Either SomeException a)
forall (m :: Type -> Type) a.
MonadIO m =>
Async a -> m (Either SomeException a)
Async.waitCatch (Async a -> m (Either SomeException a))
-> Async a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ ScopedAsync s a -> Async a
forall s a. ScopedResource s a -> a
unsafeUnwrapScopedResource ScopedAsync s a
a)