{-# LANGUAGE UnliftedFFITypes #-}
module OpenTelemetry.Context.ThreadLocal
(
getContext
, lookupContext
, attachContext
, detachContext
, adjustContext
, lookupContextOnThread
, attachContextOnThread
, detachContextFromThread
, adjustContextOnThread
) where
import OpenTelemetry.Context (Context, empty)
import Control.Concurrent
import Control.Concurrent.Thread.Storage
import Control.Monad.IO.Class
import Data.Maybe (fromMaybe)
import System.IO.Unsafe
import Prelude hiding (lookup)
type ThreadContextMap = ThreadStorageMap Context
threadContextMap :: ThreadContextMap
threadContextMap :: ThreadContextMap
threadContextMap = IO ThreadContextMap -> ThreadContextMap
forall a. IO a -> a
unsafePerformIO IO ThreadContextMap
forall (m :: * -> *) a. MonadIO m => m (ThreadStorageMap a)
newThreadStorageMap
{-# NOINLINE threadContextMap #-}
getContext :: MonadIO m => m Context
getContext :: m Context
getContext = Context -> Maybe Context -> Context
forall a. a -> Maybe a -> a
fromMaybe Context
empty (Maybe Context -> Context) -> m (Maybe Context) -> m Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe Context)
forall (m :: * -> *). MonadIO m => m (Maybe Context)
lookupContext
lookupContext :: MonadIO m => m (Maybe Context)
lookupContext :: m (Maybe Context)
lookupContext = ThreadContextMap -> m (Maybe Context)
forall (m :: * -> *) a.
MonadIO m =>
ThreadStorageMap a -> m (Maybe a)
lookup ThreadContextMap
threadContextMap
lookupContextOnThread :: MonadIO m => ThreadId -> m (Maybe Context)
lookupContextOnThread :: ThreadId -> m (Maybe Context)
lookupContextOnThread = ThreadContextMap -> ThreadId -> m (Maybe Context)
forall (m :: * -> *) a.
MonadIO m =>
ThreadStorageMap a -> ThreadId -> m (Maybe a)
lookupOnThread ThreadContextMap
threadContextMap
attachContext :: MonadIO m => Context -> m (Maybe Context)
attachContext :: Context -> m (Maybe Context)
attachContext = ThreadContextMap -> Context -> m (Maybe Context)
forall (m :: * -> *) a.
MonadIO m =>
ThreadStorageMap a -> a -> m (Maybe a)
attach ThreadContextMap
threadContextMap
attachContextOnThread :: MonadIO m => ThreadId -> Context -> m (Maybe Context)
attachContextOnThread :: ThreadId -> Context -> m (Maybe Context)
attachContextOnThread = ThreadContextMap -> ThreadId -> Context -> m (Maybe Context)
forall (m :: * -> *) a.
MonadIO m =>
ThreadStorageMap a -> ThreadId -> a -> m (Maybe a)
attachOnThread ThreadContextMap
threadContextMap
detachContext :: MonadIO m => m (Maybe Context)
detachContext :: m (Maybe Context)
detachContext = ThreadContextMap -> m (Maybe Context)
forall (m :: * -> *) a.
MonadIO m =>
ThreadStorageMap a -> m (Maybe a)
detach ThreadContextMap
threadContextMap
detachContextFromThread :: MonadIO m => ThreadId -> m (Maybe Context)
detachContextFromThread :: ThreadId -> m (Maybe Context)
detachContextFromThread = ThreadContextMap -> ThreadId -> m (Maybe Context)
forall (m :: * -> *) a.
MonadIO m =>
ThreadStorageMap a -> ThreadId -> m (Maybe a)
detachFromThread ThreadContextMap
threadContextMap
adjustContext :: MonadIO m => (Context -> Context) -> m ()
adjustContext :: (Context -> Context) -> m ()
adjustContext = ThreadContextMap -> (Context -> Context) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
ThreadStorageMap a -> (a -> a) -> m ()
adjust ThreadContextMap
threadContextMap
adjustContextOnThread :: MonadIO m => ThreadId -> (Context -> Context) -> m ()
adjustContextOnThread :: ThreadId -> (Context -> Context) -> m ()
adjustContextOnThread = ThreadContextMap -> ThreadId -> (Context -> Context) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
ThreadStorageMap a -> ThreadId -> (a -> a) -> m ()
adjustOnThread ThreadContextMap
threadContextMap