module Concurrent.Promise
( Promise
, newEmptyPromise
, newPromise
, readPromise
, writePromise
) where
import Concurrent.Exception
import Concurrent.Promise.Unsafe
import Concurrent.Par
import Concurrent.Par.Unsafe
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad
import GHC.IO
newEmptyPromise :: MonadPar d i s m => m (Promise s a)
newEmptyPromise = unsafeParIO $ do
x <- newEmptyMVar
Promise x <$> unsafeDupableInterleaveIO (readMVar x)
newPromise :: a -> Promise s a
newPromise a = unsafeDupablePerformIO $ do
x <- newMVar a
return $ Promise x a
readPromise :: Promise s a -> a
readPromise (Promise _ a) = a
writePromise :: (MonadPar d i s m, Eq a) => Promise s a -> a -> m ()
writePromise (Promise m _) a = unsafeParIO $ do
a' <- evaluate a
mask_ $ do
t <- tryPutMVar m a'
unless t $ do
b <- readMVar m
unless (a' == b) $ throwIO Contradiction