{-# language Safe #-}
module LazyAsync.Actions.Spawn
( lazyAsync, withLazyAsyncIO
, manyLazyAsyncs, withLazyAsyncListIO
, acquire, acquireIO
) where
import LazyAsync.Libraries.Async (Async, async, cancel, pollSTM, withAsync)
import LazyAsync.Types (LazyAsync (A1), Outcome (..), Resource (..),
StartPoll (..), Status (..))
import LazyAsync.Prelude (Applicative ((*>)), Bool (..), ContT (..),
Either (..), Functor (fmap), IO, Maybe (..),
MonadBase (..), MonadBaseControl (StM), MonadIO (..),
SomeException, TVar, Traversable, atomically, check,
lift, newTVarIO, readTVar, return, traverse,
writeTVar, (<&>), (>>=))
startPoll :: MonadBaseControl IO m =>
m a
-> ContT b m (StartPoll (StM m a))
startPoll :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> ContT b m (StartPoll (StM m a))
startPoll m a
action =
do
TVar Bool
s <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (base :: * -> *) (m :: * -> *) a.
(MonadBase base m, MonadIO base) =>
a -> m (TVar a)
newTVar Bool
False)
Async (StM m a)
a <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync (forall (base :: * -> *) (m :: * -> *).
(MonadBase base m, MonadIO base) =>
TVar Bool -> m ()
waitForTrue TVar Bool
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
action))
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. TVar Bool -> Async a -> StartPoll a
makeStartPoll TVar Bool
s Async (StM m a)
a)
acquireStartPoll :: MonadBaseControl IO m =>
m a
-> m (Resource m (StartPoll (StM m a)))
acquireStartPoll :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Resource m (StartPoll (StM m a)))
acquireStartPoll m a
action =
do
TVar Bool
s <- forall (base :: * -> *) (m :: * -> *) a.
(MonadBase base m, MonadIO base) =>
a -> m (TVar a)
newTVar Bool
False
Async (StM m a)
a <- forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async (forall (base :: * -> *) (m :: * -> *).
(MonadBase base m, MonadIO base) =>
TVar Bool -> m ()
waitForTrue TVar Bool
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
action)
forall (m :: * -> *) a. Monad m => a -> m a
return (Resource{ release :: m ()
release = forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
cancel Async (StM m a)
a, resource :: StartPoll (StM m a)
resource = forall a. TVar Bool -> Async a -> StartPoll a
makeStartPoll TVar Bool
s Async (StM m a)
a})
makeStartPoll :: TVar Bool -> Async a -> StartPoll a
makeStartPoll :: forall a. TVar Bool -> Async a -> StartPoll a
makeStartPoll TVar Bool
s Async a
a = forall a. STM () -> STM (Status a) -> StartPoll a
StartPoll (forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
s Bool
True) (forall a. Async a -> STM (Maybe (Either SomeException a))
pollSTM Async a
a forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Maybe (Either SomeException a) -> Status a
maybeEitherStatus)
lazyAsync :: MonadBaseControl IO m =>
m a
-> ContT r m (LazyAsync (StM m a))
lazyAsync :: forall (m :: * -> *) a r.
MonadBaseControl IO m =>
m a -> ContT r m (LazyAsync (StM m a))
lazyAsync m a
action = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. StartPoll a -> LazyAsync a
A1 (forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> ContT b m (StartPoll (StM m a))
startPoll m a
action)
manyLazyAsyncs :: (MonadBaseControl IO m, Traversable t) =>
t (m a) -> ContT r m (t (LazyAsync (StM m a)))
manyLazyAsyncs :: forall (m :: * -> *) (t :: * -> *) a r.
(MonadBaseControl IO m, Traversable t) =>
t (m a) -> ContT r m (t (LazyAsync (StM m a)))
manyLazyAsyncs = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) a r.
MonadBaseControl IO m =>
m a -> ContT r m (LazyAsync (StM m a))
lazyAsync
withLazyAsyncListIO :: [IO a] -> ([LazyAsync a] -> IO b) -> IO b
withLazyAsyncListIO :: forall a b. [IO a] -> ([LazyAsync a] -> IO b) -> IO b
withLazyAsyncListIO [IO a]
actions = forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT (forall (m :: * -> *) (t :: * -> *) a r.
(MonadBaseControl IO m, Traversable t) =>
t (m a) -> ContT r m (t (LazyAsync (StM m a)))
manyLazyAsyncs [IO a]
actions)
acquire :: MonadBaseControl IO m =>
m a
-> m (Resource m (LazyAsync (StM m a)))
acquire :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Resource m (LazyAsync (StM m a)))
acquire m a
action = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. StartPoll a -> LazyAsync a
A1) (forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Resource m (StartPoll (StM m a)))
acquireStartPoll m a
action)
acquireIO :: IO a -> IO (Resource IO (LazyAsync a))
acquireIO :: forall a. IO a -> IO (Resource IO (LazyAsync a))
acquireIO = forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Resource m (LazyAsync (StM m a)))
acquire
withLazyAsyncIO :: IO a -> (LazyAsync a -> IO b) -> IO b
withLazyAsyncIO :: forall a b. IO a -> (LazyAsync a -> IO b) -> IO b
withLazyAsyncIO IO a
action = forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT (forall (m :: * -> *) a r.
MonadBaseControl IO m =>
m a -> ContT r m (LazyAsync (StM m a))
lazyAsync IO a
action)
waitForTrue :: (MonadBase base m, MonadIO base) => TVar Bool -> m ()
waitForTrue :: forall (base :: * -> *) (m :: * -> *).
(MonadBase base m, MonadIO base) =>
TVar Bool -> m ()
waitForTrue TVar Bool
x = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. STM a -> IO a
atomically (forall a. TVar a -> STM a
readTVar TVar Bool
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> STM ()
check)))
newTVar :: (MonadBase base m, MonadIO base) => a -> m (TVar a)
newTVar :: forall (base :: * -> *) (m :: * -> *) a.
(MonadBase base m, MonadIO base) =>
a -> m (TVar a)
newTVar a
x = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. a -> IO (TVar a)
newTVarIO a
x))
maybeEitherStatus :: Maybe (Either SomeException a) -> Status a
maybeEitherStatus :: forall a. Maybe (Either SomeException a) -> Status a
maybeEitherStatus Maybe (Either SomeException a)
Nothing = forall a. Status a
Incomplete
maybeEitherStatus (Just Either SomeException a
x) = forall a. Outcome a -> Status a
Done (forall a. Either SomeException a -> Outcome a
eitherDone Either SomeException a
x)
eitherDone :: Either SomeException a -> Outcome a
eitherDone :: forall a. Either SomeException a -> Outcome a
eitherDone (Left SomeException
e) = forall a. SomeException -> Outcome a
Failure SomeException
e
eitherDone (Right a
x) = forall a. a -> Outcome a
Success a
x