-- |
-- 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 a. m a -> m a) -> m b) -> m b
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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 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 a b. m a -> m b -> m a
forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
finallyComp
       (a -> m b
f a
a)
       (IO () -> m ()
forall a. IO a -> m a
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 :: 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 a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
forall b.
HasCallStack =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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 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 a. IO a -> Parameter m a
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 :: 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 a. Simulation m a -> Simulation m a) -> Simulation m b)
-> Simulation m b
forall b.
HasCallStack =>
((forall a. Simulation m a -> Simulation m a) -> Simulation m b)
-> Simulation m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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 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 a. IO a -> Simulation m a
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 :: 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 a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
forall b.
HasCallStack =>
((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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 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 a. IO a -> Dynamics m a
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 :: 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 a. Event m a -> Event m a) -> Event m b) -> Event m b
forall b.
HasCallStack =>
((forall a. Event m a -> Event m a) -> Event m b) -> Event m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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 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 a. IO a -> Event m a
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)