{-# LANGUAGE Safe #-}

{- |
Module                  : Relude.Lifted.Concurrent
Copyright               : (c) 2016 Stephen Diehl
                          (c) 2016-2018 Serokell
                          (c) 2018-2023 Kowainik
SPDX-License-Identifier : MIT
Maintainer              : Kowainik <xrom.xkov@gmail.com>
Stability               : Stable
Portability             : Portable

Lifted 'MVar' and 'STM' functions.
-}

module Relude.Lifted.Concurrent
    ( -- * MVar
      MVar
    , newEmptyMVar
    , newMVar
    , putMVar
    , readMVar
    , swapMVar
    , takeMVar
    , tryPutMVar
    , tryReadMVar
    , tryTakeMVar

      -- * STM
    , STM
    , atomically
    , STM.throwSTM
    , STM.catchSTM

      -- * TVar
    , TVar
    , newTVarIO
    , readTVarIO
    , STM.modifyTVar'
    , STM.newTVar
    , STM.readTVar
    , STM.writeTVar

      -- * TMVar
    , TMVar
    , STM.newTMVar
    , STM.newEmptyTMVar
    , newTMVarIO
    , newEmptyTMVarIO
    , STM.takeTMVar
    , STM.putTMVar
    , STM.readTMVar
    , STM.tryReadTMVar
    , STM.swapTMVar
    , STM.tryTakeTMVar
    , STM.tryPutTMVar
    , STM.isEmptyTMVar
    , STM.mkWeakTMVar
    ) where

import Control.Concurrent.MVar (MVar)
import Control.Concurrent.STM.TMVar (TMVar)
import Control.Concurrent.STM.TVar (TVar)
import Control.Monad.STM (STM)

import Relude.Base (IO)
import Relude.Bool (Bool)
import Relude.Function (($), (.))
import Relude.Monad (Maybe, MonadIO (..))

import qualified Control.Concurrent.MVar as CCM (newEmptyMVar, newMVar, putMVar, readMVar, swapMVar,
                                                 takeMVar, tryPutMVar, tryReadMVar, tryTakeMVar)
import qualified Control.Concurrent.STM.TMVar as STM (isEmptyTMVar, mkWeakTMVar, newEmptyTMVar,
                                                      newEmptyTMVarIO, newTMVar, newTMVarIO,
                                                      putTMVar, readTMVar, swapTMVar, takeTMVar,
                                                      tryPutTMVar, tryReadTMVar, tryTakeTMVar)
import qualified Control.Concurrent.STM.TVar as STM (modifyTVar', newTVar, newTVarIO, readTVar,
                                                     readTVarIO, writeTVar)
import qualified Control.Monad.STM as STM (atomically, catchSTM, throwSTM)


----------------------------------------------------------------------------
-- Lifted Control.Concurrent.MVar
----------------------------------------------------------------------------

-- | Lifted to 'MonadIO' version of 'CCM.newEmptyMVar'.
newEmptyMVar :: MonadIO m => m (MVar a)
newEmptyMVar :: forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar = IO (MVar a) -> m (MVar a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar a)
forall a. IO (MVar a)
CCM.newEmptyMVar
{-# INLINE newEmptyMVar #-}
{-# SPECIALIZE newEmptyMVar :: IO (MVar a) #-}

-- | Lifted to 'MonadIO' version of 'CCM.newMVar'.
newMVar :: MonadIO m => a -> m (MVar a)
newMVar :: forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar = IO (MVar a) -> m (MVar a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar a) -> m (MVar a))
-> (a -> IO (MVar a)) -> a -> m (MVar a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (MVar a)
forall a. a -> IO (MVar a)
CCM.newMVar
{-# INLINE newMVar #-}
{-# SPECIALIZE newMVar :: a -> IO (MVar a) #-}

-- | Lifted to 'MonadIO' version of 'CCM.putMVar'.
putMVar :: MonadIO m => MVar a -> a -> m ()
putMVar :: forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar a
m a
a = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
CCM.putMVar MVar a
m a
a
{-# INLINE putMVar #-}
{-# SPECIALIZE putMVar :: MVar a -> a -> IO () #-}

-- | Lifted to 'MonadIO' version of 'CCM.readMVar'.
readMVar :: MonadIO m => MVar a -> m a
readMVar :: forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (MVar a -> IO a) -> MVar a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> IO a
forall a. MVar a -> IO a
CCM.readMVar
{-# INLINE readMVar #-}
{-# SPECIALIZE readMVar :: MVar a -> IO a #-}

-- | Lifted to 'MonadIO' version of 'CCM.swapMVar'.
swapMVar :: MonadIO m => MVar a -> a -> m a
swapMVar :: forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m a
swapMVar MVar a
m a
v = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO a
forall a. MVar a -> a -> IO a
CCM.swapMVar MVar a
m a
v
{-# INLINE swapMVar #-}
{-# SPECIALIZE swapMVar :: MVar a -> a -> IO a #-}

-- | Lifted to 'MonadIO' version of 'CCM.takeMVar'.
takeMVar :: MonadIO m => MVar a -> m a
takeMVar :: forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (MVar a -> IO a) -> MVar a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> IO a
forall a. MVar a -> IO a
CCM.takeMVar
{-# INLINE takeMVar #-}
{-# SPECIALIZE takeMVar :: MVar a -> IO a #-}

-- | Lifted to 'MonadIO' version of 'CCM.tryPutMVar'.
tryPutMVar :: MonadIO m => MVar a -> a -> m Bool
tryPutMVar :: forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar MVar a
m a
v = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ MVar a -> a -> IO Bool
forall a. MVar a -> a -> IO Bool
CCM.tryPutMVar MVar a
m a
v
{-# INLINE tryPutMVar #-}
{-# SPECIALIZE tryPutMVar :: MVar a -> a -> IO Bool #-}

-- | Lifted to 'MonadIO' version of 'CCM.tryReadMVar'.
tryReadMVar :: MonadIO m => MVar a -> m (Maybe a)
tryReadMVar :: forall (m :: * -> *) a. MonadIO m => MVar a -> m (Maybe a)
tryReadMVar = IO (Maybe a) -> m (Maybe a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a))
-> (MVar a -> IO (Maybe a)) -> MVar a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
CCM.tryReadMVar
{-# INLINE tryReadMVar #-}
{-# SPECIALIZE tryReadMVar :: MVar a -> IO (Maybe a) #-}

-- | Lifted to 'MonadIO' version of 'CCM.tryTakeMVar'.
tryTakeMVar :: MonadIO m => MVar a -> m (Maybe a)
tryTakeMVar :: forall (m :: * -> *) a. MonadIO m => MVar a -> m (Maybe a)
tryTakeMVar = IO (Maybe a) -> m (Maybe a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a))
-> (MVar a -> IO (Maybe a)) -> MVar a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
CCM.tryTakeMVar
{-# INLINE tryTakeMVar #-}
{-# SPECIALIZE tryTakeMVar :: MVar a -> IO (Maybe a) #-}

----------------------------------------------------------------------------
-- Lifted STM
----------------------------------------------------------------------------

-- | Lifted to 'MonadIO' version of 'STM.atomically'.
atomically :: MonadIO m => STM a -> m a
atomically :: forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (STM a -> IO a) -> STM a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM a -> IO a
forall a. STM a -> IO a
STM.atomically
{-# INLINE atomically #-}
{-# SPECIALIZE atomically :: STM a -> IO a #-}

-- | Lifted to 'MonadIO' version of 'STM.newTVarIO'.
newTVarIO :: MonadIO m => a -> m (TVar a)
newTVarIO :: forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO = IO (TVar a) -> m (TVar a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar a) -> m (TVar a))
-> (a -> IO (TVar a)) -> a -> m (TVar a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (TVar a)
forall a. a -> IO (TVar a)
STM.newTVarIO
{-# INLINE newTVarIO #-}
{-# SPECIALIZE newTVarIO :: a -> IO (TVar a) #-}

-- | Lifted to 'MonadIO' version of 'STM.readTVarIO'.
readTVarIO :: MonadIO m => TVar a -> m a
readTVarIO :: forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (TVar a -> IO a) -> TVar a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar a -> IO a
forall a. TVar a -> IO a
STM.readTVarIO
{-# INLINE readTVarIO #-}
{-# SPECIALIZE readTVarIO :: TVar a -> IO a #-}

-- | Lifted to 'MonadIO' version of 'STM.newTMVarIO'.
newTMVarIO :: MonadIO m => a -> m (TMVar a)
newTMVarIO :: forall (m :: * -> *) a. MonadIO m => a -> m (TMVar a)
newTMVarIO = IO (TMVar a) -> m (TMVar a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TMVar a) -> m (TMVar a))
-> (a -> IO (TMVar a)) -> a -> m (TMVar a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (TMVar a)
forall a. a -> IO (TMVar a)
STM.newTMVarIO
{-# INLINE newTMVarIO #-}
{-# SPECIALIZE newTMVarIO :: a -> IO (TMVar a) #-}

-- | Lifted to 'MonadIO' version of 'STM.newEmptyTMVarIO'.
newEmptyTMVarIO :: MonadIO m => m (TMVar a)
newEmptyTMVarIO :: forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO = IO (TMVar a) -> m (TMVar a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TMVar a)
forall a. IO (TMVar a)
STM.newEmptyTMVarIO
{-# INLINE newEmptyTMVarIO #-}
{-# SPECIALIZE newEmptyTMVarIO :: IO (TMVar a) #-}