module Control.Object.Instance (
Instance
, new
, newSettle
, invokeOn
, (.-)
, (?-)
) where
import Control.Concurrent
import Control.Exception (evaluate)
import Control.Object.Object
import Control.Monad.IO.Class
import Control.Monad.Catch
type Instance f g = MVar (Object f g)
invokeOn :: (MonadIO m, MonadMask m)
=> (forall x. g x -> m x) -> MVar (Object f g) -> f a -> m a
invokeOn m v f = mask $ \restore -> do
obj <- liftIO $ takeMVar v
(a, obj') <- restore (m (runObject obj f) >>= liftIO . evaluate) `onException` liftIO (putMVar v obj)
liftIO $ putMVar v obj'
return a
(.-) :: (MonadIO m, MonadMask m) => MVar (Object f m) -> f a -> m a
(.-) = invokeOn id
infixr 3 .-
(?-) :: (MonadIO m, MonadMask m) => MVar (Object f m) -> f a -> m (Maybe a)
v ?- f = mask $ \restore -> liftIO (tryTakeMVar v) >>= \case
Just obj -> do
(a, obj') <- restore (runObject obj f >>= liftIO . evaluate) `onException` liftIO (putMVar v obj)
liftIO $ putMVar v obj'
return (Just a)
Nothing -> return Nothing
new :: MonadIO m => Object f g -> m (Instance f g)
new = liftIO . newMVar
newSettle :: MonadIO m => Object f m -> m (Instance f m)
newSettle = new