{-# LANGUAGE TupleSections #-}

module OpenTracing.Jaeger.Thrift
    ( toThriftSpan
    , toThriftTags
    , toThriftProcess
    , toThriftBatch
    )
where

import           Control.Lens
import           Data.Bool                  (bool)
import           Data.Foldable
import           Data.Int                   (Int64)
import           Data.Text                  (Text)
import           Data.Text.Lazy.Builder     (toLazyText)
import           Data.Text.Lazy.Builder.Int (decimal)
import           Data.Text.Lens
import           Data.Vector                (Vector)
import qualified Data.Vector                as Vector
import           Data.Vector.Lens           (vector)
import           GHC.Stack                  (prettyCallStack)
import           Jaeger_Types
    ( Batch (..)
    , Log (..)
    , Process (..)
    , Span (..)
    , SpanRef (..)
    , Tag (..)
    )
import qualified Jaeger_Types               as Thrift
import           OpenTracing.Log
import           OpenTracing.Span
import           OpenTracing.Tags
import           OpenTracing.Time
import           OpenTracing.Types          (TraceID (..))


toThriftSpan :: FinishedSpan -> Thrift.Span
toThriftSpan :: FinishedSpan -> Span
toThriftSpan FinishedSpan
s = Span :: Int64
-> Int64
-> Int64
-> Int64
-> Text
-> Maybe (Vector SpanRef)
-> Int32
-> Int64
-> Int64
-> Maybe (Vector Tag)
-> Maybe (Vector Log)
-> Maybe Bool
-> Span
Thrift.Span
    { span_traceIdLow :: Int64
span_traceIdLow    = Getting Int64 FinishedSpan Int64 -> FinishedSpan -> Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SpanContext -> Const Int64 SpanContext)
-> FinishedSpan -> Const Int64 FinishedSpan
forall a. HasSpanFields a => Lens' a SpanContext
spanContext ((SpanContext -> Const Int64 SpanContext)
 -> FinishedSpan -> Const Int64 FinishedSpan)
-> ((Int64 -> Const Int64 Int64)
    -> SpanContext -> Const Int64 SpanContext)
-> Getting Int64 FinishedSpan Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpanContext -> Int64)
-> (Int64 -> Const Int64 Int64)
-> SpanContext
-> Const Int64 SpanContext
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SpanContext -> Int64
traceIdLo') FinishedSpan
s
    , span_traceIdHigh :: Int64
span_traceIdHigh   = Getting Int64 FinishedSpan Int64 -> FinishedSpan -> Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SpanContext -> Const Int64 SpanContext)
-> FinishedSpan -> Const Int64 FinishedSpan
forall a. HasSpanFields a => Lens' a SpanContext
spanContext ((SpanContext -> Const Int64 SpanContext)
 -> FinishedSpan -> Const Int64 FinishedSpan)
-> ((Int64 -> Const Int64 Int64)
    -> SpanContext -> Const Int64 SpanContext)
-> Getting Int64 FinishedSpan Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpanContext -> Int64)
-> (Int64 -> Const Int64 Int64)
-> SpanContext
-> Const Int64 SpanContext
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SpanContext -> Int64
traceIdHi') FinishedSpan
s
    , span_spanId :: Int64
span_spanId        = Getting Int64 FinishedSpan Int64 -> FinishedSpan -> Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SpanContext -> Const Int64 SpanContext)
-> FinishedSpan -> Const Int64 FinishedSpan
forall a. HasSpanFields a => Lens' a SpanContext
spanContext ((SpanContext -> Const Int64 SpanContext)
 -> FinishedSpan -> Const Int64 FinishedSpan)
-> ((Int64 -> Const Int64 Int64)
    -> SpanContext -> Const Int64 SpanContext)
-> Getting Int64 FinishedSpan Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpanContext -> Int64)
-> (Int64 -> Const Int64 Int64)
-> SpanContext
-> Const Int64 SpanContext
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SpanContext -> Int64
ctxSpanID') FinishedSpan
s
    , span_parentSpanId :: Int64
span_parentSpanId  = Int64 -> (Reference -> Int64) -> Maybe Reference -> Int64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int64
0 (SpanContext -> Int64
ctxSpanID' (SpanContext -> Int64)
-> (Reference -> SpanContext) -> Reference -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> SpanContext
refCtx) (Maybe Reference -> Int64)
-> ([Reference] -> Maybe Reference) -> [Reference] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Reference] -> Maybe Reference
forall (t :: * -> *). Foldable t => t Reference -> Maybe Reference
findParent
                         ([Reference] -> Int64) -> [Reference] -> Int64
forall a b. (a -> b) -> a -> b
$ Getting [Reference] FinishedSpan [Reference]
-> FinishedSpan -> [Reference]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Reference] FinishedSpan [Reference]
forall s a. HasRefs s a => Lens' s a
spanRefs FinishedSpan
s
    , span_operationName :: Text
span_operationName = Getting Text FinishedSpan Text -> FinishedSpan -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Text -> Const Text Text)
-> FinishedSpan -> Const Text FinishedSpan
forall a. HasSpanFields a => Lens' a Text
spanOperation ((Text -> Const Text Text)
 -> FinishedSpan -> Const Text FinishedSpan)
-> ((Text -> Const Text Text) -> Text -> Const Text Text)
-> Getting Text FinishedSpan Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Text -> Const Text Text
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy) FinishedSpan
s
    , span_references :: Maybe (Vector SpanRef)
span_references    = Getting
  (Maybe (Vector SpanRef)) FinishedSpan (Maybe (Vector SpanRef))
-> FinishedSpan -> Maybe (Vector SpanRef)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ( ([Reference] -> Const (Maybe (Vector SpanRef)) [Reference])
-> FinishedSpan -> Const (Maybe (Vector SpanRef)) FinishedSpan
forall s a. HasRefs s a => Lens' s a
spanRefs
                                (([Reference] -> Const (Maybe (Vector SpanRef)) [Reference])
 -> FinishedSpan -> Const (Maybe (Vector SpanRef)) FinishedSpan)
-> ((Maybe (Vector SpanRef)
     -> Const (Maybe (Vector SpanRef)) (Maybe (Vector SpanRef)))
    -> [Reference] -> Const (Maybe (Vector SpanRef)) [Reference])
-> Getting
     (Maybe (Vector SpanRef)) FinishedSpan (Maybe (Vector SpanRef))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Reference] -> [SpanRef])
-> Optic'
     (->) (Const (Maybe (Vector SpanRef))) [Reference] [SpanRef]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Reference -> SpanRef) -> [Reference] -> [SpanRef]
forall a b. (a -> b) -> [a] -> [b]
map Reference -> SpanRef
toThriftSpanRef ([Reference] -> [SpanRef])
-> ([Reference] -> [Reference]) -> [Reference] -> [SpanRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Reference] -> [Reference]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
                                Optic' (->) (Const (Maybe (Vector SpanRef))) [Reference] [SpanRef]
-> ((Maybe (Vector SpanRef)
     -> Const (Maybe (Vector SpanRef)) (Maybe (Vector SpanRef)))
    -> [SpanRef] -> Const (Maybe (Vector SpanRef)) [SpanRef])
-> (Maybe (Vector SpanRef)
    -> Const (Maybe (Vector SpanRef)) (Maybe (Vector SpanRef)))
-> [Reference]
-> Const (Maybe (Vector SpanRef)) [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector SpanRef -> Const (Maybe (Vector SpanRef)) (Vector SpanRef))
-> [SpanRef] -> Const (Maybe (Vector SpanRef)) [SpanRef]
forall a b. Iso [a] [b] (Vector a) (Vector b)
vector
                                ((Vector SpanRef
  -> Const (Maybe (Vector SpanRef)) (Vector SpanRef))
 -> [SpanRef] -> Const (Maybe (Vector SpanRef)) [SpanRef])
-> ((Maybe (Vector SpanRef)
     -> Const (Maybe (Vector SpanRef)) (Maybe (Vector SpanRef)))
    -> Vector SpanRef
    -> Const (Maybe (Vector SpanRef)) (Vector SpanRef))
-> (Maybe (Vector SpanRef)
    -> Const (Maybe (Vector SpanRef)) (Maybe (Vector SpanRef)))
-> [SpanRef]
-> Const (Maybe (Vector SpanRef)) [SpanRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview (Maybe (Vector SpanRef)) (Vector SpanRef)
-> Getter (Vector SpanRef) (Maybe (Vector SpanRef))
forall t b. AReview t b -> Getter b t
re AReview (Maybe (Vector SpanRef)) (Vector SpanRef)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
                                )
                                FinishedSpan
s
    , span_flags :: Int32
span_flags         = Getting Int32 FinishedSpan Int32 -> FinishedSpan -> Int32
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ( (SpanContext -> Const Int32 SpanContext)
-> FinishedSpan -> Const Int32 FinishedSpan
forall a. HasSpanFields a => Lens' a SpanContext
spanContext
                                ((SpanContext -> Const Int32 SpanContext)
 -> FinishedSpan -> Const Int32 FinishedSpan)
-> ((Int32 -> Const Int32 Int32)
    -> SpanContext -> Const Int32 SpanContext)
-> Getting Int32 FinishedSpan Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sampled -> Const Int32 Sampled)
-> SpanContext -> Const Int32 SpanContext
Lens' SpanContext Sampled
ctxSampled
                                ((Sampled -> Const Int32 Sampled)
 -> SpanContext -> Const Int32 SpanContext)
-> ((Int32 -> Const Int32 Int32) -> Sampled -> Const Int32 Sampled)
-> (Int32 -> Const Int32 Int32)
-> SpanContext
-> Const Int32 SpanContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview Bool Sampled -> Getter Sampled Bool
forall t b. AReview t b -> Getter b t
re AReview Bool Sampled
Iso' Bool Sampled
_IsSampled
                                ((Bool -> Const Int32 Bool) -> Sampled -> Const Int32 Sampled)
-> ((Int32 -> Const Int32 Int32) -> Bool -> Const Int32 Bool)
-> (Int32 -> Const Int32 Int32)
-> Sampled
-> Const Int32 Sampled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Int32)
-> (Int32 -> Const Int32 Int32) -> Bool -> Const Int32 Bool
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Int32 -> Int32 -> Bool -> Int32
forall a. a -> a -> Bool -> a
bool Int32
0 Int32
1)
                                )
                                FinishedSpan
s
    , span_startTime :: Int64
span_startTime     = Getting Int64 FinishedSpan Int64 -> FinishedSpan -> Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((UTCTime -> Const Int64 UTCTime)
-> FinishedSpan -> Const Int64 FinishedSpan
forall a. HasSpanFields a => Lens' a UTCTime
spanStart ((UTCTime -> Const Int64 UTCTime)
 -> FinishedSpan -> Const Int64 FinishedSpan)
-> ((Int64 -> Const Int64 Int64) -> UTCTime -> Const Int64 UTCTime)
-> Getting Int64 FinishedSpan Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime -> Int64)
-> (Int64 -> Const Int64 Int64) -> UTCTime -> Const Int64 UTCTime
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to UTCTime -> Int64
forall a b. (AsMicros a, Integral b) => a -> b
micros) FinishedSpan
s
    , span_duration :: Int64
span_duration      = Getting Int64 FinishedSpan Int64 -> FinishedSpan -> Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((NominalDiffTime -> Const Int64 NominalDiffTime)
-> FinishedSpan -> Const Int64 FinishedSpan
Lens' FinishedSpan NominalDiffTime
spanDuration ((NominalDiffTime -> Const Int64 NominalDiffTime)
 -> FinishedSpan -> Const Int64 FinishedSpan)
-> ((Int64 -> Const Int64 Int64)
    -> NominalDiffTime -> Const Int64 NominalDiffTime)
-> Getting Int64 FinishedSpan Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTime -> Int64)
-> (Int64 -> Const Int64 Int64)
-> NominalDiffTime
-> Const Int64 NominalDiffTime
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to NominalDiffTime -> Int64
forall a b. (AsMicros a, Integral b) => a -> b
micros) FinishedSpan
s
    , span_tags :: Maybe (Vector Tag)
span_tags          = Getting (Maybe (Vector Tag)) FinishedSpan (Maybe (Vector Tag))
-> FinishedSpan -> Maybe (Vector Tag)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Tags -> Const (Maybe (Vector Tag)) Tags)
-> FinishedSpan -> Const (Maybe (Vector Tag)) FinishedSpan
forall a. HasSpanFields a => Lens' a Tags
spanTags ((Tags -> Const (Maybe (Vector Tag)) Tags)
 -> FinishedSpan -> Const (Maybe (Vector Tag)) FinishedSpan)
-> ((Maybe (Vector Tag)
     -> Const (Maybe (Vector Tag)) (Maybe (Vector Tag)))
    -> Tags -> Const (Maybe (Vector Tag)) Tags)
-> Getting (Maybe (Vector Tag)) FinishedSpan (Maybe (Vector Tag))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tags -> Vector Tag)
-> Optic' (->) (Const (Maybe (Vector Tag))) Tags (Vector Tag)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Tags -> Vector Tag
toThriftTags Optic' (->) (Const (Maybe (Vector Tag))) Tags (Vector Tag)
-> ((Maybe (Vector Tag)
     -> Const (Maybe (Vector Tag)) (Maybe (Vector Tag)))
    -> Vector Tag -> Const (Maybe (Vector Tag)) (Vector Tag))
-> (Maybe (Vector Tag)
    -> Const (Maybe (Vector Tag)) (Maybe (Vector Tag)))
-> Tags
-> Const (Maybe (Vector Tag)) Tags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview (Maybe (Vector Tag)) (Vector Tag)
-> Getter (Vector Tag) (Maybe (Vector Tag))
forall t b. AReview t b -> Getter b t
re AReview (Maybe (Vector Tag)) (Vector Tag)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) FinishedSpan
s
    , span_logs :: Maybe (Vector Log)
span_logs          = Vector Log -> Maybe (Vector Log)
forall a. a -> Maybe a
Just
                         (Vector Log -> Maybe (Vector Log))
-> ([LogRecord] -> Vector Log) -> [LogRecord] -> Maybe (Vector Log)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Log] -> Vector Log
forall a. [a] -> Vector a
Vector.fromList
                         ([Log] -> Vector Log)
-> ([LogRecord] -> [Log]) -> [LogRecord] -> Vector Log
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogRecord -> [Log] -> [Log]) -> [Log] -> [LogRecord] -> [Log]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\LogRecord
r [Log]
acc -> LogRecord -> Log
toThriftLog LogRecord
r Log -> [Log] -> [Log]
forall a. a -> [a] -> [a]
: [Log]
acc) []
                         ([LogRecord] -> Maybe (Vector Log))
-> [LogRecord] -> Maybe (Vector Log)
forall a b. (a -> b) -> a -> b
$ Getting [LogRecord] FinishedSpan [LogRecord]
-> FinishedSpan -> [LogRecord]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [LogRecord] FinishedSpan [LogRecord]
forall a. HasSpanFields a => Lens' a [LogRecord]
spanLogs FinishedSpan
s
    , span_incomplete :: Maybe Bool
span_incomplete    = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    }

toThriftSpanRef :: Reference -> Thrift.SpanRef
toThriftSpanRef :: Reference -> SpanRef
toThriftSpanRef Reference
ref = SpanRef :: SpanRefType -> Int64 -> Int64 -> Int64 -> SpanRef
Thrift.SpanRef
    { spanRef_refType :: SpanRefType
spanRef_refType     = Reference -> SpanRefType
toThriftRefType Reference
ref
    , spanRef_traceIdLow :: Int64
spanRef_traceIdLow  = SpanContext -> Int64
traceIdLo' (Reference -> SpanContext
refCtx Reference
ref)
    , spanRef_traceIdHigh :: Int64
spanRef_traceIdHigh = SpanContext -> Int64
traceIdHi' (Reference -> SpanContext
refCtx Reference
ref)
    , spanRef_spanId :: Int64
spanRef_spanId      = SpanContext -> Int64
ctxSpanID' (Reference -> SpanContext
refCtx Reference
ref)
    }

toThriftRefType :: Reference -> Thrift.SpanRefType
toThriftRefType :: Reference -> SpanRefType
toThriftRefType (ChildOf     SpanContext
_) = SpanRefType
Thrift.CHILD_OF
toThriftRefType (FollowsFrom SpanContext
_) = SpanRefType
Thrift.FOLLOWS_FROM

toThriftTags :: Tags -> Vector Thrift.Tag
toThriftTags :: Tags -> Vector Tag
toThriftTags = (Text -> TagVal -> Vector Tag) -> HashMap Text TagVal -> Vector Tag
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\Text
k TagVal
v -> Tag -> Vector Tag
forall a. a -> Vector a
Vector.singleton (Text -> TagVal -> Tag
toThriftTag Text
k TagVal
v)) (HashMap Text TagVal -> Vector Tag)
-> (Tags -> HashMap Text TagVal) -> Tags -> Vector Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tags -> HashMap Text TagVal
fromTags

toThriftTag :: Text -> TagVal -> Thrift.Tag
-- acc. to https://github.com/opentracing/specification/blob/8d634bc7e3e73050f6ac1006858cddac8d9e0abe/semantic_conventions.yaml
-- "http.status_code" is supposed to be integer-valued. Jaeger, however, drops
-- the value (nb. _not_ the tag key) unless it is a string.
toThriftTag :: Text -> TagVal -> Tag
toThriftTag Text
HttpStatusCodeKey (IntT Int64
v) = Tag
Thrift.default_Tag
    { tag_key :: Text
tag_key  = ((Text -> Const Text Text) -> Text -> Const Text Text)
-> Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> Const Text Text) -> Text -> Const Text Text
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy Text
forall a. (Eq a, IsString a) => a
HttpStatusCodeKey
    , tag_vStr :: Maybe Text
tag_vStr = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Int64 -> Text) -> Int64 -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> (Int64 -> Builder) -> Int64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
forall a. Integral a => a -> Builder
decimal (Int64 -> Maybe Text) -> Int64 -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int64
v
    }
toThriftTag Text
k TagVal
v =
    let t :: Tag
t = Tag
Thrift.default_Tag { tag_key :: Text
tag_key = ((Text -> Const Text Text) -> Text -> Const Text Text)
-> Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> Const Text Text) -> Text -> Const Text Text
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy Text
k }
     in case TagVal
v of
            BoolT   Bool
x -> Tag
t { tag_vBool :: Maybe Bool
tag_vBool   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
x }
            StringT Text
x -> Tag
t { tag_vStr :: Maybe Text
tag_vStr    = Text -> Maybe Text
forall a. a -> Maybe a
Just (((Text -> Const Text Text) -> Text -> Const Text Text)
-> Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> Const Text Text) -> Text -> Const Text Text
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy Text
x) }
            IntT    Int64
x -> Tag
t { tag_vLong :: Maybe Int64
tag_vLong   = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
x }
            DoubleT Double
x -> Tag
t { tag_vDouble :: Maybe Double
tag_vDouble = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x }
            BinaryT ByteString
x -> Tag
t { tag_vBinary :: Maybe ByteString
tag_vBinary = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
x }

toThriftLog :: LogRecord -> Thrift.Log
toThriftLog :: LogRecord -> Log
toThriftLog LogRecord
r = Log :: Int64 -> Vector Tag -> Log
Thrift.Log
    { log_timestamp :: Int64
log_timestamp = Getting Int64 LogRecord Int64 -> LogRecord -> Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((UTCTime -> Const Int64 UTCTime)
-> LogRecord -> Const Int64 LogRecord
Lens' LogRecord UTCTime
logTime ((UTCTime -> Const Int64 UTCTime)
 -> LogRecord -> Const Int64 LogRecord)
-> ((Int64 -> Const Int64 Int64) -> UTCTime -> Const Int64 UTCTime)
-> Getting Int64 LogRecord Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime -> Int64)
-> (Int64 -> Const Int64 Int64) -> UTCTime -> Const Int64 UTCTime
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to UTCTime -> Int64
forall a b. (AsMicros a, Integral b) => a -> b
micros) LogRecord
r
    , log_fields :: Vector Tag
log_fields    = (LogField -> Vector Tag) -> NonEmpty LogField -> Vector Tag
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ( Tag -> Vector Tag
forall a. a -> Vector a
Vector.singleton
                              (Tag -> Vector Tag) -> (LogField -> Tag) -> LogField -> Vector Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> TagVal -> Tag) -> (Text, TagVal) -> Tag
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> TagVal -> Tag
toThriftTag
                              ((Text, TagVal) -> Tag)
-> (LogField -> (Text, TagVal)) -> LogField -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogField -> (Text, TagVal)
asTag
                              )
                    (NonEmpty LogField -> Vector Tag)
-> NonEmpty LogField -> Vector Tag
forall a b. (a -> b) -> a -> b
$ Getting (NonEmpty LogField) LogRecord (NonEmpty LogField)
-> LogRecord -> NonEmpty LogField
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (NonEmpty LogField) LogRecord (NonEmpty LogField)
Lens' LogRecord (NonEmpty LogField)
logFields LogRecord
r
    }
  where
    asTag :: LogField -> (Text, TagVal)
asTag LogField
f = (LogField -> Text
logFieldLabel LogField
f,) (TagVal -> (Text, TagVal))
-> (Text -> TagVal) -> Text -> (Text, TagVal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TagVal
StringT (Text -> (Text, TagVal)) -> Text -> (Text, TagVal)
forall a b. (a -> b) -> a -> b
$ case LogField
f of
        LogField Text
_ a
v -> Getting Text String Text -> String -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text String Text
forall t. IsText t => Iso' String t
packed (a -> String
forall a. Show a => a -> String
show a
v)
        Event      Text
v -> Text
v
        Message    Text
v -> Text
v
        Stack      CallStack
v -> Getting Text String Text -> String -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text String Text
forall t. IsText t => Iso' String t
packed (CallStack -> String
prettyCallStack CallStack
v)
        ErrKind    Text
v -> Text
v
        ErrObj     e
v -> Getting Text String Text -> String -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text String Text
forall t. IsText t => Iso' String t
packed (e -> String
forall a. Show a => a -> String
show e
v)

toThriftProcess :: Text -> Tags -> Thrift.Process
toThriftProcess :: Text -> Tags -> Process
toThriftProcess Text
srv Tags
tags = Process :: Text -> Maybe (Vector Tag) -> Process
Thrift.Process
    { process_serviceName :: Text
process_serviceName = ((Text -> Const Text Text) -> Text -> Const Text Text)
-> Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> Const Text Text) -> Text -> Const Text Text
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy Text
srv
    , process_tags :: Maybe (Vector Tag)
process_tags        = Vector Tag -> Maybe (Vector Tag)
forall a. a -> Maybe a
Just (Vector Tag -> Maybe (Vector Tag))
-> Vector Tag -> Maybe (Vector Tag)
forall a b. (a -> b) -> a -> b
$ Tags -> Vector Tag
toThriftTags Tags
tags
    }

toThriftBatch :: Thrift.Process -> Vector FinishedSpan -> Thrift.Batch
toThriftBatch :: Process -> Vector FinishedSpan -> Batch
toThriftBatch Process
tproc Vector FinishedSpan
spans = Batch :: Process -> Vector Span -> Batch
Thrift.Batch
    { batch_process :: Process
batch_process = Process
tproc
    , batch_spans :: Vector Span
batch_spans   = FinishedSpan -> Span
toThriftSpan (FinishedSpan -> Span) -> Vector FinishedSpan -> Vector Span
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector FinishedSpan
spans
    }

traceIdLo' :: SpanContext -> Int64
traceIdLo' :: SpanContext -> Int64
traceIdLo' = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64)
-> (SpanContext -> Word64) -> SpanContext -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceID -> Word64
traceIdLo (TraceID -> Word64)
-> (SpanContext -> TraceID) -> SpanContext -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanContext -> TraceID
ctxTraceID

traceIdHi' :: SpanContext -> Int64
traceIdHi' :: SpanContext -> Int64
traceIdHi' = Int64 -> (Word64 -> Int64) -> Maybe Word64 -> Int64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int64
0 Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe Word64 -> Int64)
-> (SpanContext -> Maybe Word64) -> SpanContext -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceID -> Maybe Word64
traceIdHi (TraceID -> Maybe Word64)
-> (SpanContext -> TraceID) -> SpanContext -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanContext -> TraceID
ctxTraceID

ctxSpanID' :: SpanContext -> Int64
ctxSpanID' :: SpanContext -> Int64
ctxSpanID' = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64)
-> (SpanContext -> Word64) -> SpanContext -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanContext -> Word64
ctxSpanID