context-0.2.0.1: Thread-indexed, nested contexts
Safe HaskellNone
LanguageHaskell2010

Context.Storage

Synopsis

Introduction

This module provides lower-level functions for acquiring and working with Store values. It may be useful for:

  • library authors using a Store value(s) as an implementation detail
  • application developers leveraging a global Store value(s)

In any case, this module provides more fine-grained control over Store creation. The most important aspect of this control is being able to precisely specify how Context.Concurrent will behave in regards to context propagation.

While this module is lower-level than the Context module, it is still re-exported from Context out of convenience.

Lower-level storage

withStore Source #

Arguments

:: forall m ctx a. (MonadIO m, MonadMask m) 
=> PropagationStrategy

The strategy used by Context.Concurrent for propagating context from a "parent" thread to a new thread.

-> Maybe ctx

The default value for the Store.

Providing a value will produce a non-empty Store such that mine, mines, and adjust are guaranteed to never throw NotFoundException when applied to this Store.

Providing Nothing will produce an empty Store such that mine, mines, and adjust will throw NotFoundException when the calling thread has no registered context. Providing Nothing is useful when the Store will contain context values that are always thread-specific.

-> (Store ctx -> m a) 
-> m a 

Provides a new Store. This is a lower-level function and is provided mainly to give library authors more fine-grained control when using a Store as an implementation detail.

withNonEmptyStore/withEmptyStore should generally be preferred over this function when acquiring a Store.

Since: 0.1.0.0

newStore Source #

Arguments

:: forall m ctx. MonadIO m 
=> PropagationStrategy

The strategy used by Context.Concurrent for propagating context from a "parent" thread to a new thread.

-> Maybe ctx

The default value for the Store.

Providing a value will produce a non-empty Store such that mine, mines, and adjust are guaranteed to never throw NotFoundException when applied to this Store.

Providing Nothing will produce an empty Store such that mine, mines, and adjust will throw NotFoundException when the calling thread has no registered context. Providing Nothing is useful when the Store will contain context values that are always thread-specific.

-> m (Store ctx) 

Creates a new Store. This is a lower-level function and is provided only to support the use case of creating a Store as a global:

store :: Store Int
store = unsafePerformIO $ Context.newStore Context.defaultPropagation Nothing
{-# NOINLINE store #-}

Outside of the global variable use case, withNonEmptyStore, withEmptyStore, or even the lower-level withStore should always be preferred over this function when acquiring a Store.

Since: 0.1.0.0

setDefault :: forall m ctx. MonadIO m => Store ctx -> ctx -> m () Source #

Set the default context value for a store. If the store was initialized as an empty store, this function converts it to a non-empty store. If the store was initialized as a non-empty store, this overwrites the default context value.

One common use case for this function is to convert an empty store in a global variable to a non-empty store while the application is initializing/acquiring resources:

depsStore :: Store Dependencies
depsStore = unsafePerformIO $ Context.newStore Context.defaultPropagation Nothing
{-# NOINLINE depsStore #-}

main :: IO ()
main = do
  let config = -- ...
  withDependencies config \deps -> do
    Context.setDefault depsStore deps
    -- ...

Since: 0.1.0.0

Propagation strategies

data PropagationStrategy Source #

The PropagationStrategy controls the behavior used by Context.Concurrent when propagating context from a "parent" thread to a new thread.

Since: 0.1.0.0

defaultPropagation :: PropagationStrategy Source #

The default PropagationStrategy. For any Store initialized with this PropagationStrategy, Context.Concurrent will automatically propagate the "parent" thread's latest context value from this Store so that that context is accessible in a newly-created thread.

Since: 0.1.0.0

noPropagation :: PropagationStrategy Source #

This PropagationStrategy does no propagation whatsoever. For any Store initialized with this PropagationStrategy, Context.Concurrent will not propagate the "parent" thread's context values from this Store in any way to the newly-created thread.

Since: 0.1.0.0