{-# LANGUAGE CPP, NoImplicitPrelude, FlexibleContexts, RankNTypes #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
{- |
Module : Control.Concurrent.Lifted
Copyright : Bas van Dijk
License : BSD-style
Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>
Stability : experimental
This is a wrapped version of "Control.Concurrent" with types generalized
from 'IO' to all monads in either 'MonadBase' or 'MonadBaseControl'.
-}
module Control.Concurrent.Lifted
( -- * Concurrent Haskell
ThreadId
-- * Basic concurrency operations
, myThreadId
, fork
#if MIN_VERSION_base(4,4,0)
, forkWithUnmask
#endif
#if MIN_VERSION_base(4,6,0)
, forkFinally
#endif
, killThread
, throwTo
#if MIN_VERSION_base(4,4,0)
-- ** Threads with affinity
, forkOn
, forkOnWithUnmask
, getNumCapabilities
#if MIN_VERSION_base(4,6,0)
, setNumCapabilities
#endif
, threadCapability
#endif
-- * Scheduling
, yield
-- ** Blocking
-- ** Waiting
, threadDelay
, threadWaitRead
, threadWaitWrite
-- * Communication abstractions
, module Control.Concurrent.MVar.Lifted
, module Control.Concurrent.Chan.Lifted
, module Control.Concurrent.QSem.Lifted
, module Control.Concurrent.QSemN.Lifted
#if !MIN_VERSION_base(4,7,0)
, module Control.Concurrent.SampleVar.Lifted
#endif
#if !MIN_VERSION_base(4,6,0)
-- * Merging of streams
, merge
, nmerge
#endif
-- * Bound Threads
, C.rtsSupportsBoundThreads
, forkOS
, isCurrentThreadBound
, runInBoundThread
, runInUnboundThread
#if MIN_VERSION_base(4,6,0)
-- * Weak references to ThreadIds
, mkWeakThreadId
#endif
) where
--------------------------------------------------------------------------------
-- Imports
--------------------------------------------------------------------------------
-- from base:
import Prelude ( (.) )
import Data.Bool ( Bool )
import Data.Int ( Int )
import Data.Function ( ($) )
import System.IO ( IO )
import System.Posix.Types ( Fd )
#if MIN_VERSION_base(4,6,0)
import Control.Monad ( (>>=) )
import Data.Either ( Either )
import System.Mem.Weak ( Weak )
#endif
import Control.Concurrent ( ThreadId )
import qualified Control.Concurrent as C
-- from transformers-base:
import Control.Monad.Base ( MonadBase, liftBase )
-- from monad-control:
import Control.Monad.Trans.Control ( MonadBaseControl, liftBaseOp_, liftBaseDiscard )
#if MIN_VERSION_base(4,4,0)
import Control.Monad.Trans.Control ( liftBaseWith )
import Control.Monad ( void )
#endif
-- from lifted-base (this package):
import Control.Concurrent.MVar.Lifted
import Control.Concurrent.Chan.Lifted
import Control.Concurrent.QSem.Lifted
import Control.Concurrent.QSemN.Lifted
#if !MIN_VERSION_base(4,7,0)
import Control.Concurrent.SampleVar.Lifted
#endif
import Control.Exception.Lifted ( throwTo
#if MIN_VERSION_base(4,6,0)
, SomeException, try, mask
#endif
)
#include "inlinable.h"
--------------------------------------------------------------------------------
-- Control.Concurrent
--------------------------------------------------------------------------------
-- | Generalized version of 'C.myThreadId'.
myThreadId :: MonadBase IO m => m ThreadId
myThreadId = liftBase C.myThreadId
{-# INLINABLE myThreadId #-}
-- | Generalized version of 'C.forkIO'.
--
-- Note that, while the forked computation @m ()@ has access to the captured
-- state, all its side-effects in @m@ are discarded. It is run only for its
-- side-effects in 'IO'.
fork :: MonadBaseControl IO m => m () -> m ThreadId
fork = liftBaseDiscard C.forkIO
{-# INLINABLE fork #-}
#if MIN_VERSION_base(4,4,0)
-- | Generalized version of 'C.forkIOWithUnmask'.
--
-- Note that, while the forked computation @m ()@ has access to the captured
-- state, all its side-effects in @m@ are discarded. It is run only for its
-- side-effects in 'IO'.
forkWithUnmask :: MonadBaseControl IO m => ((forall a. m a -> m a) -> m ()) -> m ThreadId
forkWithUnmask f = liftBaseWith $ \runInIO ->
C.forkIOWithUnmask $ \unmask ->
void $ runInIO $ f $ liftBaseOp_ unmask
{-# INLINABLE forkWithUnmask #-}
#endif
#if MIN_VERSION_base(4,6,0)
-- | Generalized version of 'C.forkFinally'.
--
-- Note that in @forkFinally action and_then@, while the forked
-- @action@ and the @and_then@ function have access to the captured
-- state, all their side-effects in @m@ are discarded. They're run
-- only for their side-effects in 'IO'.
forkFinally :: MonadBaseControl IO m
=> m a -> (Either SomeException a -> m ()) -> m ThreadId
forkFinally action and_then =
mask $ \restore ->
fork $ try (restore action) >>= and_then
{-# INLINABLE forkFinally #-}
#endif
-- | Generalized version of 'C.killThread'.
killThread :: MonadBase IO m => ThreadId -> m ()
killThread = liftBase . C.killThread
{-# INLINABLE killThread #-}
#if MIN_VERSION_base(4,4,0)
-- | Generalized version of 'C.forkOn'.
--
-- Note that, while the forked computation @m ()@ has access to the captured
-- state, all its side-effects in @m@ are discarded. It is run only for its
-- side-effects in 'IO'.
forkOn :: MonadBaseControl IO m => Int -> m () -> m ThreadId
forkOn = liftBaseDiscard . C.forkOn
{-# INLINABLE forkOn #-}
-- | Generalized version of 'C.forkOnWithUnmask'.
--
-- Note that, while the forked computation @m ()@ has access to the captured
-- state, all its side-effects in @m@ are discarded. It is run only for its
-- side-effects in 'IO'.
forkOnWithUnmask :: MonadBaseControl IO m => Int -> ((forall a. m a -> m a) -> m ()) -> m ThreadId
forkOnWithUnmask cap f = liftBaseWith $ \runInIO ->
C.forkOnWithUnmask cap $ \unmask ->
void $ runInIO $ f $ liftBaseOp_ unmask
{-# INLINABLE forkOnWithUnmask #-}
-- | Generalized version of 'C.getNumCapabilities'.
getNumCapabilities :: MonadBase IO m => m Int
getNumCapabilities = liftBase C.getNumCapabilities
{-# INLINABLE getNumCapabilities #-}
#if MIN_VERSION_base(4,6,0)
-- | Generalized version of 'C.setNumCapabilities'.
setNumCapabilities :: MonadBase IO m => Int -> m ()
setNumCapabilities = liftBase . C.setNumCapabilities
{-# INLINABLE setNumCapabilities #-}
#endif
-- | Generalized version of 'C.threadCapability'.
threadCapability :: MonadBase IO m => ThreadId -> m (Int, Bool)
threadCapability = liftBase . C.threadCapability
{-# INLINABLE threadCapability #-}
#endif
-- | Generalized version of 'C.yield'.
yield :: MonadBase IO m => m ()
yield = liftBase C.yield
{-# INLINABLE yield #-}
-- | Generalized version of 'C.threadDelay'.
threadDelay :: MonadBase IO m => Int -> m ()
threadDelay = liftBase . C.threadDelay
{-# INLINABLE threadDelay #-}
-- | Generalized version of 'C.threadWaitRead'.
threadWaitRead :: MonadBase IO m => Fd -> m ()
threadWaitRead = liftBase . C.threadWaitRead
{-# INLINABLE threadWaitRead #-}
-- | Generalized version of 'C.threadWaitWrite'.
threadWaitWrite :: MonadBase IO m => Fd -> m ()
threadWaitWrite = liftBase . C.threadWaitWrite
{-# INLINABLE threadWaitWrite #-}
#if !MIN_VERSION_base(4,6,0)
-- | Generalized version of 'C.mergeIO'.
merge :: MonadBase IO m => [a] -> [a] -> m [a]
merge xs ys = liftBase $ C.mergeIO xs ys
{-# INLINABLE merge #-}
-- | Generalized version of 'C.nmergeIO'.
nmerge :: MonadBase IO m => [[a]] -> m [a]
nmerge = liftBase . C.nmergeIO
{-# INLINABLE nmerge #-}
#endif
-- | Generalized version of 'C.forkOS'.
--
-- Note that, while the forked computation @m ()@ has access to the captured
-- state, all its side-effects in @m@ are discarded. It is run only for its
-- side-effects in 'IO'.
forkOS :: MonadBaseControl IO m => m () -> m ThreadId
forkOS = liftBaseDiscard C.forkOS
{-# INLINABLE forkOS #-}
-- | Generalized version of 'C.isCurrentThreadBound'.
isCurrentThreadBound :: MonadBase IO m => m Bool
isCurrentThreadBound = liftBase C.isCurrentThreadBound
{-# INLINABLE isCurrentThreadBound #-}
-- | Generalized version of 'C.runInBoundThread'.
runInBoundThread :: MonadBaseControl IO m => m a -> m a
runInBoundThread = liftBaseOp_ C.runInBoundThread
{-# INLINABLE runInBoundThread #-}
-- | Generalized version of 'C.runInUnboundThread'.
runInUnboundThread :: MonadBaseControl IO m => m a -> m a
runInUnboundThread = liftBaseOp_ C.runInUnboundThread
{-# INLINABLE runInUnboundThread #-}
#if MIN_VERSION_base(4,6,0)
-- | Generalized versio of 'C.mkWeakThreadId'.
mkWeakThreadId :: MonadBase IO m => ThreadId -> m (Weak ThreadId)
mkWeakThreadId = liftBase . C.mkWeakThreadId
{-# INLINABLE mkWeakThreadId #-}
#endif