module OpenTelemetry.Contrib.SpanTraversals (
alterSpansUpwards,
IterationInstruction (..),
) where
import Control.Monad.IO.Class
import Data.IORef
import OpenTelemetry.Internal.Trace.Types
data IterationInstruction a = Continue a | Halt
alterSpansUpwards :: (MonadIO m) => Span -> st -> (st -> ImmutableSpan -> (IterationInstruction st, ImmutableSpan)) -> m st
alterSpansUpwards :: forall (m :: * -> *) st.
MonadIO m =>
Span
-> st
-> (st
-> ImmutableSpan -> (IterationInstruction st, ImmutableSpan))
-> m st
alterSpansUpwards (Span IORef ImmutableSpan
immutableSpanRef) st
st st -> ImmutableSpan -> (IterationInstruction st, ImmutableSpan)
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
(IterationInstruction st
step, ImmutableSpan
a') <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef ImmutableSpan
immutableSpanRef (\ImmutableSpan
a -> let (IterationInstruction st
step, ImmutableSpan
a') = st -> ImmutableSpan -> (IterationInstruction st, ImmutableSpan)
f st
st ImmutableSpan
a in (ImmutableSpan
a', (IterationInstruction st
step, ImmutableSpan
a')))
case IterationInstruction st
step of
Continue st
st' -> case ImmutableSpan -> Maybe Span
spanParent ImmutableSpan
a' of
Maybe Span
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return st
st'
Just Span
s -> forall (m :: * -> *) st.
MonadIO m =>
Span
-> st
-> (st
-> ImmutableSpan -> (IterationInstruction st, ImmutableSpan))
-> m st
alterSpansUpwards Span
s st
st' st -> ImmutableSpan -> (IterationInstruction st, ImmutableSpan)
f
IterationInstruction st
Halt -> forall (m :: * -> *) a. Monad m => a -> m a
return st
st
alterSpansUpwards (FrozenSpan SpanContext
_) st
st st -> ImmutableSpan -> (IterationInstruction st, ImmutableSpan)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return st
st
alterSpansUpwards (Dropped SpanContext
_) st
st st -> ImmutableSpan -> (IterationInstruction st, ImmutableSpan)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return st
st