{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE UnboxedSums #-}

module OpenTelemetry.Context.Types where

import Data.Text (Text)
import qualified Data.Vault.Strict as V
import GHC.Exts (Any)
import OpenTelemetry.Baggage (Baggage)
import OpenTelemetry.Internal.UnpackedMaybe


{- | A @Context@ is a propagation mechanism which carries execution-scoped values
 across API boundaries and between logically associated execution units.
 Cross-cutting concerns access their data in-process using the same shared
 @Context@ object.

 The span and baggage slots use UMaybe (unboxed sums) for zero-indirection
 access when UNPACKed into the Context closure. All other keys go through
 the vault.
-}
data Context = Context
  { Context -> UMaybe Any
ctxSpanSlot :: {-# UNPACK #-} !(UMaybe Any)
  , Context -> UMaybe Baggage
ctxBaggageSlot :: {-# UNPACK #-} !(UMaybe Baggage)
  , Context -> Vault
ctxVault :: !V.Vault
  }


instance Semigroup Context where
  <> :: Context -> Context -> Context
(<>) (Context UMaybe Any
s1 UMaybe Baggage
b1 Vault
v1) (Context UMaybe Any
s2 UMaybe Baggage
b2 Vault
v2) =
    UMaybe Any -> UMaybe Baggage -> Vault -> Context
Context
      (UMaybe Any -> UMaybe Any -> UMaybe Any
forall {a}. UMaybe a -> UMaybe a -> UMaybe a
orElse UMaybe Any
s2 UMaybe Any
s1)
      (UMaybe Baggage -> UMaybe Baggage -> UMaybe Baggage
forall {a}. Semigroup a => UMaybe a -> UMaybe a -> UMaybe a
mergeBaggage UMaybe Baggage
b1 UMaybe Baggage
b2)
      (Vault -> Vault -> Vault
V.union Vault
v1 Vault
v2)
    where
      orElse :: UMaybe a -> UMaybe a -> UMaybe a
orElse UMaybe a
UNothing UMaybe a
x = UMaybe a
x
      orElse UMaybe a
x UMaybe a
_ = UMaybe a
x
      {-# INLINE orElse #-}
      mergeBaggage :: UMaybe a -> UMaybe a -> UMaybe a
mergeBaggage UMaybe a
UNothing UMaybe a
r = UMaybe a
r
      mergeBaggage UMaybe a
l UMaybe a
UNothing = UMaybe a
l
      mergeBaggage (UJust a
l) (UJust a
r) = a -> UMaybe a
forall a. a -> UMaybe a
UJust (a
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
r)
      {-# INLINE mergeBaggage #-}


instance Monoid Context where
  mempty :: Context
mempty = UMaybe Any -> UMaybe Baggage -> Vault -> Context
Context UMaybe Any
forall a. UMaybe a
UNothing UMaybe Baggage
forall a. UMaybe a
UNothing Vault
V.empty


{- | Keys are used to allow cross-cutting concerns to control access to their local state.
 They are unique such that other libraries which may use the same context
 cannot accidentally use the same key. It is recommended that concerns mediate
 data access via an API, rather than provide direct public access to their keys.
-}
data Key a = Key {forall a. Key a -> Text
keyName :: Text, forall a. Key a -> Key a
key :: V.Key a}