{-# LANGUAGE DeriveGeneric #-}
module Instana.SDK.Internal.SpanStack
( SpanStack
, empty
, entry
, isEmpty
, isSuppressed
, mapEntry
, mapTop
, peek
, pop
, popWhenMatches
, push
, pushSuppress
, readTraceId
, readW3cTraceContext
, suppress
) where
import GHC.Generics
import Instana.SDK.Internal.Id (Id)
import Instana.SDK.Internal.Util ((|>))
import Instana.SDK.Internal.W3CTraceContext (W3CTraceContext)
import Instana.SDK.Span.EntrySpan (EntrySpan)
import qualified Instana.SDK.Span.EntrySpan as EntrySpan
import Instana.SDK.Span.ExitSpan (ExitSpan)
import qualified Instana.SDK.Span.ExitSpan as ExitSpan
import Instana.SDK.Span.Span (Span (..), SpanKind (..))
data SpanStack =
None
| Suppressed W3CTraceContext
| EntryOnly EntrySpan
| EntryAndExit EntrySpan ExitSpan
deriving (SpanStack -> SpanStack -> Bool
(SpanStack -> SpanStack -> Bool)
-> (SpanStack -> SpanStack -> Bool) -> Eq SpanStack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanStack -> SpanStack -> Bool
$c/= :: SpanStack -> SpanStack -> Bool
== :: SpanStack -> SpanStack -> Bool
$c== :: SpanStack -> SpanStack -> Bool
Eq, (forall x. SpanStack -> Rep SpanStack x)
-> (forall x. Rep SpanStack x -> SpanStack) -> Generic SpanStack
forall x. Rep SpanStack x -> SpanStack
forall x. SpanStack -> Rep SpanStack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpanStack x -> SpanStack
$cfrom :: forall x. SpanStack -> Rep SpanStack x
Generic, Int -> SpanStack -> ShowS
[SpanStack] -> ShowS
SpanStack -> String
(Int -> SpanStack -> ShowS)
-> (SpanStack -> String)
-> ([SpanStack] -> ShowS)
-> Show SpanStack
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanStack] -> ShowS
$cshowList :: [SpanStack] -> ShowS
show :: SpanStack -> String
$cshow :: SpanStack -> String
showsPrec :: Int -> SpanStack -> ShowS
$cshowsPrec :: Int -> SpanStack -> ShowS
Show)
empty :: SpanStack
empty :: SpanStack
empty =
SpanStack
None
entry :: EntrySpan -> SpanStack
entry :: EntrySpan -> SpanStack
entry entrySpan :: EntrySpan
entrySpan =
SpanStack
empty
SpanStack -> (SpanStack -> SpanStack) -> SpanStack
forall a b. a -> (a -> b) -> b
|> Span -> SpanStack -> SpanStack
push (EntrySpan -> Span
Entry EntrySpan
entrySpan)
suppress :: W3CTraceContext -> SpanStack
suppress :: W3CTraceContext -> SpanStack
suppress =
W3CTraceContext -> SpanStack
Suppressed
isEmpty :: SpanStack -> Bool
isEmpty :: SpanStack -> Bool
isEmpty t :: SpanStack
t =
SpanStack
t SpanStack -> SpanStack -> Bool
forall a. Eq a => a -> a -> Bool
== SpanStack
None
isSuppressed :: SpanStack -> Bool
isSuppressed :: SpanStack -> Bool
isSuppressed stack :: SpanStack
stack =
case SpanStack
stack of
Suppressed _ -> Bool
True
_ -> Bool
False
push :: Span -> SpanStack -> SpanStack
push :: Span -> SpanStack -> SpanStack
push (Entry entrySpan :: EntrySpan
entrySpan) None =
EntrySpan -> SpanStack
EntryOnly EntrySpan
entrySpan
push (Entry entrySpan :: EntrySpan
entrySpan) (Suppressed _) =
EntrySpan -> SpanStack
EntryOnly EntrySpan
entrySpan
push (Exit exitSpan :: ExitSpan
exitSpan) (EntryOnly entrySpan :: EntrySpan
entrySpan) =
EntrySpan -> ExitSpan -> SpanStack
EntryAndExit EntrySpan
entrySpan ExitSpan
exitSpan
push _ current :: SpanStack
current =
SpanStack
current
pushSuppress :: W3CTraceContext -> SpanStack -> SpanStack
pushSuppress :: W3CTraceContext -> SpanStack -> SpanStack
pushSuppress w3cTraceContext :: W3CTraceContext
w3cTraceContext None =
W3CTraceContext -> SpanStack
Suppressed W3CTraceContext
w3cTraceContext
pushSuppress w3cTraceContext :: W3CTraceContext
w3cTraceContext (Suppressed _) =
W3CTraceContext -> SpanStack
Suppressed W3CTraceContext
w3cTraceContext
pushSuppress _ current :: SpanStack
current =
SpanStack
current
pop :: SpanStack -> (SpanStack, Maybe Span)
pop :: SpanStack -> (SpanStack, Maybe Span)
pop None =
(SpanStack
None, Maybe Span
forall a. Maybe a
Nothing)
pop (Suppressed _) =
(SpanStack
None, Maybe Span
forall a. Maybe a
Nothing)
pop (EntryOnly entrySpan :: EntrySpan
entrySpan) =
(SpanStack
None, Span -> Maybe Span
forall a. a -> Maybe a
Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ EntrySpan -> Span
Entry EntrySpan
entrySpan)
pop (EntryAndExit entrySpan :: EntrySpan
entrySpan exitSpan :: ExitSpan
exitSpan) =
(EntrySpan -> SpanStack
EntryOnly EntrySpan
entrySpan, Span -> Maybe Span
forall a. a -> Maybe a
Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ ExitSpan -> Span
Exit ExitSpan
exitSpan)
popWhenMatches :: SpanKind -> SpanStack -> (SpanStack, Maybe Span, Maybe String)
popWhenMatches :: SpanKind -> SpanStack -> (SpanStack, Maybe Span, Maybe String)
popWhenMatches _ None =
(SpanStack
None, Maybe Span
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)
popWhenMatches EntryKind (Suppressed _) =
(SpanStack
None, Maybe Span
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)
popWhenMatches _ (Suppressed w3cTraceContext :: W3CTraceContext
w3cTraceContext) =
(W3CTraceContext -> SpanStack
Suppressed W3CTraceContext
w3cTraceContext, Maybe Span
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)
popWhenMatches expectedKind :: SpanKind
expectedKind stack :: SpanStack
stack =
case (SpanKind
expectedKind, SpanStack -> Maybe Span
peek SpanStack
stack) of
(EntryKind, Just (Entry _)) ->
(SpanStack
st, Maybe Span
sp, Maybe String
forall a. Maybe a
Nothing)
where
(st :: SpanStack
st, sp :: Maybe Span
sp) = SpanStack -> (SpanStack, Maybe Span)
pop SpanStack
stack
(ExitKind, Just (Exit _)) ->
(SpanStack
st, Maybe Span
sp, Maybe String
forall a. Maybe a
Nothing)
where
(st :: SpanStack
st, sp :: Maybe Span
sp) = SpanStack -> (SpanStack, Maybe Span)
pop SpanStack
stack
(_, actualTopElement :: Maybe Span
actualTopElement) ->
( SpanStack
stack
, Maybe Span
forall a. Maybe a
Nothing
, String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ "Cannot pop \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SpanKind -> String
forall a. Show a => a -> String
show SpanKind
expectedKind) String -> ShowS
forall a. [a] -> [a] -> [a]
++
" from span stack. Current top element: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Span -> String
forall a. Show a => a -> String
show Maybe Span
actualTopElement
)
peek :: SpanStack -> Maybe Span
peek :: SpanStack -> Maybe Span
peek None =
Maybe Span
forall a. Maybe a
Nothing
peek (Suppressed _) =
Maybe Span
forall a. Maybe a
Nothing
peek (EntryOnly entrySpan :: EntrySpan
entrySpan) =
Span -> Maybe Span
forall a. a -> Maybe a
Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ EntrySpan -> Span
Entry EntrySpan
entrySpan
peek (EntryAndExit _ exitSpan :: ExitSpan
exitSpan) =
Span -> Maybe Span
forall a. a -> Maybe a
Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ ExitSpan -> Span
Exit ExitSpan
exitSpan
readTraceId :: SpanStack -> Maybe Id
readTraceId :: SpanStack -> Maybe Id
readTraceId None =
Maybe Id
forall a. Maybe a
Nothing
readTraceId (Suppressed _) =
Maybe Id
forall a. Maybe a
Nothing
readTraceId (EntryOnly entrySpan :: EntrySpan
entrySpan) =
Id -> Maybe Id
forall a. a -> Maybe a
Just (Id -> Maybe Id) -> Id -> Maybe Id
forall a b. (a -> b) -> a -> b
$ EntrySpan -> Id
EntrySpan.traceId EntrySpan
entrySpan
readTraceId (EntryAndExit entrySpan :: EntrySpan
entrySpan _) =
Id -> Maybe Id
forall a. a -> Maybe a
Just (Id -> Maybe Id) -> Id -> Maybe Id
forall a b. (a -> b) -> a -> b
$ EntrySpan -> Id
EntrySpan.traceId EntrySpan
entrySpan
readW3cTraceContext :: SpanStack -> Maybe W3CTraceContext
readW3cTraceContext :: SpanStack -> Maybe W3CTraceContext
readW3cTraceContext None =
Maybe W3CTraceContext
forall a. Maybe a
Nothing
readW3cTraceContext (Suppressed w3cTraceContext :: W3CTraceContext
w3cTraceContext) =
W3CTraceContext -> Maybe W3CTraceContext
forall a. a -> Maybe a
Just W3CTraceContext
w3cTraceContext
readW3cTraceContext (EntryOnly entrySpan :: EntrySpan
entrySpan) =
EntrySpan -> Maybe W3CTraceContext
EntrySpan.w3cTraceContext EntrySpan
entrySpan
readW3cTraceContext (EntryAndExit _ exitSpan :: ExitSpan
exitSpan) =
W3CTraceContext -> Maybe W3CTraceContext
forall a. a -> Maybe a
Just (W3CTraceContext -> Maybe W3CTraceContext)
-> W3CTraceContext -> Maybe W3CTraceContext
forall a b. (a -> b) -> a -> b
$ ExitSpan -> W3CTraceContext
ExitSpan.w3cTraceContext ExitSpan
exitSpan
mapTop :: (Span -> Span) -> SpanStack -> SpanStack
mapTop :: (Span -> Span) -> SpanStack -> SpanStack
mapTop _ None =
SpanStack
None
mapTop _ (Suppressed w3cTraceContext :: W3CTraceContext
w3cTraceContext) =
W3CTraceContext -> SpanStack
Suppressed W3CTraceContext
w3cTraceContext
mapTop fn :: Span -> Span
fn stack :: SpanStack
stack =
let
(remainder :: SpanStack
remainder, Just oldTop :: Span
oldTop) = SpanStack -> (SpanStack, Maybe Span)
pop SpanStack
stack
newTop :: Span
newTop = Span -> Span
fn Span
oldTop
in
Span -> SpanStack -> SpanStack
push Span
newTop SpanStack
remainder
mapEntry :: (Span -> Span) -> SpanStack -> SpanStack
mapEntry :: (Span -> Span) -> SpanStack -> SpanStack
mapEntry _ None =
SpanStack
None
mapEntry _ (Suppressed w3cTraceContext :: W3CTraceContext
w3cTraceContext) =
W3CTraceContext -> SpanStack
Suppressed W3CTraceContext
w3cTraceContext
mapEntry fn :: Span -> Span
fn (EntryOnly entrySpan :: EntrySpan
entrySpan) =
(Span -> Span) -> SpanStack -> SpanStack
mapTop Span -> Span
fn (EntrySpan -> SpanStack
EntryOnly EntrySpan
entrySpan)
mapEntry fn :: Span -> Span
fn (EntryAndExit oldEntrySpan :: EntrySpan
oldEntrySpan oldExitSpan :: ExitSpan
oldExitSpan) =
let
(Entry newEntrySpan :: EntrySpan
newEntrySpan) = Span -> Span
fn (EntrySpan -> Span
Entry EntrySpan
oldEntrySpan)
in
EntrySpan -> ExitSpan -> SpanStack
EntryAndExit EntrySpan
newEntrySpan ExitSpan
oldExitSpan