{-# LANGUAGE Trustworthy #-}

{- |
Copyright:  (c) 2016 Stephen Diehl
            (c) 2016-2018 Serokell
            (c) 2018-2019 Kowainik
SPDX-License-Identifier: MIT
Maintainer: Kowainik <xrom.xkov@gmail.com>

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

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

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

import Control.Concurrent.MVar (MVar)
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.TVar as STM (modifyTVar', newTVar, newTVarIO, readTVar,
                                                     readTVarIO, writeTVar)
import qualified Control.Monad.STM as STM (atomically)

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

-- | Lifted to 'MonadIO' version of 'CCM.newEmptyMVar'.
newEmptyMVar :: MonadIO m => m (MVar a)
newEmptyMVar :: m (MVar a)
newEmptyMVar = IO (MVar a) -> m (MVar 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 :: a -> m (MVar a)
newMVar = IO (MVar a) -> m (MVar 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 :: MVar a -> a -> m ()
putMVar m :: MVar a
m a :: a
a = IO () -> m ()
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 :: MVar a -> m a
readMVar = 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 :: MVar a -> a -> m a
swapMVar m :: MVar a
m v :: a
v = 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 :: MVar a -> m a
takeMVar = 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 :: MVar a -> a -> m Bool
tryPutMVar m :: MVar a
m v :: a
v = IO Bool -> m Bool
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 :: MVar a -> m (Maybe a)
tryReadMVar = IO (Maybe a) -> m (Maybe 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 :: MVar a -> m (Maybe a)
tryTakeMVar = IO (Maybe a) -> m (Maybe 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 :: STM a -> m a
atomically = 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 :: a -> m (TVar a)
newTVarIO = IO (TVar a) -> m (TVar 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 :: TVar a -> m a
readTVarIO = 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 #-}