Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Lifted Control.Concurrent.Async.
Synopsis
- data Concurrent :: Effect
- runConcurrent :: IOE :> es => Eff (Concurrent ': es) a -> Eff es a
- data Async a
- withAsync :: Concurrent :> es => Eff es a -> (Async a -> Eff es b) -> Eff es b
- withAsyncBound :: Concurrent :> es => Eff es a -> (Async a -> Eff es b) -> Eff es b
- withAsyncOn :: Concurrent :> es => Int -> Eff es a -> (Async a -> Eff es b) -> Eff es b
- withAsyncWithUnmask :: Concurrent :> es => ((forall c. Eff es c -> Eff es c) -> Eff es a) -> (Async a -> Eff es b) -> Eff es b
- withAsyncOnWithUnmask :: Concurrent :> es => Int -> ((forall c. Eff es c -> Eff es c) -> Eff es a) -> (Async a -> Eff es b) -> Eff es b
- wait :: Concurrent :> es => Async a -> Eff es a
- poll :: Concurrent :> es => Async a -> Eff es (Maybe (Either SomeException a))
- waitCatch :: Concurrent :> es => Async a -> Eff es (Either SomeException a)
- asyncThreadId :: Async a -> ThreadId
- cancel :: Concurrent :> es => Async a -> Eff es ()
- uninterruptibleCancel :: Concurrent :> es => Async a -> Eff es ()
- cancelWith :: (Exception e, Concurrent :> es) => Async a -> e -> Eff es ()
- data AsyncCancelled = AsyncCancelled
- compareAsyncs :: Async a -> Async b -> Ordering
- race :: Concurrent :> es => Eff es a -> Eff es b -> Eff es (Either a b)
- race_ :: Concurrent :> es => Eff es a -> Eff es b -> Eff es ()
- concurrently :: Concurrent :> es => Eff es a -> Eff es b -> Eff es (a, b)
- concurrently_ :: Concurrent :> es => Eff es a -> Eff es b -> Eff es ()
- mapConcurrently :: (Traversable f, Concurrent :> es) => (a -> Eff es b) -> f a -> Eff es (f b)
- forConcurrently :: (Traversable f, Concurrent :> es) => f a -> (a -> Eff es b) -> Eff es (f b)
- mapConcurrently_ :: (Foldable f, Concurrent :> es) => (a -> Eff es b) -> f a -> Eff es ()
- forConcurrently_ :: (Foldable f, Concurrent :> es) => f a -> (a -> Eff es b) -> Eff es ()
- replicateConcurrently :: Concurrent :> es => Int -> Eff es a -> Eff es [a]
- replicateConcurrently_ :: Concurrent :> es => Int -> Eff es a -> Eff es ()
- newtype Concurrently es a = Concurrently {
- runConcurrently :: Eff es a
- data Conc :: [Effect] -> Type -> Type
- conc :: Eff es a -> Conc es a
- runConc :: Concurrent :> es => Conc es a -> Eff es a
- data ConcException = EmptyWithNoAlternative
- pooledMapConcurrentlyN :: (Concurrent :> es, Traversable t) => Int -> (a -> Eff es b) -> t a -> Eff es (t b)
- pooledMapConcurrently :: (Concurrent :> es, Traversable t) => (a -> Eff es b) -> t a -> Eff es (t b)
- pooledMapConcurrentlyN_ :: (Concurrent :> es, Foldable f) => Int -> (a -> Eff es b) -> f a -> Eff es ()
- pooledMapConcurrently_ :: (Concurrent :> es, Foldable f) => (a -> Eff es b) -> f a -> Eff es ()
- pooledForConcurrentlyN :: (Concurrent :> es, Traversable t) => Int -> t a -> (a -> Eff es b) -> Eff es (t b)
- pooledForConcurrently :: (Concurrent :> es, Traversable t) => t a -> (a -> Eff es b) -> Eff es (t b)
- pooledForConcurrentlyN_ :: (Concurrent :> es, Foldable f) => Int -> f a -> (a -> Eff es b) -> Eff es ()
- pooledForConcurrently_ :: (Concurrent :> es, Foldable f) => f a -> (a -> Eff es b) -> Eff es ()
- pooledReplicateConcurrentlyN :: Concurrent :> es => Int -> Int -> Eff es a -> Eff es [a]
- pooledReplicateConcurrently :: Concurrent :> es => Int -> Eff es a -> Eff es [a]
- pooledReplicateConcurrentlyN_ :: Concurrent :> es => Int -> Int -> Eff es a -> Eff es ()
- pooledReplicateConcurrently_ :: Concurrent :> es => Int -> Eff es a -> Eff es ()
- waitSTM :: Async a -> STM a
- pollSTM :: Async a -> STM (Maybe (Either SomeException a))
- waitCatchSTM :: Async a -> STM (Either SomeException a)
- waitAny :: Concurrent :> es => [Async a] -> Eff es (Async a, a)
- waitAnyCatch :: Concurrent :> es => [Async a] -> Eff es (Async a, Either SomeException a)
- waitAnyCancel :: Concurrent :> es => [Async a] -> Eff es (Async a, a)
- waitAnyCatchCancel :: Concurrent :> es => [Async a] -> Eff es (Async a, Either SomeException a)
- waitEither :: Concurrent :> es => Async a -> Async b -> Eff es (Either a b)
- waitEitherCatch :: Concurrent :> es => Async a -> Async b -> Eff es (Either (Either SomeException a) (Either SomeException b))
- waitEitherCancel :: Concurrent :> es => Async a -> Async b -> Eff es (Either a b)
- waitEitherCatchCancel :: Concurrent :> es => Async a -> Async b -> Eff es (Either (Either SomeException a) (Either SomeException b))
- waitEither_ :: Concurrent :> es => Async a -> Async b -> Eff es ()
- waitBoth :: Concurrent :> es => Async a -> Async b -> Eff es (a, b)
- waitAnySTM :: [Async a] -> STM (Async a, a)
- waitAnyCatchSTM :: [Async a] -> STM (Async a, Either SomeException a)
- waitEitherSTM :: Async a -> Async b -> STM (Either a b)
- waitEitherCatchSTM :: Async a -> Async b -> STM (Either (Either SomeException a) (Either SomeException b))
- waitEitherSTM_ :: Async a -> Async b -> STM ()
- waitBothSTM :: Async a -> Async b -> STM (a, b)
- async :: Concurrent :> es => Eff es a -> Eff es (Async a)
- asyncBound :: Concurrent :> es => Eff es a -> Eff es (Async a)
- asyncOn :: Concurrent :> es => Int -> Eff es a -> Eff es (Async a)
- asyncWithUnmask :: Concurrent :> es => ((forall b. Eff es b -> Eff es b) -> Eff es a) -> Eff es (Async a)
- asyncOnWithUnmask :: Concurrent :> es => Int -> ((forall b. Eff es b -> Eff es b) -> Eff es a) -> Eff es (Async a)
- link :: Concurrent :> es => Async a -> Eff es ()
- linkOnly :: Concurrent :> es => (SomeException -> Bool) -> Async a -> Eff es ()
- link2 :: Concurrent :> es => Async a -> Async b -> Eff es ()
- link2Only :: Concurrent :> es => (SomeException -> Bool) -> Async a -> Async b -> Eff es ()
- data ExceptionInLinkedThread = ExceptionInLinkedThread (Async a) SomeException
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.
Asynchronous actions
An asynchronous action spawned by async
or withAsync
.
Asynchronous actions are executed in a separate thread, and
operations are provided for waiting for asynchronous actions to
complete and obtaining their results (see e.g. wait
).
High-level API
Spawning with automatic cancel
ation
withAsync :: Concurrent :> es => Eff es a -> (Async a -> Eff es b) -> Eff es b Source #
Lifted withAsync
.
withAsyncBound :: Concurrent :> es => Eff es a -> (Async a -> Eff es b) -> Eff es b Source #
Lifted withAsyncBound
.
withAsyncOn :: Concurrent :> es => Int -> Eff es a -> (Async a -> Eff es b) -> Eff es b Source #
Lifted withAsyncOn
.
withAsyncWithUnmask :: Concurrent :> es => ((forall c. Eff es c -> Eff es c) -> Eff es a) -> (Async a -> Eff es b) -> Eff es b Source #
Lifted withAsyncWithUnmask
.
withAsyncOnWithUnmask :: Concurrent :> es => Int -> ((forall c. Eff es c -> Eff es c) -> Eff es a) -> (Async a -> Eff es b) -> Eff es b Source #
Lifted withAsyncOnWithUnmask
.
Querying Async
s
waitCatch :: Concurrent :> es => Async a -> Eff es (Either SomeException a) Source #
Lifted waitCatch
.
uninterruptibleCancel :: Concurrent :> es => Async a -> Eff es () Source #
Lifted uninterruptibleCancel
.
cancelWith :: (Exception e, Concurrent :> es) => Async a -> e -> Eff es () Source #
Lifted cancelWith
.
data AsyncCancelled #
The exception thrown by cancel
to terminate a thread.
Instances
Exception AsyncCancelled | |
Defined in Control.Concurrent.Async | |
Show AsyncCancelled | |
Defined in Control.Concurrent.Async showsPrec :: Int -> AsyncCancelled -> ShowS # show :: AsyncCancelled -> String # showList :: [AsyncCancelled] -> ShowS # | |
Eq AsyncCancelled | |
Defined in Control.Concurrent.Async (==) :: AsyncCancelled -> AsyncCancelled -> Bool # (/=) :: AsyncCancelled -> AsyncCancelled -> Bool # |
compareAsyncs :: Async a -> Async b -> Ordering #
Compare two Asyncs that may have different types by their ThreadId
.
High-level utilities
concurrently :: Concurrent :> es => Eff es a -> Eff es b -> Eff es (a, b) Source #
Lifted concurrently
.
concurrently_ :: Concurrent :> es => Eff es a -> Eff es b -> Eff es () Source #
Lifted concurrently_
.
mapConcurrently :: (Traversable f, Concurrent :> es) => (a -> Eff es b) -> f a -> Eff es (f b) Source #
Lifted mapConcurrently
.
forConcurrently :: (Traversable f, Concurrent :> es) => f a -> (a -> Eff es b) -> Eff es (f b) Source #
Lifted forConcurrently
.
mapConcurrently_ :: (Foldable f, Concurrent :> es) => (a -> Eff es b) -> f a -> Eff es () Source #
Lifted mapConcurrently_
.
forConcurrently_ :: (Foldable f, Concurrent :> es) => f a -> (a -> Eff es b) -> Eff es () Source #
Lifted forConcurrently_
.
replicateConcurrently :: Concurrent :> es => Int -> Eff es a -> Eff es [a] Source #
Lifted replicateConcurrently
.
replicateConcurrently_ :: Concurrent :> es => Int -> Eff es a -> Eff es () Source #
Lifted replicateConcurrently_
.
Concurrently
newtype Concurrently es a Source #
Lifted Concurrently
.
Concurrently | |
|
Instances
Conc
data Conc :: [Effect] -> Type -> Type Source #
Lifted Conc
.
data ConcException #
Things that can go wrong in the structure of a Conc
. These are
programmer errors.
Since: unliftio-0.2.9.0
Instances
Pooled concurrency
pooledMapConcurrentlyN :: (Concurrent :> es, Traversable t) => Int -> (a -> Eff es b) -> t a -> Eff es (t b) Source #
Lifted pooledMapConcurrentlyN
.
pooledMapConcurrently :: (Concurrent :> es, Traversable t) => (a -> Eff es b) -> t a -> Eff es (t b) Source #
Lifted pooledMapConcurrently
.
pooledMapConcurrentlyN_ :: (Concurrent :> es, Foldable f) => Int -> (a -> Eff es b) -> f a -> Eff es () Source #
Lifted pooledMapConcurrentlyN
.
pooledMapConcurrently_ :: (Concurrent :> es, Foldable f) => (a -> Eff es b) -> f a -> Eff es () Source #
Lifted pooledMapConcurrently_
.
pooledForConcurrentlyN :: (Concurrent :> es, Traversable t) => Int -> t a -> (a -> Eff es b) -> Eff es (t b) Source #
Lifted pooledForConcurrentlyN
.
pooledForConcurrently :: (Concurrent :> es, Traversable t) => t a -> (a -> Eff es b) -> Eff es (t b) Source #
Lifted pooledForConcurrently
.
pooledForConcurrentlyN_ :: (Concurrent :> es, Foldable f) => Int -> f a -> (a -> Eff es b) -> Eff es () Source #
Lifted pooledForConcurrentlyN
.
pooledForConcurrently_ :: (Concurrent :> es, Foldable f) => f a -> (a -> Eff es b) -> Eff es () Source #
Lifted pooledForConcurrently_
.
pooledReplicateConcurrentlyN :: Concurrent :> es => Int -> Int -> Eff es a -> Eff es [a] Source #
Lifted pooledReplicateConcurrentlyN
.
pooledReplicateConcurrently :: Concurrent :> es => Int -> Eff es a -> Eff es [a] Source #
Lifted pooledReplicateConcurrently
.
pooledReplicateConcurrentlyN_ :: Concurrent :> es => Int -> Int -> Eff es a -> Eff es () Source #
Lifted pooledReplicateConcurrentlyN_
.
pooledReplicateConcurrently_ :: Concurrent :> es => Int -> Eff es a -> Eff es () Source #
Lifted pooledReplicateConcurrently_
.
Specialised operations
STM operations
pollSTM :: Async a -> STM (Maybe (Either SomeException a)) #
A version of poll
that can be used inside an STM transaction.
waitCatchSTM :: Async a -> STM (Either SomeException a) #
A version of waitCatch
that can be used inside an STM transaction.
Waiting for multiple Async
s
waitAnyCatch :: Concurrent :> es => [Async a] -> Eff es (Async a, Either SomeException a) Source #
Lifted waitAnyCatch
.
waitAnyCancel :: Concurrent :> es => [Async a] -> Eff es (Async a, a) Source #
Lifted waitAnyCancel
.
waitAnyCatchCancel :: Concurrent :> es => [Async a] -> Eff es (Async a, Either SomeException a) Source #
Lifted waitAnyCatchCancel
.
waitEither :: Concurrent :> es => Async a -> Async b -> Eff es (Either a b) Source #
Lifted waitEither
.
waitEitherCatch :: Concurrent :> es => Async a -> Async b -> Eff es (Either (Either SomeException a) (Either SomeException b)) Source #
Lifted waitEitherCatch
.
waitEitherCancel :: Concurrent :> es => Async a -> Async b -> Eff es (Either a b) Source #
Lifted waitEitherCancel
.
waitEitherCatchCancel :: Concurrent :> es => Async a -> Async b -> Eff es (Either (Either SomeException a) (Either SomeException b)) Source #
Lifted waitEitherCatchCancel
.
waitEither_ :: Concurrent :> es => Async a -> Async b -> Eff es () Source #
Lifted waitEither_
.
Waiting for multiple Async
s in STM
waitAnySTM :: [Async a] -> STM (Async a, a) #
A version of waitAny
that can be used inside an STM transaction.
Since: async-2.1.0
waitAnyCatchSTM :: [Async a] -> STM (Async a, Either SomeException a) #
A version of waitAnyCatch
that can be used inside an STM transaction.
Since: async-2.1.0
waitEitherSTM :: Async a -> Async b -> STM (Either a b) #
A version of waitEither
that can be used inside an STM transaction.
Since: async-2.1.0
waitEitherCatchSTM :: Async a -> Async b -> STM (Either (Either SomeException a) (Either SomeException b)) #
A version of waitEitherCatch
that can be used inside an STM transaction.
Since: async-2.1.0
waitEitherSTM_ :: Async a -> Async b -> STM () #
A version of waitEither_
that can be used inside an STM transaction.
Since: async-2.1.0
waitBothSTM :: Async a -> Async b -> STM (a, b) #
A version of waitBoth
that can be used inside an STM transaction.
Since: async-2.1.0
Low-level API
Spawning (low-level API)
asyncBound :: Concurrent :> es => Eff es a -> Eff es (Async a) Source #
Lifted asyncBound
.
asyncWithUnmask :: Concurrent :> es => ((forall b. Eff es b -> Eff es b) -> Eff es a) -> Eff es (Async a) Source #
Lifted asyncWithUnmask
.
asyncOnWithUnmask :: Concurrent :> es => Int -> ((forall b. Eff es b -> Eff es b) -> Eff es a) -> Eff es (Async a) Source #
Lifted asyncOnWithUnmask
.
Linking
linkOnly :: Concurrent :> es => (SomeException -> Bool) -> Async a -> Eff es () Source #
Lifted linkOnly
.
link2Only :: Concurrent :> es => (SomeException -> Bool) -> Async a -> Async b -> Eff es () Source #
Lifted link2Only
.
data ExceptionInLinkedThread #
Instances
Exception ExceptionInLinkedThread | |
Show ExceptionInLinkedThread | |
Defined in Control.Concurrent.Async showsPrec :: Int -> ExceptionInLinkedThread -> ShowS # show :: ExceptionInLinkedThread -> String # showList :: [ExceptionInLinkedThread] -> ShowS # |