module Control.Concurrent.MVar.Lifted
( MVar.MVar
, newEmptyMVar
, newMVar
, takeMVar
, putMVar
, readMVar
, swapMVar
, tryTakeMVar
, tryPutMVar
, isEmptyMVar
, withMVar
, modifyMVar_
, modifyMVar
, addMVarFinalizer
) where
import Data.Bool ( Bool )
import Data.Function ( ($) )
import Data.Maybe ( Maybe )
import Control.Monad ( return )
import System.IO ( IO )
import Control.Concurrent.MVar ( MVar )
import qualified Control.Concurrent.MVar as MVar
#if __GLASGOW_HASKELL__ < 700
import Control.Monad ( (>>=), (>>), fail )
#endif
import Data.Function.Unicode ( (∘) )
import Control.Monad.Base ( MonadBase, liftBase )
import Control.Monad.Trans.Control ( MonadBaseControl, liftBaseOp, liftBaseDiscard )
import Control.Exception.Lifted ( onException
#if MIN_VERSION_base(4,3,0)
, mask
#else
, block, unblock
#endif
)
#include "inlinable.h"
newEmptyMVar ∷ MonadBase IO m ⇒ m (MVar α)
newEmptyMVar = liftBase MVar.newEmptyMVar
newMVar ∷ MonadBase IO m ⇒ α → m (MVar α)
newMVar = liftBase ∘ MVar.newMVar
takeMVar ∷ MonadBase IO m ⇒ MVar α → m α
takeMVar = liftBase ∘ MVar.takeMVar
putMVar ∷ MonadBase IO m ⇒ MVar α → α → m ()
putMVar mv x = liftBase $ MVar.putMVar mv x
readMVar ∷ MonadBase IO m ⇒ MVar α → m α
readMVar = liftBase ∘ MVar.readMVar
swapMVar ∷ MonadBase IO m ⇒ MVar α → α → m α
swapMVar mv x = liftBase $ MVar.swapMVar mv x
tryTakeMVar ∷ MonadBase IO m ⇒ MVar α → m (Maybe α)
tryTakeMVar = liftBase ∘ MVar.tryTakeMVar
tryPutMVar ∷ MonadBase IO m ⇒ MVar α → α → m Bool
tryPutMVar mv x = liftBase $ MVar.tryPutMVar mv x
isEmptyMVar ∷ MonadBase IO m ⇒ MVar α → m Bool
isEmptyMVar = liftBase ∘ MVar.isEmptyMVar
withMVar ∷ MonadBaseControl IO m ⇒ MVar α → (α → m β) → m β
withMVar = liftBaseOp ∘ MVar.withMVar
modifyMVar_ ∷ (MonadBaseControl IO m, MonadBase IO m) ⇒ MVar α → (α → m α) → m ()
modifyMVar ∷ (MonadBaseControl IO m, MonadBase IO m) ⇒ MVar α → (α → m (α, β)) → m β
#if MIN_VERSION_base(4,3,0)
modifyMVar_ mv f = mask $ \restore → do
x ← takeMVar mv
x' ← restore (f x) `onException` putMVar mv x
putMVar mv x'
modifyMVar mv f = mask $ \restore → do
x ← takeMVar mv
(x', y) ← restore (f x) `onException` putMVar mv x
putMVar mv x'
return y
#else
modifyMVar_ mv f = block $ do
x ← takeMVar mv
x' ← unblock (f x) `onException` putMVar mv x
putMVar mv x'
modifyMVar mv f = block $ do
x ← takeMVar mv
(x', y) ← unblock (f x) `onException` putMVar mv x
putMVar mv x'
return y
#endif
addMVarFinalizer ∷ MonadBaseControl IO m ⇒ MVar α → m () → m ()
addMVarFinalizer = liftBaseDiscard ∘ MVar.addMVarFinalizer