{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe         #-}

-- | Concurrency useful and common functions.

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

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

import Control.Concurrent.MVar (MVar)
import Control.Concurrent.STM.TVar (TVar)
import Control.Monad (return)
import Control.Monad.STM (STM)
import Control.Monad.State (StateT (..))
import Control.Monad.Trans (MonadIO, liftIO)
import Data.Bool (Bool)
import Data.Function (($), (.))
import Data.Maybe (Maybe)
import System.IO (IO)

import qualified Control.Concurrent.MVar as CCM (modifyMVar, 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 :: forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (MVar a)
CCM.newEmptyMVar
{-# INLINE newEmptyMVar #-}

-- | 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO (MVar a)
CCM.newMVar
{-# INLINE newMVar #-}

-- | 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
CCM.putMVar MVar a
m a
a
{-# INLINE putMVar #-}

-- | 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO a
CCM.readMVar
{-# INLINE readMVar #-}

-- | 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO a
CCM.swapMVar MVar a
m a
v
{-# INLINE swapMVar #-}

-- | 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO a
CCM.takeMVar
{-# INLINE takeMVar #-}

-- | 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO Bool
CCM.tryPutMVar MVar a
m a
v
{-# INLINE tryPutMVar #-}

-- | 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO (Maybe a)
CCM.tryReadMVar
{-# INLINE tryReadMVar #-}

-- | 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO (Maybe a)
CCM.tryTakeMVar
{-# INLINE tryTakeMVar #-}

----------------------------------------------------------------------------
-- 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
STM.atomically
{-# INLINE atomically #-}

-- | 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO (TVar a)
STM.newTVarIO
{-# INLINE newTVarIO #-}

-- | 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> IO a
STM.readTVarIO
{-# INLINE readTVarIO #-}

----------------------------------------------------------------------------
-- Common helpers
----------------------------------------------------------------------------

-- | Like 'modifyMVar', but modification is specified as a 'State' computation.
--
-- This method is strict in produced @s@ value.
updateMVar' :: MonadIO m => MVar s -> StateT s IO a -> m a
updateMVar' :: forall (m :: * -> *) s a.
MonadIO m =>
MVar s -> StateT s IO a -> m a
updateMVar' MVar s
var (StateT s -> IO (a, s)
f) =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. MVar a -> (a -> IO (a, b)) -> IO b
CCM.modifyMVar MVar s
var forall a b. (a -> b) -> a -> b
$ \s
s -> do
    (a
a, !s
s') <- s -> IO (a, s)
f s
s
    forall (m :: * -> *) a. Monad m => a -> m a
return (s
s', a
a)
{-# INLINE updateMVar' #-}

-- | Like 'modifyTVar\'', but modification is specified as a 'State' monad.
updateTVar' :: TVar s -> StateT s STM a -> STM a
updateTVar' :: forall s a. TVar s -> StateT s STM a -> STM a
updateTVar' TVar s
var (StateT s -> STM (a, s)
f) = do
  s
s <- forall a. TVar a -> STM a
STM.readTVar TVar s
var
  (a
a, !s
s') <- s -> STM (a, s)
f s
s
  forall a. TVar a -> a -> STM ()
STM.writeTVar TVar s
var s
s'
  forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# INLINE updateTVar' #-}