capataz-0.1.0.1: OTP-like supervision trees in Haskell

Safe HaskellNone
LanguageHaskell2010

Control.Concurrent.Capataz

Contents

Description

Public API for the capataz library

Capataz is a library that brings an OTP-like supervisor API to the Haskell concurrency toolset.

Synopsis

Types

class HasSupervisor a where Source #

Utility typeclass to call public supervision API with types that contain a supervisor (e.g. Capataz record).

Minimal complete definition

getSupervisor

Methods

getSupervisor :: a -> Supervisor Source #

Fetches a supervisor from a record internals.

data CallbackType Source #

Internal record that indicates what type of callback function is being invoked; this is used for telemetry purposes

Instances

Eq CallbackType Source # 
Show CallbackType Source # 
Generic CallbackType Source # 

Associated Types

type Rep CallbackType :: * -> * #

type Rep CallbackType Source # 
type Rep CallbackType = D1 * (MetaData "CallbackType" "Control.Concurrent.Capataz.Internal.Types" "capataz-0.1.0.1-BMUnXiQkbJaLDuTJjK4mTQ" False) ((:+:) * (C1 * (MetaCons "OnCompletion" PrefixI False) (U1 *)) ((:+:) * (C1 * (MetaCons "OnFailure" PrefixI False) (U1 *)) (C1 * (MetaCons "OnTermination" PrefixI False) (U1 *))))

data WorkerRestartStrategy Source #

Specifies how a Supervisor deals with the lifecycle of worker process in case of completion without errors and failure.

Constructors

Permanent

Supervisor will always restart a worker process, in both completion and failure scenarios.

Transient

Supervisor will only restart worker process if it has a failure in execution.

Temporary

Supervisor will never restart a worker, even on failure.

data WorkerTerminationPolicy Source #

Defines how a Worker process termination should be handled by its supervisor.

Constructors

Infinity

Supervisor waits until infinity for the worker termination callback to finish execution.

BrutalTermination

Supervisor terminates worker process without a chance to call its termination callback.

TimeoutMillis !Int

Supervisor allows a number of milliseconds for worker termination callback complete, if not completed by specified milliseconds the termination is cancelled via a BrutalTermination signal.

Instances

Eq WorkerTerminationPolicy Source # 
Ord WorkerTerminationPolicy Source # 
Show WorkerTerminationPolicy Source # 
Generic WorkerTerminationPolicy Source # 
Default WorkerTerminationPolicy Source # 
NFData WorkerTerminationPolicy Source # 

Methods

rnf :: WorkerTerminationPolicy -> () #

type Rep WorkerTerminationPolicy Source # 
type Rep WorkerTerminationPolicy = D1 * (MetaData "WorkerTerminationPolicy" "Control.Concurrent.Capataz.Internal.Types" "capataz-0.1.0.1-BMUnXiQkbJaLDuTJjK4mTQ" False) ((:+:) * (C1 * (MetaCons "Infinity" PrefixI False) (U1 *)) ((:+:) * (C1 * (MetaCons "BrutalTermination" PrefixI False) (U1 *)) (C1 * (MetaCons "TimeoutMillis" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * Int)))))

data WorkerOptions Source #

Specifies all options that can be used to create a Worker Process. You may create a record of this type via the smart constructor "buildWorkerOptions".

Instances

data ProcessSpec Source #

Record used to specify how to build a runtime Process in a static supervision tree; to create values of this type, you must use:

  • "workerSpec" or "workerSpecWithDefaults" to build a worker process
  • "supervisorSpec" or "supervisorSpecWithDefaults" to build a supervisor process

data ProcessTerminationOrder Source #

Specifies the order in which supervised process should be terminated by a Supervisor in case of a restart or shutdown.

Constructors

NewestFirst

Supervisor terminates supervised process from most recent to oldest.

OldestFirst

Supervisor terminates supervised process from oldest to most recent.

Instances

Eq ProcessTerminationOrder Source # 
Ord ProcessTerminationOrder Source # 
Show ProcessTerminationOrder Source # 
Generic ProcessTerminationOrder Source # 
Default ProcessTerminationOrder Source # 
NFData ProcessTerminationOrder Source # 

Methods

rnf :: ProcessTerminationOrder -> () #

type Rep ProcessTerminationOrder Source # 
type Rep ProcessTerminationOrder = D1 * (MetaData "ProcessTerminationOrder" "Control.Concurrent.Capataz.Internal.Types" "capataz-0.1.0.1-BMUnXiQkbJaLDuTJjK4mTQ" False) ((:+:) * (C1 * (MetaCons "NewestFirst" PrefixI False) (U1 *)) (C1 * (MetaCons "OldestFirst" PrefixI False) (U1 *)))

data ProcessError Source #

Internal exception triggered when a callback of a Worker fails

data SupervisorRestartStrategy Source #

Specifies how a Supervisor restarts a failing process.

Constructors

AllForOne

Supervisor terminates all sibling supervised processes that didn't fail, and then restarts all of them together. This strategy serves best when all processes depend upon each other.

OneForOne

Supervisor only restarts the supervised process that failed.

Instances

Eq SupervisorRestartStrategy Source # 
Ord SupervisorRestartStrategy Source # 
Show SupervisorRestartStrategy Source # 
Generic SupervisorRestartStrategy Source # 
Default SupervisorRestartStrategy Source # 
NFData SupervisorRestartStrategy Source # 
type Rep SupervisorRestartStrategy Source # 
type Rep SupervisorRestartStrategy = D1 * (MetaData "SupervisorRestartStrategy" "Control.Concurrent.Capataz.Internal.Types" "capataz-0.1.0.1-BMUnXiQkbJaLDuTJjK4mTQ" False) ((:+:) * (C1 * (MetaCons "AllForOne" PrefixI False) (U1 *)) (C1 * (MetaCons "OneForOne" PrefixI False) (U1 *)))

data SupervisorStatus Source #

Internal record used as a state machine, indicating the state of a supervisor process

Constructors

Initializing

This state is set when the process is created and it starts spawning its static process list.

Running

This state is set when the supervisor process starts listenting to both ControlAction and MonitorEvent messages.

Halting

This state is set when the supervisor process is terminating it's assigned worker

Halted

This state is set when the supervisor process is finished

Instances

Eq SupervisorStatus Source # 
Show SupervisorStatus Source # 
Generic SupervisorStatus Source # 
NFData SupervisorStatus Source # 

Methods

rnf :: SupervisorStatus -> () #

type Rep SupervisorStatus Source # 
type Rep SupervisorStatus = D1 * (MetaData "SupervisorStatus" "Control.Concurrent.Capataz.Internal.Types" "capataz-0.1.0.1-BMUnXiQkbJaLDuTJjK4mTQ" False) ((:+:) * ((:+:) * (C1 * (MetaCons "Initializing" PrefixI False) (U1 *)) (C1 * (MetaCons "Running" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "Halting" PrefixI False) (U1 *)) (C1 * (MetaCons "Halted" PrefixI False) (U1 *))))

data CapatazOptions Source #

Allows to:

  • Specify options for The root supervisor of a capataz system.
  • Provie a "notifyEvent" callback to monitor or log a capataz system.

data Capataz Source #

Record that contains the environment of a capataz monitor, this is used as the main record to create workers and to stop the supervisor thread.

Default Options for Capataz Processes

buildSupervisorOptions Source #

Arguments

:: SupervisorName

Name used for telemetry purposes

-> (SupervisorOptions -> SupervisorOptions)

Function to modify default supervisor options

-> SupervisorOptions 

Builds a SupervisorOptions record with defaults from "buildSupervisorOptionsWithDefaults". This function allows overrides of these defaults using lenses.

This function is intended to be used in combination with "forkSupervisor".

buildSupervisorOptionsWithDefaults Source #

Arguments

:: SupervisorName

Name used for telemetry purposes

-> SupervisorOptions 

Builds a SupervisorOptions record with defaults to create a supervisor process, these defaults are:

This function is intended to be used in combination with "forkSupervisor".

buildWorkerOptions Source #

Arguments

:: WorkerName

Name used for telemetry purposes

-> IO ()

IO sub-routine to be supervised

-> (WorkerOptions -> WorkerOptions)

Function to modify default worker options

-> WorkerOptions 

Builds a WorkerOptions record, keeps the defaults from "buildWorkerOptionsWithDefaults" but allows overrides using lenses.

This function is intended to be used in combination with "forkWorker". See the ... example in the examples directory for a demonstration.

buildWorkerOptionsWithDefaults Source #

Arguments

:: WorkerName

Name used for telemetry purposes

-> IO ()

IO sub-routine to be supervised

-> WorkerOptions 

Builds a WorkerOptions record with defaults to create a worker process, the defaults are:

This function is intended to be used in combination with "forkWorker", for creating a worker in an static supervision tree, use "workerSpecWithDefaults" instead. See the ... example for a demonstration.

supervisorSpec Source #

Arguments

:: SupervisorName

Name used for telemetry purposes

-> (SupervisorOptions -> SupervisorOptions)

Function to modify default supervisor options

-> ProcessSpec 

Builds a ProcessSpec record for a supervisor process with defaults from "supervisorSpecWithDefaults". This function allows overrides of these defaults using lenses.

This function is used when building a supervisor branch in a static supervision trees.

supervisorSpecWithDefaults Source #

Arguments

:: SupervisorName

Name used for telemetry purposes

-> ProcessSpec 

Builds a ProcessSpec record for a supervisor process with defaults from "buildSupervisorOptionsWithDefaults".

This function is used when building a supervisor branch in a static supervision trees.

workerSpec Source #

Arguments

:: WorkerName

Name used for telemetry purposes

-> IO ()

IO sub-routine to be supervised

-> (WorkerOptions -> WorkerOptions)

Function to modify default worker options

-> ProcessSpec 

Builds a ProcessSpec record for a worker process with defaults from "workerSpecWithDefaults". This function allows overrides of these defaults using lenses.

This function is used when building a worker in a static supervision tree.

workerSpecWithDefaults Source #

Arguments

:: WorkerName

Name used for telemetry purposes

-> IO ()

IO sub-routine to be supervised

-> ProcessSpec 

Builds a ProcessSpec record for a worker process with defaults from "buildSupervisorOptionsWithDefaults".

This function is used when building a worker in a static supervision tree.

Lenses to modify Option Records

supervisorIntensityL :: (HasSupervisorIntensity s, Functor f) => (Int -> f Int) -> s -> f s Source #

Specifies how many errors is a supervisor able to handle; check: http://erlang.org/doc/design_principles/sup_princ.html#max_intensity.

supervisorPeriodSecondsL :: (HasSupervisorPeriodSeconds s, Functor f) => (NominalDiffTime -> f NominalDiffTime) -> s -> f s Source #

Specifies period of time in which a supervisor can receive a number of errors specified in "supervisorIntensityL".

supervisorProcessSpecListL :: (HasSupervisorProcessSpecList s, Functor f) => ([ProcessSpec] -> f [ProcessSpec]) -> s -> f s Source #

Specifies a static list of processes that start automatically with a supervisor.

supervisorProcessTerminationOrderL :: (HasSupervisorProcessTerminationOrder s, Functor f) => (ProcessTerminationOrder -> f ProcessTerminationOrder) -> s -> f s Source #

Specifies order in which a supervisor is going to terminate its supervised processes.

supervisorOnIntensityReachedL :: (HasSupervisorIntensityReachedCallback s, Functor f) => (IO () -> f (IO ())) -> s -> f s Source #

Specifies a callback sub-routine that gets executed when there is a breach in a supervisor's error intensity.

supervisorOnFailureL :: (HasSupervisorFailureCallback s, Functor f) => ((SomeException -> IO ()) -> f (SomeException -> IO ())) -> s -> f s Source #

Specifies callback sub-routine that gets executed when a supervisor fails.

workerOnFailureL :: Functor f => ((SomeException -> IO ()) -> f (SomeException -> IO ())) -> WorkerOptions -> f WorkerOptions Source #

Specifies callback that gets executed when worker sub-routine has runtime error.

NOTE: the given sub-routine execution may be interrupted depending on the worker WorkerTerminationPolicy.

workerOnCompletionL :: Functor f => (IO () -> f (IO ())) -> WorkerOptions -> f WorkerOptions Source #

Specifies callback that gets executed when worker sub-routine completes with no errors.

NOTE: the given sub-routine execution may be interrupted depending on the worker WorkerTerminationPolicy.

workerOnTerminationL :: Functor f => (IO () -> f (IO ())) -> WorkerOptions -> f WorkerOptions Source #

Specifies callback that gets executed when worker sub-routine is terminated by its supervisor; this may happen in case of a capataz system shutdown or when there is an AllForOne restart policy in place.

NOTE: the given sub-routine execution may be interrupted depending on the worker WorkerTerminationPolicy.

workerTerminationPolicyL :: Functor f => (WorkerTerminationPolicy -> f WorkerTerminationPolicy) -> WorkerOptions -> f WorkerOptions Source #

Specifies how to handle a worker termination. See WorkerTerminationPolicy documentation for more details.

workerRestartStrategyL :: Functor f => (WorkerRestartStrategy -> f WorkerRestartStrategy) -> WorkerOptions -> f WorkerOptions Source #

Specifies how supervisor should deal with an error when worker fails or completes. See WorkerRestartStrategy documentation for more details.

Core functionality

forkWorker Source #

Arguments

:: HasSupervisor supervisor 
=> WorkerOptions

Worker options (restart, name, callbacks, etc)

-> supervisor

Supervisor that supervises the worker

-> IO WorkerId

An identifier that can be used to terminate the Worker

Creates a green thread from an "IO ()" sub-routine. Depending in options defined in the WorkerOptions record, it will automatically restart this sub-routine in case of failures.

See documentation of related functions:

  • "buildWorkerOptionsWithDefault"
  • "buildWorkerOptions"

forkSupervisor Source #

Arguments

:: HasSupervisor parentSupervisor 
=> SupervisorOptions

Supervisor options

-> parentSupervisor

Parent supervisor instance that supervises new supervisor

-> IO Supervisor

A record used to dynamically create and supervise other processes

Creates a green thread which monitors other green threads for failures and restarts them using settings defined on SupervisorOptions.

See documentation of related functions:

  • "buildSupervisorOptionsWithDefault"
  • "buildSupervisorOptions"

forkCapataz :: Text -> (CapatazOptions -> CapatazOptions) -> IO Capataz Source #

Creates a Capataz record, which holds both a root supervisor and a Teardown to shut down the system. The root supervisor monitors failures on process threads defined with "supervisorProcessSpecList" or created dynamically using "forkWorker" or "forkSupervisor".

terminateProcess :: HasSupervisor supervisor => Text -> ProcessId -> supervisor -> IO Bool Source #

Stops the execution of a green thread being supervised by the given supervisor.

NOTE: If ProcessId maps to a worker that is configured with a Permanent worker restart strategy, the worker green thread will be restarted again.

Utility functions

joinCapatazThread :: Capataz -> IO () Source #

Joins the thread of the root supervisor of the given capataz system to the current thread.

getSupervisorProcessId :: Supervisor -> ProcessId Source #

Gets the process identifier of a Supervisor; normally used for termination.

getSupervisorAsync :: Supervisor -> Async () Source #

Gets the Async of a Supervisor thread.

NOTE: There is no way to get the Async value of the root supervisor; this is to avoid error scenarios.

getCapatazTeardown :: Capataz -> Teardown Source #

Gets Teardown record of this capataz system.

Teardown (re-exported)

teardown :: ITeardown teardown => teardown -> IO TeardownResult #

Executes teardown sub-routine returning a TeardownResult

Lens (re-exported)

(.~) :: ASetter s t a b -> b -> s -> t infixr 4 #

(.~) assigns a value to the target. It's the same thing as using (%~) with const:

l .~ x = l %~ const x

See set if you want a non-operator synonym.

Here it is used to change 2 fields of a 3-tuple:

>>> (0,0,0) & _1 .~ 1 & _3 .~ 3
(1,0,3)

(&) :: a -> (a -> b) -> b infixl 1 #

& is a reverse application operator. This provides notational convenience. Its precedence is one higher than that of the forward application operator $, which allows & to be nested in $.

Since: 4.8.0.0

set :: ASetter s t a b -> b -> s -> t #

set is a synonym for (.~).

Setting the 1st component of a pair:

set _1 :: x -> (a, b) -> (x, b)
set _1 = \x t -> (x, snd t)

Using it to rewrite (<$):

set mapped :: Functor f => a -> f b -> f a
set mapped = (<$)