-- | Lifted "Control.Concurrent.MVar" with operations that force values put
-- inside an 'MVar' to WHNF.
module Effectful.Concurrent.MVar.Strict
  ( -- * Effect
    Concurrent

    -- ** Handlers
  , runConcurrent

    -- * MVar
  , MVar
  , newEmptyMVar
  , newMVar
  , takeMVar
  , putMVar
  , readMVar
  , swapMVar
  , tryTakeMVar
  , tryPutMVar
  , isEmptyMVar
  , withMVar
  , withMVarMasked
  , modifyMVar
  , modifyMVar_
  , modifyMVarMasked
  , modifyMVarMasked_
  , tryReadMVar
  , mkWeakMVar
  ) where

import System.Mem.Weak (Weak)
import Control.Concurrent.MVar (MVar)
import qualified Control.Concurrent.MVar as M

import Effectful
import Effectful.Concurrent.Effect
import Effectful.Dispatch.Static
import Effectful.Dispatch.Static.Primitive
import Effectful.Dispatch.Static.Unsafe

-- | Lifted 'M.newEmptyMVar'.
newEmptyMVar :: Concurrent :> es => Eff es (MVar a)
newEmptyMVar :: Eff es (MVar a)
newEmptyMVar = IO (MVar a) -> Eff es (MVar a)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO (MVar a)
forall a. IO (MVar a)
M.newEmptyMVar

-- | Lifted 'M.newMVar' that evaluates the value to WHNF.
newMVar :: Concurrent :> es => a -> Eff es (MVar a)
newMVar :: a -> Eff es (MVar a)
newMVar a
a = IO (MVar a) -> Eff es (MVar a)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (MVar a) -> Eff es (MVar a)) -> IO (MVar a) -> Eff es (MVar a)
forall a b. (a -> b) -> a -> b
$ a
a a -> IO (MVar a) -> IO (MVar a)
`seq` a -> IO (MVar a)
forall a. a -> IO (MVar a)
M.newMVar a
a

-- | Lifted 'M.takeMVar'.
takeMVar :: Concurrent :> es => MVar a -> Eff es a
takeMVar :: MVar a -> Eff es a
takeMVar = IO a -> Eff es a
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO a -> Eff es a) -> (MVar a -> IO a) -> MVar a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> IO a
forall a. MVar a -> IO a
M.takeMVar

-- | Lifted 'M.putMVar'.
putMVar :: Concurrent :> es => MVar a -> a -> Eff es ()
putMVar :: MVar a -> a -> Eff es ()
putMVar MVar a
var a
a = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> IO () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ a
a a -> IO () -> IO ()
`seq` MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
M.putMVar MVar a
var a
a

-- | Lifted 'M.readMVar'.
readMVar :: Concurrent :> es => MVar a -> Eff es a
readMVar :: MVar a -> Eff es a
readMVar = IO a -> Eff es a
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO a -> Eff es a) -> (MVar a -> IO a) -> MVar a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> IO a
forall a. MVar a -> IO a
M.readMVar

-- | Lifted 'M.swapMVar' that evaluates the new value to WHNF.
swapMVar :: Concurrent :> es => MVar a -> a -> Eff es a
swapMVar :: MVar a -> a -> Eff es a
swapMVar MVar a
var a
a = IO a -> Eff es a
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ a
a a -> IO a -> IO a
`seq` MVar a -> a -> IO a
forall a. MVar a -> a -> IO a
M.swapMVar MVar a
var a
a

-- | Lifted 'M.tryTakeMVar'.
tryTakeMVar :: Concurrent :> es => MVar a -> Eff es (Maybe a)
tryTakeMVar :: MVar a -> Eff es (Maybe a)
tryTakeMVar = IO (Maybe a) -> Eff es (Maybe a)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Maybe a) -> Eff es (Maybe a))
-> (MVar a -> IO (Maybe a)) -> MVar a -> Eff es (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
M.tryTakeMVar

-- | Lifted 'M.tryPutMVar' that evaluates the new value to WHNF.
tryPutMVar :: Concurrent :> es => MVar a -> a -> Eff es Bool
tryPutMVar :: MVar a -> a -> Eff es Bool
tryPutMVar MVar a
var a
a = IO Bool -> Eff es Bool
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Bool -> Eff es Bool) -> IO Bool -> Eff es Bool
forall a b. (a -> b) -> a -> b
$ a
a a -> IO Bool -> IO Bool
`seq` MVar a -> a -> IO Bool
forall a. MVar a -> a -> IO Bool
M.tryPutMVar MVar a
var a
a

-- | Lifted 'M.isEmptyMVar'.
isEmptyMVar :: Concurrent :> es => MVar a -> Eff es Bool
isEmptyMVar :: MVar a -> Eff es Bool
isEmptyMVar = IO Bool -> Eff es Bool
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Bool -> Eff es Bool)
-> (MVar a -> IO Bool) -> MVar a -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> IO Bool
forall a. MVar a -> IO Bool
M.isEmptyMVar

-- | Lifted 'M.tryReadMVar'.
tryReadMVar :: Concurrent :> es => MVar a -> Eff es (Maybe a)
tryReadMVar :: MVar a -> Eff es (Maybe a)
tryReadMVar = IO (Maybe a) -> Eff es (Maybe a)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Maybe a) -> Eff es (Maybe a))
-> (MVar a -> IO (Maybe a)) -> MVar a -> Eff es (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
M.tryReadMVar

-- | Lifted 'M.withMVar'.
withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
withMVar :: MVar a -> (a -> Eff es b) -> Eff es b
withMVar MVar a
var a -> Eff es b
f = ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (((forall r. Eff es r -> IO r) -> IO b) -> Eff es b)
-> ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
  MVar a -> (a -> IO b) -> IO b
forall a b. MVar a -> (a -> IO b) -> IO b
M.withMVar MVar a
var ((a -> IO b) -> IO b) -> (a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ Eff es b -> IO b
forall r. Eff es r -> IO r
unlift (Eff es b -> IO b) -> (a -> Eff es b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Eff es b
f

-- | Lifted 'M.withMVarMasked'.
withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
withMVarMasked :: MVar a -> (a -> Eff es b) -> Eff es b
withMVarMasked MVar a
var a -> Eff es b
f = ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (((forall r. Eff es r -> IO r) -> IO b) -> Eff es b)
-> ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
  MVar a -> (a -> IO b) -> IO b
forall a b. MVar a -> (a -> IO b) -> IO b
M.withMVarMasked MVar a
var ((a -> IO b) -> IO b) -> (a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ Eff es b -> IO b
forall r. Eff es r -> IO r
unlift (Eff es b -> IO b) -> (a -> Eff es b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Eff es b
f

-- | Lifted 'M.modifyMVar_' that evaluates the new value to WHNF.
modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
modifyMVar_ :: MVar a -> (a -> Eff es a) -> Eff es ()
modifyMVar_ MVar a
var a -> Eff es a
f = ((forall r. Eff es r -> IO r) -> IO ()) -> Eff es ()
forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (((forall r. Eff es r -> IO r) -> IO ()) -> Eff es ())
-> ((forall r. Eff es r -> IO r) -> IO ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
  MVar a -> (a -> IO a) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
M.modifyMVar_ MVar a
var ((a -> IO a) -> IO ()) -> (a -> IO a) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a
a0 -> do
    a
a <- Eff es a -> IO a
forall r. Eff es r -> IO r
unlift (Eff es a -> IO a) -> Eff es a -> IO a
forall a b. (a -> b) -> a -> b
$ a -> Eff es a
f a
a0
    a
a a -> IO a -> IO a
`seq` a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a

-- | Lifted 'M.modifyMVar' that evaluates the new value to WHNF.
modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
modifyMVar :: MVar a -> (a -> Eff es (a, b)) -> Eff es b
modifyMVar MVar a
var a -> Eff es (a, b)
f = ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (((forall r. Eff es r -> IO r) -> IO b) -> Eff es b)
-> ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
  MVar a -> (a -> IO (a, b)) -> IO b
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
M.modifyMVar MVar a
var ((a -> IO (a, b)) -> IO b) -> (a -> IO (a, b)) -> IO b
forall a b. (a -> b) -> a -> b
$ \a
a0 -> do
    (a
a, b
b) <- Eff es (a, b) -> IO (a, b)
forall r. Eff es r -> IO r
unlift (Eff es (a, b) -> IO (a, b)) -> Eff es (a, b) -> IO (a, b)
forall a b. (a -> b) -> a -> b
$ a -> Eff es (a, b)
f a
a0
    a
a a -> IO (a, b) -> IO (a, b)
`seq` (a, b) -> IO (a, b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a
a, b
b)

-- | Lifted 'M.modifyMVarMasked_' that evaluates the new value to WHNF.
modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
modifyMVarMasked_ :: MVar a -> (a -> Eff es a) -> Eff es ()
modifyMVarMasked_ MVar a
var a -> Eff es a
f = ((forall r. Eff es r -> IO r) -> IO ()) -> Eff es ()
forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (((forall r. Eff es r -> IO r) -> IO ()) -> Eff es ())
-> ((forall r. Eff es r -> IO r) -> IO ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
  MVar a -> (a -> IO a) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
M.modifyMVarMasked_ MVar a
var ((a -> IO a) -> IO ()) -> (a -> IO a) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a
a0 -> do
    a
a <- Eff es a -> IO a
forall r. Eff es r -> IO r
unlift (Eff es a -> IO a) -> Eff es a -> IO a
forall a b. (a -> b) -> a -> b
$ a -> Eff es a
f a
a0
    a
a a -> IO a -> IO a
`seq` a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a

-- | Lifted 'M.modifyMVarMasked' that evaluates the new value to WHNF.
modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
modifyMVarMasked :: MVar a -> (a -> Eff es (a, b)) -> Eff es b
modifyMVarMasked MVar a
var a -> Eff es (a, b)
f = ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (((forall r. Eff es r -> IO r) -> IO b) -> Eff es b)
-> ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
  MVar a -> (a -> IO (a, b)) -> IO b
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
M.modifyMVarMasked MVar a
var ((a -> IO (a, b)) -> IO b) -> (a -> IO (a, b)) -> IO b
forall a b. (a -> b) -> a -> b
$ \a
a0 -> do
    (a, b)
a <- Eff es (a, b) -> IO (a, b)
forall r. Eff es r -> IO r
unlift (Eff es (a, b) -> IO (a, b)) -> Eff es (a, b) -> IO (a, b)
forall a b. (a -> b) -> a -> b
$ a -> Eff es (a, b)
f a
a0
    (a, b)
a (a, b) -> IO (a, b) -> IO (a, b)
`seq` (a, b) -> IO (a, b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a, b)
a

-- | Lifted 'M.mkWeakMVar'.
mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))
mkWeakMVar :: MVar a -> Eff es () -> Eff es (Weak (MVar a))
mkWeakMVar MVar a
var Eff es ()
f = (Env es -> IO (Weak (MVar a))) -> Eff es (Weak (MVar a))
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO (Weak (MVar a))) -> Eff es (Weak (MVar a)))
-> (Env es -> IO (Weak (MVar a))) -> Eff es (Weak (MVar a))
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
  -- The finalizer can run at any point and in any thread.
  MVar a -> IO () -> IO (Weak (MVar a))
forall a. MVar a -> IO () -> IO (Weak (MVar a))
M.mkWeakMVar MVar a
var (IO () -> IO (Weak (MVar a)))
-> (Env es -> IO ()) -> Env es -> IO (Weak (MVar a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es () -> Env es -> IO ()
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff es ()
f (Env es -> IO (Weak (MVar a))) -> IO (Env es) -> IO (Weak (MVar a))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env es -> IO (Env es)
forall (es :: [Effect]). Env es -> IO (Env es)
cloneEnv Env es
es