-- |
-- 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 :: MVar a -> (a -> m b) -> m b
withMVarComp MVar a
v a -> m b
f =
  ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore ->
  do a
a <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
v
     m b -> m () -> m b
forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
finallyComp
       (a -> m b
f a
a)
       (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO ()
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 :: MVar a -> (a -> Parameter m b) -> Parameter m b
withMVarParameter MVar a
v a -> Parameter m b
f =
  ((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
 -> Parameter m b)
-> ((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
forall a b. (a -> b) -> a -> b
$ \forall a. Parameter m a -> Parameter m a
restore ->
  do a
a <- IO a -> Parameter m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Parameter m a) -> IO a -> Parameter m a
forall a b. (a -> b) -> a -> b
$ MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
v
     Parameter m b -> Parameter m () -> Parameter m b
forall (m :: * -> *) a b.
MonadException m =>
Parameter m a -> Parameter m b -> Parameter m a
finallyParameter
       (a -> Parameter m b
f a
a)
       (IO () -> Parameter m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Parameter m ()) -> IO () -> Parameter m ()
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO ()
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 :: MVar a -> (a -> Simulation m b) -> Simulation m b
withMVarSimulation MVar a
v a -> Simulation m b
f =
  ((forall a. Simulation m a -> Simulation m a) -> Simulation m b)
-> Simulation m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. Simulation m a -> Simulation m a) -> Simulation m b)
 -> Simulation m b)
-> ((forall a. Simulation m a -> Simulation m a) -> Simulation m b)
-> Simulation m b
forall a b. (a -> b) -> a -> b
$ \forall a. Simulation m a -> Simulation m a
restore ->
  do a
a <- IO a -> Simulation m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Simulation m a) -> IO a -> Simulation m a
forall a b. (a -> b) -> a -> b
$ MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
v
     Simulation m b -> Simulation m () -> Simulation m b
forall (m :: * -> *) a b.
MonadException m =>
Simulation m a -> Simulation m b -> Simulation m a
finallySimulation
       (a -> Simulation m b
f a
a)
       (IO () -> Simulation m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Simulation m ()) -> IO () -> Simulation m ()
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO ()
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 :: MVar a -> (a -> Dynamics m b) -> Dynamics m b
withMVarDynamics MVar a
v a -> Dynamics m b
f =
  ((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
 -> Dynamics m b)
-> ((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
forall a b. (a -> b) -> a -> b
$ \forall a. Dynamics m a -> Dynamics m a
restore ->
  do a
a <- IO a -> Dynamics m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Dynamics m a) -> IO a -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
v
     Dynamics m b -> Dynamics m () -> Dynamics m b
forall (m :: * -> *) a b.
MonadException m =>
Dynamics m a -> Dynamics m b -> Dynamics m a
finallyDynamics
       (a -> Dynamics m b
f a
a)
       (IO () -> Dynamics m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Dynamics m ()) -> IO () -> Dynamics m ()
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO ()
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 :: MVar a -> (a -> Event m b) -> Event m b
withMVarEvent MVar a
v a -> Event m b
f =
  ((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. Event m a -> Event m a) -> Event m b) -> Event m b)
-> ((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
forall a b. (a -> b) -> a -> b
$ \forall a. Event m a -> Event m a
restore ->
  do a
a <- IO a -> Event m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Event m a) -> IO a -> Event m a
forall a b. (a -> b) -> a -> b
$ MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
v
     Event m b -> Event m () -> Event m b
forall (m :: * -> *) a b.
MonadException m =>
Event m a -> Event m b -> Event m a
finallyEvent
       (a -> Event m b
f a
a)
       (IO () -> Event m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event m ()) -> IO () -> Event m ()
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
v a
a)