{-# LANGUAGE CPP, NoImplicitPrelude, FlexibleContexts, RankNTypes #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #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