-- |
-- Module     : Simulation.Aivika.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.Experiment.Concurrent.MVar
       (maybeReadMVar,
        maybePutMVar) where

import Control.Exception
import Control.Concurrent.MVar

import Data.Maybe

-- | Like 'maybe' but for the synchronized variable.
maybeReadMVar :: b -> (a -> IO b) -> MVar (Maybe a) -> IO b
maybeReadMVar :: forall b a. b -> (a -> IO b) -> MVar (Maybe a) -> IO b
maybeReadMVar b
b0 a -> IO b
f MVar (Maybe a)
x =
  do Maybe a
a <- forall a. MVar a -> IO a
readMVar MVar (Maybe a)
x
     case Maybe a
a of
       Just a
a  -> a -> IO 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.
maybePutMVar :: MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b
maybePutMVar :: forall a b. MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b
maybePutMVar MVar (Maybe a)
x IO a
m0 a -> IO b
f =
  forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
  do Maybe a
a <- forall a. MVar a -> IO a
takeMVar MVar (Maybe a)
x
     case Maybe a
a of
       Just a
a ->
         do forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe a)
x (forall a. a -> Maybe a
Just a
a)
            a -> IO b
f a
a
       Maybe a
Nothing ->
         do let handle :: SomeException -> IO a
                handle :: forall a. SomeException -> IO a
handle SomeException
e = do forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe a)
x forall a. Maybe a
Nothing
                              forall a e. Exception e => e -> a
throw SomeException
e
            a
a0 <- forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
m0 forall a. SomeException -> IO a
handle
            forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe a)
x (forall a. a -> Maybe a
Just a
a0)
            a -> IO b
f a
a0