{-# language Safe #-}

module LazyAsync.Actions.Wait where

import LazyAsync.Actions.Poll (pollSTM)

import LazyAsync.Types (LazyAsync, Outcome (..), Status (..))

import LazyAsync.Prelude (Functor (fmap), IO, MonadBase (liftBase),
                          MonadBaseControl (..), MonadIO (..), MonadThrow (..),
                          STM, Traversable (sequenceA), atomically, retry,
                          return, (=<<), (>=>), (>>=))

-- | Akin to 'waitCatch'
waitCatchSTM :: LazyAsync a -> STM (Outcome a)
waitCatchSTM :: LazyAsync a -> STM (Outcome a)
waitCatchSTM = LazyAsync a -> STM (Status a)
forall a. LazyAsync a -> STM (Status a)
pollSTM (LazyAsync a -> STM (Status a))
-> (Status a -> STM (Outcome a)) -> LazyAsync a -> STM (Outcome a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Status a -> STM (Outcome a)
forall a. Status a -> STM (Outcome a)
statusOutcomeSTM

-- | ⏸️ Waits for the action to complete and ✅ returns its value
--
-- 💣 If the action throws an exception, then the exception is returned
--
-- 🛑 Does not start the action
waitCatch :: (MonadBaseControl base m, MonadIO base) => LazyAsync (StM m a) -> m (Outcome a)
waitCatch :: LazyAsync (StM m a) -> m (Outcome a)
waitCatch LazyAsync (StM m a)
x = Outcome (m a) -> m (Outcome a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Outcome (m a) -> m (Outcome a))
-> m (Outcome (m a)) -> m (Outcome a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< base (Outcome (m a)) -> m (Outcome (m a))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase ((Outcome (StM m a) -> Outcome (m a))
-> base (Outcome (StM m a)) -> base (Outcome (m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StM m a -> m a) -> Outcome (StM m a) -> Outcome (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM) (IO (Outcome (StM m a)) -> base (Outcome (StM m a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (LazyAsync (StM m a) -> IO (Outcome (StM m a))
forall a. LazyAsync a -> IO (Outcome a)
waitCatchIO LazyAsync (StM m a)
x)))

-- | Akin to 'waitCatch'
waitCatchIO :: LazyAsync a -> IO (Outcome a)
waitCatchIO :: LazyAsync a -> IO (Outcome a)
waitCatchIO LazyAsync a
la = STM (Outcome a) -> IO (Outcome a)
forall a. STM a -> IO a
atomically (LazyAsync a -> STM (Outcome a)
forall a. LazyAsync a -> STM (Outcome a)
waitCatchSTM LazyAsync a
la)

-- | ⏸️ Waits for the action to complete and ✅ returns its value
--
-- 💣 If the action throws an exception, then the exception is re-thrown
--
-- 🛑 Does not start the action
wait :: (MonadBaseControl base m, MonadIO base) => LazyAsync (StM m a) -> m a
wait :: LazyAsync (StM m a) -> m a
wait LazyAsync (StM m a)
x = base (StM m a) -> m (StM m a)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Outcome (StM m a)) -> base (Outcome (StM m a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (LazyAsync (StM m a) -> IO (Outcome (StM m a))
forall a. LazyAsync a -> IO (Outcome a)
waitCatchIO LazyAsync (StM m a)
x) base (Outcome (StM m a))
-> (Outcome (StM m a) -> base (StM m a)) -> base (StM m a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Outcome (StM m a)
o -> IO (StM m a) -> base (StM m a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Outcome (StM m a) -> IO (StM m a)
forall (m :: * -> *) a. MonadThrow m => Outcome a -> m a
outcomeSuccess Outcome (StM m a)
o))) m (StM m a) -> (StM m a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM

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

statusOutcomeSTM :: Status a -> STM (Outcome a)
statusOutcomeSTM :: Status a -> STM (Outcome a)
statusOutcomeSTM Status a
Incomplete = STM (Outcome a)
forall a. STM a
retry
statusOutcomeSTM (Done Outcome a
x)   = Outcome a -> STM (Outcome a)
forall (m :: * -> *) a. Monad m => a -> m a
return Outcome a
x

outcomeSuccess :: MonadThrow m => Outcome a -> m a
outcomeSuccess :: Outcome a -> m a
outcomeSuccess (Failure SomeException
e) = SomeException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
e
outcomeSuccess (Success a
x) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x