{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE Safe #-}

module Control.Concurrent.Async.UIO (UAsync, async, asyncE, race, raceE, cancel) where

import Control.Applicative ((<$>))
import qualified Control.Concurrent.Async as A
import Control.Exception (SomeException)
import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT)
import UnexceptionalIO (UIO, runUnexceptionalIO, unsafeFromIO)
import UnexceptionalIO.ExceptT (EUIO, fromIO)

newtype UAsync a = UAsync { unUAsync ∷ A.Async a } deriving (Functor, Eq, Ord)

async ∷ UIO a → UIO (UAsync a)
async = fmap UAsync . unsafeFromIO . A.async . runUnexceptionalIO

asyncE ∷ EUIO a → UIO (UAsync (Either SomeException a))
asyncE = async . runExceptT

race ∷ UIO a → UIO b → UIO (Either a b)
race a b = unsafeFromIO $ A.race (runUnexceptionalIO a) (runUnexceptionalIO b)

raceE ∷ EUIO a → EUIO b → EUIO (Either a b)
raceE a b = ExceptT $ merge <$> race (runExceptT a) (runExceptT b) where
    merge ∷ Either (Either SomeException a) (Either SomeException b) → Either SomeException (Either a b)
    merge (Left  (Left e))  = Left e
    merge (Right (Left e))  = Left e
    merge (Left  (Right ra)) = Right (Left  ra)
    merge (Right (Right rb)) = Right (Right rb)

cancel ∷ UAsync a → EUIO ()
cancel = fromIO . A.cancel . unUAsync
