{-# LANGUAGE CPP, NoImplicitPrelude, FlexibleContexts, RankNTypes #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
module Control.Concurrent.Lifted
(
ThreadId
, 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)
, forkOn
, forkOnWithUnmask
, getNumCapabilities
#if MIN_VERSION_base(4,6,0)
, setNumCapabilities
#endif
, threadCapability
#endif
, yield
, threadDelay
, threadWaitRead
, threadWaitWrite
, 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)
, merge
, nmerge
#endif
, C.rtsSupportsBoundThreads
, forkOS
, isCurrentThreadBound
, runInBoundThread
, runInUnboundThread
#if MIN_VERSION_base(4,6,0)
, mkWeakThreadId
#endif
) where
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
import Control.Monad.Base ( MonadBase, liftBase )
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
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"
myThreadId :: MonadBase IO m => m ThreadId
myThreadId :: forall (m :: * -> *). MonadBase IO m => m ThreadId
myThreadId = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO ThreadId
C.myThreadId
{-# INLINABLE myThreadId #-}
fork :: MonadBaseControl IO m => m () -> m ThreadId
fork :: forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork = forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(b () -> b a) -> m () -> m a
liftBaseDiscard IO () -> IO ThreadId
C.forkIO
{-# INLINABLE fork #-}
#if MIN_VERSION_base(4,4,0)
forkWithUnmask :: MonadBaseControl IO m => ((forall a. m a -> m a) -> m ()) -> m ThreadId
forkWithUnmask :: forall (m :: * -> *).
MonadBaseControl IO m =>
((forall a. m a -> m a) -> m ()) -> m ThreadId
forkWithUnmask (forall a. m a -> m a) -> m ()
f = forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
C.forkIOWithUnmask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask ->
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ RunInBase m IO
runInIO forall a b. (a -> b) -> a -> b
$ (forall a. m a -> m a) -> m ()
f forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ forall a. IO a -> IO a
unmask
{-# INLINABLE forkWithUnmask #-}
#endif
#if MIN_VERSION_base(4,6,0)
forkFinally :: MonadBaseControl IO m
=> m a -> (Either SomeException a -> m ()) -> m ThreadId
forkFinally :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> (Either SomeException a -> m ()) -> m ThreadId
forkFinally m a
action Either SomeException a -> m ()
and_then =
forall (m :: * -> *) b.
MonadBaseControl IO m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore ->
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try (forall a. m a -> m a
restore m a
action) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either SomeException a -> m ()
and_then
{-# INLINABLE forkFinally #-}
#endif
killThread :: MonadBase IO m => ThreadId -> m ()
killThread :: forall (m :: * -> *). MonadBase IO m => ThreadId -> m ()
killThread = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> IO ()
C.killThread
{-# INLINABLE killThread #-}
#if MIN_VERSION_base(4,4,0)
forkOn :: MonadBaseControl IO m => Int -> m () -> m ThreadId
forkOn :: forall (m :: * -> *).
MonadBaseControl IO m =>
Int -> m () -> m ThreadId
forkOn = forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(b () -> b a) -> m () -> m a
liftBaseDiscard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO () -> IO ThreadId
C.forkOn
{-# INLINABLE forkOn #-}
forkOnWithUnmask :: MonadBaseControl IO m => Int -> ((forall a. m a -> m a) -> m ()) -> m ThreadId
forkOnWithUnmask :: forall (m :: * -> *).
MonadBaseControl IO m =>
Int -> ((forall a. m a -> m a) -> m ()) -> m ThreadId
forkOnWithUnmask Int
cap (forall a. m a -> m a) -> m ()
f = forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
C.forkOnWithUnmask Int
cap forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask ->
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ RunInBase m IO
runInIO forall a b. (a -> b) -> a -> b
$ (forall a. m a -> m a) -> m ()
f forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ forall a. IO a -> IO a
unmask
{-# INLINABLE forkOnWithUnmask #-}
getNumCapabilities :: MonadBase IO m => m Int
getNumCapabilities :: forall (m :: * -> *). MonadBase IO m => m Int
getNumCapabilities = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO Int
C.getNumCapabilities
{-# INLINABLE getNumCapabilities #-}
#if MIN_VERSION_base(4,6,0)
setNumCapabilities :: MonadBase IO m => Int -> m ()
setNumCapabilities :: forall (m :: * -> *). MonadBase IO m => Int -> m ()
setNumCapabilities = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
C.setNumCapabilities
{-# INLINABLE setNumCapabilities #-}
#endif
threadCapability :: MonadBase IO m => ThreadId -> m (Int, Bool)
threadCapability :: forall (m :: * -> *). MonadBase IO m => ThreadId -> m (Int, Bool)
threadCapability = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> IO (Int, Bool)
C.threadCapability
{-# INLINABLE threadCapability #-}
#endif
yield :: MonadBase IO m => m ()
yield :: forall (m :: * -> *). MonadBase IO m => m ()
yield = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO ()
C.yield
{-# INLINABLE yield #-}
threadDelay :: MonadBase IO m => Int -> m ()
threadDelay :: forall (m :: * -> *). MonadBase IO m => Int -> m ()
threadDelay = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
C.threadDelay
{-# INLINABLE threadDelay #-}
threadWaitRead :: MonadBase IO m => Fd -> m ()
threadWaitRead :: forall (m :: * -> *). MonadBase IO m => Fd -> m ()
threadWaitRead = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> IO ()
C.threadWaitRead
{-# INLINABLE threadWaitRead #-}
threadWaitWrite :: MonadBase IO m => Fd -> m ()
threadWaitWrite :: forall (m :: * -> *). MonadBase IO m => Fd -> m ()
threadWaitWrite = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> IO ()
C.threadWaitWrite
{-# INLINABLE threadWaitWrite #-}
#if !MIN_VERSION_base(4,6,0)
merge :: MonadBase IO m => [a] -> [a] -> m [a]
merge xs ys = liftBase $ C.mergeIO xs ys
{-# INLINABLE merge #-}
nmerge :: MonadBase IO m => [[a]] -> m [a]
nmerge = liftBase . C.nmergeIO
{-# INLINABLE nmerge #-}
#endif
forkOS :: MonadBaseControl IO m => m () -> m ThreadId
forkOS :: forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
forkOS = forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(b () -> b a) -> m () -> m a
liftBaseDiscard IO () -> IO ThreadId
C.forkOS
{-# INLINABLE forkOS #-}
isCurrentThreadBound :: MonadBase IO m => m Bool
isCurrentThreadBound :: forall (m :: * -> *). MonadBase IO m => m Bool
isCurrentThreadBound = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO Bool
C.isCurrentThreadBound
{-# INLINABLE isCurrentThreadBound #-}
runInBoundThread :: MonadBaseControl IO m => m a -> m a
runInBoundThread :: forall (m :: * -> *) a. MonadBaseControl IO m => m a -> m a
runInBoundThread = forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ forall a. IO a -> IO a
C.runInBoundThread
{-# INLINABLE runInBoundThread #-}
runInUnboundThread :: MonadBaseControl IO m => m a -> m a
runInUnboundThread :: forall (m :: * -> *) a. MonadBaseControl IO m => m a -> m a
runInUnboundThread = forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ forall a. IO a -> IO a
C.runInUnboundThread
{-# INLINABLE runInUnboundThread #-}
#if MIN_VERSION_base(4,6,0)
mkWeakThreadId :: MonadBase IO m => ThreadId -> m (Weak ThreadId)
mkWeakThreadId :: forall (m :: * -> *).
MonadBase IO m =>
ThreadId -> m (Weak ThreadId)
mkWeakThreadId = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> IO (Weak ThreadId)
C.mkWeakThreadId
{-# INLINABLE mkWeakThreadId #-}
#endif