{-# LANGUAGE TemplateHaskell #-} module Polysemy.Async ( -- * Effect Async (..) -- * Actions , async , await , cancel -- * Helpers , sequenceConcurrently -- * Interpretations , asyncToIO , asyncToIOFinal , lowerAsync ) where import qualified Control.Concurrent.Async as A import Polysemy import Polysemy.Final ------------------------------------------------------------------------------ -- | An effect for spawning asynchronous computations. -- -- The 'Maybe' returned by 'async' is due to the fact that we can't be sure an -- 'Polysemy.Error.Error' effect didn't fail locally. -- -- @since 0.5.0.0 data Async m a where Async :: m a -> Async m (A.Async (Maybe a)) Await :: A.Async a -> Async m a Cancel :: A.Async a -> Async m () makeSem ''Async ------------------------------------------------------------------------------ -- | Perform a sequence of effectful actions concurrently. -- -- @since 1.2.2.0 sequenceConcurrently :: forall t r a. (Traversable t, Member Async r) => t (Sem r a) -> Sem r (t (Maybe a)) sequenceConcurrently :: t (Sem r a) -> Sem r (t (Maybe a)) sequenceConcurrently t (Sem r a) t = (Sem r a -> Sem r (Async (Maybe a))) -> t (Sem r a) -> Sem r (t (Async (Maybe a))) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse Sem r a -> Sem r (Async (Maybe a)) forall (r :: EffectRow) a. Member Async r => Sem r a -> Sem r (Async (Maybe a)) async t (Sem r a) t Sem r (t (Async (Maybe a))) -> (t (Async (Maybe a)) -> Sem r (t (Maybe a))) -> Sem r (t (Maybe a)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (Async (Maybe a) -> Sem r (Maybe a)) -> t (Async (Maybe a)) -> Sem r (t (Maybe a)) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse Async (Maybe a) -> Sem r (Maybe a) forall (r :: EffectRow) a. Member Async r => Async a -> Sem r a await {-# INLINABLE sequenceConcurrently #-} ------------------------------------------------------------------------------ -- | A more flexible --- though less performant --- -- version of 'asyncToIOFinal'. -- -- This function is capable of running 'Async' effects anywhere within an -- effect stack, without relying on 'Final' to lower it into 'IO'. -- Notably, this means that 'Polysemy.State.State' effects will be consistent -- in the presence of 'Async'. -- -- 'asyncToIO' is __unsafe__ if you're using 'await' inside higher-order actions -- of other effects interpreted after 'Async'. -- See <https://github.com/polysemy-research/polysemy/issues/205 Issue #205>. -- -- Prefer 'asyncToIOFinal' unless you need to run pure, stateful interpreters -- after the interpreter for 'Async'. -- (Pure interpreters are interpreters that aren't expressed in terms of -- another effect or monad; for example, 'Polysemy.State.runState'.) -- -- @since 1.0.0.0 asyncToIO :: Member (Embed IO) r => Sem (Async ': r) a -> Sem r a asyncToIO :: Sem (Async : r) a -> Sem r a asyncToIO Sem (Async : r) a m = ((forall x. Sem r x -> IO x) -> IO () -> IO a) -> Sem r a forall (r :: EffectRow) a. Member (Embed IO) r => ((forall x. Sem r x -> IO x) -> IO () -> IO a) -> Sem r a withLowerToIO (((forall x. Sem r x -> IO x) -> IO () -> IO a) -> Sem r a) -> ((forall x. Sem r x -> IO x) -> IO () -> IO a) -> Sem r a forall a b. (a -> b) -> a -> b $ \forall x. Sem r x -> IO x lower IO () _ -> Sem r a -> IO a forall x. Sem r x -> IO x lower (Sem r a -> IO a) -> Sem r a -> IO a forall a b. (a -> b) -> a -> b $ (forall (rInitial :: EffectRow) x. Async (Sem rInitial) x -> Tactical Async (Sem rInitial) r x) -> Sem (Async : r) a -> Sem r a forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a. (forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Tactical e (Sem rInitial) r x) -> Sem (e : r) a -> Sem r a interpretH ( \case Async a -> do Sem (Async : r) (f a) ma <- Sem rInitial a -> Sem (WithTactics Async f (Sem rInitial) r) (Sem (Async : r) (f a)) forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (f :: * -> *) (r :: EffectRow). m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a)) runT Sem rInitial a a Inspector f ins <- Sem (WithTactics Async f (Sem rInitial) r) (Inspector f) forall (e :: (* -> *) -> * -> *) (f :: * -> *) (m :: * -> *) (r :: EffectRow). Sem (WithTactics e f m r) (Inspector f) getInspectorT Async (f a) fa <- IO (Async (f a)) -> Sem (WithTactics Async f (Sem rInitial) r) (Async (f a)) forall (m :: * -> *) (r :: EffectRow) a. Member (Embed m) r => m a -> Sem r a embed (IO (Async (f a)) -> Sem (WithTactics Async f (Sem rInitial) r) (Async (f a))) -> IO (Async (f a)) -> Sem (WithTactics Async f (Sem rInitial) r) (Async (f a)) forall a b. (a -> b) -> a -> b $ IO (f a) -> IO (Async (f a)) forall a. IO a -> IO (Async a) A.async (IO (f a) -> IO (Async (f a))) -> IO (f a) -> IO (Async (f a)) forall a b. (a -> b) -> a -> b $ Sem r (f a) -> IO (f a) forall x. Sem r x -> IO x lower (Sem r (f a) -> IO (f a)) -> Sem r (f a) -> IO (f a) forall a b. (a -> b) -> a -> b $ Sem (Async : r) (f a) -> Sem r (f a) forall (r :: EffectRow) a. Member (Embed IO) r => Sem (Async : r) a -> Sem r a asyncToIO Sem (Async : r) (f a) ma Async (Maybe a) -> Sem (WithTactics Async f (Sem rInitial) r) (f (Async (Maybe a))) forall (f :: * -> *) a (e :: (* -> *) -> * -> *) (m :: * -> *) (r :: EffectRow). Functor f => a -> Sem (WithTactics e f m r) (f a) pureT (Async (Maybe a) -> Sem (WithTactics Async f (Sem rInitial) r) (f (Async (Maybe a)))) -> Async (Maybe a) -> Sem (WithTactics Async f (Sem rInitial) r) (f (Async (Maybe a))) forall a b. (a -> b) -> a -> b $ Inspector f -> forall x. f x -> Maybe x forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x inspect Inspector f ins (f a -> Maybe a) -> Async (f a) -> Async (Maybe a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Async (f a) fa Await a -> x -> Sem (WithTactics Async f (Sem rInitial) r) (f x) forall (f :: * -> *) a (e :: (* -> *) -> * -> *) (m :: * -> *) (r :: EffectRow). Functor f => a -> Sem (WithTactics e f m r) (f a) pureT (x -> Sem (WithTactics Async f (Sem rInitial) r) (f x)) -> Sem (WithTactics Async f (Sem rInitial) r) x -> Sem (WithTactics Async f (Sem rInitial) r) (f x) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO x -> Sem (WithTactics Async f (Sem rInitial) r) x forall (m :: * -> *) (r :: EffectRow) a. Member (Embed m) r => m a -> Sem r a embed (Async x -> IO x forall a. Async a -> IO a A.wait Async x a) Cancel a -> () -> Sem (WithTactics Async f (Sem rInitial) r) (f ()) forall (f :: * -> *) a (e :: (* -> *) -> * -> *) (m :: * -> *) (r :: EffectRow). Functor f => a -> Sem (WithTactics e f m r) (f a) pureT (() -> Sem (WithTactics Async f (Sem rInitial) r) (f ())) -> Sem (WithTactics Async f (Sem rInitial) r) () -> Sem (WithTactics Async f (Sem rInitial) r) (f ()) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO () -> Sem (WithTactics Async f (Sem rInitial) r) () forall (m :: * -> *) (r :: EffectRow) a. Member (Embed m) r => m a -> Sem r a embed (Async a -> IO () forall a. Async a -> IO () A.cancel Async a a) ) Sem (Async : r) a m {-# INLINE asyncToIO #-} ------------------------------------------------------------------------------ -- | Run an 'Async' effect in terms of 'A.async' through final 'IO'. -- -- /Beware/: Effects that aren't interpreted in terms of 'IO' -- will have local state semantics in regards to 'Async' effects -- interpreted this way. See 'Final'. -- -- Notably, unlike 'asyncToIO', this is not consistent with -- 'Polysemy.State.State' unless 'Polysemy.State.runStateIORef' is used. -- State that seems like it should be threaded globally throughout 'Async' -- /will not be./ -- -- Use 'asyncToIO' instead if you need to run -- pure, stateful interpreters after the interpreter for 'Async'. -- (Pure interpreters are interpreters that aren't expressed in terms of -- another effect or monad; for example, 'Polysemy.State.runState'.) -- -- @since 1.2.0.0 asyncToIOFinal :: Member (Final IO) r => Sem (Async ': r) a -> Sem r a asyncToIOFinal :: Sem (Async : r) a -> Sem r a asyncToIOFinal = (forall x (rInitial :: EffectRow). Async (Sem rInitial) x -> Strategic IO (Sem rInitial) x) -> Sem (Async : r) a -> Sem r a forall (m :: * -> *) (e :: (* -> *) -> * -> *) (r :: EffectRow) a. Member (Final m) r => (forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Strategic m (Sem rInitial) x) -> Sem (e : r) a -> Sem r a interpretFinal ((forall x (rInitial :: EffectRow). Async (Sem rInitial) x -> Strategic IO (Sem rInitial) x) -> Sem (Async : r) a -> Sem r a) -> (forall x (rInitial :: EffectRow). Async (Sem rInitial) x -> Strategic IO (Sem rInitial) x) -> Sem (Async : r) a -> Sem r a forall a b. (a -> b) -> a -> b $ \case Async m -> do Inspector f ins <- Sem (WithStrategy IO f (Sem rInitial)) (Inspector f) forall (m :: * -> *) (f :: * -> *) (n :: * -> *). Sem (WithStrategy m f n) (Inspector f) getInspectorS IO (f a) m' <- Sem rInitial a -> Sem (WithStrategy IO f (Sem rInitial)) (IO (f a)) forall (n :: * -> *) a (m :: * -> *) (f :: * -> *). n a -> Sem (WithStrategy m f n) (m (f a)) runS Sem rInitial a m IO (Async (Maybe a)) -> Strategic IO (Sem rInitial) (Async (Maybe a)) forall (m :: * -> *) a (n :: * -> *). Functor m => m a -> Strategic m n a liftS (IO (Async (Maybe a)) -> Strategic IO (Sem rInitial) (Async (Maybe a))) -> IO (Async (Maybe a)) -> Strategic IO (Sem rInitial) (Async (Maybe a)) forall a b. (a -> b) -> a -> b $ IO (Maybe a) -> IO (Async (Maybe a)) forall a. IO a -> IO (Async a) A.async (Inspector f -> forall x. f x -> Maybe x forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x inspect Inspector f ins (f a -> Maybe a) -> IO (f a) -> IO (Maybe a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO (f a) m') Await a -> IO x -> Strategic IO (Sem rInitial) x forall (m :: * -> *) a (n :: * -> *). Functor m => m a -> Strategic m n a liftS (Async x -> IO x forall a. Async a -> IO a A.wait Async x a) Cancel a -> IO () -> Strategic IO (Sem rInitial) () forall (m :: * -> *) a (n :: * -> *). Functor m => m a -> Strategic m n a liftS (Async a -> IO () forall a. Async a -> IO () A.cancel Async a a) {-# INLINE asyncToIOFinal #-} ------------------------------------------------------------------------------ -- | Run an 'Async' effect in terms of 'A.async'. -- -- @since 1.0.0.0 lowerAsync :: Member (Embed IO) r => (forall x. Sem r x -> IO x) -- ^ Strategy for lowering a 'Sem' action down to 'IO'. This is likely -- some combination of 'runM' and other interpreters composed via '.@'. -> Sem (Async ': r) a -> Sem r a lowerAsync :: (forall x. Sem r x -> IO x) -> Sem (Async : r) a -> Sem r a lowerAsync forall x. Sem r x -> IO x lower Sem (Async : r) a m = (forall (rInitial :: EffectRow) x. Async (Sem rInitial) x -> Tactical Async (Sem rInitial) r x) -> Sem (Async : r) a -> Sem r a forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a. (forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Tactical e (Sem rInitial) r x) -> Sem (e : r) a -> Sem r a interpretH ( \case Async a -> do Sem (Async : r) (f a) ma <- Sem rInitial a -> Sem (WithTactics Async f (Sem rInitial) r) (Sem (Async : r) (f a)) forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (f :: * -> *) (r :: EffectRow). m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a)) runT Sem rInitial a a Inspector f ins <- Sem (WithTactics Async f (Sem rInitial) r) (Inspector f) forall (e :: (* -> *) -> * -> *) (f :: * -> *) (m :: * -> *) (r :: EffectRow). Sem (WithTactics e f m r) (Inspector f) getInspectorT Async (f a) fa <- IO (Async (f a)) -> Sem (WithTactics Async f (Sem rInitial) r) (Async (f a)) forall (m :: * -> *) (r :: EffectRow) a. Member (Embed m) r => m a -> Sem r a embed (IO (Async (f a)) -> Sem (WithTactics Async f (Sem rInitial) r) (Async (f a))) -> IO (Async (f a)) -> Sem (WithTactics Async f (Sem rInitial) r) (Async (f a)) forall a b. (a -> b) -> a -> b $ IO (f a) -> IO (Async (f a)) forall a. IO a -> IO (Async a) A.async (IO (f a) -> IO (Async (f a))) -> IO (f a) -> IO (Async (f a)) forall a b. (a -> b) -> a -> b $ Sem r (f a) -> IO (f a) forall x. Sem r x -> IO x lower (Sem r (f a) -> IO (f a)) -> Sem r (f a) -> IO (f a) forall a b. (a -> b) -> a -> b $ (forall x. Sem r x -> IO x) -> Sem (Async : r) (f a) -> Sem r (f a) forall (r :: EffectRow) a. Member (Embed IO) r => (forall x. Sem r x -> IO x) -> Sem (Async : r) a -> Sem r a lowerAsync forall x. Sem r x -> IO x lower Sem (Async : r) (f a) ma Async (Maybe a) -> Sem (WithTactics Async f (Sem rInitial) r) (f (Async (Maybe a))) forall (f :: * -> *) a (e :: (* -> *) -> * -> *) (m :: * -> *) (r :: EffectRow). Functor f => a -> Sem (WithTactics e f m r) (f a) pureT (Async (Maybe a) -> Sem (WithTactics Async f (Sem rInitial) r) (f (Async (Maybe a)))) -> Async (Maybe a) -> Sem (WithTactics Async f (Sem rInitial) r) (f (Async (Maybe a))) forall a b. (a -> b) -> a -> b $ Inspector f -> forall x. f x -> Maybe x forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x inspect Inspector f ins (f a -> Maybe a) -> Async (f a) -> Async (Maybe a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Async (f a) fa Await a -> x -> Sem (WithTactics Async f (Sem rInitial) r) (f x) forall (f :: * -> *) a (e :: (* -> *) -> * -> *) (m :: * -> *) (r :: EffectRow). Functor f => a -> Sem (WithTactics e f m r) (f a) pureT (x -> Sem (WithTactics Async f (Sem rInitial) r) (f x)) -> Sem (WithTactics Async f (Sem rInitial) r) x -> Sem (WithTactics Async f (Sem rInitial) r) (f x) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO x -> Sem (WithTactics Async f (Sem rInitial) r) x forall (m :: * -> *) (r :: EffectRow) a. Member (Embed m) r => m a -> Sem r a embed (Async x -> IO x forall a. Async a -> IO a A.wait Async x a) Cancel a -> () -> Sem (WithTactics Async f (Sem rInitial) r) (f ()) forall (f :: * -> *) a (e :: (* -> *) -> * -> *) (m :: * -> *) (r :: EffectRow). Functor f => a -> Sem (WithTactics e f m r) (f a) pureT (() -> Sem (WithTactics Async f (Sem rInitial) r) (f ())) -> Sem (WithTactics Async f (Sem rInitial) r) () -> Sem (WithTactics Async f (Sem rInitial) r) (f ()) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO () -> Sem (WithTactics Async f (Sem rInitial) r) () forall (m :: * -> *) (r :: EffectRow) a. Member (Embed m) r => m a -> Sem r a embed (Async a -> IO () forall a. Async a -> IO () A.cancel Async a a) ) Sem (Async : r) a m {-# INLINE lowerAsync #-} {-# DEPRECATED lowerAsync "Use 'asyncToIOFinal' instead" #-}