module UnliftIO.Async.Utils
  ( allocateAsync, allocateLinkedAsync
  , allocateAsyncWithUnmask, allocateLinkedAsyncWithUnmask
  , allocateAsyncMasked, allocateLinkedAsyncMasked
  ) where

import ClassyPrelude hiding (cancel, async, link)
import Control.Lens

import UnliftIO.Async

import Control.Monad.Trans.Resource


allocateAsync :: forall m a.
                 MonadResource m
              => IO a -> m (Async a)
allocateAsync = fmap (view _2) . flip allocate cancel . liftIO . async

allocateLinkedAsync :: forall m a. (MonadUnliftIO m, MonadResource m) => IO a -> m (Async a)
allocateLinkedAsync = uncurry (<$) . (id &&& link) <=< allocateAsync

  
allocateAsyncWithUnmask :: forall m a.
                           MonadResource m
                        => ((forall b. IO b -> IO b) -> IO a) -> m (Async a)
allocateAsyncWithUnmask act = fmap (view _2) . flip allocate cancel . liftIO $ asyncWithUnmask act

allocateLinkedAsyncWithUnmask :: forall m a. (MonadUnliftIO m, MonadResource m) => ((forall b. IO b -> IO b) -> IO a) -> m (Async a)
allocateLinkedAsyncWithUnmask act = uncurry (<$) . (id &&& link) =<< allocateAsyncWithUnmask act

  
allocateAsyncMasked :: forall m a.
                       MonadResource m
                    => IO a -> m (Async a)
allocateAsyncMasked act = fmap (view _2) . flip allocate cancel . liftIO $ asyncWithUnmask (const act)

allocateLinkedAsyncMasked :: forall m a. (MonadUnliftIO m, MonadResource m) => IO a -> m (Async a)
allocateLinkedAsyncMasked = uncurry (<$) . (id &&& link) <=< allocateAsyncMasked
