{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- | This module corresponds to "Control.Concurrent.MVar" in the @base@ package.
module Control.Concurrent.Class.MonadMVar.Strict
  ( -- * StrictMVar
    StrictMVar
  , LazyMVar
  , castStrictMVar
  , toLazyMVar
  , fromLazyMVar
  , newEmptyMVar
  , newMVar
  , takeMVar
  , putMVar
  , readMVar
  , swapMVar
  , tryTakeMVar
  , tryPutMVar
  , isEmptyMVar
  , withMVar
  , withMVarMasked
  , modifyMVar_
  , modifyMVar
  , modifyMVarMasked_
  , modifyMVarMasked
  , tryReadMVar
    -- * Re-exports
  , MonadMVar
  ) where

import           Control.Concurrent.Class.MonadMVar (MonadMVar)
import qualified Control.Concurrent.Class.MonadMVar as Lazy

--
-- StrictMVar
--

type LazyMVar m = Lazy.MVar m

newtype StrictMVar m a = StrictMVar {
    forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar      :: LazyMVar m a
  }

castStrictMVar :: LazyMVar m ~ LazyMVar n
               => StrictMVar m a -> StrictMVar n a
castStrictMVar :: forall (m :: * -> *) (n :: * -> *) a.
(LazyMVar m ~ LazyMVar n) =>
StrictMVar m a -> StrictMVar n a
castStrictMVar StrictMVar m a
v = forall (m :: * -> *) a. LazyMVar m a -> StrictMVar m a
StrictMVar (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v)

-- | Get the underlying @MVar@
--
-- Since we obviously cannot guarantee that updates to this 'LazyMVar' will be
-- strict, this should be used with caution.
toLazyMVar :: StrictMVar m a -> LazyMVar m a
toLazyMVar :: forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
toLazyMVar = forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar

-- | Create a 'StrictMVar' from a 'LazyMVar'
--
-- It is not guaranteed that the 'LazyMVar' contains a value that is in WHNF, so
-- there is no guarantee that the resulting 'StrictMVar' contains a value that
-- is in WHNF. This should be used with caution.
fromLazyMVar :: Lazy.MVar m a -> StrictMVar m a
fromLazyMVar :: forall (m :: * -> *) a. LazyMVar m a -> StrictMVar m a
fromLazyMVar = forall (m :: * -> *) a. LazyMVar m a -> StrictMVar m a
StrictMVar

newEmptyMVar :: MonadMVar m => m (StrictMVar m a)
newEmptyMVar :: forall (m :: * -> *) a. MonadMVar m => m (StrictMVar m a)
newEmptyMVar = forall (m :: * -> *) a. LazyMVar m a -> StrictMVar m a
fromLazyMVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadMVar m => m (MVar m a)
Lazy.newEmptyMVar

newMVar :: MonadMVar m => a -> m (StrictMVar m a)
newMVar :: forall (m :: * -> *) a. MonadMVar m => a -> m (StrictMVar m a)
newMVar !a
a = forall (m :: * -> *) a. LazyMVar m a -> StrictMVar m a
fromLazyMVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadMVar m => a -> m (MVar m a)
Lazy.newMVar a
a

takeMVar :: MonadMVar m => StrictMVar m a -> m a
takeMVar :: forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> m a
takeMVar = forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
Lazy.takeMVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar

putMVar :: MonadMVar m => StrictMVar m a -> a -> m ()
putMVar :: forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> a -> m ()
putMVar StrictMVar m a
v !a
a = forall (m :: * -> *) a. MonadMVar m => MVar m a -> a -> m ()
Lazy.putMVar (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v) a
a

readMVar :: MonadMVar m => StrictMVar m a -> m a
readMVar :: forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> m a
readMVar StrictMVar m a
v = forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
Lazy.readMVar (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v)

swapMVar :: MonadMVar m => StrictMVar m a -> a -> m a
swapMVar :: forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> a -> m a
swapMVar StrictMVar m a
v !a
a = forall (m :: * -> *) a. MonadMVar m => MVar m a -> a -> m a
Lazy.swapMVar (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v) a
a

tryTakeMVar :: MonadMVar m => StrictMVar m a -> m (Maybe a)
tryTakeMVar :: forall (m :: * -> *) a.
MonadMVar m =>
StrictMVar m a -> m (Maybe a)
tryTakeMVar StrictMVar m a
v = forall (m :: * -> *) a. MonadMVar m => MVar m a -> m (Maybe a)
Lazy.tryTakeMVar (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v)

tryPutMVar :: MonadMVar m => StrictMVar m a -> a -> m Bool
tryPutMVar :: forall (m :: * -> *) a.
MonadMVar m =>
StrictMVar m a -> a -> m Bool
tryPutMVar StrictMVar m a
v !a
a = forall (m :: * -> *) a. MonadMVar m => MVar m a -> a -> m Bool
Lazy.tryPutMVar (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v) a
a

isEmptyMVar :: MonadMVar m => StrictMVar m a -> m Bool
isEmptyMVar :: forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> m Bool
isEmptyMVar StrictMVar m a
v = forall (m :: * -> *) a. MonadMVar m => MVar m a -> m Bool
Lazy.isEmptyMVar (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v)

withMVar :: MonadMVar m => StrictMVar m a -> (a -> m b) -> m b
withMVar :: forall (m :: * -> *) a b.
MonadMVar m =>
StrictMVar m a -> (a -> m b) -> m b
withMVar StrictMVar m a
v = forall (m :: * -> *) a b.
MonadMVar m =>
MVar m a -> (a -> m b) -> m b
Lazy.withMVar (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v)

withMVarMasked :: MonadMVar m => StrictMVar m a -> (a -> m b) -> m b
withMVarMasked :: forall (m :: * -> *) a b.
MonadMVar m =>
StrictMVar m a -> (a -> m b) -> m b
withMVarMasked StrictMVar m a
v = forall (m :: * -> *) a b.
MonadMVar m =>
MVar m a -> (a -> m b) -> m b
Lazy.withMVarMasked (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v)

modifyMVar_ :: MonadMVar m => StrictMVar m a -> (a -> m a) -> m ()
modifyMVar_ :: forall (m :: * -> *) a.
MonadMVar m =>
StrictMVar m a -> (a -> m a) -> m ()
modifyMVar_ StrictMVar m a
v a -> m a
io = forall (m :: * -> *) a.
MonadMVar m =>
MVar m a -> (a -> m a) -> m ()
Lazy.modifyMVar_ (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v) a -> m a
io'
  where
    io' :: a -> m a
io' a
a = do
      !a
a' <- a -> m a
io a
a
      forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a'

modifyMVar :: MonadMVar m => StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVar :: forall (m :: * -> *) a b.
MonadMVar m =>
StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVar StrictMVar m a
v a -> m (a, b)
io = forall (m :: * -> *) a b.
MonadMVar m =>
MVar m a -> (a -> m (a, b)) -> m b
Lazy.modifyMVar (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v) a -> m (a, b)
io'
  where
    io' :: a -> m (a, b)
io' a
a = do
      (!a
a', b
b) <- a -> m (a, b)
io a
a
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a', b
b)

modifyMVarMasked_ :: MonadMVar m => StrictMVar m a -> (a -> m a) -> m ()
modifyMVarMasked_ :: forall (m :: * -> *) a.
MonadMVar m =>
StrictMVar m a -> (a -> m a) -> m ()
modifyMVarMasked_ StrictMVar m a
v a -> m a
io = forall (m :: * -> *) a.
MonadMVar m =>
MVar m a -> (a -> m a) -> m ()
Lazy.modifyMVarMasked_ (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v) a -> m a
io'
  where
    io' :: a -> m a
io' a
a = do
      !a
a' <- a -> m a
io a
a
      forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a'

modifyMVarMasked :: MonadMVar m => StrictMVar m a -> (a -> m (a,b)) -> m b
modifyMVarMasked :: forall (m :: * -> *) a b.
MonadMVar m =>
StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVarMasked StrictMVar m a
v a -> m (a, b)
io = forall (m :: * -> *) a b.
MonadMVar m =>
MVar m a -> (a -> m (a, b)) -> m b
Lazy.modifyMVarMasked (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v) a -> m (a, b)
io'
  where
    io' :: a -> m (a, b)
io' a
a = do
      (!a
a', b
b) <- a -> m (a, b)
io a
a
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a', b
b)

tryReadMVar :: MonadMVar m => StrictMVar m a -> m (Maybe a)
tryReadMVar :: forall (m :: * -> *) a.
MonadMVar m =>
StrictMVar m a -> m (Maybe a)
tryReadMVar StrictMVar m a
v = forall (m :: * -> *) a. MonadMVar m => MVar m a -> m (Maybe a)
Lazy.tryReadMVar (forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v)