ki-0: A lightweight, structured concurrency library
Safe HaskellNone
LanguageHaskell2010

Ki.Internal

Synopsis

Documentation

newtype CancelToken Source #

A cancel token represents a request for cancellation; this request can be fulfilled by throwing the token as an exception.

Constructors

CancelToken Int 

data Context Source #

Constructors

Context 

Fields

  • cancelContext :: IO ()
     
  • contextCancelTokenSTM :: STM CancelToken
     
  • deriveContext :: STM Context

    Derive a child context from a parent context.

    • If the parent is already cancelled, so is the child.
    • If the parent isn't already canceled, the child registers itself with the parent such that:
    • When the parent is cancelled, so is the child
    • When the child is cancelled, it removes the parent's reference to it

globalContext :: Context Source #

The global context. It cannot be cancelled.

data Ctx Source #

Constructors

Ctx 

Fields

  • cancelTokenVar :: TVar (Maybe CancelToken)
     
  • childrenVar :: TVar (IntMap Ctx)
     
  • nextIdVar :: TVar Int

    The next id to assign to a child context. The child needs a unique identifier so it can delete itself from its parent's children map if it's cancelled independently. Wrap-around seems ok; that's a *lot* of children for one parent to have.

  • onCancel :: STM ()

    When I'm cancelled, this action removes myself from my parent's context. This isn't simply a pointer to the parent Ctx for three reasons:

    • Root contexts don't have a parent, so it'd have to be a Maybe (one more pointer indirection)
    • We don't really need a reference to the parent, because we only want to be able to remove ourselves from its children map, so just storing the STM action that does exactly seems a bit safer, even if conceptually it's a bit indirect.
    • If we stored a reference to the parent, we'd also have to store our own id, rather than just currying it into this action.

newtype Duration Source #

A length of time with microsecond precision. Numeric literals are treated as seconds.

Constructors

Duration (Fixed E6) 

Instances

Instances details
Enum Duration Source # 
Instance details

Defined in Ki.Duration

Eq Duration Source # 
Instance details

Defined in Ki.Duration

Fractional Duration Source # 
Instance details

Defined in Ki.Duration

Data Duration Source # 
Instance details

Defined in Ki.Duration

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Duration -> c Duration #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Duration #

toConstr :: Duration -> Constr #

dataTypeOf :: Duration -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Duration) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration) #

gmapT :: (forall b. Data b => b -> b) -> Duration -> Duration #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Duration -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Duration -> r #

gmapQ :: (forall d. Data d => d -> u) -> Duration -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Duration -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Duration -> m Duration #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Duration -> m Duration #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Duration -> m Duration #

Num Duration Source # 
Instance details

Defined in Ki.Duration

Ord Duration Source # 
Instance details

Defined in Ki.Duration

Read Duration Source # 
Instance details

Defined in Ki.Duration

Real Duration Source # 
Instance details

Defined in Ki.Duration

RealFrac Duration Source # 
Instance details

Defined in Ki.Duration

Methods

properFraction :: Integral b => Duration -> (b, Duration) #

truncate :: Integral b => Duration -> b #

round :: Integral b => Duration -> b #

ceiling :: Integral b => Duration -> b #

floor :: Integral b => Duration -> b #

Show Duration Source # 
Instance details

Defined in Ki.Duration

Generic Duration Source # 
Instance details

Defined in Ki.Duration

Associated Types

type Rep Duration :: Type -> Type #

Methods

from :: Duration -> Rep Duration x #

to :: Rep Duration x -> Duration #

type Rep Duration Source # 
Instance details

Defined in Ki.Duration

type Rep Duration = D1 ('MetaData "Duration" "Ki.Duration" "ki-0-inplace" 'True) (C1 ('MetaCons "Duration" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Fixed E6))))

microseconds :: Duration Source #

One microsecond.

milliseconds :: Duration Source #

One millisecond.

seconds :: Duration Source #

One second.

data Scope Source #

A scope delimits the lifetime of all threads created within it.

Constructors

Scope 

Fields

  • context :: Context
     
  • closedVar :: TVar Bool

    Whether this scope is closed. Invariant: if closed, no threads are starting.

  • runningVar :: TVar (Set ThreadId)

    The set of threads that are currently running.

  • startingVar :: TVar Int

    The number of threads that are *guaranteed* to be about to start, in the sense that only the GHC scheduler can continue to delay; no async exception can strike here and prevent one of these threads from starting.

    If this number is non-zero, and that's problematic (e.g. because we're trying to cancel this scope), we always respect it and wait for it to drop to zero before proceeding.

cancelScope :: Scope -> IO () Source #

Cancel all contexts derived from a scope.

scopeFork :: Scope -> ((forall x. IO x -> IO x) -> IO a) -> (ThreadId -> Either SomeException a -> IO ()) -> IO ThreadId Source #

scoped :: Context -> (Scope -> IO a) -> IO a Source #

wait :: Scope -> IO () Source #

Wait until all threads created within a scope finish.

waitFor :: Scope -> Duration -> IO () Source #

Variant of wait that waits for up to the given duration.

waitSTM :: Scope -> STM () Source #

STM variant of wait.

data ScopeClosing Source #

Exception thrown by a parent thread to its children when the scope is closing.

Constructors

ScopeClosing 

data Thread a Source #

A running thread.

Instances

Instances details
Functor Thread Source # 
Instance details

Defined in Ki.Thread

Methods

fmap :: (a -> b) -> Thread a -> Thread b #

(<$) :: a -> Thread b -> Thread a #

Eq (Thread a) Source # 
Instance details

Defined in Ki.Thread

Methods

(==) :: Thread a -> Thread a -> Bool #

(/=) :: Thread a -> Thread a -> Bool #

Ord (Thread a) Source # 
Instance details

Defined in Ki.Thread

Methods

compare :: Thread a -> Thread a -> Ordering #

(<) :: Thread a -> Thread a -> Bool #

(<=) :: Thread a -> Thread a -> Bool #

(>) :: Thread a -> Thread a -> Bool #

(>=) :: Thread a -> Thread a -> Bool #

max :: Thread a -> Thread a -> Thread a #

min :: Thread a -> Thread a -> Thread a #

Generic (Thread a) Source # 
Instance details

Defined in Ki.Thread

Associated Types

type Rep (Thread a) :: Type -> Type #

Methods

from :: Thread a -> Rep (Thread a) x #

to :: Rep (Thread a) x -> Thread a #

type Rep (Thread a) Source # 
Instance details

Defined in Ki.Thread

type Rep (Thread a) = D1 ('MetaData "Thread" "Ki.Thread" "ki-0-inplace" 'False) (C1 ('MetaCons "Thread" 'PrefixI 'True) (S1 ('MetaSel ('Just "threadId") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ThreadId) :*: S1 ('MetaSel ('Just "action") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (STM a))))

async :: Scope -> IO a -> IO (Thread (Either ThreadFailed a)) Source #

Create a thread within a scope to compute a value concurrently.

Throws:

  • Calls error if the scope is closed.

asyncWithUnmask :: Scope -> ((forall x. IO x -> IO x) -> IO a) -> IO (Thread (Either ThreadFailed a)) Source #

Variant of async that provides the thread a function that unmasks asynchronous exceptions.

Throws:

  • Calls error if the scope is closed.

await :: Thread a -> IO a Source #

awaitSTM :: Thread a -> STM a Source #

STM variant of await.

awaitFor :: Thread a -> Duration -> IO (Maybe a) Source #

Variant of await that gives up after the given duration.

awaitFor thread duration =
  timeout duration (pure . Just <$> awaitSTM thread) (pure Nothing)

fork :: Scope -> IO a -> IO (Thread a) Source #

Create a thread within a scope to compute a value concurrently.

If the thread throws an exception, the exception is wrapped in ThreadFailed and immediately propagated up the call tree to the thread that opened its scope.

Throws:

  • Calls error if the scope is closed.

fork_ :: Scope -> IO () -> IO () Source #

Variant of fork that does not return a handle to the created thread.

Throws:

  • Calls error if the scope is closed.

forkWithUnmask :: Scope -> ((forall x. IO x -> IO x) -> IO a) -> IO (Thread a) Source #

Variant of fork that provides the thread a function that unmasks asynchronous exceptions.

Throws:

  • Calls error if the scope is closed.

forkWithUnmask_ :: Scope -> ((forall x. IO x -> IO x) -> IO ()) -> IO () Source #

Variant of forkWithUnmask that does not return a handle to the created thread.

Throws:

  • Calls error if the scope is closed.

data ThreadFailed Source #

A thread failed, either by throwing or being thrown an exception.

newtype ThreadFailedAsync Source #

An async wrapper around ThreadFailed, used when a child thread communicates its failure to its parent. This is preferred to throwing ThreadFailed directly, so that client code (outside of this library) can follow best-practices when encountering a mysterious async exception: clean up resources and re-throw it.

timeoutSTM :: Duration -> STM (IO a) -> IO a -> IO a Source #

Wait for an STM action to return an IO action, or if the given duration elapses, return the given IO action instead.