{-|
Module: OpenTracing.Span

Data types and functions for manipulating [spans](https://github.com/opentracing/specification/blob/master/specification.md#span)
-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase             #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE NamedFieldPuns         #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE RecordWildCards        #-}
{-# LANGUAGE StrictData             #-}
{-# LANGUAGE TemplateHaskell        #-}
{-# LANGUAGE TupleSections          #-}

module OpenTracing.Span
    ( SpanContext(..)
    , ctxSampled
    , ctxBaggage

    , Span
    , newSpan

    , HasSpanFields

    , ActiveSpan
    , mkActive
    , modifyActiveSpan
    , readActiveSpan
    , addTag
    , addLogRecord
    , addLogRecord'
    , setBaggageItem
    , getBaggageItem

    , FinishedSpan
    , spanFinish

    , spanContext
    , spanOperation
    , spanStart
    , spanTags
    , spanRefs
    , spanLogs
    , spanDuration

    , SpanOpts
    , spanOpts
    , spanOptOperation
    , spanOptRefs
    , spanOptTags
    , spanOptSampled

    , Reference(..)
    , findParent

    , SpanRefs
    , refActiveParents
    , refPredecessors
    , refPropagated
    , childOf
    , followsFrom
    , freezeRefs

    , Sampled(..)
    , _IsSampled
    , sampled

    , Traced(..)
    )
where

import Control.Applicative
import Control.Lens           hiding (op, pre, (.=))
import Control.Monad.IO.Class
import Data.Aeson             (ToJSON (..), object, (.=))
import Data.Aeson.Encoding    (int, pairs)
import Data.Bool              (bool)
import Data.Foldable
import Data.HashMap.Strict    (HashMap, insert)
import Data.IORef
import Data.List.NonEmpty     (NonEmpty (..))
import Data.Semigroup
import Data.Text              (Text)
import Data.Time.Clock
import Data.Word
import OpenTracing.Log
import OpenTracing.Tags
import OpenTracing.Types
import Prelude                hiding (span)

-- | A `SpanContext` is the data that uniquely identifies a span
-- and the context in which it occurs. Spans occur in traces, which form
-- complete pictures of a computation, potentially across multiple machines.
--
-- @since 0.1.0.0
data SpanContext = SpanContext
    { SpanContext -> TraceID
ctxTraceID      :: TraceID
    -- ^ A trace identifier. Trace ids are globally unique
    , SpanContext -> Word64
ctxSpanID       :: Word64
    -- ^ A span identifier. Span identifiers are unique to their trace.
    , SpanContext -> Maybe Word64
ctxParentSpanID :: Maybe Word64
    -- ^ Spans without a parent are known as "root spans"
    , SpanContext -> Sampled
_ctxSampled     :: Sampled
    -- ^ Whether or not this span is going to be reported.
    , SpanContext -> HashMap Text Text
_ctxBaggage     :: HashMap Text Text
    -- ^ Baggage is arbitrary key:value pairs that cross process boundaries.
    }

instance ToJSON SpanContext where
    toEncoding :: SpanContext -> Encoding
toEncoding SpanContext{Maybe Word64
Word64
HashMap Text Text
TraceID
Sampled
_ctxBaggage :: HashMap Text Text
_ctxSampled :: Sampled
ctxParentSpanID :: Maybe Word64
ctxSpanID :: Word64
ctxTraceID :: TraceID
_ctxBaggage :: SpanContext -> HashMap Text Text
_ctxSampled :: SpanContext -> Sampled
ctxParentSpanID :: SpanContext -> Maybe Word64
ctxSpanID :: SpanContext -> Word64
ctxTraceID :: SpanContext -> TraceID
..} = Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$
           Key
"trace_id" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. AsHex a => Getter a Text
hexText TraceID
ctxTraceID
        forall a. Semigroup a => a -> a -> a
<> Key
"span_id"  forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. AsHex a => Getter a Text
hexText Word64
ctxSpanID
        forall a. Semigroup a => a -> a -> a
<> Key
"sampled"  forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Sampled
_ctxSampled
        forall a. Semigroup a => a -> a -> a
<> Key
"baggage"  forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HashMap Text Text
_ctxBaggage

    toJSON :: SpanContext -> Value
toJSON SpanContext{Maybe Word64
Word64
HashMap Text Text
TraceID
Sampled
_ctxBaggage :: HashMap Text Text
_ctxSampled :: Sampled
ctxParentSpanID :: Maybe Word64
ctxSpanID :: Word64
ctxTraceID :: TraceID
_ctxBaggage :: SpanContext -> HashMap Text Text
_ctxSampled :: SpanContext -> Sampled
ctxParentSpanID :: SpanContext -> Maybe Word64
ctxSpanID :: SpanContext -> Word64
ctxTraceID :: SpanContext -> TraceID
..} = [Pair] -> Value
object
        [ Key
"trace_id" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. AsHex a => Getter a Text
hexText TraceID
ctxTraceID
        , Key
"span_id"  forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. AsHex a => Getter a Text
hexText Word64
ctxSpanID
        , Key
"sampled"  forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Sampled
_ctxSampled
        , Key
"baggage"  forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HashMap Text Text
_ctxBaggage
        ]

-- | A wrapper for a value that was produced by a traced computation.
--
-- @since 0.1.0.0
data Traced a = Traced
    { forall a. Traced a -> a
tracedResult :: a
    -- ^ The raw value produced
    , forall a. Traced a -> FinishedSpan
tracedSpan   :: ~FinishedSpan
    -- ^ The resulting span that was created
    }

-- | A datatype indicating whether a recorded span was sampled, i.e. whether or not
-- it will be reported. Traces are often sampled in high volume environments to keep
-- the amount of data generated manageable.
--
-- @since 0.1.0.0
data Sampled = NotSampled | Sampled
    deriving (Sampled -> Sampled -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sampled -> Sampled -> Bool
$c/= :: Sampled -> Sampled -> Bool
== :: Sampled -> Sampled -> Bool
$c== :: Sampled -> Sampled -> Bool
Eq, Int -> Sampled -> ShowS
[Sampled] -> ShowS
Sampled -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sampled] -> ShowS
$cshowList :: [Sampled] -> ShowS
show :: Sampled -> String
$cshow :: Sampled -> String
showsPrec :: Int -> Sampled -> ShowS
$cshowsPrec :: Int -> Sampled -> ShowS
Show, ReadPrec [Sampled]
ReadPrec Sampled
Int -> ReadS Sampled
ReadS [Sampled]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Sampled]
$creadListPrec :: ReadPrec [Sampled]
readPrec :: ReadPrec Sampled
$creadPrec :: ReadPrec Sampled
readList :: ReadS [Sampled]
$creadList :: ReadS [Sampled]
readsPrec :: Int -> ReadS Sampled
$creadsPrec :: Int -> ReadS Sampled
Read, Sampled
forall a. a -> a -> Bounded a
maxBound :: Sampled
$cmaxBound :: Sampled
minBound :: Sampled
$cminBound :: Sampled
Bounded, Int -> Sampled
Sampled -> Int
Sampled -> [Sampled]
Sampled -> Sampled
Sampled -> Sampled -> [Sampled]
Sampled -> Sampled -> Sampled -> [Sampled]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Sampled -> Sampled -> Sampled -> [Sampled]
$cenumFromThenTo :: Sampled -> Sampled -> Sampled -> [Sampled]
enumFromTo :: Sampled -> Sampled -> [Sampled]
$cenumFromTo :: Sampled -> Sampled -> [Sampled]
enumFromThen :: Sampled -> Sampled -> [Sampled]
$cenumFromThen :: Sampled -> Sampled -> [Sampled]
enumFrom :: Sampled -> [Sampled]
$cenumFrom :: Sampled -> [Sampled]
fromEnum :: Sampled -> Int
$cfromEnum :: Sampled -> Int
toEnum :: Int -> Sampled
$ctoEnum :: Int -> Sampled
pred :: Sampled -> Sampled
$cpred :: Sampled -> Sampled
succ :: Sampled -> Sampled
$csucc :: Sampled -> Sampled
Enum)

instance ToJSON Sampled where
    toJSON :: Sampled -> Value
toJSON     = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
    toEncoding :: Sampled -> Encoding
toEncoding = Int -> Encoding
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

_IsSampled :: Iso' Bool Sampled
_IsSampled :: Iso' Bool Sampled
_IsSampled = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a. a -> a -> Bool -> a
bool Sampled
NotSampled Sampled
Sampled) forall a b. (a -> b) -> a -> b
$ \case
    Sampled
Sampled    -> Bool
True
    Sampled
NotSampled -> Bool
False

-- | A reference from one span to another. Spans can be related in two ways:
--
--   * `ChildOf` indicates that the parent span is dependent on the child span in order
--      to produce its own result.
--
--   * `FollowsFrom` indicates that there is no dependence relation, perhaps the
--      parent span spawned an asynchronous task.
--
-- More info in the [OpenTracing spec](https://github.com/opentracing/specification/blob/master/specification.md#references-between-spans)
--
-- @since 0.1.0.0
data Reference
    = ChildOf     { Reference -> SpanContext
refCtx :: SpanContext }
    | FollowsFrom { refCtx :: SpanContext }

findParent :: Foldable t => t Reference -> Maybe Reference
findParent :: forall (t :: * -> *). Foldable t => t Reference -> Maybe Reference
findParent = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe Reference -> Reference -> Maybe Reference
go forall a. Maybe a
Nothing
  where
    go :: Maybe Reference -> Reference -> Maybe Reference
go Maybe Reference
Nothing  Reference
y = forall a. a -> Maybe a
Just Reference
y
    go (Just Reference
x) Reference
y = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Reference -> Reference -> Ordering
prec Reference
x Reference
y of { Ordering
LT -> Reference
y; Ordering
_ -> Reference
x }

    prec :: Reference -> Reference -> Ordering
prec (ChildOf     SpanContext
_) (FollowsFrom SpanContext
_) = Ordering
GT
    prec (FollowsFrom SpanContext
_) (ChildOf     SpanContext
_) = Ordering
LT
    prec Reference
_               Reference
_               = Ordering
EQ

-- | The different references that a span can hold to other spans.
--
-- @since 0.1.0.0
data SpanRefs = SpanRefs
    { SpanRefs -> [ActiveSpan]
_refActiveParents :: [ActiveSpan  ]
    -- ^ Parent span references. `ActiveSpans` are still in progress (parent spans by
    -- definition depend on their children to complete)
    , SpanRefs -> [FinishedSpan]
_refPredecessors  :: [FinishedSpan]
    -- ^ Spans that this span `FollowsFrom`
    , SpanRefs -> [Reference]
_refPropagated    :: [Reference   ]
    -- ^ References that are propagated across process boundaries. Can be either parents
    -- or predecessors.
    }

instance Semigroup SpanRefs where
    (SpanRefs [ActiveSpan]
par [FinishedSpan]
pre [Reference]
pro) <> :: SpanRefs -> SpanRefs -> SpanRefs
<> (SpanRefs [ActiveSpan]
par' [FinishedSpan]
pre' [Reference]
pro') = SpanRefs
        { _refActiveParents :: [ActiveSpan]
_refActiveParents = [ActiveSpan]
par forall a. Semigroup a => a -> a -> a
<> [ActiveSpan]
par'
        , _refPredecessors :: [FinishedSpan]
_refPredecessors  = [FinishedSpan]
pre forall a. Semigroup a => a -> a -> a
<> [FinishedSpan]
pre'
        , _refPropagated :: [Reference]
_refPropagated    = [Reference]
pro forall a. Semigroup a => a -> a -> a
<> [Reference]
pro'
        }

instance Monoid SpanRefs where
    mempty :: SpanRefs
mempty  = [ActiveSpan] -> [FinishedSpan] -> [Reference] -> SpanRefs
SpanRefs forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
    mappend :: SpanRefs -> SpanRefs -> SpanRefs
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Create a `SpanRefs` containing the single refrence to a parent span.
--
-- @since 0.1.0.0
childOf :: ActiveSpan -> SpanRefs
childOf :: ActiveSpan -> SpanRefs
childOf ActiveSpan
a = forall a. Monoid a => a
mempty { _refActiveParents :: [ActiveSpan]
_refActiveParents = [ActiveSpan
a] }

-- | Create a `SpanRefs` containing the single refrence to a predecessor span.
--
-- @since 0.1.0.0
followsFrom :: FinishedSpan -> SpanRefs
followsFrom :: FinishedSpan -> SpanRefs
followsFrom FinishedSpan
a = forall a. Monoid a => a
mempty { _refPredecessors :: [FinishedSpan]
_refPredecessors = [FinishedSpan
a] }

-- | Convert `SpanRefs` (which may include the mutable `ActiveSpan`s) into
-- an immutable list of `Reference`s
--
-- @since 0.1.0.0
freezeRefs :: SpanRefs -> IO [Reference]
freezeRefs :: SpanRefs -> IO [Reference]
freezeRefs SpanRefs{[FinishedSpan]
[ActiveSpan]
[Reference]
_refPropagated :: [Reference]
_refPredecessors :: [FinishedSpan]
_refActiveParents :: [ActiveSpan]
_refPropagated :: SpanRefs -> [Reference]
_refPredecessors :: SpanRefs -> [FinishedSpan]
_refActiveParents :: SpanRefs -> [ActiveSpan]
..} = do
    [Reference]
a <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SpanContext -> Reference
ChildOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> SpanContext
_sContext) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => ActiveSpan -> m Span
readActiveSpan) [ActiveSpan]
_refActiveParents
    let b :: [Reference]
b = forall a b. (a -> b) -> [a] -> [b]
map (SpanContext -> Reference
FollowsFrom forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinishedSpan -> SpanContext
_fContext) [FinishedSpan]
_refPredecessors
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Reference]
a forall a. Semigroup a => a -> a -> a
<> [Reference]
b forall a. Semigroup a => a -> a -> a
<> [Reference]
_refPropagated

-- | `SpanOpts` is the metadata information about a span needed in order to start
-- measuring a span. This is the information that application code will provide in
-- order to indicate what a span is doing and how it related to other spans. More info
-- in the [OpenTracing spec](https://github.com/opentracing/specification/blob/master/specification.md#start-a-new-span)
--
-- @since 0.1.0.0
data SpanOpts = SpanOpts
    { SpanOpts -> Text
_spanOptOperation :: Text
    -- ^ The span operation, a human-readable string which concisely represents the
    -- work done by the Span
    , SpanOpts -> SpanRefs
_spanOptRefs      :: SpanRefs
    -- ^ Zero or more references to related spans. Zero references indicates that
    -- a span is a root span and should be given a new trace ID.
    , SpanOpts -> [Tag]
_spanOptTags      :: [Tag]
    -- ^ Tags describing the work done by the span in more detail than the operation
    -- provides.
    , SpanOpts -> Maybe Sampled
_spanOptSampled   :: Maybe Sampled
    -- ^ Force 'Span' to be sampled (or not).
    -- 'Nothing' denotes leave decision to 'Sampler' (the default)
    }

-- | Create a new `SpanOpts` with the minimal amount of required information.
--
-- @since 0.1.0.0
spanOpts :: Text -> SpanRefs -> SpanOpts
spanOpts :: Text -> SpanRefs -> SpanOpts
spanOpts Text
op SpanRefs
refs = SpanOpts
    { _spanOptOperation :: Text
_spanOptOperation = Text
op
    , _spanOptRefs :: SpanRefs
_spanOptRefs      = SpanRefs
refs
    , _spanOptTags :: [Tag]
_spanOptTags      = forall a. Monoid a => a
mempty
    , _spanOptSampled :: Maybe Sampled
_spanOptSampled   = forall a. Maybe a
Nothing
    }

-- | `Span` is a span that has been started (but not finished). See the [OpenTracing spec](https://github.com/opentracing/specification/blob/master/specification.md#span) for
-- more info
--
-- @since 0.1.0.0
data Span = Span
    { Span -> SpanContext
_sContext   :: SpanContext
    -- ^ The context in which a span occurs
    , Span -> Text
_sOperation :: Text
    -- ^ The operation that describes a span (see `SpanOpts` for more info)
    , Span -> UTCTime
_sStart     :: UTCTime
    -- ^ The time that the span started
    , Span -> Tags
_sTags      :: Tags
    -- ^ Tags describing the span in more detail than the operation.
    , Span -> SpanRefs
_sRefs      :: SpanRefs
    -- ^ References the span holds to other spans
    , Span -> [LogRecord]
_sLogs      :: [LogRecord]
    -- ^ Structured data the describe events over the lifetime of the span
    }

-- | Create a new `Span` with the provided info. The created `Span` will have a start
-- time equal to the system time when `newSpan` is called.
--
-- @since 0.1.0.0
newSpan
    :: ( MonadIO  m
       , Foldable t
       )
    => SpanContext
    -> Text
    -> SpanRefs
    -> t Tag
    -> m Span
newSpan :: forall (m :: * -> *) (t :: * -> *).
(MonadIO m, Foldable t) =>
SpanContext -> Text -> SpanRefs -> t Tag -> m Span
newSpan SpanContext
ctx Text
op SpanRefs
refs t Tag
ts = do
    UTCTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Span
        { _sContext :: SpanContext
_sContext   = SpanContext
ctx
        , _sOperation :: Text
_sOperation = Text
op
        , _sStart :: UTCTime
_sStart     = UTCTime
t
        , _sTags :: Tags
_sTags      = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Tag -> Tags -> Tags
`setTag` forall a. Monoid a => a
mempty) t Tag
ts
        , _sRefs :: SpanRefs
_sRefs      = SpanRefs
refs
        , _sLogs :: [LogRecord]
_sLogs      = forall a. Monoid a => a
mempty
        }

-- | A mutable `Span` that is currently being recorded.
--
-- @since 0.1.0.0
newtype ActiveSpan = ActiveSpan { ActiveSpan -> IORef Span
fromActiveSpan :: IORef Span }

-- | @since 0.1.0.0
mkActive :: MonadIO m => Span -> m ActiveSpan
mkActive :: forall (m :: * -> *). MonadIO m => Span -> m ActiveSpan
mkActive = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef Span -> ActiveSpan
ActiveSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO (IORef a)
newIORef

-- | @since 0.1.0.0
modifyActiveSpan :: MonadIO m => ActiveSpan -> (Span -> Span) -> m ()
modifyActiveSpan :: forall (m :: * -> *).
MonadIO m =>
ActiveSpan -> (Span -> Span) -> m ()
modifyActiveSpan ActiveSpan{IORef Span
fromActiveSpan :: IORef Span
fromActiveSpan :: ActiveSpan -> IORef Span
fromActiveSpan} Span -> Span
f =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Span
fromActiveSpan ((,()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Span
f)

-- | @since 0.1.0.0
readActiveSpan :: MonadIO m => ActiveSpan -> m Span
readActiveSpan :: forall (m :: * -> *). MonadIO m => ActiveSpan -> m Span
readActiveSpan = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IORef a -> IO a
readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActiveSpan -> IORef Span
fromActiveSpan

-- | A span that has finished executing.
--
-- @since 0.1.0.0
data FinishedSpan = FinishedSpan
    { FinishedSpan -> SpanContext
_fContext   :: SpanContext
    , FinishedSpan -> Text
_fOperation :: Text
    , FinishedSpan -> UTCTime
_fStart     :: UTCTime
    , FinishedSpan -> NominalDiffTime
_fDuration  :: NominalDiffTime
    , FinishedSpan -> Tags
_fTags      :: Tags
    , FinishedSpan -> [Reference]
_fRefs      :: [Reference]
    , FinishedSpan -> [LogRecord]
_fLogs      :: [LogRecord]
    }

-- | Convert an unfinished `Span` into a `FinishedSpan`
--
-- @since 0.1.0.0
spanFinish :: MonadIO m => Span -> m FinishedSpan
spanFinish :: forall (m :: * -> *). MonadIO m => Span -> m FinishedSpan
spanFinish Span
s = do
    (UTCTime
t,[Reference]
refs) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) IO UTCTime
getCurrentTime (SpanRefs -> IO [Reference]
freezeRefs (Span -> SpanRefs
_sRefs Span
s))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure FinishedSpan
        { _fContext :: SpanContext
_fContext   = Span -> SpanContext
_sContext Span
s
        , _fOperation :: Text
_fOperation = Span -> Text
_sOperation Span
s
        , _fStart :: UTCTime
_fStart     = Span -> UTCTime
_sStart Span
s
        , _fDuration :: NominalDiffTime
_fDuration  = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t (Span -> UTCTime
_sStart Span
s)
        , _fTags :: Tags
_fTags      = Span -> Tags
_sTags Span
s
        , _fRefs :: [Reference]
_fRefs      = [Reference]
refs
        , _fLogs :: [LogRecord]
_fLogs      = Span -> [LogRecord]
_sLogs Span
s
        }

makeLenses ''SpanContext
makeLenses ''SpanOpts
makeLenses ''Span
makeLenses ''FinishedSpan
makeLenses ''SpanRefs

class HasSpanFields a where
    spanContext   :: Lens' a SpanContext
    spanOperation :: Lens' a Text
    spanStart     :: Lens' a UTCTime
    spanTags      :: Lens' a Tags
    spanLogs      :: Lens' a [LogRecord]

instance HasSpanFields Span where
    spanContext :: Lens' Span SpanContext
spanContext   = Lens' Span SpanContext
sContext
    spanOperation :: Lens' Span Text
spanOperation = Lens' Span Text
sOperation
    spanStart :: Lens' Span UTCTime
spanStart     = Lens' Span UTCTime
sStart
    spanTags :: Lens' Span Tags
spanTags      = Lens' Span Tags
sTags
    spanLogs :: Lens' Span [LogRecord]
spanLogs      = Lens' Span [LogRecord]
sLogs

instance HasSpanFields FinishedSpan where
    spanContext :: Lens' FinishedSpan SpanContext
spanContext   = Lens' FinishedSpan SpanContext
fContext
    spanOperation :: Lens' FinishedSpan Text
spanOperation = Lens' FinishedSpan Text
fOperation
    spanStart :: Lens' FinishedSpan UTCTime
spanStart     = Lens' FinishedSpan UTCTime
fStart
    spanTags :: Lens' FinishedSpan Tags
spanTags      = Lens' FinishedSpan Tags
fTags
    spanLogs :: Lens' FinishedSpan [LogRecord]
spanLogs      = Lens' FinishedSpan [LogRecord]
fLogs

class HasSampled a where
    sampled :: Lens' a Sampled

instance HasSampled Sampled where
    sampled :: Lens' Sampled Sampled
sampled = forall a. a -> a
id

instance HasSampled SpanContext where
    sampled :: Lens' SpanContext Sampled
sampled = Lens' SpanContext Sampled
ctxSampled

instance HasSampled Span where
    sampled :: Lens' Span Sampled
sampled = forall a. HasSpanFields a => Lens' a SpanContext
spanContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSampled a => Lens' a Sampled
sampled

instance HasSampled FinishedSpan where
    sampled :: Lens' FinishedSpan Sampled
sampled = forall a. HasSpanFields a => Lens' a SpanContext
spanContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSampled a => Lens' a Sampled
sampled


class HasRefs s a | s -> a where
    spanRefs :: Lens' s a

instance HasRefs Span SpanRefs where
    spanRefs :: Lens' Span SpanRefs
spanRefs = Lens' Span SpanRefs
sRefs

instance HasRefs FinishedSpan [Reference] where
    spanRefs :: Lens' FinishedSpan [Reference]
spanRefs = Lens' FinishedSpan [Reference]
fRefs


spanDuration :: Lens' FinishedSpan NominalDiffTime
spanDuration :: Lens' FinishedSpan NominalDiffTime
spanDuration = Lens' FinishedSpan NominalDiffTime
fDuration

addTag :: MonadIO m => ActiveSpan -> Tag -> m ()
addTag :: forall (m :: * -> *). MonadIO m => ActiveSpan -> Tag -> m ()
addTag ActiveSpan
s Tag
t = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *).
MonadIO m =>
ActiveSpan -> (Span -> Span) -> m ()
modifyActiveSpan ActiveSpan
s forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a. HasSpanFields a => Lens' a Tags
spanTags (Tag -> Tags -> Tags
setTag Tag
t)

-- | Log structured data to an `ActiveSpan`. More info in the [OpenTracing spec](https://github.com/opentracing/specification/blob/master/specification.md#log-structured-data)
--
-- @since 0.1.0.0
addLogRecord :: MonadIO m => ActiveSpan -> LogField -> m ()
addLogRecord :: forall (m :: * -> *). MonadIO m => ActiveSpan -> LogField -> m ()
addLogRecord ActiveSpan
s LogField
f = forall (m :: * -> *).
MonadIO m =>
ActiveSpan -> LogField -> [LogField] -> m ()
addLogRecord' ActiveSpan
s LogField
f []

addLogRecord' :: MonadIO m => ActiveSpan -> LogField -> [LogField] -> m ()
addLogRecord' :: forall (m :: * -> *).
MonadIO m =>
ActiveSpan -> LogField -> [LogField] -> m ()
addLogRecord' ActiveSpan
s LogField
f [LogField]
fs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    UTCTime
t <- IO UTCTime
getCurrentTime
    forall (m :: * -> *).
MonadIO m =>
ActiveSpan -> (Span -> Span) -> m ()
modifyActiveSpan ActiveSpan
s forall a b. (a -> b) -> a -> b
$
        forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a. HasSpanFields a => Lens' a [LogRecord]
spanLogs (UTCTime -> NonEmpty LogField -> LogRecord
LogRecord UTCTime
t (LogField
f forall a. a -> [a] -> NonEmpty a
:| [LogField]
fs)forall a. a -> [a] -> [a]
:)

setBaggageItem :: MonadIO m => ActiveSpan -> Text -> Text -> m ()
setBaggageItem :: forall (m :: * -> *).
MonadIO m =>
ActiveSpan -> Text -> Text -> m ()
setBaggageItem ActiveSpan
s Text
k Text
v = forall (m :: * -> *).
MonadIO m =>
ActiveSpan -> (Span -> Span) -> m ()
modifyActiveSpan ActiveSpan
s forall a b. (a -> b) -> a -> b
$
  forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall a. HasSpanFields a => Lens' a SpanContext
spanContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SpanContext (HashMap Text Text)
ctxBaggage) (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert Text
k Text
v)

getBaggageItem :: MonadIO m => ActiveSpan -> Text -> m (Maybe Text)
getBaggageItem :: forall (m :: * -> *).
MonadIO m =>
ActiveSpan -> Text -> m (Maybe Text)
getBaggageItem ActiveSpan
s Text
k = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall a. HasSpanFields a => Lens' a SpanContext
spanContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SpanContext (HashMap Text Text)
ctxBaggage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
k) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => ActiveSpan -> m Span
readActiveSpan ActiveSpan
s