{-# LANGUAGE DefaultSignatures      #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE QuantifiedConstraints  #-}
{-# LANGUAGE TypeFamilyDependencies #-}

module Control.Concurrent.Class.MonadMVar
  ( MonadMVar (..)
    -- * non-standard extensions
  , MonadInspectMVar (..)
  , MonadLabelledMVar (..)
  ) where

import Control.Concurrent.MVar qualified as IO
import Control.Monad.Class.MonadThrow

import Control.Monad.Reader (ReaderT (..))
import Control.Monad.Trans (lift)

import Data.Kind (Type)


class Monad m => MonadMVar m where
  {-# MINIMAL newEmptyMVar,
              takeMVar, tryTakeMVar,
              putMVar,  tryPutMVar,
              readMVar, tryReadMVar,
              isEmptyMVar #-}

  type MVar m :: Type -> Type

  -- | See 'IO.newEmptyMVar'.
  newEmptyMVar      :: m (MVar m a)
  -- | See 'IO.takeMVar'.
  takeMVar          :: MVar m a -> m a
  -- | See 'IO.putMVar'.
  putMVar           :: MVar m a -> a -> m ()
  -- | See 'IO.tryTakeMVar'.
  tryTakeMVar       :: MVar m a -> m (Maybe a)
  -- | See 'IO.tryPutMVar'.
  tryPutMVar        :: MVar m a -> a -> m Bool
  -- | See 'IO.isEmptyMVar'.
  isEmptyMVar       :: MVar m a -> m Bool

  -- methods with a default implementation
  -- | See 'IO.newMVar'.
  newMVar           :: a -> m (MVar m a)
  -- | See 'IO.readMVar'.
  readMVar          :: MVar m a -> m a
  -- | See 'IO.tryReadMVar'.
  tryReadMVar       :: MVar m a -> m (Maybe a)
  -- | See 'IO.swapMVar'.
  swapMVar          :: MVar m a -> a -> m a
  -- | See 'IO.withMVar'.
  withMVar          :: MVar m a -> (a -> m b) -> m b
  -- | See 'IO.withMVarMasked'.
  withMVarMasked    :: MVar m a -> (a -> m b) -> m b
  -- | See 'IO.modifyMVar_'.
  modifyMVar_       :: MVar m a -> (a -> m a) -> m ()
  -- | See 'IO.modifyMVar'.
  modifyMVar        :: MVar m a -> (a -> m (a, b)) -> m b
  -- | See 'IO.modifyMVarMasked_'.
  modifyMVarMasked_ :: MVar m a -> (a -> m a) -> m ()
  -- | See 'IO.modifyMVarMasked'.
  modifyMVarMasked  :: MVar m a -> (a -> m (a,b)) -> m b

  default newMVar :: a -> m (MVar m a)
  newMVar a
a = do
    v <- m (MVar m a)
forall a. m (MVar m a)
forall (m :: * -> *) a. MonadMVar m => m (MVar m a)
newEmptyMVar
    putMVar v a
    return v
  {-# INLINE newMVar #-}

  default swapMVar :: MonadMask m => MVar m a -> a -> m a
  swapMVar MVar m a
mvar a
new =
    m a -> m a
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ do
      old <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
takeMVar MVar m a
mvar
      putMVar mvar new
      return old
  {-# INLINE swapMVar #-}

  default withMVar :: MonadMask m => MVar m a -> (a -> m b) -> m b
  withMVar MVar m a
m a -> m b
io =
    ((forall a. m a -> m a) -> m b) -> m b
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
      a <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
takeMVar MVar m a
m
      b <- restore (io a) `onException` putMVar m a
      putMVar m a
      return b
  {-# INLINE withMVar #-}

  default withMVarMasked :: MonadMask m => MVar m a -> (a -> m b) -> m b
  withMVarMasked MVar m a
m a -> m b
io =
    m b -> m b
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ do
      a <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
takeMVar MVar m a
m
      b <- io a `onException` putMVar m a
      putMVar m a
      return b
  {-# INLINE withMVarMasked #-}

  default modifyMVar_ :: MonadMask m => MVar m a -> (a -> m a) -> m ()
  modifyMVar_ MVar m a
m a -> m a
io =
    ((forall a. m a -> m a) -> m ()) -> m ()
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m ()) -> m ())
-> ((forall a. m a -> m a) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
      a  <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
takeMVar MVar m a
m
      a' <- restore (io a) `onException` putMVar m a
      putMVar m a'
  {-# INLINE modifyMVar_ #-}

  default modifyMVar :: (MonadMask m, MonadEvaluate m)
                     => MVar m a -> (a -> m (a,b)) -> m b
  modifyMVar MVar m a
m a -> m (a, b)
io =
    ((forall a. m a -> m a) -> m b) -> m b
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
      a      <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
takeMVar MVar m a
m
      (a',b) <- restore (io a >>= evaluate) `onException` putMVar m a
      putMVar m a'
      return b
  {-# INLINE modifyMVar #-}

  default modifyMVarMasked_ :: MonadMask m => MVar m a -> (a -> m a) -> m ()
  modifyMVarMasked_ MVar m a
m a -> m a
io =
    m () -> m ()
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      a  <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
takeMVar MVar m a
m
      a' <- io a `onException` putMVar m a
      putMVar m a'
  {-# INLINE modifyMVarMasked_ #-}

  default modifyMVarMasked :: (MonadMask m, MonadEvaluate m)
                           => MVar m a -> (a -> m (a,b)) -> m b
  modifyMVarMasked MVar m a
m a -> m (a, b)
io =
    m b -> m b
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ do
      a      <- MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
takeMVar MVar m a
m
      (a',b) <- (io a >>= evaluate) `onException` putMVar m a
      putMVar m a'
      return b
  {-# INLINE modifyMVarMasked #-}

--
-- IO instance
--

instance MonadMVar IO where
    type MVar IO      = IO.MVar
    newEmptyMVar :: forall a. IO (MVar IO a)
newEmptyMVar      = IO (MVar a)
IO (MVar IO a)
forall a. IO (MVar a)
IO.newEmptyMVar
    newMVar :: forall a. a -> IO (MVar IO a)
newMVar           = a -> IO (MVar a)
a -> IO (MVar IO a)
forall a. a -> IO (MVar a)
IO.newMVar
    takeMVar :: forall a. MVar IO a -> IO a
takeMVar          = MVar a -> IO a
MVar IO a -> IO a
forall a. MVar a -> IO a
IO.takeMVar
    putMVar :: forall a. MVar IO a -> a -> IO ()
putMVar           = MVar a -> a -> IO ()
MVar IO a -> a -> IO ()
forall a. MVar a -> a -> IO ()
IO.putMVar
    readMVar :: forall a. MVar IO a -> IO a
readMVar          = MVar a -> IO a
MVar IO a -> IO a
forall a. MVar a -> IO a
IO.readMVar
    swapMVar :: forall a. MVar IO a -> a -> IO a
swapMVar          = MVar a -> a -> IO a
MVar IO a -> a -> IO a
forall a. MVar a -> a -> IO a
IO.swapMVar
    tryTakeMVar :: forall a. MVar IO a -> IO (Maybe a)
tryTakeMVar       = MVar a -> IO (Maybe a)
MVar IO a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
IO.tryTakeMVar
    tryPutMVar :: forall a. MVar IO a -> a -> IO Bool
tryPutMVar        = MVar a -> a -> IO Bool
MVar IO a -> a -> IO Bool
forall a. MVar a -> a -> IO Bool
IO.tryPutMVar
    tryReadMVar :: forall a. MVar IO a -> IO (Maybe a)
tryReadMVar       = MVar a -> IO (Maybe a)
MVar IO a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
IO.tryReadMVar
    isEmptyMVar :: forall a. MVar IO a -> IO Bool
isEmptyMVar       = MVar a -> IO Bool
MVar IO a -> IO Bool
forall a. MVar a -> IO Bool
IO.isEmptyMVar
    withMVar :: forall a b. MVar IO a -> (a -> IO b) -> IO b
withMVar          = MVar a -> (a -> IO b) -> IO b
MVar IO a -> (a -> IO b) -> IO b
forall a b. MVar a -> (a -> IO b) -> IO b
IO.withMVar
    withMVarMasked :: forall a b. MVar IO a -> (a -> IO b) -> IO b
withMVarMasked    = MVar a -> (a -> IO b) -> IO b
MVar IO a -> (a -> IO b) -> IO b
forall a b. MVar a -> (a -> IO b) -> IO b
IO.withMVarMasked
    modifyMVar_ :: forall a. MVar IO a -> (a -> IO a) -> IO ()
modifyMVar_       = MVar a -> (a -> IO a) -> IO ()
MVar IO a -> (a -> IO a) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
IO.modifyMVar_
    modifyMVar :: forall a b. MVar IO a -> (a -> IO (a, b)) -> IO b
modifyMVar        = MVar a -> (a -> IO (a, b)) -> IO b
MVar IO a -> (a -> IO (a, b)) -> IO b
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
IO.modifyMVar
    modifyMVarMasked_ :: forall a. MVar IO a -> (a -> IO a) -> IO ()
modifyMVarMasked_ = MVar a -> (a -> IO a) -> IO ()
MVar IO a -> (a -> IO a) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
IO.modifyMVarMasked_
    modifyMVarMasked :: forall a b. MVar IO a -> (a -> IO (a, b)) -> IO b
modifyMVarMasked  = MVar a -> (a -> IO (a, b)) -> IO b
MVar IO a -> (a -> IO (a, b)) -> IO b
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
IO.modifyMVarMasked

--
-- ReaderT instance
--

newtype WrappedMVar r (m :: Type -> Type) a = WrappedMVar { forall r (m :: * -> *) a. WrappedMVar r m a -> MVar m a
unwrapMVar :: MVar m a }

instance ( MonadMask m
         , MonadMVar m
         ) => MonadMVar (ReaderT r m) where
    type MVar (ReaderT r m) = WrappedMVar r m
    newEmptyMVar :: forall a. ReaderT r m (MVar (ReaderT r m) a)
newEmptyMVar = MVar m a -> WrappedMVar r m a
forall r (m :: * -> *) a. MVar m a -> WrappedMVar r m a
WrappedMVar (MVar m a -> WrappedMVar r m a)
-> ReaderT r m (MVar m a) -> ReaderT r m (WrappedMVar r m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (MVar m a) -> ReaderT r m (MVar m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (MVar m a)
forall a. m (MVar m a)
forall (m :: * -> *) a. MonadMVar m => m (MVar m a)
newEmptyMVar
    newMVar :: forall a. a -> ReaderT r m (MVar (ReaderT r m) a)
newMVar      = (MVar m a -> WrappedMVar r m a)
-> ReaderT r m (MVar m a) -> ReaderT r m (WrappedMVar r m a)
forall a b. (a -> b) -> ReaderT r m a -> ReaderT r m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVar m a -> WrappedMVar r m a
forall r (m :: * -> *) a. MVar m a -> WrappedMVar r m a
WrappedMVar (ReaderT r m (MVar m a) -> ReaderT r m (WrappedMVar r m a))
-> (a -> ReaderT r m (MVar m a))
-> a
-> ReaderT r m (WrappedMVar r m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (MVar m a) -> ReaderT r m (MVar m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MVar m a) -> ReaderT r m (MVar m a))
-> (a -> m (MVar m a)) -> a -> ReaderT r m (MVar m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (MVar m a)
forall a. a -> m (MVar m a)
forall (m :: * -> *) a. MonadMVar m => a -> m (MVar m a)
newMVar
    takeMVar :: forall a. MVar (ReaderT r m) a -> ReaderT r m a
takeMVar     = m a -> ReaderT r m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> (WrappedMVar r m a -> m a) -> WrappedMVar r m a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
takeMVar    (MVar m a -> m a)
-> (WrappedMVar r m a -> MVar m a) -> WrappedMVar r m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMVar r m a -> MVar m a
forall r (m :: * -> *) a. WrappedMVar r m a -> MVar m a
unwrapMVar
    putMVar :: forall a. MVar (ReaderT r m) a -> a -> ReaderT r m ()
putMVar      = m () -> ReaderT r m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (WrappedMVar r m a -> a -> m ())
-> WrappedMVar r m a
-> a
-> ReaderT r m ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: (MVar m a -> a -> m ()
forall a. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadMVar m => MVar m a -> a -> m ()
putMVar     (MVar m a -> a -> m ())
-> (WrappedMVar r m a -> MVar m a)
-> WrappedMVar r m a
-> a
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMVar r m a -> MVar m a
forall r (m :: * -> *) a. WrappedMVar r m a -> MVar m a
unwrapMVar)
    readMVar :: forall a. MVar (ReaderT r m) a -> ReaderT r m a
readMVar     = m a -> ReaderT r m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> (WrappedMVar r m a -> m a) -> WrappedMVar r m a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   MVar m a -> m a
forall a. MVar m a -> m a
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m a
readMVar    (MVar m a -> m a)
-> (WrappedMVar r m a -> MVar m a) -> WrappedMVar r m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMVar r m a -> MVar m a
forall r (m :: * -> *) a. WrappedMVar r m a -> MVar m a
unwrapMVar
    tryReadMVar :: forall a. MVar (ReaderT r m) a -> ReaderT r m (Maybe a)
tryReadMVar  = m (Maybe a) -> ReaderT r m (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe a) -> ReaderT r m (Maybe a))
-> (WrappedMVar r m a -> m (Maybe a))
-> WrappedMVar r m a
-> ReaderT r m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   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)
tryReadMVar (MVar m a -> m (Maybe a))
-> (WrappedMVar r m a -> MVar m a)
-> WrappedMVar r m a
-> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMVar r m a -> MVar m a
forall r (m :: * -> *) a. WrappedMVar r m a -> MVar m a
unwrapMVar
    swapMVar :: forall a. MVar (ReaderT r m) a -> a -> ReaderT r m a
swapMVar     = m a -> ReaderT r m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> (WrappedMVar r m a -> a -> m a)
-> WrappedMVar r m a
-> a
-> ReaderT r m a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: (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
swapMVar    (MVar m a -> a -> m a)
-> (WrappedMVar r m a -> MVar m a) -> WrappedMVar r m a -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMVar r m a -> MVar m a
forall r (m :: * -> *) a. WrappedMVar r m a -> MVar m a
unwrapMVar)
    tryTakeMVar :: forall a. MVar (ReaderT r m) a -> ReaderT r m (Maybe a)
tryTakeMVar  = m (Maybe a) -> ReaderT r m (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe a) -> ReaderT r m (Maybe a))
-> (WrappedMVar r m a -> m (Maybe a))
-> WrappedMVar r m a
-> ReaderT r m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   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)
tryTakeMVar (MVar m a -> m (Maybe a))
-> (WrappedMVar r m a -> MVar m a)
-> WrappedMVar r m a
-> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMVar r m a -> MVar m a
forall r (m :: * -> *) a. WrappedMVar r m a -> MVar m a
unwrapMVar
    tryPutMVar :: forall a. MVar (ReaderT r m) a -> a -> ReaderT r m Bool
tryPutMVar   = m Bool -> ReaderT r m Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ReaderT r m Bool)
-> (WrappedMVar r m a -> a -> m Bool)
-> WrappedMVar r m a
-> a
-> ReaderT r m Bool
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: (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
tryPutMVar  (MVar m a -> a -> m Bool)
-> (WrappedMVar r m a -> MVar m a)
-> WrappedMVar r m a
-> a
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMVar r m a -> MVar m a
forall r (m :: * -> *) a. WrappedMVar r m a -> MVar m a
unwrapMVar)
    isEmptyMVar :: forall a. MVar (ReaderT r m) a -> ReaderT r m Bool
isEmptyMVar  = m Bool -> ReaderT r m Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ReaderT r m Bool)
-> (WrappedMVar r m a -> m Bool)
-> WrappedMVar r m a
-> ReaderT r m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   MVar m a -> m Bool
forall a. MVar m a -> m Bool
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m Bool
isEmptyMVar (MVar m a -> m Bool)
-> (WrappedMVar r m a -> MVar m a) -> WrappedMVar r m a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMVar r m a -> MVar m a
forall r (m :: * -> *) a. WrappedMVar r m a -> MVar m a
unwrapMVar
    withMVar :: forall a b.
MVar (ReaderT r m) a -> (a -> ReaderT r m b) -> ReaderT r m b
withMVar (WrappedMVar MVar m a
v) a -> ReaderT r m b
f = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ \r
r ->
      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
withMVar MVar m a
v (\a
a -> ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m b
f a
a) r
r)
    withMVarMasked :: forall a b.
MVar (ReaderT r m) a -> (a -> ReaderT r m b) -> ReaderT r m b
withMVarMasked (WrappedMVar MVar m a
v) a -> ReaderT r m b
f = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ \r
r ->
      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
withMVarMasked MVar m a
v (\a
a -> ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m b
f a
a) r
r)
    modifyMVar_ :: forall a.
MVar (ReaderT r m) a -> (a -> ReaderT r m a) -> ReaderT r m ()
modifyMVar_ (WrappedMVar MVar m a
v) a -> ReaderT r m a
f = (r -> m ()) -> ReaderT r m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m ()) -> ReaderT r m ()) -> (r -> m ()) -> ReaderT r m ()
forall a b. (a -> b) -> a -> b
$ \r
r ->
      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 ()
modifyMVar_ MVar m a
v (\a
a -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m a
f a
a) r
r)
    modifyMVar :: forall a b.
MVar (ReaderT r m) a -> (a -> ReaderT r m (a, b)) -> ReaderT r m b
modifyMVar (WrappedMVar MVar m a
v) a -> ReaderT r m (a, b)
f = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ \r
r ->
      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
modifyMVar MVar m a
v (\a
a -> ReaderT r m (a, b) -> r -> m (a, b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m (a, b)
f a
a) r
r)
    modifyMVarMasked_ :: forall a.
MVar (ReaderT r m) a -> (a -> ReaderT r m a) -> ReaderT r m ()
modifyMVarMasked_ (WrappedMVar MVar m a
v) a -> ReaderT r m a
f = (r -> m ()) -> ReaderT r m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m ()) -> ReaderT r m ()) -> (r -> m ()) -> ReaderT r m ()
forall a b. (a -> b) -> a -> b
$ \r
r ->
      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 ()
modifyMVarMasked_ MVar m a
v (\a
a -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m a
f a
a) r
r)
    modifyMVarMasked :: forall a b.
MVar (ReaderT r m) a -> (a -> ReaderT r m (a, b)) -> ReaderT r m b
modifyMVarMasked (WrappedMVar MVar m a
v) a -> ReaderT r m (a, b)
f = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ \r
r ->
      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
modifyMVarMasked MVar m a
v (\a
a -> ReaderT r m (a, b) -> r -> m (a, b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m (a, b)
f a
a) r
r)

--
-- MonadInspectMVar
--

-- | This type class is intended for
-- ['io-sim'](https://hackage.haskell.org/package/io-sim), where one might want
-- to access an 'MVar' in the underlying 'ST' monad.
class (MonadMVar m, Monad (InspectMVarMonad m)) => MonadInspectMVar m where
  type InspectMVarMonad m :: Type -> Type
  -- | Return the value of an 'MVar' as an 'InspectMVarMonad' computation. Can
  -- be 'Nothing' if the 'MVar' is empty.
  inspectMVar :: proxy m -> MVar m a -> InspectMVarMonad m (Maybe a)

instance MonadInspectMVar IO where
  type InspectMVarMonad IO = IO
  inspectMVar :: forall (proxy :: (* -> *) -> *) a.
proxy IO -> MVar IO a -> InspectMVarMonad IO (Maybe a)
inspectMVar proxy IO
_ = MVar IO a -> IO (Maybe a)
MVar IO a -> InspectMVarMonad IO (Maybe a)
forall a. MVar IO a -> IO (Maybe a)
forall (m :: * -> *) a. MonadMVar m => MVar m a -> m (Maybe a)
tryReadMVar

-- | Labelled `MVar`s
--
-- The `IO` instances is no-op, the `IOSim` instance enhances simulation trace.
-- This is very useful when analysing low lever concurrency issues (e.g.
-- deadlocks, livelocks etc).
class MonadMVar m
   => MonadLabelledMVar m where
  -- | Name an `MVar`
  labelMVar :: MVar m a -> String -> m ()

instance MonadLabelledMVar IO where
  labelMVar :: forall a. MVar IO a -> String -> IO ()
labelMVar = \MVar IO a
_ String
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
--
-- Utilities
--

(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
(c -> d
f .: :: forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: a -> b -> c
g) a
x b
y = c -> d
f (a -> b -> c
g a
x b
y)