{-# language Safe #-}

module LazyAsync.Actions.Poll where

import LazyAsync.Actions.Empty (emptyStatus)
import LazyAsync.Actions.Pure  (pureStatus)
import LazyAsync.Types         (Complex (..), LazyAsync (..), StartPoll (..),
                                Status (..))

import LazyAsync.Prelude (IO, MonadBaseControl, MonadIO, STM, StM, atomically,
                          fmap, liftA2, liftBase, liftIO, restoreM, return,
                          sequenceA, (=<<))

-- | 🕵️ Checks whether an asynchronous action has completed yet
--
-- 🛑 Does not start the action
poll :: (MonadBaseControl base m, MonadIO base) => LazyAsync (StM m a) -> m (Status a)
poll :: LazyAsync (StM m a) -> m (Status a)
poll LazyAsync (StM m a)
la = Status (m a) -> m (Status a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Status (m a) -> m (Status a)) -> m (Status (m a)) -> m (Status a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< base (Status (m a)) -> m (Status (m a))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase ((Status (StM m a) -> Status (m a))
-> base (Status (StM m a)) -> base (Status (m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StM m a -> m a) -> Status (StM m a) -> Status (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 (Status (StM m a)) -> base (Status (StM m a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (LazyAsync (StM m a) -> IO (Status (StM m a))
forall a. LazyAsync a -> IO (Status a)
pollIO LazyAsync (StM m a)
la)))

-- | Akin to 'poll'
pollIO :: LazyAsync a -> IO (Status a)
pollIO :: LazyAsync a -> IO (Status a)
pollIO LazyAsync a
la = STM (Status a) -> IO (Status a)
forall a. STM a -> IO a
atomically (LazyAsync a -> STM (Status a)
forall a. LazyAsync a -> STM (Status a)
pollSTM LazyAsync a
la)

-- | Akin to 'poll'
pollSTM :: LazyAsync a -> STM (Status a)
pollSTM :: LazyAsync a -> STM (Status a)
pollSTM (Pure a
x)             = Status a -> STM (Status a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Status a
forall a. a -> Status a
pureStatus a
x)
pollSTM (A1 (StartPoll STM ()
_ STM (Status a)
a)) = STM (Status a)
a
pollSTM (A2 (Complex Status x -> Status y -> Status a
o LazyAsync x
x LazyAsync y
y)) = (Status x -> Status y -> Status a)
-> STM (Status x) -> STM (Status y) -> STM (Status a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Status x -> Status y -> Status a
o) (LazyAsync x -> STM (Status x)
forall a. LazyAsync a -> STM (Status a)
pollSTM LazyAsync x
x) (LazyAsync y -> STM (Status y)
forall a. LazyAsync a -> STM (Status a)
pollSTM LazyAsync y
y)
pollSTM LazyAsync a
Empty                = Status a -> STM (Status a)
forall (m :: * -> *) a. Monad m => a -> m a
return Status a
forall a. Status a
emptyStatus