Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Lifted Control.Concurrent.
For functions that spawn threads, the order of preference for their usage is recommended as follows:
1) High level functions from Effectful.Concurrent.Async such as
withAsync
,
concurrently
or
mapConcurrently
.
2) Low level functions from Effectful.Concurrent.Async such as
async
.
3) Low level functions from Effectful.Concurrent such as forkIO
.
Synopsis
- data Concurrent :: Effect
- runConcurrent :: IOE :> es => Eff (Concurrent ': es) a -> Eff es a
- myThreadId :: Concurrent :> es => Eff es ThreadId
- forkIO :: Concurrent :> es => Eff es () -> Eff es ThreadId
- forkFinally :: Concurrent :> es => Eff es a -> (Either SomeException a -> Eff es ()) -> Eff es ThreadId
- forkIOWithUnmask :: Concurrent :> es => ((forall a. Eff es a -> Eff es a) -> Eff es ()) -> Eff es ThreadId
- killThread :: Concurrent :> es => ThreadId -> Eff es ()
- throwTo :: (Concurrent :> es, Exception e) => ThreadId -> e -> Eff es ()
- forkOn :: Concurrent :> es => Int -> Eff es () -> Eff es ThreadId
- forkOnWithUnmask :: Concurrent :> es => Int -> ((forall a. Eff es a -> Eff es a) -> Eff es ()) -> Eff es ThreadId
- getNumCapabilities :: Concurrent :> es => Eff es Int
- setNumCapabilities :: Concurrent :> es => Int -> Eff es ()
- getNumProcessors :: Concurrent :> es => Eff es Int
- threadCapability :: Concurrent :> es => ThreadId -> Eff es (Int, Bool)
- yield :: Concurrent :> es => Eff es ()
- threadDelay :: Concurrent :> es => Int -> Eff es ()
- threadWaitRead :: Concurrent :> es => Fd -> Eff es ()
- threadWaitWrite :: Concurrent :> es => Fd -> Eff es ()
- threadWaitReadSTM :: Concurrent :> es => Fd -> Eff es (STM (), Eff es ())
- threadWaitWriteSTM :: Concurrent :> es => Fd -> Eff es (STM (), Eff es ())
- forkOS :: Concurrent :> es => Eff es () -> Eff es ThreadId
- forkOSWithUnmask :: Concurrent :> es => ((forall a. Eff es a -> Eff es a) -> Eff es ()) -> Eff es ThreadId
- isCurrentThreadBound :: Concurrent :> es => Eff es Bool
- runInBoundThread :: Concurrent :> es => Eff es a -> Eff es a
- runInUnboundThread :: Concurrent :> es => Eff es a -> Eff es a
- mkWeakThreadId :: Concurrent :> es => ThreadId -> Eff es (Weak ThreadId)
- rtsSupportsBoundThreads :: Bool
Effect
data Concurrent :: Effect Source #
Provide the ability to run Eff
computations concurrently in multiple
threads and communicate between them.
Warning: unless you stick to high level functions from the
withAsync
family, the Concurrent
effect makes
it possible to escape the scope of any scoped effect operation. Consider the
following:
>>>
import qualified Effectful.Reader.Static as R
>>>
printAsk msg = liftIO . putStrLn . (msg ++) . (": " ++) =<< R.ask
>>>
:{
runEff . R.runReader "GLOBAL" . runConcurrent $ do a <- R.local (const "LOCAL") $ do a <- async $ do printAsk "child (first)" threadDelay 20000 printAsk "child (second)" threadDelay 10000 printAsk "parent (inside)" pure a printAsk "parent (outside)" wait a :} child (first): LOCAL parent (inside): LOCAL parent (outside): GLOBAL child (second): LOCAL
Note that the asynchronous computation doesn't respect the scope of
local
, i.e. the child thread still behaves like
it's inside the local
block, even though the parent
thread already got out of it.
This is because the value provided by the Reader
effect is thread local, i.e. each thread manages its own version of it. For
the Reader
it is the only reasonable behavior, it
wouldn't be very useful if its "read only" value was affected by calls to
local
from its parent or child threads.
However, the cut isn't so clear if it comes to effects that provide access to
a mutable state. That's why statically dispatched State
and Writer
effects come in two flavors, local and shared:
>>>
import qualified Effectful.State.Static.Local as SL
>>>
:{
runEff . SL.execState "Hi" . runConcurrent $ do replicateConcurrently_ 3 $ SL.modify (++ "!") :} "Hi"
>>>
import qualified Effectful.State.Static.Shared as SS
>>>
:{
runEff . SS.execState "Hi" . runConcurrent $ do replicateConcurrently_ 3 $ SS.modify (++ "!") :} "Hi!!!"
In the first example state updates made concurrently are not reflected in the parent thread because the value is thread local, but in the second example they are, because the value is shared.
Instances
type DispatchOf Concurrent Source # | |
Defined in Effectful.Concurrent.Effect | |
data StaticRep Concurrent Source # | |
Defined in Effectful.Concurrent.Effect |
Handlers
runConcurrent :: IOE :> es => Eff (Concurrent ': es) a -> Eff es a Source #
Run the Concurrent
effect.
Basic concurrency operations
myThreadId :: Concurrent :> es => Eff es ThreadId Source #
Lifted myThreadId
.
forkFinally :: Concurrent :> es => Eff es a -> (Either SomeException a -> Eff es ()) -> Eff es ThreadId Source #
Lifted forkFinally
.
forkIOWithUnmask :: Concurrent :> es => ((forall a. Eff es a -> Eff es a) -> Eff es ()) -> Eff es ThreadId Source #
Lifted forkIOWithUnmask
.
killThread :: Concurrent :> es => ThreadId -> Eff es () Source #
Lifted killThread
.
Threads with affinity
forkOnWithUnmask :: Concurrent :> es => Int -> ((forall a. Eff es a -> Eff es a) -> Eff es ()) -> Eff es ThreadId Source #
Lifted forkOnWithUnmask
.
getNumCapabilities :: Concurrent :> es => Eff es Int Source #
Lifted getNumCapabilities
.
setNumCapabilities :: Concurrent :> es => Int -> Eff es () Source #
Lifted setNumCapabilities
.
getNumProcessors :: Concurrent :> es => Eff es Int Source #
Lifted getNumProcessors
.
threadCapability :: Concurrent :> es => ThreadId -> Eff es (Int, Bool) Source #
Lifted threadCapability
.
Scheduling
Waiting
threadDelay :: Concurrent :> es => Int -> Eff es () Source #
Lifted threadDelay
.
threadWaitRead :: Concurrent :> es => Fd -> Eff es () Source #
Lifted threadWaitRead
.
threadWaitWrite :: Concurrent :> es => Fd -> Eff es () Source #
Lifted threadWaitWrite
.
threadWaitReadSTM :: Concurrent :> es => Fd -> Eff es (STM (), Eff es ()) Source #
Lifted threadWaitReadSTM
.
threadWaitWriteSTM :: Concurrent :> es => Fd -> Eff es (STM (), Eff es ()) Source #
Lifted threadWaitWriteSTM
.
Bound threads
forkOSWithUnmask :: Concurrent :> es => ((forall a. Eff es a -> Eff es a) -> Eff es ()) -> Eff es ThreadId Source #
Lifted forkOSWithUnmask
.
isCurrentThreadBound :: Concurrent :> es => Eff es Bool Source #
Lifted isCurrentThreadBound
.
runInBoundThread :: Concurrent :> es => Eff es a -> Eff es a Source #
Lifted runInBoundThread
.
runInUnboundThread :: Concurrent :> es => Eff es a -> Eff es a Source #
Lifted runInUnboundThread
.
Weak references to ThreadIds
mkWeakThreadId :: Concurrent :> es => ThreadId -> Eff es (Weak ThreadId) Source #
Lifted mkWeakThreadId
.
Re-exports
rtsSupportsBoundThreads :: Bool #
True
if bound threads are supported.
If rtsSupportsBoundThreads
is False
, isCurrentThreadBound
will always return False
and both forkOS
and runInBoundThread
will
fail.