{-# language Safe #-}

module LazyAsync.Actions.StartWait where

import LazyAsync.Actions.Start (start)
import LazyAsync.Actions.Wait  (wait, waitCatch)

import LazyAsync.Types (LazyAsync, Outcome)

import LazyAsync.Prelude (Applicative ((*>)), IO, MonadBaseControl (StM),
                          MonadIO)

-- | 🚀 Starts an asynchronous action,
-- ⏸️ waits for it to complete, and
-- ✅ returns its value
--
-- 💣 If the action throws an exception, then the exception is re-thrown
--
-- 🌈 @('startWait' x)@ is equivalent to @('start' x '*>' 'wait' x)@
startWait :: (MonadBaseControl base m, MonadIO base) => LazyAsync (StM m a) -> m a
startWait :: LazyAsync (StM m a) -> m a
startWait LazyAsync (StM m a)
x = LazyAsync (StM m a) -> m ()
forall (base :: * -> *) (m :: * -> *) a.
(MonadBase base m, MonadIO base) =>
LazyAsync a -> m ()
start LazyAsync (StM m a)
x m () -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LazyAsync (StM m a) -> m a
forall (base :: * -> *) (m :: * -> *) a.
(MonadBaseControl base m, MonadIO base) =>
LazyAsync (StM m a) -> m a
wait LazyAsync (StM m a)
x

-- | Akin to 'startWait'
startWaitIO :: LazyAsync a -> IO a
startWaitIO :: LazyAsync a -> IO a
startWaitIO = LazyAsync a -> IO a
forall (base :: * -> *) (m :: * -> *) a.
(MonadBaseControl base m, MonadIO base) =>
LazyAsync (StM m a) -> m a
startWait

-- | 🚀 Starts an asynchronous action,
-- ⏸️ waits for it to complete, and
-- ✅ returns its value
--
-- 💣 If the action throws an exception, then the exception is returned
--
-- 🌈 @('startWaitCatch' x)@ is equivalent to @('start' x '*>' 'waitCatch' x)@
startWaitCatch :: (MonadBaseControl base m, MonadIO base) => LazyAsync (StM m a) -> m (Outcome a)
startWaitCatch :: LazyAsync (StM m a) -> m (Outcome a)
startWaitCatch LazyAsync (StM m a)
x = LazyAsync (StM m a) -> m ()
forall (base :: * -> *) (m :: * -> *) a.
(MonadBase base m, MonadIO base) =>
LazyAsync a -> m ()
start LazyAsync (StM m a)
x m () -> m (Outcome a) -> m (Outcome a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LazyAsync (StM m a) -> m (Outcome a)
forall (base :: * -> *) (m :: * -> *) a.
(MonadBaseControl base m, MonadIO base) =>
LazyAsync (StM m a) -> m (Outcome a)
waitCatch LazyAsync (StM m a)
x

-- | Akin to 'startWaitCatch'
startWaitCatchIO :: LazyAsync a -> IO (Outcome a)
startWaitCatchIO :: LazyAsync a -> IO (Outcome a)
startWaitCatchIO = LazyAsync a -> IO (Outcome a)
forall (base :: * -> *) (m :: * -> *) a.
(MonadBaseControl base m, MonadIO base) =>
LazyAsync (StM m a) -> m (Outcome a)
startWaitCatch