{-# 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
  , labelMVar
    -- * Re-exports
  , MonadMVar
  ) where

import Control.Concurrent.Class.MonadMVar (MonadLabelledMVar, MonadMVar)
import Control.Concurrent.Class.MonadMVar qualified 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 = LazyMVar n a -> StrictMVar n a
forall (m :: * -> *) a. LazyMVar m a -> StrictMVar m a
StrictMVar (StrictMVar m a -> LazyMVar m a
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 = StrictMVar m a -> LazyMVar m a
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 = LazyMVar m a -> StrictMVar m a
forall (m :: * -> *) a. LazyMVar m a -> StrictMVar m a
StrictMVar

labelMVar :: MonadLabelledMVar m => StrictMVar m a -> String -> m ()
labelMVar :: forall (m :: * -> *) a.
MonadLabelledMVar m =>
StrictMVar m a -> String -> m ()
labelMVar (StrictMVar LazyMVar m a
m) = LazyMVar m a -> String -> m ()
forall a. MVar m a -> String -> m ()
forall (m :: * -> *) a.
MonadLabelledMVar m =>
MVar m a -> String -> m ()
Lazy.labelMVar LazyMVar m a
m

newEmptyMVar :: MonadMVar m => m (StrictMVar m a)
newEmptyMVar :: forall (m :: * -> *) a. MonadMVar m => m (StrictMVar m a)
newEmptyMVar = MVar m a -> StrictMVar m a
forall (m :: * -> *) a. LazyMVar m a -> StrictMVar m a
fromLazyMVar (MVar m a -> StrictMVar m a) -> m (MVar m a) -> m (StrictMVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (MVar m a)
forall a. m (MVar m a)
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 = MVar m a -> StrictMVar m a
forall (m :: * -> *) a. LazyMVar m a -> StrictMVar m a
fromLazyMVar (MVar m a -> StrictMVar m a) -> m (MVar m a) -> m (StrictMVar m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (MVar m a)
forall a. a -> m (MVar m a)
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 = MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
Lazy.takeMVar (MVar m a -> m a)
-> (StrictMVar m a -> MVar m a) -> StrictMVar m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMVar m a -> MVar m a
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 = MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadMVar m => MVar m a -> a -> m ()
Lazy.putMVar (StrictMVar m a -> MVar m a
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 = MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
Lazy.readMVar (StrictMVar m a -> MVar m a
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 = MVar m a -> a -> m a
forall a. MVar m a -> a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> a -> m a
Lazy.swapMVar (StrictMVar m a -> MVar m a
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 = MVar m a -> m (Maybe a)
forall a. MVar m a -> m (Maybe a)
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m (Maybe a)
Lazy.tryTakeMVar (StrictMVar m a -> MVar m a
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 = MVar m a -> a -> m Bool
forall a. MVar m a -> a -> m Bool
forall (m :: * -> *) a. MonadMVar m => MVar m a -> a -> m Bool
Lazy.tryPutMVar (StrictMVar m a -> MVar m a
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 = MVar m a -> m Bool
forall a. MVar m a -> m Bool
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m Bool
Lazy.isEmptyMVar (StrictMVar m a -> MVar m a
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 = MVar m a -> (a -> m b) -> m b
forall a b. MVar m a -> (a -> m b) -> m b
forall (m :: * -> *) a b.
MonadMVar m =>
MVar m a -> (a -> m b) -> m b
Lazy.withMVar (StrictMVar m a -> MVar m a
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 = MVar m a -> (a -> m b) -> m b
forall a b. MVar m a -> (a -> m b) -> m b
forall (m :: * -> *) a b.
MonadMVar m =>
MVar m a -> (a -> m b) -> m b
Lazy.withMVarMasked (StrictMVar m a -> MVar m a
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 = MVar m a -> (a -> m a) -> m ()
forall a. MVar m a -> (a -> m a) -> m ()
forall (m :: * -> *) a.
MonadMVar m =>
MVar m a -> (a -> m a) -> m ()
Lazy.modifyMVar_ (StrictMVar m a -> MVar m a
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 -> m a
io a
a
      pure 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 = MVar m a -> (a -> m (a, b)) -> m b
forall a b. MVar m a -> (a -> m (a, b)) -> m b
forall (m :: * -> *) a b.
MonadMVar m =>
MVar m a -> (a -> m (a, b)) -> m b
Lazy.modifyMVar (StrictMVar m a -> MVar m a
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', b) <- a -> m (a, b)
io a
a
      pure (a', 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 = MVar m a -> (a -> m a) -> m ()
forall a. MVar m a -> (a -> m a) -> m ()
forall (m :: * -> *) a.
MonadMVar m =>
MVar m a -> (a -> m a) -> m ()
Lazy.modifyMVarMasked_ (StrictMVar m a -> MVar m a
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 -> m a
io a
a
      pure 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 = MVar m a -> (a -> m (a, b)) -> m b
forall a b. MVar m a -> (a -> m (a, b)) -> m b
forall (m :: * -> *) a b.
MonadMVar m =>
MVar m a -> (a -> m (a, b)) -> m b
Lazy.modifyMVarMasked (StrictMVar m a -> MVar m a
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', b) <- a -> m (a, b)
io a
a
      pure (a', 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 = MVar m a -> m (Maybe a)
forall a. MVar m a -> m (Maybe a)
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m (Maybe a)
Lazy.tryReadMVar (StrictMVar m a -> MVar m a
forall (m :: * -> *) a. StrictMVar m a -> LazyMVar m a
mvar StrictMVar m a
v)