{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module OTel.API.Trace.Core.Internal
  ( -- * Disclaimer
    -- $disclaimer
    trace_
  , trace
  , MonadTracing(..)
  , MonadTracingIO(..)

  , TracerProvider(..)

  , Tracer(..)

  , contextBackendSpan
  , contextKeySpan

  , SpanContext(..)
  , emptySpanContext
  , spanContextIsValid
  , spanContextIsSampled

  , TraceId(..)
  , traceIdToHexText
  , traceIdToBytesVector
  , traceIdToHexBuilder
  , traceIdToBytesBuilder
  , emptyTraceId
  , traceIdFromWords

  , SpanId(..)
  , spanIdToHexText
  , spanIdToBytesVector
  , spanIdToHexBuilder
  , spanIdToBytesBuilder
  , emptySpanId
  , spanIdFromWords

  , TraceFlags(..)
  , traceFlagsToHexText
  , traceFlagsToHexBuilder
  , traceFlagsSampled
  , isSampledFlagSet

  , TraceState(..)
  , emptyTraceState
  , nullTraceState
  , sizeTraceState
  , memberTraceState
  , lookupTraceState
  , findWithDefaultTraceState
  , deleteTraceState
  , filterTraceState
  , filterWithKeyTraceState
  , foldMapWithKeyTraceState
  , toListTraceState
  , TraceStateBuilder(..)
  , buildTraceState
  , buildTraceStatePure

  , SpanEvents(..)
  , spanEventsFromList
  , spanEventsToList
  , freezeAllSpanEventAttrs
  , SpanEvent(..)
  , freezeSpanEventAttrs
  , SpanEventSpecs(..)
  , singletonSpanEventSpecs
  , spanEventSpecsFromList
  , spanEventSpecsToList
  , SpanEventSpec(..)
  , defaultSpanEventSpec
  , SpanEventName(..)
  , SpanLinks(..)
  , spanLinksFromList
  , spanLinksToList
  , freezeAllSpanLinkAttrs
  , SpanLinkSpecs(..)
  , singletonSpanLinkSpecs
  , spanLinkSpecsFromList
  , spanLinkSpecsToList
  , SpanLink(..)
  , freezeSpanLinkAttrs
  , SpanLinkName(..)
  , SpanLinkSpec(..)
  , defaultSpanLinkSpec
  , SpanSpec(..)
  , defaultSpanSpec
  , UpdateSpanSpec(..)
  , defaultUpdateSpanSpec
  , buildSpanUpdater
  , recordException
  , exceptionEvent
  , SpanName(..)
  , MutableSpan(..)
  , unsafeNewMutableSpan
  , unsafeReadMutableSpan
  , unsafeModifyMutableSpan
  , Span(..)
  , spanIsRemote
  , spanIsSampled
  , spanIsRoot
  , spanIsChildOf
  , SpanFrozenAt
  , SpanFrozenTimestamp(..)
  , frozenTimestamp
  , freezeSpan
  , SpanLineage(..)
  , SpanKind(..)
  , SpanStatus(..)
  ) where

#if MIN_VERSION_base(4,18,0)
import Control.Applicative ()
#else
import Control.Applicative (Applicative(..))
#endif

import Control.Exception (SomeException(..))
import Control.Monad.Catch (MonadThrow, throwM)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.IO.Unlift (MonadUnliftIO(withRunInIO))
import Control.Monad.Logger (LoggingT)
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Monad.Trans.Control (MonadTransControl(liftWith, restoreT))
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Identity (IdentityT(..))
import Control.Monad.Trans.Maybe (MaybeT)
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.Resource (ResourceT)
import Data.Aeson (KeyValue((.=)), ToJSON(..))
import Data.Aeson.Types (Pair)
import Data.Bifunctor (Bifunctor(..))
import Data.Bits (Bits(testBit), Ior(..))
import Data.ByteString.Builder (Builder)
import Data.DList (DList)
import Data.HashMap.Strict (HashMap)
import Data.IORef (IORef)
import Data.Kind (Type)
import Data.Monoid (Ap(..))
import Data.String (IsString(fromString))
import Data.Text (Text)
import Data.Word (Word64, Word8)
import GHC.Stack (CallStack, HasCallStack, callStack)
import OTel.API.Common
  ( AttrsFor(..), KV(..), Key(..), TimestampSource(..), Attrs, AttrsBuilder, AttrsLimits
  , InstrumentationScope, IsTextKV, Timestamp, WithAttrs(..)
  )
import OTel.API.Common.Internal (runAttrsBuilder)
import OTel.API.Context.Core (Context, ContextBackend, ContextKey)
import OTel.API.Context.Core.Internal
  ( ContextBackend(contextBackendValueKey), unsafeNewContextBackend
  )
import OTel.API.Trace.Core.Attributes
  ( pattern EXCEPTION_ESCAPED, pattern EXCEPTION_MESSAGE, pattern EXCEPTION_TYPE
  )
import OTel.API.Trace.Core.TraceState.Errors
  ( TraceStateError(..), TraceStateErrors(..), TraceStateKeyTypeUnknownError(..)
  , TraceStateSimpleKeyContainsInvalidCharsError(..), TraceStateSimpleKeyIsEmptyError(..)
  , TraceStateSimpleKeyTooLongError(..), TraceStateSystemIdContainsInvalidCharsError(..)
  , TraceStateSystemIdIsEmptyError(..), TraceStateSystemIdTooLongError(..)
  , TraceStateTenantIdContainsInvalidCharsError(..), TraceStateTenantIdIsEmptyError(..)
  , TraceStateTenantIdTooLongError(..), TraceStateValueContainsInvalidCharsError(..)
  , TraceStateValueIsEmptyError(..), TraceStateValueTooLongError(..)
  )
import Prelude hiding (span)
import System.IO.Unsafe (unsafePerformIO)
import qualified Control.Exception as Exception
import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
import qualified Control.Monad.Trans.State.Lazy as State.Lazy
import qualified Control.Monad.Trans.State.Strict as State.Strict
import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy
import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as ByteString.Lazy
import qualified Data.Char as Char
import qualified Data.DList as DList
import qualified Data.Foldable as Foldable
import qualified Data.HashMap.Strict as HashMap
import qualified Data.IORef as IORef
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text.Encoding
import qualified Data.Traversable as Traversable
import qualified Data.Typeable as Typeable
import qualified Data.Vector.Unboxed as Unboxed

trace_
  :: (MonadTracing m, HasCallStack)
  => SpanSpec
  -> m a
  -> m a
trace_ :: forall (m :: * -> *) a.
(MonadTracing m, HasCallStack) =>
SpanSpec -> m a -> m a
trace_ SpanSpec
spanSpec = CallStack -> SpanSpec -> (MutableSpan -> m a) -> m a
forall a. CallStack -> SpanSpec -> (MutableSpan -> m a) -> m a
forall (m :: * -> *) a.
MonadTracing m =>
CallStack -> SpanSpec -> (MutableSpan -> m a) -> m a
traceCS CallStack
HasCallStack => CallStack
callStack SpanSpec
spanSpec ((MutableSpan -> m a) -> m a)
-> (m a -> MutableSpan -> m a) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> MutableSpan -> m a
forall a b. a -> b -> a
const

trace
  :: (MonadTracing m, HasCallStack)
  => SpanSpec
  -> (MutableSpan -> m a)
  -> m a
trace :: forall (m :: * -> *) a.
(MonadTracing m, HasCallStack) =>
SpanSpec -> (MutableSpan -> m a) -> m a
trace = CallStack -> SpanSpec -> (MutableSpan -> m a) -> m a
forall a. CallStack -> SpanSpec -> (MutableSpan -> m a) -> m a
forall (m :: * -> *) a.
MonadTracing m =>
CallStack -> SpanSpec -> (MutableSpan -> m a) -> m a
traceCS CallStack
HasCallStack => CallStack
callStack

class (Monad m) => MonadTracing m where
  traceCS :: CallStack -> SpanSpec -> (MutableSpan -> m a) -> m a
  getSpanContext :: MutableSpan -> m SpanContext
  updateSpan :: MutableSpan -> UpdateSpanSpec -> m ()

  default traceCS
    :: (MonadTransControl t, MonadTracing n, m ~ t n)
    => CallStack
    -> SpanSpec
    -> (MutableSpan -> m a)
    -> m a
  traceCS CallStack
cs SpanSpec
spanSpec MutableSpan -> m a
f = do
    n (StT t a) -> m a
n (StT t a) -> t n a
forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (n (StT t a) -> m a) -> (StT t a -> n (StT t a)) -> StT t a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StT t a -> n (StT t a)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (StT t a -> m a) -> m (StT t a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Run t -> n (StT t a)) -> t n (StT t a)
forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith \Run t
run -> CallStack
-> SpanSpec -> (MutableSpan -> n (StT t a)) -> n (StT t a)
forall a. CallStack -> SpanSpec -> (MutableSpan -> n a) -> n a
forall (m :: * -> *) a.
MonadTracing m =>
CallStack -> SpanSpec -> (MutableSpan -> m a) -> m a
traceCS CallStack
cs SpanSpec
spanSpec (t n a -> n (StT t a)
Run t
run (t n a -> n (StT t a))
-> (MutableSpan -> t n a) -> MutableSpan -> n (StT t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableSpan -> m a
MutableSpan -> t n a
f)

  default getSpanContext
    :: (MonadTrans t, MonadTracing n, m ~ t n)
    => MutableSpan
    -> m SpanContext
  getSpanContext = n SpanContext -> m SpanContext
n SpanContext -> t n SpanContext
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n SpanContext -> m SpanContext)
-> (MutableSpan -> n SpanContext) -> MutableSpan -> m SpanContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableSpan -> n SpanContext
forall (m :: * -> *).
MonadTracing m =>
MutableSpan -> m SpanContext
getSpanContext

  default updateSpan
    :: (MonadTrans t, MonadTracing n, m ~ t n)
    => MutableSpan
    -> UpdateSpanSpec
    -> m ()
  updateSpan MutableSpan
mutableSpan = n () -> m ()
n () -> t n ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n () -> m ())
-> (UpdateSpanSpec -> n ()) -> UpdateSpanSpec -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableSpan -> UpdateSpanSpec -> n ()
forall (m :: * -> *).
MonadTracing m =>
MutableSpan -> UpdateSpanSpec -> m ()
updateSpan MutableSpan
mutableSpan

instance (MonadTracing m) => MonadTracing (ExceptT e m)
instance (MonadTracing m) => MonadTracing (IdentityT m)
instance (MonadTracing m) => MonadTracing (MaybeT m)
instance (MonadTracing m) => MonadTracing (ReaderT r m)
instance (MonadTracing m) => MonadTracing (State.Lazy.StateT r m)
instance (MonadTracing m) => MonadTracing (State.Strict.StateT r m)
instance (MonadTracing m, Monoid w) => MonadTracing (RWS.Lazy.RWST r w s m)
instance (MonadTracing m, Monoid w) => MonadTracing (RWS.Strict.RWST r w s m)
instance (MonadTracing m, Monoid w) => MonadTracing (Writer.Lazy.WriterT w m)
instance (MonadTracing m, Monoid w) => MonadTracing (Writer.Strict.WriterT w m)
instance (MonadTracing m) => MonadTracing (LoggingT m)
instance (MonadTracing m, MonadUnliftIO m) => MonadTracing (ResourceT m) where
  traceCS :: forall a.
CallStack
-> SpanSpec -> (MutableSpan -> ResourceT m a) -> ResourceT m a
traceCS CallStack
cs SpanSpec
spanSpec MutableSpan -> ResourceT m a
f = do
    ((forall a. ResourceT m a -> IO a) -> IO a) -> ResourceT m a
forall b.
((forall a. ResourceT m a -> IO a) -> IO b) -> ResourceT m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. ResourceT m a -> IO a
runInIO -> do
      ResourceT m a -> IO a
forall a. ResourceT m a -> IO a
runInIO (ResourceT m a -> IO a) -> ResourceT m a -> IO a
forall a b. (a -> b) -> a -> b
$ CallStack
-> SpanSpec -> (MutableSpan -> ResourceT m a) -> ResourceT m a
forall a.
CallStack
-> SpanSpec -> (MutableSpan -> ResourceT m a) -> ResourceT m a
forall (m :: * -> *) a.
MonadTracing m =>
CallStack -> SpanSpec -> (MutableSpan -> m a) -> m a
traceCS CallStack
cs SpanSpec
spanSpec MutableSpan -> ResourceT m a
f

  getSpanContext :: MutableSpan -> ResourceT m SpanContext
getSpanContext MutableSpan
mutableSpan = do
    ((forall a. ResourceT m a -> IO a) -> IO SpanContext)
-> ResourceT m SpanContext
forall b.
((forall a. ResourceT m a -> IO a) -> IO b) -> ResourceT m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. ResourceT m a -> IO a
runInIO -> do
      ResourceT m SpanContext -> IO SpanContext
forall a. ResourceT m a -> IO a
runInIO (ResourceT m SpanContext -> IO SpanContext)
-> ResourceT m SpanContext -> IO SpanContext
forall a b. (a -> b) -> a -> b
$ MutableSpan -> ResourceT m SpanContext
forall (m :: * -> *).
MonadTracing m =>
MutableSpan -> m SpanContext
getSpanContext MutableSpan
mutableSpan

  updateSpan :: MutableSpan -> UpdateSpanSpec -> ResourceT m ()
updateSpan MutableSpan
mutableSpan UpdateSpanSpec
updateSpanSpec = do
    ((forall a. ResourceT m a -> IO a) -> IO ()) -> ResourceT m ()
forall b.
((forall a. ResourceT m a -> IO a) -> IO b) -> ResourceT m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. ResourceT m a -> IO a
runInIO -> do
      ResourceT m () -> IO ()
forall a. ResourceT m a -> IO a
runInIO (ResourceT m () -> IO ()) -> ResourceT m () -> IO ()
forall a b. (a -> b) -> a -> b
$ MutableSpan -> UpdateSpanSpec -> ResourceT m ()
forall (m :: * -> *).
MonadTracing m =>
MutableSpan -> UpdateSpanSpec -> m ()
updateSpan MutableSpan
mutableSpan UpdateSpanSpec
updateSpanSpec

class (MonadTracing m, MonadIO m) => MonadTracingIO m where
  askTracerIO :: m Tracer

  default askTracerIO
    :: (MonadTrans t, MonadTracingIO n, m ~ t n)
    => m Tracer
  askTracerIO = n Tracer -> t n Tracer
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Tracer
forall (m :: * -> *). MonadTracingIO m => m Tracer
askTracerIO

instance (MonadTracingIO m) => MonadTracingIO (ExceptT e m)
instance (MonadTracingIO m) => MonadTracingIO (IdentityT m)
instance (MonadTracingIO m) => MonadTracingIO (MaybeT m)
instance (MonadTracingIO m) => MonadTracingIO (ReaderT r m)
instance (MonadTracingIO m) => MonadTracingIO (State.Lazy.StateT r m)
instance (MonadTracingIO m) => MonadTracingIO (State.Strict.StateT r m)
instance (MonadTracingIO m, Monoid w) => MonadTracingIO (RWS.Lazy.RWST r w s m)
instance (MonadTracingIO m, Monoid w) => MonadTracingIO (RWS.Strict.RWST r w s m)
instance (MonadTracingIO m, Monoid w) => MonadTracingIO (Writer.Lazy.WriterT w m)
instance (MonadTracingIO m, Monoid w) => MonadTracingIO (Writer.Strict.WriterT w m)
instance (MonadTracingIO m) => MonadTracingIO (LoggingT m)
instance (MonadTracingIO m, MonadUnliftIO m) => MonadTracingIO (ResourceT m) where
  askTracerIO :: ResourceT m Tracer
askTracerIO = do
    ((forall a. ResourceT m a -> IO a) -> IO Tracer)
-> ResourceT m Tracer
forall b.
((forall a. ResourceT m a -> IO a) -> IO b) -> ResourceT m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. ResourceT m a -> IO a
runInIO -> do
      ResourceT m Tracer -> IO Tracer
forall a. ResourceT m a -> IO a
runInIO ResourceT m Tracer
forall (m :: * -> *). MonadTracingIO m => m Tracer
askTracerIO

data TracerProvider = TracerProvider
  { TracerProvider -> InstrumentationScope -> IO Tracer
tracerProviderGetTracer :: InstrumentationScope -> IO Tracer
  , TracerProvider -> IO ()
tracerProviderShutdown :: IO ()
  , TracerProvider -> IO ()
tracerProviderForceFlush :: IO ()
  }

data Tracer = Tracer
  { Tracer -> InstrumentationScope
tracerInstrumentationScope :: InstrumentationScope
  , Tracer -> IO Timestamp
tracerNow :: IO Timestamp
  , Tracer
-> CallStack -> Context -> SpanSpec -> IO (MutableSpan, [Pair])
tracerStartSpan :: CallStack -> Context -> SpanSpec -> IO (MutableSpan, [Pair])
  , Tracer -> Span Attrs -> IO ()
tracerProcessSpan :: Span Attrs -> IO ()
  , Tracer -> AttrsLimits 'AttrsForSpan
tracerSpanAttrsLimits :: AttrsLimits 'AttrsForSpan
  , Tracer -> AttrsLimits 'AttrsForSpanEvent
tracerSpanEventAttrsLimits :: AttrsLimits 'AttrsForSpanEvent
  , Tracer -> AttrsLimits 'AttrsForSpanLink
tracerSpanLinkAttrsLimits :: AttrsLimits 'AttrsForSpanLink
  }

contextBackendSpan :: ContextBackend MutableSpan
contextBackendSpan :: ContextBackend MutableSpan
contextBackendSpan = IO (ContextBackend MutableSpan) -> ContextBackend MutableSpan
forall a. IO a -> a
unsafePerformIO (IO (ContextBackend MutableSpan) -> ContextBackend MutableSpan)
-> IO (ContextBackend MutableSpan) -> ContextBackend MutableSpan
forall a b. (a -> b) -> a -> b
$ IO (ContextBackend MutableSpan) -> IO (ContextBackend MutableSpan)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (ContextBackend MutableSpan)
forall (m :: * -> *) a.
(MonadIO m, Typeable a) =>
m (ContextBackend a)
unsafeNewContextBackend
{-# NOINLINE contextBackendSpan #-}

contextKeySpan :: ContextKey MutableSpan
contextKeySpan :: ContextKey MutableSpan
contextKeySpan = ContextBackend MutableSpan -> ContextKey MutableSpan
forall a. ContextBackend a -> ContextKey a
contextBackendValueKey ContextBackend MutableSpan
contextBackendSpan

data SpanContext = SpanContext
  { SpanContext -> TraceId
spanContextTraceId :: TraceId
  , SpanContext -> SpanId
spanContextSpanId :: SpanId
  , SpanContext -> TraceFlags
spanContextTraceFlags :: TraceFlags
  , SpanContext -> TraceState
spanContextTraceState :: TraceState
  , SpanContext -> Bool
spanContextIsRemote :: Bool
  } deriving stock (SpanContext -> SpanContext -> Bool
(SpanContext -> SpanContext -> Bool)
-> (SpanContext -> SpanContext -> Bool) -> Eq SpanContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanContext -> SpanContext -> Bool
== :: SpanContext -> SpanContext -> Bool
$c/= :: SpanContext -> SpanContext -> Bool
/= :: SpanContext -> SpanContext -> Bool
Eq, Int -> SpanContext -> ShowS
[SpanContext] -> ShowS
SpanContext -> String
(Int -> SpanContext -> ShowS)
-> (SpanContext -> String)
-> ([SpanContext] -> ShowS)
-> Show SpanContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanContext -> ShowS
showsPrec :: Int -> SpanContext -> ShowS
$cshow :: SpanContext -> String
show :: SpanContext -> String
$cshowList :: [SpanContext] -> ShowS
showList :: [SpanContext] -> ShowS
Show)

instance ToJSON SpanContext where
  toJSON :: SpanContext -> Value
toJSON SpanContext
spanContext =
    [Pair] -> Value
Aeson.object
      [ Key
"traceId" Key -> TraceId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TraceId
spanContextTraceId
      , Key
"spanId" Key -> SpanId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanId
spanContextSpanId
      , Key
"traceFlags" Key -> TraceFlags -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TraceFlags
spanContextTraceFlags
      , Key
"traceState" Key -> TraceState -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TraceState
spanContextTraceState
      , Key
"isRemote" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
spanContextIsRemote
      ]
    where
    SpanContext
      { TraceId
spanContextTraceId :: SpanContext -> TraceId
spanContextTraceId :: TraceId
spanContextTraceId
      , SpanId
spanContextSpanId :: SpanContext -> SpanId
spanContextSpanId :: SpanId
spanContextSpanId
      , TraceFlags
spanContextTraceFlags :: SpanContext -> TraceFlags
spanContextTraceFlags :: TraceFlags
spanContextTraceFlags
      , TraceState
spanContextTraceState :: SpanContext -> TraceState
spanContextTraceState :: TraceState
spanContextTraceState
      , Bool
spanContextIsRemote :: SpanContext -> Bool
spanContextIsRemote :: Bool
spanContextIsRemote
      } = SpanContext
spanContext

emptySpanContext :: SpanContext
emptySpanContext :: SpanContext
emptySpanContext =
  SpanContext
    { spanContextTraceId :: TraceId
spanContextTraceId = TraceId
emptyTraceId
    , spanContextSpanId :: SpanId
spanContextSpanId = SpanId
emptySpanId
    , spanContextTraceFlags :: TraceFlags
spanContextTraceFlags = TraceFlags
forall a. Monoid a => a
mempty
    , spanContextTraceState :: TraceState
spanContextTraceState = TraceState
emptyTraceState
    , spanContextIsRemote :: Bool
spanContextIsRemote = Bool
False
    }

spanContextIsValid :: SpanContext -> Bool
spanContextIsValid :: SpanContext -> Bool
spanContextIsValid SpanContext
spanContext =
  TraceId
spanContextTraceId TraceId -> TraceId -> Bool
forall a. Eq a => a -> a -> Bool
/= TraceId
emptyTraceId Bool -> Bool -> Bool
&& SpanId
spanContextSpanId SpanId -> SpanId -> Bool
forall a. Eq a => a -> a -> Bool
/= SpanId
emptySpanId
  where
  SpanContext { TraceId
spanContextTraceId :: SpanContext -> TraceId
spanContextTraceId :: TraceId
spanContextTraceId, SpanId
spanContextSpanId :: SpanContext -> SpanId
spanContextSpanId :: SpanId
spanContextSpanId } = SpanContext
spanContext

spanContextIsSampled :: SpanContext -> Bool
spanContextIsSampled :: SpanContext -> Bool
spanContextIsSampled SpanContext
spanContext = TraceFlags -> Bool
isSampledFlagSet TraceFlags
spanContextTraceFlags
  where
  SpanContext { TraceFlags
spanContextTraceFlags :: SpanContext -> TraceFlags
spanContextTraceFlags :: TraceFlags
spanContextTraceFlags } = SpanContext
spanContext

data TraceId = TraceId
  { TraceId -> Word64
traceIdHi :: Word64
  , TraceId -> Word64
traceIdLo :: Word64
  } deriving stock (TraceId -> TraceId -> Bool
(TraceId -> TraceId -> Bool)
-> (TraceId -> TraceId -> Bool) -> Eq TraceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TraceId -> TraceId -> Bool
== :: TraceId -> TraceId -> Bool
$c/= :: TraceId -> TraceId -> Bool
/= :: TraceId -> TraceId -> Bool
Eq)

instance Show TraceId where
  show :: TraceId -> String
show = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (TraceId -> Text) -> TraceId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceId -> Text
traceIdToHexText

instance ToJSON TraceId where
  toJSON :: TraceId -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (TraceId -> Text) -> TraceId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceId -> Text
traceIdToHexText

traceIdToHexText :: TraceId -> Text
traceIdToHexText :: TraceId -> Text
traceIdToHexText TraceId
traceId =
  ByteString -> Text
Text.Encoding.decodeUtf8
    (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
ByteString.toStrict
    (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString
    (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ TraceId -> Builder
traceIdToHexBuilder TraceId
traceId

traceIdToBytesVector :: TraceId -> Unboxed.Vector Word8
traceIdToBytesVector :: TraceId -> Vector Word8
traceIdToBytesVector TraceId
traceId =
  [Word8] -> Vector Word8
forall a. Unbox a => [a] -> Vector a
Unboxed.fromList
    ([Word8] -> Vector Word8) -> [Word8] -> Vector Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
ByteString.Lazy.unpack
    (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString
    (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ TraceId -> Builder
traceIdToBytesBuilder TraceId
traceId

traceIdToHexBuilder :: TraceId -> Builder
traceIdToHexBuilder :: TraceId -> Builder
traceIdToHexBuilder TraceId
traceId =
  Word64 -> Builder
Builder.word64HexFixed Word64
traceIdHi Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
Builder.word64HexFixed Word64
traceIdLo
  where
  TraceId { Word64
traceIdHi :: TraceId -> Word64
traceIdHi :: Word64
traceIdHi, Word64
traceIdLo :: TraceId -> Word64
traceIdLo :: Word64
traceIdLo } = TraceId
traceId

traceIdToBytesBuilder :: TraceId -> Builder
traceIdToBytesBuilder :: TraceId -> Builder
traceIdToBytesBuilder TraceId
traceId =
  Word64 -> Builder
Builder.word64BE Word64
traceIdHi Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
Builder.word64BE Word64
traceIdLo
  where
  TraceId { Word64
traceIdHi :: TraceId -> Word64
traceIdHi :: Word64
traceIdHi, Word64
traceIdLo :: TraceId -> Word64
traceIdLo :: Word64
traceIdLo } = TraceId
traceId

emptyTraceId :: TraceId
emptyTraceId :: TraceId
emptyTraceId = TraceId { traceIdHi :: Word64
traceIdHi = Word64
0, traceIdLo :: Word64
traceIdLo = Word64
0 }

traceIdFromWords :: Word64 -> Word64 -> TraceId
traceIdFromWords :: Word64 -> Word64 -> TraceId
traceIdFromWords = Word64 -> Word64 -> TraceId
TraceId

newtype SpanId = SpanId
  { SpanId -> Word64
spanIdLo :: Word64
  } deriving stock (SpanId -> SpanId -> Bool
(SpanId -> SpanId -> Bool)
-> (SpanId -> SpanId -> Bool) -> Eq SpanId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanId -> SpanId -> Bool
== :: SpanId -> SpanId -> Bool
$c/= :: SpanId -> SpanId -> Bool
/= :: SpanId -> SpanId -> Bool
Eq)

instance Show SpanId where
  show :: SpanId -> String
show = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (SpanId -> Text) -> SpanId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanId -> Text
spanIdToHexText

instance ToJSON SpanId where
  toJSON :: SpanId -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (SpanId -> Text) -> SpanId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanId -> Text
spanIdToHexText

spanIdToHexText :: SpanId -> Text
spanIdToHexText :: SpanId -> Text
spanIdToHexText SpanId
spanId =
  ByteString -> Text
Text.Encoding.decodeUtf8
    (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
ByteString.toStrict
    (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString
    (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ SpanId -> Builder
spanIdToHexBuilder SpanId
spanId

spanIdToBytesVector :: SpanId -> Unboxed.Vector Word8
spanIdToBytesVector :: SpanId -> Vector Word8
spanIdToBytesVector SpanId
spanId =
  [Word8] -> Vector Word8
forall a. Unbox a => [a] -> Vector a
Unboxed.fromList
    ([Word8] -> Vector Word8) -> [Word8] -> Vector Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
ByteString.Lazy.unpack
    (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString
    (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ SpanId -> Builder
spanIdToBytesBuilder SpanId
spanId

spanIdToHexBuilder :: SpanId -> Builder
spanIdToHexBuilder :: SpanId -> Builder
spanIdToHexBuilder SpanId
spanId =
  Word64 -> Builder
Builder.word64HexFixed Word64
spanIdLo
  where
  SpanId { Word64
spanIdLo :: SpanId -> Word64
spanIdLo :: Word64
spanIdLo } = SpanId
spanId

spanIdToBytesBuilder :: SpanId -> Builder
spanIdToBytesBuilder :: SpanId -> Builder
spanIdToBytesBuilder SpanId
spanId =
  Word64 -> Builder
Builder.word64BE Word64
spanIdLo
  where
  SpanId { Word64
spanIdLo :: SpanId -> Word64
spanIdLo :: Word64
spanIdLo } = SpanId
spanId

emptySpanId :: SpanId
emptySpanId :: SpanId
emptySpanId = SpanId { spanIdLo :: Word64
spanIdLo = Word64
0 }

spanIdFromWords :: Word64 -> SpanId
spanIdFromWords :: Word64 -> SpanId
spanIdFromWords = Word64 -> SpanId
SpanId

newtype TraceFlags = TraceFlags
  { TraceFlags -> Word8
unTraceFlags :: Word8
  } deriving stock (TraceFlags -> TraceFlags -> Bool
(TraceFlags -> TraceFlags -> Bool)
-> (TraceFlags -> TraceFlags -> Bool) -> Eq TraceFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TraceFlags -> TraceFlags -> Bool
== :: TraceFlags -> TraceFlags -> Bool
$c/= :: TraceFlags -> TraceFlags -> Bool
/= :: TraceFlags -> TraceFlags -> Bool
Eq, Int -> TraceFlags -> ShowS
[TraceFlags] -> ShowS
TraceFlags -> String
(Int -> TraceFlags -> ShowS)
-> (TraceFlags -> String)
-> ([TraceFlags] -> ShowS)
-> Show TraceFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceFlags -> ShowS
showsPrec :: Int -> TraceFlags -> ShowS
$cshow :: TraceFlags -> String
show :: TraceFlags -> String
$cshowList :: [TraceFlags] -> ShowS
showList :: [TraceFlags] -> ShowS
Show)
    deriving (NonEmpty TraceFlags -> TraceFlags
TraceFlags -> TraceFlags -> TraceFlags
(TraceFlags -> TraceFlags -> TraceFlags)
-> (NonEmpty TraceFlags -> TraceFlags)
-> (forall b. Integral b => b -> TraceFlags -> TraceFlags)
-> Semigroup TraceFlags
forall b. Integral b => b -> TraceFlags -> TraceFlags
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: TraceFlags -> TraceFlags -> TraceFlags
<> :: TraceFlags -> TraceFlags -> TraceFlags
$csconcat :: NonEmpty TraceFlags -> TraceFlags
sconcat :: NonEmpty TraceFlags -> TraceFlags
$cstimes :: forall b. Integral b => b -> TraceFlags -> TraceFlags
stimes :: forall b. Integral b => b -> TraceFlags -> TraceFlags
Semigroup, Semigroup TraceFlags
TraceFlags
Semigroup TraceFlags =>
TraceFlags
-> (TraceFlags -> TraceFlags -> TraceFlags)
-> ([TraceFlags] -> TraceFlags)
-> Monoid TraceFlags
[TraceFlags] -> TraceFlags
TraceFlags -> TraceFlags -> TraceFlags
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: TraceFlags
mempty :: TraceFlags
$cmappend :: TraceFlags -> TraceFlags -> TraceFlags
mappend :: TraceFlags -> TraceFlags -> TraceFlags
$cmconcat :: [TraceFlags] -> TraceFlags
mconcat :: [TraceFlags] -> TraceFlags
Monoid) via (Ior Word8)

instance ToJSON TraceFlags where
  toJSON :: TraceFlags -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (TraceFlags -> Text) -> TraceFlags -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceFlags -> Text
traceFlagsToHexText

traceFlagsToHexText :: TraceFlags -> Text
traceFlagsToHexText :: TraceFlags -> Text
traceFlagsToHexText TraceFlags
traceFlags =
  ByteString -> Text
Text.Encoding.decodeUtf8
    (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
ByteString.toStrict
    (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString
    (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ TraceFlags -> Builder
traceFlagsToHexBuilder TraceFlags
traceFlags

traceFlagsToHexBuilder :: TraceFlags -> Builder
traceFlagsToHexBuilder :: TraceFlags -> Builder
traceFlagsToHexBuilder TraceFlags
traceFlags =
  Word8 -> Builder
Builder.word8HexFixed (Word8 -> Builder) -> Word8 -> Builder
forall a b. (a -> b) -> a -> b
$ TraceFlags -> Word8
unTraceFlags TraceFlags
traceFlags

traceFlagsSampled :: TraceFlags
traceFlagsSampled :: TraceFlags
traceFlagsSampled = TraceFlags { unTraceFlags :: Word8
unTraceFlags = Word8
1 }

isSampledFlagSet :: TraceFlags -> Bool
isSampledFlagSet :: TraceFlags -> Bool
isSampledFlagSet TraceFlags
traceFlags =
  TraceFlags -> Word8
unTraceFlags TraceFlags
traceFlags Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
0

newtype TraceState = TraceState
  { TraceState -> HashMap Text Text
unTraceState :: HashMap Text Text
  } deriving stock (TraceState -> TraceState -> Bool
(TraceState -> TraceState -> Bool)
-> (TraceState -> TraceState -> Bool) -> Eq TraceState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TraceState -> TraceState -> Bool
== :: TraceState -> TraceState -> Bool
$c/= :: TraceState -> TraceState -> Bool
/= :: TraceState -> TraceState -> Bool
Eq, Int -> TraceState -> ShowS
[TraceState] -> ShowS
TraceState -> String
(Int -> TraceState -> ShowS)
-> (TraceState -> String)
-> ([TraceState] -> ShowS)
-> Show TraceState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceState -> ShowS
showsPrec :: Int -> TraceState -> ShowS
$cshow :: TraceState -> String
show :: TraceState -> String
$cshowList :: [TraceState] -> ShowS
showList :: [TraceState] -> ShowS
Show)
    deriving ([TraceState] -> Value
[TraceState] -> Encoding
TraceState -> Bool
TraceState -> Value
TraceState -> Encoding
(TraceState -> Value)
-> (TraceState -> Encoding)
-> ([TraceState] -> Value)
-> ([TraceState] -> Encoding)
-> (TraceState -> Bool)
-> ToJSON TraceState
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TraceState -> Value
toJSON :: TraceState -> Value
$ctoEncoding :: TraceState -> Encoding
toEncoding :: TraceState -> Encoding
$ctoJSONList :: [TraceState] -> Value
toJSONList :: [TraceState] -> Value
$ctoEncodingList :: [TraceState] -> Encoding
toEncodingList :: [TraceState] -> Encoding
$comitField :: TraceState -> Bool
omitField :: TraceState -> Bool
ToJSON) via (HashMap Text Text)

emptyTraceState :: TraceState
emptyTraceState :: TraceState
emptyTraceState = TraceState { unTraceState :: HashMap Text Text
unTraceState = HashMap Text Text
forall a. Monoid a => a
mempty }

nullTraceState :: TraceState -> Bool
nullTraceState :: TraceState -> Bool
nullTraceState = HashMap Text Text -> Bool
forall k v. HashMap k v -> Bool
HashMap.null (HashMap Text Text -> Bool)
-> (TraceState -> HashMap Text Text) -> TraceState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceState -> HashMap Text Text
unTraceState

sizeTraceState :: TraceState -> Int
sizeTraceState :: TraceState -> Int
sizeTraceState = HashMap Text Text -> Int
forall k v. HashMap k v -> Int
HashMap.size (HashMap Text Text -> Int)
-> (TraceState -> HashMap Text Text) -> TraceState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceState -> HashMap Text Text
unTraceState

memberTraceState :: Key Text -> TraceState -> Bool
memberTraceState :: Key Text -> TraceState -> Bool
memberTraceState Key Text
key = Text -> HashMap Text Text -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member (Key Text -> Text
forall a. Key a -> Text
unKey Key Text
key) (HashMap Text Text -> Bool)
-> (TraceState -> HashMap Text Text) -> TraceState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceState -> HashMap Text Text
unTraceState

lookupTraceState :: Key Text -> TraceState -> Maybe Text
lookupTraceState :: Key Text -> TraceState -> Maybe Text
lookupTraceState Key Text
key = Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Key Text -> Text
forall a. Key a -> Text
unKey Key Text
key) (HashMap Text Text -> Maybe Text)
-> (TraceState -> HashMap Text Text) -> TraceState -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceState -> HashMap Text Text
unTraceState

findWithDefaultTraceState :: Text -> Key Text -> TraceState -> Text
findWithDefaultTraceState :: Text -> Key Text -> TraceState -> Text
findWithDefaultTraceState Text
defVal Key Text
key =
  Text -> Text -> HashMap Text Text -> Text
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.findWithDefault Text
defVal (Key Text -> Text
forall a. Key a -> Text
unKey Key Text
key) (HashMap Text Text -> Text)
-> (TraceState -> HashMap Text Text) -> TraceState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceState -> HashMap Text Text
unTraceState

deleteTraceState :: Key Text -> TraceState -> TraceState
deleteTraceState :: Key Text -> TraceState -> TraceState
deleteTraceState Key Text
key = HashMap Text Text -> TraceState
TraceState (HashMap Text Text -> TraceState)
-> (TraceState -> HashMap Text Text) -> TraceState -> TraceState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HashMap Text Text -> HashMap Text Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete (Key Text -> Text
forall a. Key a -> Text
unKey Key Text
key) (HashMap Text Text -> HashMap Text Text)
-> (TraceState -> HashMap Text Text)
-> TraceState
-> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceState -> HashMap Text Text
unTraceState

filterTraceState :: (Text -> Bool) -> TraceState -> TraceState
filterTraceState :: (Text -> Bool) -> TraceState -> TraceState
filterTraceState Text -> Bool
f = HashMap Text Text -> TraceState
TraceState (HashMap Text Text -> TraceState)
-> (TraceState -> HashMap Text Text) -> TraceState -> TraceState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> HashMap Text Text -> HashMap Text Text
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter Text -> Bool
f (HashMap Text Text -> HashMap Text Text)
-> (TraceState -> HashMap Text Text)
-> TraceState
-> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceState -> HashMap Text Text
unTraceState

filterWithKeyTraceState :: (Key Text -> Text -> Bool) -> TraceState -> TraceState
filterWithKeyTraceState :: (Key Text -> Text -> Bool) -> TraceState -> TraceState
filterWithKeyTraceState Key Text -> Text -> Bool
f = HashMap Text Text -> TraceState
TraceState (HashMap Text Text -> TraceState)
-> (TraceState -> HashMap Text Text) -> TraceState -> TraceState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Bool) -> HashMap Text Text -> HashMap Text Text
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey Text -> Text -> Bool
f' (HashMap Text Text -> HashMap Text Text)
-> (TraceState -> HashMap Text Text)
-> TraceState
-> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceState -> HashMap Text Text
unTraceState
  where
  f' :: Text -> Text -> Bool
f' Text
keyText Text
val = Key Text -> Text -> Bool
f (Text -> Key Text
forall a. Text -> Key a
Key Text
keyText) Text
val

foldMapWithKeyTraceState
  :: forall m
   . (Monoid m)
  => (Key Text -> Text -> m)
  -> TraceState
  -> m
foldMapWithKeyTraceState :: forall m. Monoid m => (Key Text -> Text -> m) -> TraceState -> m
foldMapWithKeyTraceState Key Text -> Text -> m
f TraceState
traceState =
  ((Text -> Text -> m) -> HashMap Text Text -> m)
-> HashMap Text Text -> (Text -> Text -> m) -> m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Text -> m) -> HashMap Text Text -> m
forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
HashMap.foldMapWithKey (TraceState -> HashMap Text Text
unTraceState TraceState
traceState) \Text
keyText Text
val ->
    Key Text -> Text -> m
f (Text -> Key Text
forall a. Text -> Key a
Key Text
keyText) Text
val

toListTraceState :: TraceState -> [(Key Text, Text)]
toListTraceState :: TraceState -> [(Key Text, Text)]
toListTraceState TraceState
traceState = (Key Text -> Text -> [(Key Text, Text)] -> [(Key Text, Text)])
-> TraceState -> [(Key Text, Text)] -> [(Key Text, Text)]
forall m. Monoid m => (Key Text -> Text -> m) -> TraceState -> m
foldMapWithKeyTraceState (\Key Text
k Text
v -> ((Key Text
k, Text
v) (Key Text, Text) -> [(Key Text, Text)] -> [(Key Text, Text)]
forall a. a -> [a] -> [a]
:)) TraceState
traceState []

newtype TraceStateBuilder a = TraceStateBuilder
  { forall a. TraceStateBuilder a -> Either (DList TraceStateError) a
unTraceStateBuilder :: Either (DList TraceStateError) a
  } deriving
      ( (forall a b.
 (a -> b) -> TraceStateBuilder a -> TraceStateBuilder b)
-> (forall a b. a -> TraceStateBuilder b -> TraceStateBuilder a)
-> Functor TraceStateBuilder
forall a b. a -> TraceStateBuilder b -> TraceStateBuilder a
forall a b. (a -> b) -> TraceStateBuilder a -> TraceStateBuilder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TraceStateBuilder a -> TraceStateBuilder b
fmap :: forall a b. (a -> b) -> TraceStateBuilder a -> TraceStateBuilder b
$c<$ :: forall a b. a -> TraceStateBuilder b -> TraceStateBuilder a
<$ :: forall a b. a -> TraceStateBuilder b -> TraceStateBuilder a
Functor -- @base@
      ) via (Either (DList TraceStateError))
    deriving
      ( NonEmpty (TraceStateBuilder a) -> TraceStateBuilder a
TraceStateBuilder a -> TraceStateBuilder a -> TraceStateBuilder a
(TraceStateBuilder a -> TraceStateBuilder a -> TraceStateBuilder a)
-> (NonEmpty (TraceStateBuilder a) -> TraceStateBuilder a)
-> (forall b.
    Integral b =>
    b -> TraceStateBuilder a -> TraceStateBuilder a)
-> Semigroup (TraceStateBuilder a)
forall b.
Integral b =>
b -> TraceStateBuilder a -> TraceStateBuilder a
forall a.
Semigroup a =>
NonEmpty (TraceStateBuilder a) -> TraceStateBuilder a
forall a.
Semigroup a =>
TraceStateBuilder a -> TraceStateBuilder a -> TraceStateBuilder a
forall a b.
(Semigroup a, Integral b) =>
b -> TraceStateBuilder a -> TraceStateBuilder a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall a.
Semigroup a =>
TraceStateBuilder a -> TraceStateBuilder a -> TraceStateBuilder a
<> :: TraceStateBuilder a -> TraceStateBuilder a -> TraceStateBuilder a
$csconcat :: forall a.
Semigroup a =>
NonEmpty (TraceStateBuilder a) -> TraceStateBuilder a
sconcat :: NonEmpty (TraceStateBuilder a) -> TraceStateBuilder a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> TraceStateBuilder a -> TraceStateBuilder a
stimes :: forall b.
Integral b =>
b -> TraceStateBuilder a -> TraceStateBuilder a
Semigroup, Semigroup (TraceStateBuilder a)
TraceStateBuilder a
Semigroup (TraceStateBuilder a) =>
TraceStateBuilder a
-> (TraceStateBuilder a
    -> TraceStateBuilder a -> TraceStateBuilder a)
-> ([TraceStateBuilder a] -> TraceStateBuilder a)
-> Monoid (TraceStateBuilder a)
[TraceStateBuilder a] -> TraceStateBuilder a
TraceStateBuilder a -> TraceStateBuilder a -> TraceStateBuilder a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (TraceStateBuilder a)
forall a. Monoid a => TraceStateBuilder a
forall a. Monoid a => [TraceStateBuilder a] -> TraceStateBuilder a
forall a.
Monoid a =>
TraceStateBuilder a -> TraceStateBuilder a -> TraceStateBuilder a
$cmempty :: forall a. Monoid a => TraceStateBuilder a
mempty :: TraceStateBuilder a
$cmappend :: forall a.
Monoid a =>
TraceStateBuilder a -> TraceStateBuilder a -> TraceStateBuilder a
mappend :: TraceStateBuilder a -> TraceStateBuilder a -> TraceStateBuilder a
$cmconcat :: forall a. Monoid a => [TraceStateBuilder a] -> TraceStateBuilder a
mconcat :: [TraceStateBuilder a] -> TraceStateBuilder a
Monoid -- @base@
      ) via (Ap TraceStateBuilder a)

instance Applicative TraceStateBuilder where
  pure :: forall a. a -> TraceStateBuilder a
pure = Either (DList TraceStateError) a -> TraceStateBuilder a
forall a. Either (DList TraceStateError) a -> TraceStateBuilder a
TraceStateBuilder (Either (DList TraceStateError) a -> TraceStateBuilder a)
-> (a -> Either (DList TraceStateError) a)
-> a
-> TraceStateBuilder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (DList TraceStateError) a
forall a b. b -> Either a b
Right
  liftA2 :: forall a b c.
(a -> b -> c)
-> TraceStateBuilder a
-> TraceStateBuilder b
-> TraceStateBuilder c
liftA2 a -> b -> c
f (TraceStateBuilder Either (DList TraceStateError) a
mx) (TraceStateBuilder Either (DList TraceStateError) b
my) =
    Either (DList TraceStateError) c -> TraceStateBuilder c
forall a. Either (DList TraceStateError) a -> TraceStateBuilder a
TraceStateBuilder (Either (DList TraceStateError) c -> TraceStateBuilder c)
-> Either (DList TraceStateError) c -> TraceStateBuilder c
forall a b. (a -> b) -> a -> b
$ case (Either (DList TraceStateError) a
mx, Either (DList TraceStateError) b
my) of
      (Left DList TraceStateError
ex, Left DList TraceStateError
ey) -> DList TraceStateError -> Either (DList TraceStateError) c
forall a b. a -> Either a b
Left (DList TraceStateError -> Either (DList TraceStateError) c)
-> DList TraceStateError -> Either (DList TraceStateError) c
forall a b. (a -> b) -> a -> b
$ DList TraceStateError
ex DList TraceStateError
-> DList TraceStateError -> DList TraceStateError
forall a. Semigroup a => a -> a -> a
<> DList TraceStateError
ey
      (Left DList TraceStateError
ex, Right {}) -> DList TraceStateError -> Either (DList TraceStateError) c
forall a b. a -> Either a b
Left DList TraceStateError
ex
      (Right {}, Left DList TraceStateError
ey) -> DList TraceStateError -> Either (DList TraceStateError) c
forall a b. a -> Either a b
Left DList TraceStateError
ey
      (Right a
x, Right b
y) -> c -> Either (DList TraceStateError) c
forall a b. b -> Either a b
Right (c -> Either (DList TraceStateError) c)
-> c -> Either (DList TraceStateError) c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
x b
y

instance KV (TraceStateBuilder TraceState) where
  type KVConstraints (TraceStateBuilder TraceState) = IsTextKV
  .@ :: forall from to.
KVConstraints (TraceStateBuilder TraceState) from to =>
Key to -> from -> TraceStateBuilder TraceState
(.@) = Key to -> from -> TraceStateBuilder TraceState
Key Text -> Text -> TraceStateBuilder TraceState
go
    where
    go :: Key Text -> Text -> TraceStateBuilder TraceState
    go :: Key Text -> Text -> TraceStateBuilder TraceState
go (Key Text
keyText) Text
valText = do
      Text
traceStateKey <- (Key Text -> Text)
-> TraceStateBuilder (Key Text) -> TraceStateBuilder Text
forall a b. (a -> b) -> TraceStateBuilder a -> TraceStateBuilder b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Key Text -> Text
forall a. Key a -> Text
unKey TraceStateBuilder (Key Text)
parseKey
      Text
traceStateVal <- TraceStateBuilder Text
parseValue
      pure $ HashMap Text Text -> TraceState
TraceState (HashMap Text Text -> TraceState)
-> HashMap Text Text -> TraceState
forall a b. (a -> b) -> a -> b
$ Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
traceStateKey Text
traceStateVal
      where
      parseKey :: TraceStateBuilder (Key Text)
      parseKey :: TraceStateBuilder (Key Text)
parseKey =
        Either (DList TraceStateError) (Key Text)
-> TraceStateBuilder (Key Text)
forall a. Either (DList TraceStateError) a -> TraceStateBuilder a
TraceStateBuilder do
          case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"@" Text
keyText of
            [] -> String -> Either (DList TraceStateError) (Key Text)
forall a. HasCallStack => String -> a
error String
"TraceStateBuilder: parseKey - impossible!"
            [Text
simpleKeyText] -> do
              if Text -> Bool
Text.null Text
simpleKeyText then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateSimpleKeyIsEmptyError -> TraceStateError
TraceStateSimpleKeyIsEmpty TraceStateSimpleKeyIsEmptyError
                  { $sel:rawValue:TraceStateSimpleKeyIsEmptyError :: Text
rawValue = Text
valText
                  }
              else if Text -> Int
Text.length Text
simpleKeyText Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
256 then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateSimpleKeyTooLongError -> TraceStateError
TraceStateSimpleKeyTooLong TraceStateSimpleKeyTooLongError
                  { $sel:rawKey:TraceStateSimpleKeyTooLongError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
simpleKeyText
                  , $sel:rawValue:TraceStateSimpleKeyTooLongError :: Text
rawValue = Text
valText
                  }
              else if Bool -> Bool
not (Char -> Bool
isFirstSimpleKeyCharValid (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
Text.head Text
simpleKeyText) then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateSimpleKeyContainsInvalidCharsError -> TraceStateError
TraceStateSimpleKeyContainsInvalidChars TraceStateSimpleKeyContainsInvalidCharsError
                  { $sel:rawKey:TraceStateSimpleKeyContainsInvalidCharsError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
simpleKeyText
                  , $sel:rawValue:TraceStateSimpleKeyContainsInvalidCharsError :: Text
rawValue = Text
valText
                  , $sel:invalidChars:TraceStateSimpleKeyContainsInvalidCharsError :: Text
invalidChars = Char -> Text
Text.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
Text.head Text
simpleKeyText
                  }
              else if Bool -> Bool
not (Text -> Bool
Text.null Text
invalidChars) then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateSimpleKeyContainsInvalidCharsError -> TraceStateError
TraceStateSimpleKeyContainsInvalidChars TraceStateSimpleKeyContainsInvalidCharsError
                  { $sel:rawKey:TraceStateSimpleKeyContainsInvalidCharsError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
simpleKeyText
                  , $sel:rawValue:TraceStateSimpleKeyContainsInvalidCharsError :: Text
rawValue = Text
valText
                  , Text
$sel:invalidChars:TraceStateSimpleKeyContainsInvalidCharsError :: Text
invalidChars :: Text
invalidChars
                  }
              else do
                Key Text -> Either (DList TraceStateError) (Key Text)
forall a b. b -> Either a b
Right (Key Text -> Either (DList TraceStateError) (Key Text))
-> Key Text -> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
              where
              invalidChars :: Text
invalidChars = (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isValidKeyChar) Text
simpleKeyText
            [Text
tenantIdText, Text
systemIdText] -> do
              if Text -> Bool
Text.null Text
tenantIdText then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateTenantIdIsEmptyError -> TraceStateError
TraceStateTenantIdIsEmpty TraceStateTenantIdIsEmptyError
                  { $sel:rawSystemId:TraceStateTenantIdIsEmptyError :: Text
rawSystemId = Text
systemIdText
                  , $sel:rawValue:TraceStateTenantIdIsEmptyError :: Text
rawValue = Text
valText
                  }
              else if Text -> Int
Text.length Text
tenantIdText Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
241 then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateTenantIdTooLongError -> TraceStateError
TraceStateTenantIdTooLong TraceStateTenantIdTooLongError
                  { $sel:rawTenantId:TraceStateTenantIdTooLongError :: Text
rawTenantId = Text
tenantIdText
                  , $sel:rawSystemId:TraceStateTenantIdTooLongError :: Text
rawSystemId = Text
systemIdText
                  , $sel:rawValue:TraceStateTenantIdTooLongError :: Text
rawValue = Text
valText
                  }
              else if Bool -> Bool
not (Char -> Bool
isFirstTenantIdCharValid (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
Text.head Text
tenantIdText) then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateTenantIdContainsInvalidCharsError -> TraceStateError
TraceStateTenantIdContainsInvalidChars TraceStateTenantIdContainsInvalidCharsError
                  { $sel:rawTenantId:TraceStateTenantIdContainsInvalidCharsError :: Text
rawTenantId = Text
tenantIdText
                  , $sel:rawSystemId:TraceStateTenantIdContainsInvalidCharsError :: Text
rawSystemId = Text
systemIdText
                  , $sel:rawValue:TraceStateTenantIdContainsInvalidCharsError :: Text
rawValue = Text
valText
                  , $sel:invalidChars:TraceStateTenantIdContainsInvalidCharsError :: Text
invalidChars = Char -> Text
Text.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
Text.head Text
tenantIdText
                  }
              else if Bool -> Bool
not (Text -> Bool
Text.null Text
invalidTenantIdChars) then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateTenantIdContainsInvalidCharsError -> TraceStateError
TraceStateTenantIdContainsInvalidChars TraceStateTenantIdContainsInvalidCharsError
                  { $sel:rawTenantId:TraceStateTenantIdContainsInvalidCharsError :: Text
rawTenantId = Text
tenantIdText
                  , $sel:rawSystemId:TraceStateTenantIdContainsInvalidCharsError :: Text
rawSystemId = Text
systemIdText
                  , $sel:rawValue:TraceStateTenantIdContainsInvalidCharsError :: Text
rawValue = Text
valText
                  , $sel:invalidChars:TraceStateTenantIdContainsInvalidCharsError :: Text
invalidChars = Text
invalidTenantIdChars
                  }
              else if Text -> Bool
Text.null Text
systemIdText then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateSystemIdIsEmptyError -> TraceStateError
TraceStateSystemIdIsEmpty TraceStateSystemIdIsEmptyError
                  { $sel:rawSystemId:TraceStateSystemIdIsEmptyError :: Text
rawSystemId = Text
systemIdText
                  , $sel:rawValue:TraceStateSystemIdIsEmptyError :: Text
rawValue = Text
valText
                  }
              else if Text -> Int
Text.length Text
systemIdText Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
14 then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateSystemIdTooLongError -> TraceStateError
TraceStateSystemIdTooLong TraceStateSystemIdTooLongError
                  { $sel:rawTenantId:TraceStateSystemIdTooLongError :: Text
rawTenantId = Text
tenantIdText
                  , $sel:rawSystemId:TraceStateSystemIdTooLongError :: Text
rawSystemId = Text
systemIdText
                  , $sel:rawValue:TraceStateSystemIdTooLongError :: Text
rawValue = Text
valText
                  }
              else if Bool -> Bool
not (Char -> Bool
isFirstSystemIdCharValid (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
Text.head Text
systemIdText) then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateSystemIdContainsInvalidCharsError -> TraceStateError
TraceStateSystemIdContainsInvalidChars TraceStateSystemIdContainsInvalidCharsError
                  { $sel:rawTenantId:TraceStateSystemIdContainsInvalidCharsError :: Text
rawTenantId = Text
systemIdText
                  , $sel:rawSystemId:TraceStateSystemIdContainsInvalidCharsError :: Text
rawSystemId = Text
systemIdText
                  , $sel:rawValue:TraceStateSystemIdContainsInvalidCharsError :: Text
rawValue = Text
valText
                  , $sel:invalidChars:TraceStateSystemIdContainsInvalidCharsError :: Text
invalidChars = Char -> Text
Text.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
Text.head Text
systemIdText
                  }
              else if Bool -> Bool
not (Text -> Bool
Text.null Text
invalidSystemIdChars) then do
                DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateSystemIdContainsInvalidCharsError -> TraceStateError
TraceStateSystemIdContainsInvalidChars TraceStateSystemIdContainsInvalidCharsError
                  { $sel:rawTenantId:TraceStateSystemIdContainsInvalidCharsError :: Text
rawTenantId = Text
systemIdText
                  , $sel:rawSystemId:TraceStateSystemIdContainsInvalidCharsError :: Text
rawSystemId = Text
systemIdText
                  , $sel:rawValue:TraceStateSystemIdContainsInvalidCharsError :: Text
rawValue = Text
valText
                  , $sel:invalidChars:TraceStateSystemIdContainsInvalidCharsError :: Text
invalidChars = Text
invalidSystemIdChars
                  }
              else do
                Key Text -> Either (DList TraceStateError) (Key Text)
forall a b. b -> Either a b
Right (Key Text -> Either (DList TraceStateError) (Key Text))
-> Key Text -> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
              where
              invalidTenantIdChars :: Text
invalidTenantIdChars = (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isValidKeyChar) Text
tenantIdText
              invalidSystemIdChars :: Text
invalidSystemIdChars = (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isValidKeyChar) Text
systemIdText
            [Text]
_texts -> do
              DList TraceStateError -> Either (DList TraceStateError) (Key Text)
forall a b. a -> Either a b
Left (DList TraceStateError
 -> Either (DList TraceStateError) (Key Text))
-> DList TraceStateError
-> Either (DList TraceStateError) (Key Text)
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateKeyTypeUnknownError -> TraceStateError
TraceStateKeyTypeUnknown TraceStateKeyTypeUnknownError
                { $sel:rawKey:TraceStateKeyTypeUnknownError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
                , $sel:rawValue:TraceStateKeyTypeUnknownError :: Text
rawValue = Text
valText
                }

      parseValue :: TraceStateBuilder Text
      parseValue :: TraceStateBuilder Text
parseValue =
        Either (DList TraceStateError) Text -> TraceStateBuilder Text
forall a. Either (DList TraceStateError) a -> TraceStateBuilder a
TraceStateBuilder do
          if Text -> Bool
Text.null Text
valText then do
            DList TraceStateError -> Either (DList TraceStateError) Text
forall a b. a -> Either a b
Left (DList TraceStateError -> Either (DList TraceStateError) Text)
-> DList TraceStateError -> Either (DList TraceStateError) Text
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateValueIsEmptyError -> TraceStateError
TraceStateValueIsEmpty TraceStateValueIsEmptyError
              { $sel:rawKey:TraceStateValueIsEmptyError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
              }
          else if Text -> Int
Text.length Text
valText Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
256 then do
            DList TraceStateError -> Either (DList TraceStateError) Text
forall a b. a -> Either a b
Left (DList TraceStateError -> Either (DList TraceStateError) Text)
-> DList TraceStateError -> Either (DList TraceStateError) Text
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateValueTooLongError -> TraceStateError
TraceStateValueTooLong TraceStateValueTooLongError
              { $sel:rawKey:TraceStateValueTooLongError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
              , $sel:rawValue:TraceStateValueTooLongError :: Text
rawValue = Text
valText
              }
          else if Bool -> Bool
not (Char -> Bool
isLastValueCharValid (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
Text.last Text
valText) then do
            DList TraceStateError -> Either (DList TraceStateError) Text
forall a b. a -> Either a b
Left (DList TraceStateError -> Either (DList TraceStateError) Text)
-> DList TraceStateError -> Either (DList TraceStateError) Text
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateValueContainsInvalidCharsError -> TraceStateError
TraceStateValueContainsInvalidChars TraceStateValueContainsInvalidCharsError
              { $sel:rawKey:TraceStateValueContainsInvalidCharsError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
              , $sel:rawValue:TraceStateValueContainsInvalidCharsError :: Text
rawValue = Text
valText
              , $sel:invalidChars:TraceStateValueContainsInvalidCharsError :: Text
invalidChars = Char -> Text
Text.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
Text.last Text
valText
              }
          else if Bool -> Bool
not (Text -> Bool
Text.null Text
invalidChars) then do
            DList TraceStateError -> Either (DList TraceStateError) Text
forall a b. a -> Either a b
Left (DList TraceStateError -> Either (DList TraceStateError) Text)
-> DList TraceStateError -> Either (DList TraceStateError) Text
forall a b. (a -> b) -> a -> b
$ TraceStateError -> DList TraceStateError
forall a. a -> DList a
DList.singleton (TraceStateError -> DList TraceStateError)
-> TraceStateError -> DList TraceStateError
forall a b. (a -> b) -> a -> b
$ TraceStateValueContainsInvalidCharsError -> TraceStateError
TraceStateValueContainsInvalidChars TraceStateValueContainsInvalidCharsError
              { $sel:rawKey:TraceStateValueContainsInvalidCharsError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
              , $sel:rawValue:TraceStateValueContainsInvalidCharsError :: Text
rawValue = Text
valText
              , Text
$sel:invalidChars:TraceStateValueContainsInvalidCharsError :: Text
invalidChars :: Text
invalidChars
              }
          else do
            Text -> Either (DList TraceStateError) Text
forall a. a -> Either (DList TraceStateError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
valText
        where
        invalidChars :: Text
invalidChars = (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isValidValueChar) Text
valText

      isValidKeyChar :: Char -> Bool
      isValidKeyChar :: Char -> Bool
isValidKeyChar Char
c
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = Bool
True
        | Bool
otherwise = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x61 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7a
        where
        n :: Int
n = Char -> Int
Char.ord Char
c

      isFirstSimpleKeyCharValid :: Char -> Bool
      isFirstSimpleKeyCharValid :: Char -> Bool
isFirstSimpleKeyCharValid Char
c = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x61 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7a
        where
        n :: Int
n = Char -> Int
Char.ord Char
c

      isFirstTenantIdCharValid :: Char -> Bool
      isFirstTenantIdCharValid :: Char -> Bool
isFirstTenantIdCharValid Char
c = (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x61 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7a) Bool -> Bool -> Bool
|| Char -> Bool
Char.isDigit Char
c
        where
        n :: Int
n = Char -> Int
Char.ord Char
c

      isFirstSystemIdCharValid :: Char -> Bool
      isFirstSystemIdCharValid :: Char -> Bool
isFirstSystemIdCharValid Char
c = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x61 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7a
        where
        n :: Int
n = Char -> Int
Char.ord Char
c

      isValidValueChar :: Char -> Bool
      isValidValueChar :: Char -> Bool
isValidValueChar Char
c
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x20 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x2b = Bool
True
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x2d Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x3c = Bool
True
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x3e Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7e = Bool
True
        | Bool
otherwise = Bool
False
        where
        n :: Int
n = Char -> Int
Char.ord Char
c

      isLastValueCharValid :: Char -> Bool
      isLastValueCharValid :: Char -> Bool
isLastValueCharValid Char
c = Char -> Bool
isValidValueChar Char
c Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0x20
        where
        n :: Int
n = Char -> Int
Char.ord Char
c

buildTraceState
  :: forall m
   . (MonadThrow m)
  => TraceStateBuilder TraceState
  -> m TraceState
buildTraceState :: forall (m :: * -> *).
MonadThrow m =>
TraceStateBuilder TraceState -> m TraceState
buildTraceState TraceStateBuilder TraceState
builder =
  case TraceStateBuilder TraceState -> Either TraceStateErrors TraceState
buildTraceStatePure TraceStateBuilder TraceState
builder of
    Left TraceStateErrors
err -> TraceStateErrors -> m TraceState
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM TraceStateErrors
err
    Right TraceState
x -> TraceState -> m TraceState
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TraceState
x

buildTraceStatePure :: TraceStateBuilder TraceState -> Either TraceStateErrors TraceState
buildTraceStatePure :: TraceStateBuilder TraceState -> Either TraceStateErrors TraceState
buildTraceStatePure = (DList TraceStateError -> TraceStateErrors)
-> Either (DList TraceStateError) TraceState
-> Either TraceStateErrors TraceState
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([TraceStateError] -> TraceStateErrors
TraceStateErrors ([TraceStateError] -> TraceStateErrors)
-> (DList TraceStateError -> [TraceStateError])
-> DList TraceStateError
-> TraceStateErrors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList TraceStateError -> [TraceStateError]
forall a. DList a -> [a]
DList.toList) (Either (DList TraceStateError) TraceState
 -> Either TraceStateErrors TraceState)
-> (TraceStateBuilder TraceState
    -> Either (DList TraceStateError) TraceState)
-> TraceStateBuilder TraceState
-> Either TraceStateErrors TraceState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceStateBuilder TraceState
-> Either (DList TraceStateError) TraceState
forall a. TraceStateBuilder a -> Either (DList TraceStateError) a
unTraceStateBuilder

newtype SpanEvents (attrs :: AttrsFor -> Type) = SpanEvents
  { forall (attrs :: AttrsFor -> *).
SpanEvents attrs -> DList (SpanEvent attrs)
unSpanEvents :: DList (SpanEvent attrs)
  }

instance ToJSON (SpanEvents Attrs) where
  toJSON :: SpanEvents Attrs -> Value
toJSON = DList (SpanEvent Attrs) -> Value
forall a. ToJSON a => a -> Value
toJSON (DList (SpanEvent Attrs) -> Value)
-> (SpanEvents Attrs -> DList (SpanEvent Attrs))
-> SpanEvents Attrs
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanEvents Attrs -> DList (SpanEvent Attrs)
forall (attrs :: AttrsFor -> *).
SpanEvents attrs -> DList (SpanEvent attrs)
unSpanEvents

deriving stock instance (Eq (attrs 'AttrsForSpanEvent)) => Eq (SpanEvents attrs)
deriving stock instance (Show (attrs 'AttrsForSpanEvent)) => Show (SpanEvents attrs)
deriving via (DList (SpanEvent attrs)) instance Monoid (SpanEvents attrs)
deriving via (DList (SpanEvent attrs)) instance Semigroup (SpanEvents attrs)

spanEventsFromList :: [SpanEvent attrs] -> SpanEvents attrs
spanEventsFromList :: forall (attrs :: AttrsFor -> *).
[SpanEvent attrs] -> SpanEvents attrs
spanEventsFromList = DList (SpanEvent attrs) -> SpanEvents attrs
forall (attrs :: AttrsFor -> *).
DList (SpanEvent attrs) -> SpanEvents attrs
SpanEvents (DList (SpanEvent attrs) -> SpanEvents attrs)
-> ([SpanEvent attrs] -> DList (SpanEvent attrs))
-> [SpanEvent attrs]
-> SpanEvents attrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SpanEvent attrs] -> DList (SpanEvent attrs)
forall a. [a] -> DList a
DList.fromList

spanEventsToList :: SpanEvents attrs -> [SpanEvent attrs]
spanEventsToList :: forall (attrs :: AttrsFor -> *).
SpanEvents attrs -> [SpanEvent attrs]
spanEventsToList = DList (SpanEvent attrs) -> [SpanEvent attrs]
forall a. DList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (DList (SpanEvent attrs) -> [SpanEvent attrs])
-> (SpanEvents attrs -> DList (SpanEvent attrs))
-> SpanEvents attrs
-> [SpanEvent attrs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanEvents attrs -> DList (SpanEvent attrs)
forall (attrs :: AttrsFor -> *).
SpanEvents attrs -> DList (SpanEvent attrs)
unSpanEvents

freezeAllSpanEventAttrs
  :: AttrsLimits 'AttrsForSpanEvent
  -> SpanEvents AttrsBuilder
  -> SpanEvents Attrs
freezeAllSpanEventAttrs :: AttrsLimits 'AttrsForSpanEvent
-> SpanEvents AttrsBuilder -> SpanEvents Attrs
freezeAllSpanEventAttrs AttrsLimits 'AttrsForSpanEvent
attrsLimits SpanEvents AttrsBuilder
spanEvent =
  DList (SpanEvent Attrs) -> SpanEvents Attrs
forall (attrs :: AttrsFor -> *).
DList (SpanEvent attrs) -> SpanEvents attrs
SpanEvents
    (DList (SpanEvent Attrs) -> SpanEvents Attrs)
-> DList (SpanEvent Attrs) -> SpanEvents Attrs
forall a b. (a -> b) -> a -> b
$ (SpanEvent AttrsBuilder -> SpanEvent Attrs)
-> DList (SpanEvent AttrsBuilder) -> DList (SpanEvent Attrs)
forall a b. (a -> b) -> DList a -> DList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AttrsLimits 'AttrsForSpanEvent
-> SpanEvent AttrsBuilder -> SpanEvent Attrs
freezeSpanEventAttrs AttrsLimits 'AttrsForSpanEvent
attrsLimits)
    (DList (SpanEvent AttrsBuilder) -> DList (SpanEvent Attrs))
-> DList (SpanEvent AttrsBuilder) -> DList (SpanEvent Attrs)
forall a b. (a -> b) -> a -> b
$ SpanEvents AttrsBuilder -> DList (SpanEvent AttrsBuilder)
forall (attrs :: AttrsFor -> *).
SpanEvents attrs -> DList (SpanEvent attrs)
unSpanEvents SpanEvents AttrsBuilder
spanEvent

data SpanEvent (attrs :: AttrsFor -> Type) = SpanEvent
  { forall (attrs :: AttrsFor -> *). SpanEvent attrs -> SpanEventName
spanEventName :: SpanEventName
  , forall (attrs :: AttrsFor -> *). SpanEvent attrs -> Timestamp
spanEventTimestamp :: Timestamp
  , forall (attrs :: AttrsFor -> *).
SpanEvent attrs -> attrs 'AttrsForSpanEvent
spanEventAttrs :: attrs 'AttrsForSpanEvent
  }

instance ToJSON (SpanEvent Attrs) where
  toJSON :: SpanEvent Attrs -> Value
toJSON SpanEvent Attrs
spanEvent =
    [Pair] -> Value
Aeson.object
      [ Key
"name" Key -> SpanEventName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanEventName
spanEventName
      , Key
"timestamp" Key -> Timestamp -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Timestamp
spanEventTimestamp
      , Key
"attributes" Key -> Attrs 'AttrsForSpanEvent -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Attrs 'AttrsForSpanEvent
spanEventAttrs
      ]
    where
    SpanEvent
      { SpanEventName
spanEventName :: forall (attrs :: AttrsFor -> *). SpanEvent attrs -> SpanEventName
spanEventName :: SpanEventName
spanEventName
      , Timestamp
spanEventTimestamp :: forall (attrs :: AttrsFor -> *). SpanEvent attrs -> Timestamp
spanEventTimestamp :: Timestamp
spanEventTimestamp
      , Attrs 'AttrsForSpanEvent
spanEventAttrs :: forall (attrs :: AttrsFor -> *).
SpanEvent attrs -> attrs 'AttrsForSpanEvent
spanEventAttrs :: Attrs 'AttrsForSpanEvent
spanEventAttrs
      } = SpanEvent Attrs
spanEvent

deriving stock instance (Eq (attrs 'AttrsForSpanEvent)) => Eq (SpanEvent attrs)
deriving stock instance (Show (attrs 'AttrsForSpanEvent)) => Show (SpanEvent attrs)

freezeSpanEventAttrs
  :: AttrsLimits 'AttrsForSpanEvent
  -> SpanEvent AttrsBuilder
  -> SpanEvent Attrs
freezeSpanEventAttrs :: AttrsLimits 'AttrsForSpanEvent
-> SpanEvent AttrsBuilder -> SpanEvent Attrs
freezeSpanEventAttrs AttrsLimits 'AttrsForSpanEvent
attrsLimits SpanEvent AttrsBuilder
spanEvent =
  SpanEvent AttrsBuilder
spanEvent
    { spanEventAttrs = runAttrsBuilder (spanEventAttrs spanEvent) attrsLimits
    }

newtype SpanEventSpecs = SpanEventSpecs
  { SpanEventSpecs -> DList SpanEventSpec
unSpanEventSpecs :: DList SpanEventSpec
  } deriving (Semigroup SpanEventSpecs
SpanEventSpecs
Semigroup SpanEventSpecs =>
SpanEventSpecs
-> (SpanEventSpecs -> SpanEventSpecs -> SpanEventSpecs)
-> ([SpanEventSpecs] -> SpanEventSpecs)
-> Monoid SpanEventSpecs
[SpanEventSpecs] -> SpanEventSpecs
SpanEventSpecs -> SpanEventSpecs -> SpanEventSpecs
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SpanEventSpecs
mempty :: SpanEventSpecs
$cmappend :: SpanEventSpecs -> SpanEventSpecs -> SpanEventSpecs
mappend :: SpanEventSpecs -> SpanEventSpecs -> SpanEventSpecs
$cmconcat :: [SpanEventSpecs] -> SpanEventSpecs
mconcat :: [SpanEventSpecs] -> SpanEventSpecs
Monoid, NonEmpty SpanEventSpecs -> SpanEventSpecs
SpanEventSpecs -> SpanEventSpecs -> SpanEventSpecs
(SpanEventSpecs -> SpanEventSpecs -> SpanEventSpecs)
-> (NonEmpty SpanEventSpecs -> SpanEventSpecs)
-> (forall b. Integral b => b -> SpanEventSpecs -> SpanEventSpecs)
-> Semigroup SpanEventSpecs
forall b. Integral b => b -> SpanEventSpecs -> SpanEventSpecs
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SpanEventSpecs -> SpanEventSpecs -> SpanEventSpecs
<> :: SpanEventSpecs -> SpanEventSpecs -> SpanEventSpecs
$csconcat :: NonEmpty SpanEventSpecs -> SpanEventSpecs
sconcat :: NonEmpty SpanEventSpecs -> SpanEventSpecs
$cstimes :: forall b. Integral b => b -> SpanEventSpecs -> SpanEventSpecs
stimes :: forall b. Integral b => b -> SpanEventSpecs -> SpanEventSpecs
Semigroup) via (DList SpanEventSpec)

singletonSpanEventSpecs :: SpanEventSpec -> SpanEventSpecs
singletonSpanEventSpecs :: SpanEventSpec -> SpanEventSpecs
singletonSpanEventSpecs = DList SpanEventSpec -> SpanEventSpecs
SpanEventSpecs (DList SpanEventSpec -> SpanEventSpecs)
-> (SpanEventSpec -> DList SpanEventSpec)
-> SpanEventSpec
-> SpanEventSpecs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanEventSpec -> DList SpanEventSpec
forall a. a -> DList a
DList.singleton

spanEventSpecsFromList :: [SpanEventSpec] -> SpanEventSpecs
spanEventSpecsFromList :: [SpanEventSpec] -> SpanEventSpecs
spanEventSpecsFromList = DList SpanEventSpec -> SpanEventSpecs
SpanEventSpecs (DList SpanEventSpec -> SpanEventSpecs)
-> ([SpanEventSpec] -> DList SpanEventSpec)
-> [SpanEventSpec]
-> SpanEventSpecs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SpanEventSpec] -> DList SpanEventSpec
forall a. [a] -> DList a
DList.fromList

spanEventSpecsToList :: SpanEventSpecs -> [SpanEventSpec]
spanEventSpecsToList :: SpanEventSpecs -> [SpanEventSpec]
spanEventSpecsToList = DList SpanEventSpec -> [SpanEventSpec]
forall a. DList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (DList SpanEventSpec -> [SpanEventSpec])
-> (SpanEventSpecs -> DList SpanEventSpec)
-> SpanEventSpecs
-> [SpanEventSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanEventSpecs -> DList SpanEventSpec
unSpanEventSpecs

data SpanEventSpec = SpanEventSpec
  { SpanEventSpec -> SpanEventName
spanEventSpecName :: SpanEventName
  , SpanEventSpec -> TimestampSource
spanEventSpecTimestamp :: TimestampSource
  , SpanEventSpec -> AttrsBuilder 'AttrsForSpanEvent
spanEventSpecAttrs :: AttrsBuilder 'AttrsForSpanEvent
  }

instance IsString SpanEventSpec where
  fromString :: String -> SpanEventSpec
fromString String
s =
    SpanEventSpec
defaultSpanEventSpec
      { spanEventSpecName = fromString s
      }

instance WithAttrs SpanEventSpec where
  type WithAttrsAttrType SpanEventSpec = 'AttrsForSpanEvent
  SpanEventSpec
spanEventSpec .:@ :: SpanEventSpec
-> AttrsBuilder (WithAttrsAttrType SpanEventSpec) -> SpanEventSpec
.:@ AttrsBuilder (WithAttrsAttrType SpanEventSpec)
attrs =
    SpanEventSpec
spanEventSpec { spanEventSpecAttrs = attrs <> spanEventSpecAttrs spanEventSpec }

defaultSpanEventSpec :: SpanEventSpec
defaultSpanEventSpec :: SpanEventSpec
defaultSpanEventSpec =
  SpanEventSpec
    { spanEventSpecName :: SpanEventName
spanEventSpecName = SpanEventName
""
    , spanEventSpecTimestamp :: TimestampSource
spanEventSpecTimestamp = TimestampSource
TimestampSourceNow
    , spanEventSpecAttrs :: AttrsBuilder 'AttrsForSpanEvent
spanEventSpecAttrs = AttrsBuilder 'AttrsForSpanEvent
forall a. Monoid a => a
mempty
    }

newtype SpanEventName = SpanEventName
  { SpanEventName -> Text
unSpanEventName :: Text
  } deriving stock (SpanEventName -> SpanEventName -> Bool
(SpanEventName -> SpanEventName -> Bool)
-> (SpanEventName -> SpanEventName -> Bool) -> Eq SpanEventName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanEventName -> SpanEventName -> Bool
== :: SpanEventName -> SpanEventName -> Bool
$c/= :: SpanEventName -> SpanEventName -> Bool
/= :: SpanEventName -> SpanEventName -> Bool
Eq, Int -> SpanEventName -> ShowS
[SpanEventName] -> ShowS
SpanEventName -> String
(Int -> SpanEventName -> ShowS)
-> (SpanEventName -> String)
-> ([SpanEventName] -> ShowS)
-> Show SpanEventName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanEventName -> ShowS
showsPrec :: Int -> SpanEventName -> ShowS
$cshow :: SpanEventName -> String
show :: SpanEventName -> String
$cshowList :: [SpanEventName] -> ShowS
showList :: [SpanEventName] -> ShowS
Show)
    deriving ([SpanEventName] -> Value
[SpanEventName] -> Encoding
SpanEventName -> Bool
SpanEventName -> Value
SpanEventName -> Encoding
(SpanEventName -> Value)
-> (SpanEventName -> Encoding)
-> ([SpanEventName] -> Value)
-> ([SpanEventName] -> Encoding)
-> (SpanEventName -> Bool)
-> ToJSON SpanEventName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SpanEventName -> Value
toJSON :: SpanEventName -> Value
$ctoEncoding :: SpanEventName -> Encoding
toEncoding :: SpanEventName -> Encoding
$ctoJSONList :: [SpanEventName] -> Value
toJSONList :: [SpanEventName] -> Value
$ctoEncodingList :: [SpanEventName] -> Encoding
toEncodingList :: [SpanEventName] -> Encoding
$comitField :: SpanEventName -> Bool
omitField :: SpanEventName -> Bool
ToJSON) via (Text)

instance IsString SpanEventName where
  fromString :: String -> SpanEventName
fromString = Text -> SpanEventName
SpanEventName (Text -> SpanEventName)
-> (String -> Text) -> String -> SpanEventName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

newtype SpanLinks (attrs :: AttrsFor -> Type) = SpanLinks
  { forall (attrs :: AttrsFor -> *).
SpanLinks attrs -> DList (SpanLink attrs)
unSpanLinks :: DList (SpanLink attrs)
  }

instance ToJSON (SpanLinks Attrs) where
  toJSON :: SpanLinks Attrs -> Value
toJSON = DList (SpanLink Attrs) -> Value
forall a. ToJSON a => a -> Value
toJSON (DList (SpanLink Attrs) -> Value)
-> (SpanLinks Attrs -> DList (SpanLink Attrs))
-> SpanLinks Attrs
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanLinks Attrs -> DList (SpanLink Attrs)
forall (attrs :: AttrsFor -> *).
SpanLinks attrs -> DList (SpanLink attrs)
unSpanLinks

deriving stock instance (Eq (attrs 'AttrsForSpanLink)) => Eq (SpanLinks attrs)
deriving stock instance (Show (attrs 'AttrsForSpanLink)) => Show (SpanLinks attrs)
deriving via (DList (SpanLink attrs)) instance Monoid (SpanLinks attrs)
deriving via (DList (SpanLink attrs)) instance Semigroup (SpanLinks attrs)

spanLinksFromList :: [SpanLink attrs] -> SpanLinks attrs
spanLinksFromList :: forall (attrs :: AttrsFor -> *).
[SpanLink attrs] -> SpanLinks attrs
spanLinksFromList = DList (SpanLink attrs) -> SpanLinks attrs
forall (attrs :: AttrsFor -> *).
DList (SpanLink attrs) -> SpanLinks attrs
SpanLinks (DList (SpanLink attrs) -> SpanLinks attrs)
-> ([SpanLink attrs] -> DList (SpanLink attrs))
-> [SpanLink attrs]
-> SpanLinks attrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SpanLink attrs] -> DList (SpanLink attrs)
forall a. [a] -> DList a
DList.fromList

spanLinksToList :: SpanLinks attrs -> [SpanLink attrs]
spanLinksToList :: forall (attrs :: AttrsFor -> *).
SpanLinks attrs -> [SpanLink attrs]
spanLinksToList = DList (SpanLink attrs) -> [SpanLink attrs]
forall a. DList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (DList (SpanLink attrs) -> [SpanLink attrs])
-> (SpanLinks attrs -> DList (SpanLink attrs))
-> SpanLinks attrs
-> [SpanLink attrs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanLinks attrs -> DList (SpanLink attrs)
forall (attrs :: AttrsFor -> *).
SpanLinks attrs -> DList (SpanLink attrs)
unSpanLinks

freezeAllSpanLinkAttrs
  :: AttrsLimits 'AttrsForSpanLink
  -> SpanLinks AttrsBuilder
  -> SpanLinks Attrs
freezeAllSpanLinkAttrs :: AttrsLimits 'AttrsForSpanLink
-> SpanLinks AttrsBuilder -> SpanLinks Attrs
freezeAllSpanLinkAttrs AttrsLimits 'AttrsForSpanLink
attrsLimits SpanLinks AttrsBuilder
spanLink =
  DList (SpanLink Attrs) -> SpanLinks Attrs
forall (attrs :: AttrsFor -> *).
DList (SpanLink attrs) -> SpanLinks attrs
SpanLinks
    (DList (SpanLink Attrs) -> SpanLinks Attrs)
-> DList (SpanLink Attrs) -> SpanLinks Attrs
forall a b. (a -> b) -> a -> b
$ (SpanLink AttrsBuilder -> SpanLink Attrs)
-> DList (SpanLink AttrsBuilder) -> DList (SpanLink Attrs)
forall a b. (a -> b) -> DList a -> DList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AttrsLimits 'AttrsForSpanLink
-> SpanLink AttrsBuilder -> SpanLink Attrs
freezeSpanLinkAttrs AttrsLimits 'AttrsForSpanLink
attrsLimits)
    (DList (SpanLink AttrsBuilder) -> DList (SpanLink Attrs))
-> DList (SpanLink AttrsBuilder) -> DList (SpanLink Attrs)
forall a b. (a -> b) -> a -> b
$ SpanLinks AttrsBuilder -> DList (SpanLink AttrsBuilder)
forall (attrs :: AttrsFor -> *).
SpanLinks attrs -> DList (SpanLink attrs)
unSpanLinks SpanLinks AttrsBuilder
spanLink

newtype SpanLinkSpecs = SpanLinkSpecs
  { SpanLinkSpecs -> DList SpanLinkSpec
unSpanLinkSpecs :: DList SpanLinkSpec
  } deriving (Semigroup SpanLinkSpecs
SpanLinkSpecs
Semigroup SpanLinkSpecs =>
SpanLinkSpecs
-> (SpanLinkSpecs -> SpanLinkSpecs -> SpanLinkSpecs)
-> ([SpanLinkSpecs] -> SpanLinkSpecs)
-> Monoid SpanLinkSpecs
[SpanLinkSpecs] -> SpanLinkSpecs
SpanLinkSpecs -> SpanLinkSpecs -> SpanLinkSpecs
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SpanLinkSpecs
mempty :: SpanLinkSpecs
$cmappend :: SpanLinkSpecs -> SpanLinkSpecs -> SpanLinkSpecs
mappend :: SpanLinkSpecs -> SpanLinkSpecs -> SpanLinkSpecs
$cmconcat :: [SpanLinkSpecs] -> SpanLinkSpecs
mconcat :: [SpanLinkSpecs] -> SpanLinkSpecs
Monoid, NonEmpty SpanLinkSpecs -> SpanLinkSpecs
SpanLinkSpecs -> SpanLinkSpecs -> SpanLinkSpecs
(SpanLinkSpecs -> SpanLinkSpecs -> SpanLinkSpecs)
-> (NonEmpty SpanLinkSpecs -> SpanLinkSpecs)
-> (forall b. Integral b => b -> SpanLinkSpecs -> SpanLinkSpecs)
-> Semigroup SpanLinkSpecs
forall b. Integral b => b -> SpanLinkSpecs -> SpanLinkSpecs
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SpanLinkSpecs -> SpanLinkSpecs -> SpanLinkSpecs
<> :: SpanLinkSpecs -> SpanLinkSpecs -> SpanLinkSpecs
$csconcat :: NonEmpty SpanLinkSpecs -> SpanLinkSpecs
sconcat :: NonEmpty SpanLinkSpecs -> SpanLinkSpecs
$cstimes :: forall b. Integral b => b -> SpanLinkSpecs -> SpanLinkSpecs
stimes :: forall b. Integral b => b -> SpanLinkSpecs -> SpanLinkSpecs
Semigroup) via (DList SpanLinkSpec)

singletonSpanLinkSpecs :: SpanLinkSpec -> SpanLinkSpecs
singletonSpanLinkSpecs :: SpanLinkSpec -> SpanLinkSpecs
singletonSpanLinkSpecs = DList SpanLinkSpec -> SpanLinkSpecs
SpanLinkSpecs (DList SpanLinkSpec -> SpanLinkSpecs)
-> (SpanLinkSpec -> DList SpanLinkSpec)
-> SpanLinkSpec
-> SpanLinkSpecs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanLinkSpec -> DList SpanLinkSpec
forall a. a -> DList a
DList.singleton

spanLinkSpecsFromList :: [SpanLinkSpec] -> SpanLinkSpecs
spanLinkSpecsFromList :: [SpanLinkSpec] -> SpanLinkSpecs
spanLinkSpecsFromList = DList SpanLinkSpec -> SpanLinkSpecs
SpanLinkSpecs (DList SpanLinkSpec -> SpanLinkSpecs)
-> ([SpanLinkSpec] -> DList SpanLinkSpec)
-> [SpanLinkSpec]
-> SpanLinkSpecs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SpanLinkSpec] -> DList SpanLinkSpec
forall a. [a] -> DList a
DList.fromList

spanLinkSpecsToList :: SpanLinkSpecs -> [SpanLinkSpec]
spanLinkSpecsToList :: SpanLinkSpecs -> [SpanLinkSpec]
spanLinkSpecsToList = DList SpanLinkSpec -> [SpanLinkSpec]
forall a. DList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (DList SpanLinkSpec -> [SpanLinkSpec])
-> (SpanLinkSpecs -> DList SpanLinkSpec)
-> SpanLinkSpecs
-> [SpanLinkSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanLinkSpecs -> DList SpanLinkSpec
unSpanLinkSpecs

data SpanLink (attrs :: AttrsFor -> Type) = SpanLink
  { forall (attrs :: AttrsFor -> *). SpanLink attrs -> SpanContext
spanLinkSpanContext :: SpanContext
  , forall (attrs :: AttrsFor -> *).
SpanLink attrs -> attrs 'AttrsForSpanLink
spanLinkAttrs :: attrs 'AttrsForSpanLink
  }

instance ToJSON (SpanLink Attrs) where
  toJSON :: SpanLink Attrs -> Value
toJSON SpanLink Attrs
spanLink =
    [Pair] -> Value
Aeson.object
      [ Key
"spanContext" Key -> SpanContext -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanContext
spanLinkSpanContext
      , Key
"attributes" Key -> Attrs 'AttrsForSpanLink -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Attrs 'AttrsForSpanLink
spanLinkAttrs
      ]
    where
    SpanLink
      { SpanContext
spanLinkSpanContext :: forall (attrs :: AttrsFor -> *). SpanLink attrs -> SpanContext
spanLinkSpanContext :: SpanContext
spanLinkSpanContext
      , Attrs 'AttrsForSpanLink
spanLinkAttrs :: forall (attrs :: AttrsFor -> *).
SpanLink attrs -> attrs 'AttrsForSpanLink
spanLinkAttrs :: Attrs 'AttrsForSpanLink
spanLinkAttrs
      } = SpanLink Attrs
spanLink

deriving stock instance (Eq (attrs 'AttrsForSpanLink)) => Eq (SpanLink attrs)
deriving stock instance (Show (attrs 'AttrsForSpanLink)) => Show (SpanLink attrs)

freezeSpanLinkAttrs
  :: AttrsLimits 'AttrsForSpanLink
  -> SpanLink AttrsBuilder
  -> SpanLink Attrs
freezeSpanLinkAttrs :: AttrsLimits 'AttrsForSpanLink
-> SpanLink AttrsBuilder -> SpanLink Attrs
freezeSpanLinkAttrs AttrsLimits 'AttrsForSpanLink
attrsLimits SpanLink AttrsBuilder
spanLink =
  SpanLink AttrsBuilder
spanLink
    { spanLinkAttrs = runAttrsBuilder (spanLinkAttrs spanLink) attrsLimits
    }

newtype SpanLinkName = SpanLinkName
  { SpanLinkName -> Text
unSpanLinkName :: Text
  } deriving stock (SpanLinkName -> SpanLinkName -> Bool
(SpanLinkName -> SpanLinkName -> Bool)
-> (SpanLinkName -> SpanLinkName -> Bool) -> Eq SpanLinkName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanLinkName -> SpanLinkName -> Bool
== :: SpanLinkName -> SpanLinkName -> Bool
$c/= :: SpanLinkName -> SpanLinkName -> Bool
/= :: SpanLinkName -> SpanLinkName -> Bool
Eq, Int -> SpanLinkName -> ShowS
[SpanLinkName] -> ShowS
SpanLinkName -> String
(Int -> SpanLinkName -> ShowS)
-> (SpanLinkName -> String)
-> ([SpanLinkName] -> ShowS)
-> Show SpanLinkName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanLinkName -> ShowS
showsPrec :: Int -> SpanLinkName -> ShowS
$cshow :: SpanLinkName -> String
show :: SpanLinkName -> String
$cshowList :: [SpanLinkName] -> ShowS
showList :: [SpanLinkName] -> ShowS
Show)

instance IsString SpanLinkName where
  fromString :: String -> SpanLinkName
fromString = Text -> SpanLinkName
SpanLinkName (Text -> SpanLinkName)
-> (String -> Text) -> String -> SpanLinkName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

data SpanLinkSpec = SpanLinkSpec
  { SpanLinkSpec -> SpanContext
spanLinkSpecSpanContext :: SpanContext
  , SpanLinkSpec -> AttrsBuilder 'AttrsForSpanLink
spanLinkSpecAttrs :: AttrsBuilder 'AttrsForSpanLink
  }

instance WithAttrs SpanLinkSpec where
  type WithAttrsAttrType SpanLinkSpec = 'AttrsForSpanLink
  SpanLinkSpec
spanLinkSpec .:@ :: SpanLinkSpec
-> AttrsBuilder (WithAttrsAttrType SpanLinkSpec) -> SpanLinkSpec
.:@ AttrsBuilder (WithAttrsAttrType SpanLinkSpec)
attrs =
    SpanLinkSpec
spanLinkSpec { spanLinkSpecAttrs = attrs <> spanLinkSpecAttrs spanLinkSpec }

defaultSpanLinkSpec :: SpanLinkSpec
defaultSpanLinkSpec :: SpanLinkSpec
defaultSpanLinkSpec =
  SpanLinkSpec
    { spanLinkSpecSpanContext :: SpanContext
spanLinkSpecSpanContext = SpanContext
emptySpanContext
    , spanLinkSpecAttrs :: AttrsBuilder 'AttrsForSpanLink
spanLinkSpecAttrs = AttrsBuilder 'AttrsForSpanLink
forall a. Monoid a => a
mempty
    }

data SpanSpec = SpanSpec
  { SpanSpec -> SpanName
spanSpecName :: SpanName
  , SpanSpec -> Maybe Context
spanSpecParentContext :: Maybe Context
  , SpanSpec -> TimestampSource
spanSpecStart :: TimestampSource
  , SpanSpec -> SpanKind
spanSpecKind :: SpanKind
  , SpanSpec -> AttrsBuilder 'AttrsForSpan
spanSpecAttrs :: AttrsBuilder 'AttrsForSpan
  , SpanSpec -> SpanLinkSpecs
spanSpecLinks :: SpanLinkSpecs
  }

instance IsString SpanSpec where
  fromString :: String -> SpanSpec
fromString String
s =
    SpanSpec
defaultSpanSpec
      { spanSpecName = fromString s
      }

instance WithAttrs SpanSpec where
  type WithAttrsAttrType SpanSpec = 'AttrsForSpan
  SpanSpec
spanSpec .:@ :: SpanSpec -> AttrsBuilder (WithAttrsAttrType SpanSpec) -> SpanSpec
.:@ AttrsBuilder (WithAttrsAttrType SpanSpec)
attrs =
    SpanSpec
spanSpec { spanSpecAttrs = attrs <> spanSpecAttrs spanSpec }

defaultSpanSpec :: SpanSpec
defaultSpanSpec :: SpanSpec
defaultSpanSpec =
  SpanSpec
    { spanSpecName :: SpanName
spanSpecName = SpanName
""
    , spanSpecParentContext :: Maybe Context
spanSpecParentContext = Maybe Context
forall a. Maybe a
Nothing
    , spanSpecStart :: TimestampSource
spanSpecStart = TimestampSource
TimestampSourceNow
    , spanSpecKind :: SpanKind
spanSpecKind = SpanKind
SpanKindInternal
    , spanSpecAttrs :: AttrsBuilder 'AttrsForSpan
spanSpecAttrs = AttrsBuilder 'AttrsForSpan
forall a. Monoid a => a
mempty
    , spanSpecLinks :: SpanLinkSpecs
spanSpecLinks = SpanLinkSpecs
forall a. Monoid a => a
mempty
    }

data UpdateSpanSpec = UpdateSpanSpec
  { UpdateSpanSpec -> Maybe SpanName
updateSpanSpecName :: Maybe SpanName
  , UpdateSpanSpec -> Maybe SpanStatus
updateSpanSpecStatus :: Maybe SpanStatus
  , UpdateSpanSpec -> Maybe (AttrsBuilder 'AttrsForSpan)
updateSpanSpecAttrs :: Maybe (AttrsBuilder 'AttrsForSpan)
  , UpdateSpanSpec -> Maybe SpanEventSpecs
updateSpanSpecEvents :: Maybe SpanEventSpecs
  }

instance IsString UpdateSpanSpec where
  fromString :: String -> UpdateSpanSpec
fromString String
s =
    UpdateSpanSpec
defaultUpdateSpanSpec
      { updateSpanSpecName = Just $ fromString s
      }

instance WithAttrs UpdateSpanSpec where
  type WithAttrsAttrType UpdateSpanSpec = 'AttrsForSpan
  UpdateSpanSpec
updateSpanSpec .:@ :: UpdateSpanSpec
-> AttrsBuilder (WithAttrsAttrType UpdateSpanSpec)
-> UpdateSpanSpec
.:@ AttrsBuilder (WithAttrsAttrType UpdateSpanSpec)
attrs =
    UpdateSpanSpec
updateSpanSpec { updateSpanSpecAttrs = Just attrs <> updateSpanSpecAttrs updateSpanSpec }

defaultUpdateSpanSpec :: UpdateSpanSpec
defaultUpdateSpanSpec :: UpdateSpanSpec
defaultUpdateSpanSpec =
  UpdateSpanSpec
    { updateSpanSpecName :: Maybe SpanName
updateSpanSpecName = Maybe SpanName
forall a. Maybe a
Nothing
    , updateSpanSpecStatus :: Maybe SpanStatus
updateSpanSpecStatus = Maybe SpanStatus
forall a. Maybe a
Nothing
    , updateSpanSpecAttrs :: Maybe (AttrsBuilder 'AttrsForSpan)
updateSpanSpecAttrs = Maybe (AttrsBuilder 'AttrsForSpan)
forall a. Maybe a
Nothing
    , updateSpanSpecEvents :: Maybe SpanEventSpecs
updateSpanSpecEvents = Maybe SpanEventSpecs
forall a. Maybe a
Nothing
    }

buildSpanUpdater
  :: forall m
   . (Monad m)
  => m Timestamp
  -> UpdateSpanSpec
  -> m (Span AttrsBuilder -> Span AttrsBuilder)
buildSpanUpdater :: forall (m :: * -> *).
Monad m =>
m Timestamp
-> UpdateSpanSpec -> m (Span AttrsBuilder -> Span AttrsBuilder)
buildSpanUpdater m Timestamp
getTimestamp UpdateSpanSpec
updateSpanSpec = do
  SpanEvents AttrsBuilder
newSpanEvents <- do
    (DList (SpanEvent AttrsBuilder) -> SpanEvents AttrsBuilder)
-> m (DList (SpanEvent AttrsBuilder))
-> m (SpanEvents AttrsBuilder)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList (SpanEvent AttrsBuilder) -> SpanEvents AttrsBuilder
forall (attrs :: AttrsFor -> *).
DList (SpanEvent attrs) -> SpanEvents attrs
SpanEvents do
      case Maybe SpanEventSpecs
updateSpanSpecEvents of
        Maybe SpanEventSpecs
Nothing -> DList (SpanEvent AttrsBuilder)
-> m (DList (SpanEvent AttrsBuilder))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList (SpanEvent AttrsBuilder)
forall a. Monoid a => a
mempty
        Just SpanEventSpecs
spanEventSpecs -> do
          DList SpanEventSpec
-> (SpanEventSpec -> m (SpanEvent AttrsBuilder))
-> m (DList (SpanEvent AttrsBuilder))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
Traversable.for (SpanEventSpecs -> DList SpanEventSpec
unSpanEventSpecs SpanEventSpecs
spanEventSpecs) \SpanEventSpec
spanEventSpec -> do
            Timestamp
spanEventTimestamp <- do
              case SpanEventSpec -> TimestampSource
spanEventSpecTimestamp SpanEventSpec
spanEventSpec of
                TimestampSourceAt Timestamp
timestamp -> Timestamp -> m Timestamp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timestamp
timestamp
                TimestampSource
TimestampSourceNow -> m Timestamp
getTimestamp
            pure SpanEvent
              { spanEventName :: SpanEventName
spanEventName = SpanEventSpec -> SpanEventName
spanEventSpecName SpanEventSpec
spanEventSpec
              , Timestamp
spanEventTimestamp :: Timestamp
spanEventTimestamp :: Timestamp
spanEventTimestamp
              , spanEventAttrs :: AttrsBuilder 'AttrsForSpanEvent
spanEventAttrs = SpanEventSpec -> AttrsBuilder 'AttrsForSpanEvent
spanEventSpecAttrs SpanEventSpec
spanEventSpec
              }
  pure \Span AttrsBuilder
span ->
    if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Span AttrsBuilder -> Bool
forall (attrs :: AttrsFor -> *). Span attrs -> Bool
spanIsRecording Span AttrsBuilder
span then
      Span AttrsBuilder
span
    else
      Span AttrsBuilder
span
        { spanName =
            Maybe.fromMaybe (spanName span) updateSpanSpecName
        , spanStatus =
            Maybe.maybe (spanStatus span) (max $ spanStatus span) updateSpanSpecStatus
        , spanAttrs =
            case updateSpanSpecAttrs of
              Maybe (AttrsBuilder 'AttrsForSpan)
Nothing -> Span AttrsBuilder -> AttrsBuilder 'AttrsForSpan
forall (attrs :: AttrsFor -> *). Span attrs -> attrs 'AttrsForSpan
spanAttrs Span AttrsBuilder
span
              Just AttrsBuilder 'AttrsForSpan
attrsBuilder ->
                AttrsBuilder 'AttrsForSpan
attrsBuilder AttrsBuilder 'AttrsForSpan
-> AttrsBuilder 'AttrsForSpan -> AttrsBuilder 'AttrsForSpan
forall a. Semigroup a => a -> a -> a
<> Span AttrsBuilder -> AttrsBuilder 'AttrsForSpan
forall (attrs :: AttrsFor -> *). Span attrs -> attrs 'AttrsForSpan
spanAttrs Span AttrsBuilder
span
        , spanEvents =
            spanEvents span <> newSpanEvents
        }
  where
  UpdateSpanSpec
    { Maybe SpanName
updateSpanSpecName :: UpdateSpanSpec -> Maybe SpanName
updateSpanSpecName :: Maybe SpanName
updateSpanSpecName
    , Maybe SpanStatus
updateSpanSpecStatus :: UpdateSpanSpec -> Maybe SpanStatus
updateSpanSpecStatus :: Maybe SpanStatus
updateSpanSpecStatus
    , Maybe (AttrsBuilder 'AttrsForSpan)
updateSpanSpecAttrs :: UpdateSpanSpec -> Maybe (AttrsBuilder 'AttrsForSpan)
updateSpanSpecAttrs :: Maybe (AttrsBuilder 'AttrsForSpan)
updateSpanSpecAttrs
    , Maybe SpanEventSpecs
updateSpanSpecEvents :: UpdateSpanSpec -> Maybe SpanEventSpecs
updateSpanSpecEvents :: Maybe SpanEventSpecs
updateSpanSpecEvents
    } = UpdateSpanSpec
updateSpanSpec

recordException
  :: SomeException
  -> Bool
  -> TimestampSource
  -> AttrsBuilder 'AttrsForSpanEvent
  -> UpdateSpanSpec
recordException :: SomeException
-> Bool
-> TimestampSource
-> AttrsBuilder 'AttrsForSpanEvent
-> UpdateSpanSpec
recordException SomeException
someEx Bool
escaped TimestampSource
timestamp AttrsBuilder 'AttrsForSpanEvent
attributes =
  UpdateSpanSpec
defaultUpdateSpanSpec
    { updateSpanSpecEvents =
        Just $ spanEventSpecsFromList
          [ exceptionEvent someEx escaped timestamp attributes
          ]
    , updateSpanSpecStatus =
        if not escaped then
          updateSpanSpecStatus defaultUpdateSpanSpec
        else
          Just $ SpanStatusError "Exception escaped enclosing scope"
    }

exceptionEvent
  :: SomeException
  -> Bool
  -> TimestampSource
  -> AttrsBuilder 'AttrsForSpanEvent
  -> SpanEventSpec
exceptionEvent :: SomeException
-> Bool
-> TimestampSource
-> AttrsBuilder 'AttrsForSpanEvent
-> SpanEventSpec
exceptionEvent (SomeException e
e) Bool
escaped TimestampSource
timestamp AttrsBuilder 'AttrsForSpanEvent
attributes =
  SpanEventSpec
    { spanEventSpecName :: SpanEventName
spanEventSpecName = SpanEventName
"exception"
    , spanEventSpecTimestamp :: TimestampSource
spanEventSpecTimestamp = TimestampSource
timestamp
    , spanEventSpecAttrs :: AttrsBuilder 'AttrsForSpanEvent
spanEventSpecAttrs =
        AttrsBuilder 'AttrsForSpanEvent
attributes
          AttrsBuilder 'AttrsForSpanEvent
-> AttrsBuilder 'AttrsForSpanEvent
-> AttrsBuilder 'AttrsForSpanEvent
forall a. Semigroup a => a -> a -> a
<> Key Text
EXCEPTION_TYPE Key Text -> String -> AttrsBuilder 'AttrsForSpanEvent
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder 'AttrsForSpanEvent) from to =>
Key to -> from -> AttrsBuilder 'AttrsForSpanEvent
.@ TypeRep -> String
forall a. Show a => a -> String
show (e -> TypeRep
forall a. Typeable a => a -> TypeRep
Typeable.typeOf e
e)
          AttrsBuilder 'AttrsForSpanEvent
-> AttrsBuilder 'AttrsForSpanEvent
-> AttrsBuilder 'AttrsForSpanEvent
forall a. Semigroup a => a -> a -> a
<> Key Text
EXCEPTION_MESSAGE Key Text -> String -> AttrsBuilder 'AttrsForSpanEvent
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder 'AttrsForSpanEvent) from to =>
Key to -> from -> AttrsBuilder 'AttrsForSpanEvent
.@ e -> String
forall e. Exception e => e -> String
Exception.displayException e
e
          AttrsBuilder 'AttrsForSpanEvent
-> AttrsBuilder 'AttrsForSpanEvent
-> AttrsBuilder 'AttrsForSpanEvent
forall a. Semigroup a => a -> a -> a
<> Key Bool
EXCEPTION_ESCAPED Key Bool -> Bool -> AttrsBuilder 'AttrsForSpanEvent
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder 'AttrsForSpanEvent) from to =>
Key to -> from -> AttrsBuilder 'AttrsForSpanEvent
.@ Bool
escaped
    }

newtype SpanName = SpanName
  { SpanName -> Text
unSpanName :: Text
  } deriving stock (SpanName -> SpanName -> Bool
(SpanName -> SpanName -> Bool)
-> (SpanName -> SpanName -> Bool) -> Eq SpanName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanName -> SpanName -> Bool
== :: SpanName -> SpanName -> Bool
$c/= :: SpanName -> SpanName -> Bool
/= :: SpanName -> SpanName -> Bool
Eq, Int -> SpanName -> ShowS
[SpanName] -> ShowS
SpanName -> String
(Int -> SpanName -> ShowS)
-> (SpanName -> String) -> ([SpanName] -> ShowS) -> Show SpanName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanName -> ShowS
showsPrec :: Int -> SpanName -> ShowS
$cshow :: SpanName -> String
show :: SpanName -> String
$cshowList :: [SpanName] -> ShowS
showList :: [SpanName] -> ShowS
Show)
    deriving ([SpanName] -> Value
[SpanName] -> Encoding
SpanName -> Bool
SpanName -> Value
SpanName -> Encoding
(SpanName -> Value)
-> (SpanName -> Encoding)
-> ([SpanName] -> Value)
-> ([SpanName] -> Encoding)
-> (SpanName -> Bool)
-> ToJSON SpanName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SpanName -> Value
toJSON :: SpanName -> Value
$ctoEncoding :: SpanName -> Encoding
toEncoding :: SpanName -> Encoding
$ctoJSONList :: [SpanName] -> Value
toJSONList :: [SpanName] -> Value
$ctoEncodingList :: [SpanName] -> Encoding
toEncodingList :: [SpanName] -> Encoding
$comitField :: SpanName -> Bool
omitField :: SpanName -> Bool
ToJSON) via (Text)

instance IsString SpanName where
  fromString :: String -> SpanName
fromString = Text -> SpanName
SpanName (Text -> SpanName) -> (String -> Text) -> String -> SpanName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

newtype MutableSpan = MutableSpan
  { MutableSpan -> IORef (Span AttrsBuilder)
unMutableSpan :: IORef (Span AttrsBuilder)
  }

unsafeNewMutableSpan :: Span AttrsBuilder -> IO MutableSpan
unsafeNewMutableSpan :: Span AttrsBuilder -> IO MutableSpan
unsafeNewMutableSpan = (IORef (Span AttrsBuilder) -> MutableSpan)
-> IO (IORef (Span AttrsBuilder)) -> IO MutableSpan
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef (Span AttrsBuilder) -> MutableSpan
MutableSpan (IO (IORef (Span AttrsBuilder)) -> IO MutableSpan)
-> (Span AttrsBuilder -> IO (IORef (Span AttrsBuilder)))
-> Span AttrsBuilder
-> IO MutableSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span AttrsBuilder -> IO (IORef (Span AttrsBuilder))
forall a. a -> IO (IORef a)
IORef.newIORef

unsafeReadMutableSpan :: MutableSpan -> IO (Span AttrsBuilder)
unsafeReadMutableSpan :: MutableSpan -> IO (Span AttrsBuilder)
unsafeReadMutableSpan MutableSpan
mutableSpan =
  MutableSpan
-> (Span AttrsBuilder -> (Span AttrsBuilder, Span AttrsBuilder))
-> IO (Span AttrsBuilder)
forall a.
MutableSpan
-> (Span AttrsBuilder -> (Span AttrsBuilder, a)) -> IO a
unsafeModifyMutableSpan MutableSpan
mutableSpan \Span AttrsBuilder
s -> (Span AttrsBuilder
s, Span AttrsBuilder
s)
{-# INLINE unsafeReadMutableSpan #-}

unsafeModifyMutableSpan
  :: MutableSpan
  -> (Span AttrsBuilder -> (Span AttrsBuilder, a))
  -> IO a
unsafeModifyMutableSpan :: forall a.
MutableSpan
-> (Span AttrsBuilder -> (Span AttrsBuilder, a)) -> IO a
unsafeModifyMutableSpan = IORef (Span AttrsBuilder)
-> (Span AttrsBuilder -> (Span AttrsBuilder, a)) -> IO a
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' (IORef (Span AttrsBuilder)
 -> (Span AttrsBuilder -> (Span AttrsBuilder, a)) -> IO a)
-> (MutableSpan -> IORef (Span AttrsBuilder))
-> MutableSpan
-> (Span AttrsBuilder -> (Span AttrsBuilder, a))
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableSpan -> IORef (Span AttrsBuilder)
unMutableSpan
{-# INLINE unsafeModifyMutableSpan #-}

data Span (attrs :: AttrsFor -> Type) = Span
  { forall (attrs :: AttrsFor -> *). Span attrs -> SpanLineage
spanLineage :: SpanLineage
  , forall (attrs :: AttrsFor -> *). Span attrs -> SpanContext
spanContext :: SpanContext
  , forall (attrs :: AttrsFor -> *). Span attrs -> SpanName
spanName :: SpanName
  , forall (attrs :: AttrsFor -> *). Span attrs -> SpanStatus
spanStatus :: SpanStatus
  , forall (attrs :: AttrsFor -> *). Span attrs -> Timestamp
spanStart :: Timestamp
  , forall (attrs :: AttrsFor -> *). Span attrs -> SpanFrozenAt attrs
spanFrozenAt :: SpanFrozenAt attrs
  , forall (attrs :: AttrsFor -> *). Span attrs -> SpanKind
spanKind :: SpanKind
  , forall (attrs :: AttrsFor -> *). Span attrs -> attrs 'AttrsForSpan
spanAttrs :: attrs 'AttrsForSpan
  , forall (attrs :: AttrsFor -> *). Span attrs -> SpanLinks attrs
spanLinks :: SpanLinks attrs
  , forall (attrs :: AttrsFor -> *). Span attrs -> SpanEvents attrs
spanEvents :: SpanEvents attrs
  , forall (attrs :: AttrsFor -> *). Span attrs -> Bool
spanIsRecording :: Bool
  , forall (attrs :: AttrsFor -> *). Span attrs -> InstrumentationScope
spanInstrumentationScope :: InstrumentationScope
  }

deriving stock instance Eq (Span Attrs)
deriving stock instance Show (Span Attrs)

instance ToJSON (Span Attrs) where
  toJSON :: Span Attrs -> Value
toJSON Span Attrs
span =
    [Pair] -> Value
Aeson.object
      [ Key
"parent" Key -> SpanLineage -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanLineage
spanLineage
      , Key
"spanContext" Key -> SpanContext -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanContext
spanContext
      , Key
"name" Key -> SpanName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanName
spanName
      , Key
"status" Key -> SpanStatus -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanStatus
spanStatus
      , Key
"start" Key -> Timestamp -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Timestamp
spanStart
      , Key
"frozenAt" Key -> SpanFrozenTimestamp -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanFrozenTimestamp
SpanFrozenAt Attrs
spanFrozenAt
      , Key
"kind" Key -> SpanKind -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanKind
spanKind
      , Key
"attributes" Key -> Attrs 'AttrsForSpan -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Attrs 'AttrsForSpan
spanAttrs
      , Key
"links" Key -> SpanLinks Attrs -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanLinks Attrs
spanLinks
      , Key
"events" Key -> SpanEvents Attrs -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanEvents Attrs
spanEvents
      , Key
"isRecording" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
spanIsRecording
      , Key
"instrumentationScope" Key -> InstrumentationScope -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= InstrumentationScope
spanInstrumentationScope
      ]
    where
    Span
      { SpanLineage
spanLineage :: forall (attrs :: AttrsFor -> *). Span attrs -> SpanLineage
spanLineage :: SpanLineage
spanLineage
      , SpanContext
spanContext :: forall (attrs :: AttrsFor -> *). Span attrs -> SpanContext
spanContext :: SpanContext
spanContext
      , SpanName
spanName :: forall (attrs :: AttrsFor -> *). Span attrs -> SpanName
spanName :: SpanName
spanName
      , SpanStatus
spanStatus :: forall (attrs :: AttrsFor -> *). Span attrs -> SpanStatus
spanStatus :: SpanStatus
spanStatus
      , Timestamp
spanStart :: forall (attrs :: AttrsFor -> *). Span attrs -> Timestamp
spanStart :: Timestamp
spanStart
      , SpanFrozenAt Attrs
spanFrozenAt :: forall (attrs :: AttrsFor -> *). Span attrs -> SpanFrozenAt attrs
spanFrozenAt :: SpanFrozenAt Attrs
spanFrozenAt
      , SpanKind
spanKind :: forall (attrs :: AttrsFor -> *). Span attrs -> SpanKind
spanKind :: SpanKind
spanKind
      , Attrs 'AttrsForSpan
spanAttrs :: forall (attrs :: AttrsFor -> *). Span attrs -> attrs 'AttrsForSpan
spanAttrs :: Attrs 'AttrsForSpan
spanAttrs
      , SpanLinks Attrs
spanLinks :: forall (attrs :: AttrsFor -> *). Span attrs -> SpanLinks attrs
spanLinks :: SpanLinks Attrs
spanLinks
      , SpanEvents Attrs
spanEvents :: forall (attrs :: AttrsFor -> *). Span attrs -> SpanEvents attrs
spanEvents :: SpanEvents Attrs
spanEvents
      , Bool
spanIsRecording :: forall (attrs :: AttrsFor -> *). Span attrs -> Bool
spanIsRecording :: Bool
spanIsRecording
      , InstrumentationScope
spanInstrumentationScope :: forall (attrs :: AttrsFor -> *). Span attrs -> InstrumentationScope
spanInstrumentationScope :: InstrumentationScope
spanInstrumentationScope
      } = Span Attrs
span

spanIsRemote :: Span attrs -> Bool
spanIsRemote :: forall (attrs :: AttrsFor -> *). Span attrs -> Bool
spanIsRemote Span attrs
span = SpanContext -> Bool
spanContextIsRemote SpanContext
spanContext
  where
  Span { SpanContext
spanContext :: forall (attrs :: AttrsFor -> *). Span attrs -> SpanContext
spanContext :: SpanContext
spanContext } = Span attrs
span

spanIsSampled :: Span attrs -> Bool
spanIsSampled :: forall (attrs :: AttrsFor -> *). Span attrs -> Bool
spanIsSampled Span attrs
span = SpanContext -> Bool
spanContextIsSampled SpanContext
spanContext
  where
  Span { SpanContext
spanContext :: forall (attrs :: AttrsFor -> *). Span attrs -> SpanContext
spanContext :: SpanContext
spanContext } = Span attrs
span

spanIsRoot :: Span attrs -> Bool
spanIsRoot :: forall (attrs :: AttrsFor -> *). Span attrs -> Bool
spanIsRoot Span attrs
span = SpanLineage
SpanLineageRoot SpanLineage -> SpanLineage -> Bool
forall a. Eq a => a -> a -> Bool
== Span attrs -> SpanLineage
forall (attrs :: AttrsFor -> *). Span attrs -> SpanLineage
spanLineage Span attrs
span

spanIsChildOf :: Span attrs -> Span attrs -> Bool
spanIsChildOf :: forall (attrs :: AttrsFor -> *). Span attrs -> Span attrs -> Bool
spanIsChildOf Span attrs
childSpan Span attrs
parentSpan =
  SpanContext -> SpanLineage
SpanLineageChildOf (Span attrs -> SpanContext
forall (attrs :: AttrsFor -> *). Span attrs -> SpanContext
spanContext Span attrs
parentSpan) SpanLineage -> SpanLineage -> Bool
forall a. Eq a => a -> a -> Bool
== Span attrs -> SpanLineage
forall (attrs :: AttrsFor -> *). Span attrs -> SpanLineage
spanLineage Span attrs
childSpan

type family SpanFrozenAt (attrs :: AttrsFor -> Type) :: Type where
  SpanFrozenAt AttrsBuilder = Maybe Timestamp
  SpanFrozenAt Attrs = SpanFrozenTimestamp

data SpanFrozenTimestamp
  = SpanFrozenTimestampFrozen Timestamp
  | SpanFrozenTimestampEnded Timestamp
  deriving stock (SpanFrozenTimestamp -> SpanFrozenTimestamp -> Bool
(SpanFrozenTimestamp -> SpanFrozenTimestamp -> Bool)
-> (SpanFrozenTimestamp -> SpanFrozenTimestamp -> Bool)
-> Eq SpanFrozenTimestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanFrozenTimestamp -> SpanFrozenTimestamp -> Bool
== :: SpanFrozenTimestamp -> SpanFrozenTimestamp -> Bool
$c/= :: SpanFrozenTimestamp -> SpanFrozenTimestamp -> Bool
/= :: SpanFrozenTimestamp -> SpanFrozenTimestamp -> Bool
Eq, Int -> SpanFrozenTimestamp -> ShowS
[SpanFrozenTimestamp] -> ShowS
SpanFrozenTimestamp -> String
(Int -> SpanFrozenTimestamp -> ShowS)
-> (SpanFrozenTimestamp -> String)
-> ([SpanFrozenTimestamp] -> ShowS)
-> Show SpanFrozenTimestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanFrozenTimestamp -> ShowS
showsPrec :: Int -> SpanFrozenTimestamp -> ShowS
$cshow :: SpanFrozenTimestamp -> String
show :: SpanFrozenTimestamp -> String
$cshowList :: [SpanFrozenTimestamp] -> ShowS
showList :: [SpanFrozenTimestamp] -> ShowS
Show)

instance ToJSON SpanFrozenTimestamp where
  toJSON :: SpanFrozenTimestamp -> Value
toJSON = \case
    SpanFrozenTimestampFrozen Timestamp
timestamp ->
      [Pair] -> Value
Aeson.object
        [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"frozen" :: Text)
        , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Timestamp -> Value
forall a. ToJSON a => a -> Value
toJSON Timestamp
timestamp
        ]
    SpanFrozenTimestampEnded Timestamp
timestamp ->
      [Pair] -> Value
Aeson.object
        [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"ended" :: Text)
        , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Timestamp -> Value
forall a. ToJSON a => a -> Value
toJSON Timestamp
timestamp
        ]

frozenTimestamp :: SpanFrozenTimestamp -> Timestamp
frozenTimestamp :: SpanFrozenTimestamp -> Timestamp
frozenTimestamp = \case
  SpanFrozenTimestampFrozen Timestamp
timestamp -> Timestamp
timestamp
  SpanFrozenTimestampEnded Timestamp
timestamp -> Timestamp
timestamp

freezeSpan
  :: Timestamp
  -> AttrsLimits 'AttrsForSpanLink
  -> AttrsLimits 'AttrsForSpanEvent
  -> AttrsLimits 'AttrsForSpan
  -> Span AttrsBuilder
  -> Span Attrs
freezeSpan :: Timestamp
-> AttrsLimits 'AttrsForSpanLink
-> AttrsLimits 'AttrsForSpanEvent
-> AttrsLimits 'AttrsForSpan
-> Span AttrsBuilder
-> Span Attrs
freezeSpan Timestamp
defaultSpanFrozenAt AttrsLimits 'AttrsForSpanLink
spanLinkAttrsLimits AttrsLimits 'AttrsForSpanEvent
spanEventAttrsLimits AttrsLimits 'AttrsForSpan
spanAttrsLimits Span AttrsBuilder
span =
  Span AttrsBuilder
span
    { spanFrozenAt =
        case spanFrozenAt span of
          Maybe Timestamp
SpanFrozenAt AttrsBuilder
Nothing -> Timestamp -> SpanFrozenTimestamp
SpanFrozenTimestampFrozen Timestamp
defaultSpanFrozenAt
          Just Timestamp
timestamp -> Timestamp -> SpanFrozenTimestamp
SpanFrozenTimestampEnded Timestamp
timestamp
    , spanAttrs =
        runAttrsBuilder (spanAttrs span) spanAttrsLimits
    , spanLinks =
        freezeAllSpanLinkAttrs spanLinkAttrsLimits $ spanLinks span
    , spanEvents =
        freezeAllSpanEventAttrs spanEventAttrsLimits $ spanEvents span
    }

data SpanLineage
  = SpanLineageRoot
  | SpanLineageChildOf SpanContext
  deriving stock (SpanLineage -> SpanLineage -> Bool
(SpanLineage -> SpanLineage -> Bool)
-> (SpanLineage -> SpanLineage -> Bool) -> Eq SpanLineage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanLineage -> SpanLineage -> Bool
== :: SpanLineage -> SpanLineage -> Bool
$c/= :: SpanLineage -> SpanLineage -> Bool
/= :: SpanLineage -> SpanLineage -> Bool
Eq, Int -> SpanLineage -> ShowS
[SpanLineage] -> ShowS
SpanLineage -> String
(Int -> SpanLineage -> ShowS)
-> (SpanLineage -> String)
-> ([SpanLineage] -> ShowS)
-> Show SpanLineage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanLineage -> ShowS
showsPrec :: Int -> SpanLineage -> ShowS
$cshow :: SpanLineage -> String
show :: SpanLineage -> String
$cshowList :: [SpanLineage] -> ShowS
showList :: [SpanLineage] -> ShowS
Show)

instance ToJSON SpanLineage where
  toJSON :: SpanLineage -> Value
toJSON = \case
    SpanLineage
SpanLineageRoot ->
      [Pair] -> Value
Aeson.object
        [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"root" :: Text)
        ]
    SpanLineageChildOf SpanContext
spanContext ->
      [Pair] -> Value
Aeson.object
        [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"childOf" :: Text)
        , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SpanContext -> Value
forall a. ToJSON a => a -> Value
toJSON SpanContext
spanContext
        ]

data SpanKind
  = SpanKindServer
  | SpanKindClient
  | SpanKindProducer
  | SpanKindConsumer
  | SpanKindInternal
  deriving stock (SpanKind -> SpanKind -> Bool
(SpanKind -> SpanKind -> Bool)
-> (SpanKind -> SpanKind -> Bool) -> Eq SpanKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanKind -> SpanKind -> Bool
== :: SpanKind -> SpanKind -> Bool
$c/= :: SpanKind -> SpanKind -> Bool
/= :: SpanKind -> SpanKind -> Bool
Eq, Int -> SpanKind -> ShowS
[SpanKind] -> ShowS
SpanKind -> String
(Int -> SpanKind -> ShowS)
-> (SpanKind -> String) -> ([SpanKind] -> ShowS) -> Show SpanKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanKind -> ShowS
showsPrec :: Int -> SpanKind -> ShowS
$cshow :: SpanKind -> String
show :: SpanKind -> String
$cshowList :: [SpanKind] -> ShowS
showList :: [SpanKind] -> ShowS
Show)

instance ToJSON SpanKind where
  toJSON :: SpanKind -> Value
toJSON = \case
    SpanKind
SpanKindServer -> [Pair] -> Value
Aeson.object [Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"server" :: Text)]
    SpanKind
SpanKindClient -> [Pair] -> Value
Aeson.object [Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"client" :: Text)]
    SpanKind
SpanKindProducer -> [Pair] -> Value
Aeson.object [Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"producer" :: Text)]
    SpanKind
SpanKindConsumer -> [Pair] -> Value
Aeson.object [Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"consumer" :: Text)]
    SpanKind
SpanKindInternal -> [Pair] -> Value
Aeson.object [Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"internal" :: Text)]

data SpanStatus
  = SpanStatusUnset
  | SpanStatusError Text
  | SpanStatusOk
  deriving stock (SpanStatus -> SpanStatus -> Bool
(SpanStatus -> SpanStatus -> Bool)
-> (SpanStatus -> SpanStatus -> Bool) -> Eq SpanStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanStatus -> SpanStatus -> Bool
== :: SpanStatus -> SpanStatus -> Bool
$c/= :: SpanStatus -> SpanStatus -> Bool
/= :: SpanStatus -> SpanStatus -> Bool
Eq, Int -> SpanStatus -> ShowS
[SpanStatus] -> ShowS
SpanStatus -> String
(Int -> SpanStatus -> ShowS)
-> (SpanStatus -> String)
-> ([SpanStatus] -> ShowS)
-> Show SpanStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanStatus -> ShowS
showsPrec :: Int -> SpanStatus -> ShowS
$cshow :: SpanStatus -> String
show :: SpanStatus -> String
$cshowList :: [SpanStatus] -> ShowS
showList :: [SpanStatus] -> ShowS
Show)

instance Ord SpanStatus where
  compare :: SpanStatus -> SpanStatus -> Ordering
compare SpanStatus
x SpanStatus
y =
    case (SpanStatus
x, SpanStatus
y) of
      (SpanStatusUnset {}, SpanStatusUnset {}) -> Ordering
EQ
      (SpanStatusUnset {}, SpanStatusError {}) -> Ordering
LT
      (SpanStatusUnset {}, SpanStatusOk {}) -> Ordering
LT
      (SpanStatusError {}, SpanStatusUnset {}) -> Ordering
GT
      (SpanStatusError {}, SpanStatusError {}) -> Ordering
EQ
      (SpanStatusError {}, SpanStatusOk {}) -> Ordering
LT
      (SpanStatusOk {}, SpanStatusUnset {}) -> Ordering
GT
      (SpanStatusOk {}, SpanStatusError {}) -> Ordering
GT
      (SpanStatusOk {}, SpanStatusOk {}) -> Ordering
EQ

instance ToJSON SpanStatus where
  toJSON :: SpanStatus -> Value
toJSON = \case
    SpanStatus
SpanStatusUnset ->
      [Pair] -> Value
Aeson.object
        [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"unset" :: Text)
        ]
    SpanStatus
SpanStatusOk ->
      [Pair] -> Value
Aeson.object
        [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"ok" :: Text)
        ]
    SpanStatusError Text
errText ->
      [Pair] -> Value
Aeson.object
        [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"error" :: Text)
        , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
errText
        ]

-- $disclaimer
--
-- In general, changes to this module will not be reflected in the library's
-- version updates. Direct use of this module should be done with utmost care,
-- otherwise invariants will easily be violated.