{-# LANGUAGE TemplateHaskell #-}
module Polysemy.Async
(
Async (..)
, async
, await
, runAsync
, runAsyncInIO
) where
import qualified Control.Concurrent.Async as A
import Polysemy
data Async m a where
Async :: m a -> Async m (A.Async (Maybe a))
Await :: A.Async a -> Async m a
makeSem ''Async
runAsync
:: LastMember (Lift IO) r
=> Sem (Async ': r) a
-> Sem r a
runAsync m = withLowerToIO $ \lower _ -> lower $
interpretH
( \case
Async a -> do
ma <- runT a
ins <- getInspectorT
fa <- sendM $ A.async $ lower $ runAsync_b ma
pureT $ fmap (inspect ins) fa
Await a -> pureT =<< sendM (A.wait a)
) m
{-# INLINE runAsync #-}
runAsync_b
:: LastMember (Lift IO) r
=> Sem (Async ': r) a
-> Sem r a
runAsync_b = runAsync
{-# NOINLINE runAsync_b #-}
runAsyncInIO
:: Member (Lift IO) r
=> (forall x. Sem r x -> IO x)
-> Sem (Async ': r) a
-> Sem r a
runAsyncInIO lower m = interpretH
( \case
Async a -> do
ma <- runT a
ins <- getInspectorT
fa <- sendM $ A.async $ lower $ runAsyncInIO_b lower ma
pureT $ fmap (inspect ins) fa
Await a -> pureT =<< sendM (A.wait a)
) m
{-# INLINE runAsyncInIO #-}
runAsyncInIO_b
:: Member (Lift IO) r
=> (forall x. Sem r x -> IO x)
-> Sem (Async ': r) a
-> Sem r a
runAsyncInIO_b = runAsyncInIO
{-# NOINLINE runAsyncInIO_b #-}