{- | Module : Control.Async License : BSD3 Maintainer : simons@cryp.to Stability : stable Portability : portable An implementation of IO computations that return their value asynchronously. -} module Control.Async ( Async , forkAsync , throwToAsync , killAsync , isReadyAsync , waitForAsync , parIO ) where import Control.Concurrent import Control.Exception type AsyncMVar a = MVar (Either SomeException a) -- | @Async a@ represents a value @a@ that is being computed -- asynchronously, i.e. a value that is going to become available at -- some point in the future. data Async a = Child ThreadId (AsyncMVar a) forkAsync' :: IO a -> AsyncMVar a -> IO (Async a) forkAsync' f mv = fmap (`Child` mv) (mask $ \unmask -> forkIO (try (unmask f) >>= tryPutMVar mv >> return ())) -- | Start an asynchronous computation. forkAsync :: IO a -> IO (Async a) forkAsync f = newEmptyMVar >>= forkAsync' f -- | Throw an asynchronous exception to the thread that performs the -- computation associated with this value. throwToAsync :: Exception e => Async a -> e -> IO () throwToAsync (Child pid _) = throwTo pid -- | Abort the asynchronous computation associated with this value. killAsync :: Async a -> IO () killAsync (Child pid _) = killThread pid -- | Test whether the asynchronous value has become available. isReadyAsync :: Async a -> IO Bool isReadyAsync (Child _ mv) = fmap not (isEmptyMVar mv) -- | Wait for the asynchronous value to become available, and retrieve -- it. If the computation that generated the value has thrown an -- exception, then that exception will be raised here. waitForAsync :: Async a -> IO a waitForAsync (Child _ sync) = fmap (either throw id) (readMVar sync) -- | Run both computations in parallel and return the @a@ value of the -- computation that terminates first. An exception in either of the two -- computations aborts the entire @parIO@ computation. parIO :: IO a -> IO a -> IO a parIO f g = do sync <- newEmptyMVar bracket (forkAsync' f sync) killAsync (\_ -> bracket (forkAsync' g sync) killAsync waitForAsync)