-- |
-- Module     : Simulation.Aivika.Trans.Concurrent.MVar
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The module defines helper functions for working with 'MVar'.
--
module Simulation.Aivika.Trans.Concurrent.MVar
       (withMVarComp,
        withMVarParameter,
        withMVarSimulation,
        withMVarDynamics,
        withMVarEvent) where

import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Trans
import qualified Control.Monad.Catch as MC

import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Parameter
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Dynamics
import Simulation.Aivika.Trans.Event
import Simulation.Aivika.Trans.Process

-- | Like 'withMVar' but operates within the specified computation.
withMVarComp :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> m b) -> m b
withMVarComp :: forall (m :: * -> *) a b.
(MonadComp m, MonadIO m, MonadMask m) =>
MVar a -> (a -> m b) -> m b
withMVarComp MVar a
v a -> m b
f =
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore ->
  do a
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar a
v
     forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
finallyComp
       (a -> m b
f a
a)
       (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar a
v a
a)

-- | Like 'withMVar' but operates within the 'Parameter' computation.
withMVarParameter :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> Parameter m b) -> Parameter m b
withMVarParameter :: forall (m :: * -> *) a b.
(MonadComp m, MonadIO m, MonadMask m) =>
MVar a -> (a -> Parameter m b) -> Parameter m b
withMVarParameter MVar a
v a -> Parameter m b
f =
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask forall a b. (a -> b) -> a -> b
$ \forall a. Parameter m a -> Parameter m a
restore ->
  do a
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar a
v
     forall (m :: * -> *) a b.
MonadException m =>
Parameter m a -> Parameter m b -> Parameter m a
finallyParameter
       (a -> Parameter m b
f a
a)
       (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar a
v a
a)

-- | Like 'withMVar' but operates within the 'Simulation' computation.
withMVarSimulation :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> Simulation m b) -> Simulation m b
withMVarSimulation :: forall (m :: * -> *) a b.
(MonadComp m, MonadIO m, MonadMask m) =>
MVar a -> (a -> Simulation m b) -> Simulation m b
withMVarSimulation MVar a
v a -> Simulation m b
f =
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask forall a b. (a -> b) -> a -> b
$ \forall a. Simulation m a -> Simulation m a
restore ->
  do a
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar a
v
     forall (m :: * -> *) a b.
MonadException m =>
Simulation m a -> Simulation m b -> Simulation m a
finallySimulation
       (a -> Simulation m b
f a
a)
       (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar a
v a
a)

-- | Like 'withMVar' but operates within the 'Dynamics' computation.
withMVarDynamics :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> Dynamics m b) -> Dynamics m b
withMVarDynamics :: forall (m :: * -> *) a b.
(MonadComp m, MonadIO m, MonadMask m) =>
MVar a -> (a -> Dynamics m b) -> Dynamics m b
withMVarDynamics MVar a
v a -> Dynamics m b
f =
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask forall a b. (a -> b) -> a -> b
$ \forall a. Dynamics m a -> Dynamics m a
restore ->
  do a
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar a
v
     forall (m :: * -> *) a b.
MonadException m =>
Dynamics m a -> Dynamics m b -> Dynamics m a
finallyDynamics
       (a -> Dynamics m b
f a
a)
       (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar a
v a
a)

-- | Like 'withMVar' but operates within the 'Event' computation.
withMVarEvent :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> Event m b) -> Event m b
withMVarEvent :: forall (m :: * -> *) a b.
(MonadComp m, MonadIO m, MonadMask m) =>
MVar a -> (a -> Event m b) -> Event m b
withMVarEvent MVar a
v a -> Event m b
f =
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask forall a b. (a -> b) -> a -> b
$ \forall a. Event m a -> Event m a
restore ->
  do a
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar a
v
     forall (m :: * -> *) a b.
MonadException m =>
Event m a -> Event m b -> Event m a
finallyEvent
       (a -> Event m b
f a
a)
       (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar a
v a
a)