{-# LANGUAGE TemplateHaskell #-}

-- | Description: The effect 'Async', providing an interface to "Control.Concurrent.Async"
module Polysemy.Async
  ( -- * Effect
    Async (..)

    -- * Actions
  , async
  , await
  , cancel

    -- * Helpers
  , sequenceConcurrently

    -- * Interpretations
  , asyncToIOFinal
  ) 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
  -- | Run the given action asynchronously and return a thread handle.
  Async :: m a -> Async m (A.Async (Maybe a))
  -- | Wait for the thread referenced by the given handle to terminate.
  Await :: A.Async a -> Async m a
  -- | Cancel the thread referenced by the given handle.
  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 :: forall (t :: * -> *) (r :: EffectRow) a.
(Traversable t, Member Async r) =>
t (Sem r a) -> Sem r (t (Maybe a))
sequenceConcurrently t (Sem r a)
t = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (r :: EffectRow) a.
Member Async r =>
Sem r a -> Sem r (Async (Maybe a))
async t (Sem r a)
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (r :: EffectRow) a. Member Async r => Async a -> Sem r a
await
{-# INLINABLE sequenceConcurrently #-}

------------------------------------------------------------------------------
-- | 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'.
--
-- @since 1.2.0.0
asyncToIOFinal :: Member (Final IO) r
               => Sem (Async ': r) a
               -> Sem r a
asyncToIOFinal :: forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem (Async : r) a -> Sem r a
asyncToIOFinal = forall (m :: * -> *) (e :: Effect) (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 a b. (a -> b) -> a -> b
$ \case
  Async Sem rInitial a
m -> do
    Inspector f
ins <- forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (Inspector f)
getInspectorS
    IO (f a)
m'  <- forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem rInitial a
m
    forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
A.async (forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
inspect Inspector f
ins forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (f a)
m')
  Await Async x
a -> forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (forall a. Async a -> IO a
A.wait Async x
a)
  Cancel Async a
a -> forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (forall a. Async a -> IO ()
A.cancel Async a
a)
{-# INLINE asyncToIOFinal #-}