-- |
-- Module     : Simulation.Aivika.Trans.Experiment.Concurrent.MVar
-- Copyright  : Copyright (c) 2012-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 synchronized variable 'MVar'.
--

module Simulation.Aivika.Trans.Experiment.Concurrent.MVar
       (maybeReadMVarComp,
        maybeReadMVarParameter,
        maybeReadMVarSimulation,
        maybeReadMVarDynamics,
        maybeReadMVarEvent,
        maybeReadMVarProcess,
        maybePutMVarComp,
        maybePutMVarParameter,
        maybePutMVarSimulation,
        maybePutMVarDynamics,
        maybePutMVarEvent,
        maybePutMVarProcess) where

import Control.Exception
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Trans

import Data.Maybe

import Simulation.Aivika.Trans

-- | Like 'maybe' but for the synchronized variable.
maybeReadMVarComp :: (MonadComp m, MonadIO m) => b -> (a -> m b) -> MVar (Maybe a) -> m b
{-# INLINABLE maybeReadMVarComp #-}
maybeReadMVarComp :: forall (m :: * -> *) b a.
(MonadComp m, MonadIO m) =>
b -> (a -> m b) -> MVar (Maybe a) -> m b
maybeReadMVarComp b
b0 a -> m b
f MVar (Maybe a)
x =
  do Maybe 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
readMVar MVar (Maybe a)
x
     case Maybe a
a of
       Just a
a  -> a -> m b
f a
a
       Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b0

-- | Like 'maybeReadMVarComp' but within the 'Parameter' computation.
maybeReadMVarParameter :: (MonadComp m, MonadIO m) => b -> (a -> Parameter m b) -> MVar (Maybe a) -> Parameter m b
{-# INLINABLE maybeReadMVarParameter #-}
maybeReadMVarParameter :: forall (m :: * -> *) b a.
(MonadComp m, MonadIO m) =>
b -> (a -> Parameter m b) -> MVar (Maybe a) -> Parameter m b
maybeReadMVarParameter b
b0 a -> Parameter m b
f MVar (Maybe a)
x =
  do Maybe 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
readMVar MVar (Maybe a)
x
     case Maybe a
a of
       Just a
a  -> a -> Parameter m b
f a
a
       Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b0

-- | Like 'maybeReadMVarComp' but within the 'Simulation' computation.
maybeReadMVarSimulation :: (MonadComp m, MonadIO m) => b -> (a -> Simulation m b) -> MVar (Maybe a) -> Simulation m b
{-# INLINABLE maybeReadMVarSimulation #-}
maybeReadMVarSimulation :: forall (m :: * -> *) b a.
(MonadComp m, MonadIO m) =>
b -> (a -> Simulation m b) -> MVar (Maybe a) -> Simulation m b
maybeReadMVarSimulation b
b0 a -> Simulation m b
f MVar (Maybe a)
x =
  do Maybe 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
readMVar MVar (Maybe a)
x
     case Maybe a
a of
       Just a
a  -> a -> Simulation m b
f a
a
       Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b0

-- | Like 'maybeReadMVarComp' but within the 'Dynamics' computation.
maybeReadMVarDynamics :: (MonadComp m, MonadIO m) => b -> (a -> Dynamics m b) -> MVar (Maybe a) -> Dynamics m b
{-# INLINABLE maybeReadMVarDynamics #-}
maybeReadMVarDynamics :: forall (m :: * -> *) b a.
(MonadComp m, MonadIO m) =>
b -> (a -> Dynamics m b) -> MVar (Maybe a) -> Dynamics m b
maybeReadMVarDynamics b
b0 a -> Dynamics m b
f MVar (Maybe a)
x =
  do Maybe 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
readMVar MVar (Maybe a)
x
     case Maybe a
a of
       Just a
a  -> a -> Dynamics m b
f a
a
       Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b0

-- | Like 'maybeReadMVarComp' but within the 'Event' computation.
maybeReadMVarEvent :: (MonadComp m, MonadIO m) => b -> (a -> Event m b) -> MVar (Maybe a) -> Event m b
{-# INLINABLE maybeReadMVarEvent #-}
maybeReadMVarEvent :: forall (m :: * -> *) b a.
(MonadComp m, MonadIO m) =>
b -> (a -> Event m b) -> MVar (Maybe a) -> Event m b
maybeReadMVarEvent b
b0 a -> Event m b
f MVar (Maybe a)
x =
  do Maybe 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
readMVar MVar (Maybe a)
x
     case Maybe a
a of
       Just a
a  -> a -> Event m b
f a
a
       Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b0

-- | Like 'maybeReadMVarComp' but within the 'Process' computation.
maybeReadMVarProcess :: (MonadDES m, MonadIO m) => b -> (a -> Process m b) -> MVar (Maybe a) -> Process m b
{-# INLINABLE maybeReadMVarProcess #-}
maybeReadMVarProcess :: forall (m :: * -> *) b a.
(MonadDES m, MonadIO m) =>
b -> (a -> Process m b) -> MVar (Maybe a) -> Process m b
maybeReadMVarProcess b
b0 a -> Process m b
f MVar (Maybe a)
x =
  do Maybe 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
readMVar MVar (Maybe a)
x
     case Maybe a
a of
       Just a
a  -> a -> Process m b
f a
a
       Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b0

-- | Update the contents if the variable was empty and then return a result of
-- applying the specified function to either the initial or current value.
maybePutMVarComp :: (MonadComp m, MonadIO m) => MVar (Maybe a) -> m a -> (a -> m b) -> m b
{-# INLINABLE maybePutMVarComp #-}
maybePutMVarComp :: forall (m :: * -> *) a b.
(MonadComp m, MonadIO m) =>
MVar (Maybe a) -> m a -> (a -> m b) -> m b
maybePutMVarComp MVar (Maybe a)
x m a
m0 a -> m b
f =
  -- N.B. it should be actually masked to be protected from the asynchronous exceptions
  do Maybe 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 (Maybe a)
x
     case Maybe a
a of
       Just a
a ->
         do 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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a)
            a -> m b
f a
a
       Maybe a
Nothing ->
         do let handle :: (MonadComp m, MonadIO m) => SomeException -> m a
                handle :: forall (m :: * -> *) a.
(MonadComp m, MonadIO m) =>
SomeException -> m a
handle SomeException
e = do 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 (Maybe a)
x forall a. Maybe a
Nothing
                              forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp SomeException
e
            a
a0 <- forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp m a
m0 forall (m :: * -> *) a.
(MonadComp m, MonadIO m) =>
SomeException -> m a
handle
            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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a0)
            a -> m b
f a
a0

-- | Like 'maybePutMVarComp' but within the 'Parameter' computation.
maybePutMVarParameter :: (MonadComp m, MonadIO m) => MVar (Maybe a) -> Parameter m a -> (a -> Parameter m b) -> Parameter m b
{-# INLINABLE maybePutMVarParameter #-}
maybePutMVarParameter :: forall (m :: * -> *) a b.
(MonadComp m, MonadIO m) =>
MVar (Maybe a)
-> Parameter m a -> (a -> Parameter m b) -> Parameter m b
maybePutMVarParameter MVar (Maybe a)
x Parameter m a
m0 a -> Parameter m b
f =
  -- N.B. it should be actually masked to be protected from the asynchronous exceptions
  do Maybe 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 (Maybe a)
x
     case Maybe a
a of
       Just a
a ->
         do 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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a)
            a -> Parameter m b
f a
a
       Maybe a
Nothing ->
         do let handle :: (MonadComp m, MonadIO m) => SomeException -> Parameter m a
                handle :: forall (m :: * -> *) a.
(MonadComp m, MonadIO m) =>
SomeException -> Parameter m a
handle SomeException
e = do 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 (Maybe a)
x forall a. Maybe a
Nothing
                              forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Parameter m a
throwParameter SomeException
e
            a
a0 <- forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Parameter m a -> (e -> Parameter m a) -> Parameter m a
catchParameter Parameter m a
m0 forall (m :: * -> *) a.
(MonadComp m, MonadIO m) =>
SomeException -> Parameter m a
handle
            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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a0)
            a -> Parameter m b
f a
a0

-- | Like 'maybePutMVarComp' but within the 'Simulation' computation.
maybePutMVarSimulation :: (MonadComp m, MonadIO m) => MVar (Maybe a) -> Simulation m a -> (a -> Simulation m b) -> Simulation m b
{-# INLINABLE maybePutMVarSimulation #-}
maybePutMVarSimulation :: forall (m :: * -> *) a b.
(MonadComp m, MonadIO m) =>
MVar (Maybe a)
-> Simulation m a -> (a -> Simulation m b) -> Simulation m b
maybePutMVarSimulation MVar (Maybe a)
x Simulation m a
m0 a -> Simulation m b
f =
  -- N.B. it should be actually masked to be protected from the asynchronous exceptions
  do Maybe 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 (Maybe a)
x
     case Maybe a
a of
       Just a
a ->
         do 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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a)
            a -> Simulation m b
f a
a
       Maybe a
Nothing ->
         do let handle :: (MonadComp m, MonadIO m) => SomeException -> Simulation m a
                handle :: forall (m :: * -> *) a.
(MonadComp m, MonadIO m) =>
SomeException -> Simulation m a
handle SomeException
e = do 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 (Maybe a)
x forall a. Maybe a
Nothing
                              forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Simulation m a
throwSimulation SomeException
e
            a
a0 <- forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Simulation m a -> (e -> Simulation m a) -> Simulation m a
catchSimulation Simulation m a
m0 forall (m :: * -> *) a.
(MonadComp m, MonadIO m) =>
SomeException -> Simulation m a
handle
            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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a0)
            a -> Simulation m b
f a
a0

-- | Like 'maybePutMVarComp' but within the 'Dynamics' computation.
maybePutMVarDynamics :: (MonadComp m, MonadIO m) => MVar (Maybe a) -> Dynamics m a -> (a -> Dynamics m b) -> Dynamics m b
{-# INLINABLE maybePutMVarDynamics #-}
maybePutMVarDynamics :: forall (m :: * -> *) a b.
(MonadComp m, MonadIO m) =>
MVar (Maybe a)
-> Dynamics m a -> (a -> Dynamics m b) -> Dynamics m b
maybePutMVarDynamics MVar (Maybe a)
x Dynamics m a
m0 a -> Dynamics m b
f =
  -- N.B. it should be actually masked to be protected from the asynchronous exceptions
  do Maybe 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 (Maybe a)
x
     case Maybe a
a of
       Just a
a ->
         do 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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a)
            a -> Dynamics m b
f a
a
       Maybe a
Nothing ->
         do let handle :: (MonadComp m, MonadIO m) => SomeException -> Dynamics m a
                handle :: forall (m :: * -> *) a.
(MonadComp m, MonadIO m) =>
SomeException -> Dynamics m a
handle SomeException
e = do 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 (Maybe a)
x forall a. Maybe a
Nothing
                              forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Dynamics m a
throwDynamics SomeException
e
            a
a0 <- forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Dynamics m a -> (e -> Dynamics m a) -> Dynamics m a
catchDynamics Dynamics m a
m0 forall (m :: * -> *) a.
(MonadComp m, MonadIO m) =>
SomeException -> Dynamics m a
handle
            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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a0)
            a -> Dynamics m b
f a
a0

-- | Like 'maybePutMVarComp' but within the 'Event' computation.
maybePutMVarEvent :: (MonadComp m, MonadIO m) => MVar (Maybe a) -> Event m a -> (a -> Event m b) -> Event m b
{-# INLINABLE maybePutMVarEvent #-}
maybePutMVarEvent :: forall (m :: * -> *) a b.
(MonadComp m, MonadIO m) =>
MVar (Maybe a) -> Event m a -> (a -> Event m b) -> Event m b
maybePutMVarEvent MVar (Maybe a)
x Event m a
m0 a -> Event m b
f =
  -- N.B. it should be actually masked to be protected from the asynchronous exceptions
  do Maybe 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 (Maybe a)
x
     case Maybe a
a of
       Just a
a ->
         do 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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a)
            a -> Event m b
f a
a
       Maybe a
Nothing ->
         do let handle :: (MonadComp m, MonadIO m) => SomeException -> Event m a
                handle :: forall (m :: * -> *) a.
(MonadComp m, MonadIO m) =>
SomeException -> Event m a
handle SomeException
e = do 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 (Maybe a)
x forall a. Maybe a
Nothing
                              forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent SomeException
e
            a
a0 <- forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Event m a -> (e -> Event m a) -> Event m a
catchEvent Event m a
m0 forall (m :: * -> *) a.
(MonadComp m, MonadIO m) =>
SomeException -> Event m a
handle
            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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a0)
            a -> Event m b
f a
a0

-- | Like 'maybePutMVarComp' but within the 'Process' computation.
maybePutMVarProcess :: (MonadDES m, MonadIO m) => MVar (Maybe a) -> Process m a -> (a -> Process m b) -> Process m b
{-# INLINABLE maybePutMVarProcess #-}
maybePutMVarProcess :: forall (m :: * -> *) a b.
(MonadDES m, MonadIO m) =>
MVar (Maybe a) -> Process m a -> (a -> Process m b) -> Process m b
maybePutMVarProcess MVar (Maybe a)
x Process m a
m0 a -> Process m b
f =
  -- N.B. it should be actually masked to be protected from the asynchronous exceptions
  do Maybe 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 (Maybe a)
x
     case Maybe a
a of
       Just a
a ->
         do 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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a)
            a -> Process m b
f a
a
       Maybe a
Nothing ->
         do let handle :: (MonadDES m, MonadIO m) => SomeException -> Process m a
                handle :: forall (m :: * -> *) a.
(MonadDES m, MonadIO m) =>
SomeException -> Process m a
handle SomeException
e = do 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 (Maybe a)
x forall a. Maybe a
Nothing
                              forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess SomeException
e
            a
a0 <- forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
Process m a -> (e -> Process m a) -> Process m a
catchProcess Process m a
m0 forall (m :: * -> *) a.
(MonadDES m, MonadIO m) =>
SomeException -> Process m a
handle
            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 (Maybe a)
x (forall a. a -> Maybe a
Just a
a0)
            a -> Process m b
f a
a0