{-# LANGUAGE TupleSections #-}

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

import           Data.ByteString.Lazy       (toStrict)
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 = 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
Lens' FinishedSpan 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
Lens' FinishedSpan 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
Lens' FinishedSpan 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
Lens' FinishedSpan [Reference]
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 Getting Text FinishedSpan Text
forall a. HasSpanFields a => Lens' a Text
Lens' FinishedSpan Text
spanOperation 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
Lens' FinishedSpan [Reference]
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])
-> ([SpanRef] -> Const (Maybe (Vector SpanRef)) [SpanRef])
-> [Reference]
-> Const (Maybe (Vector SpanRef)) [Reference]
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 a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
                                (([SpanRef] -> Const (Maybe (Vector SpanRef)) [SpanRef])
 -> [Reference] -> Const (Maybe (Vector SpanRef)) [Reference])
-> ((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 (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Vector a) (f (Vector b)) -> p [a] (f [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 (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe 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
Lens' FinishedSpan 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
Lens' FinishedSpan 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 b. Integral b => UTCTime -> b
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 b. Integral b => NominalDiffTime -> b
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
Lens' FinishedSpan 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)
-> (Vector Tag -> Const (Maybe (Vector Tag)) (Vector Tag))
-> Tags
-> Const (Maybe (Vector Tag)) Tags
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Tags -> Vector Tag
toThriftTags ((Vector Tag -> Const (Maybe (Vector Tag)) (Vector Tag))
 -> Tags -> Const (Maybe (Vector Tag)) Tags)
-> ((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 (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe 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 a b. (a -> b -> b) -> b -> [a] -> b
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]
Lens' FinishedSpan [LogRecord]
spanLogs FinishedSpan
s
    }

toThriftSpanRef :: Reference -> Thrift.SpanRef
toThriftSpanRef :: Reference -> SpanRef
toThriftSpanRef Reference
ref = 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 m a. Monoid m => (Text -> a -> m) -> HashMap Text a -> m
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) = Thrift.Tag
    { tag_key :: Text
tag_key     = Text
forall a. (Eq a, IsString a) => a
HttpStatusCodeKey
    , tag_vType :: TagType
tag_vType   = TagType
Thrift.STRING
    , 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
. Getting Text Text Text -> Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Text Text
forall lazy strict. Strict lazy strict => Iso' lazy strict
Iso' Text Text
strict (Text -> Text) -> (Int64 -> Text) -> Int64 -> 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
    , tag_vDouble :: Maybe Double
tag_vDouble = Maybe Double
forall a. Maybe a
Nothing
    , tag_vBool :: Maybe Bool
tag_vBool   = Maybe Bool
forall a. Maybe a
Nothing
    , tag_vLong :: Maybe Int64
tag_vLong   = Maybe Int64
forall a. Maybe a
Nothing
    , tag_vBinary :: Maybe ByteString
tag_vBinary = Maybe ByteString
forall a. Maybe a
Nothing
    }
toThriftTag Text
k TagVal
v =
  Thrift.Tag
  {
    tag_key :: Text
tag_key = Text
k
  , tag_vType :: TagType
tag_vType = case TagVal
v of
      BoolT   Bool
_ -> TagType
Thrift.BOOL
      StringT Text
_ -> TagType
Thrift.STRING
      IntT    Int64
_ -> TagType
Thrift.LONG
      DoubleT Double
_ -> TagType
Thrift.DOUBLE
      BinaryT ByteString
_ -> TagType
Thrift.BINARY
  , tag_vStr :: Maybe Text
tag_vStr = case TagVal
v of
      StringT Text
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
      TagVal
_ -> Maybe Text
forall a. Maybe a
Nothing
  , tag_vDouble :: Maybe Double
tag_vDouble = case TagVal
v of
      DoubleT Double
x -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x
      TagVal
_ -> Maybe Double
forall a. Maybe a
Nothing
  , tag_vBool :: Maybe Bool
tag_vBool = case TagVal
v of
      BoolT Bool
x -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
x
      TagVal
_ -> Maybe Bool
forall a. Maybe a
Nothing
  , tag_vLong :: Maybe Int64
tag_vLong = case TagVal
v of
      IntT Int64
x -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
x
      TagVal
_ -> Maybe Int64
forall a. Maybe a
Nothing
  , tag_vBinary :: Maybe ByteString
tag_vBinary = case TagVal
v of
      BinaryT ByteString
x -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> ByteString
toStrict ByteString
x)
      TagVal
_ -> Maybe ByteString
forall a. Maybe a
Nothing
  }

toThriftLog :: LogRecord -> Thrift.Log
toThriftLog :: LogRecord -> Log
toThriftLog LogRecord
r = 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 b. Integral b => UTCTime -> b
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 m a. Monoid m => (a -> m) -> NonEmpty a -> m
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
Iso' String Text
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
Iso' String Text
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
Iso' String Text
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 = Thrift.Process
    { process_serviceName :: Text
process_serviceName = 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 = 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
    , batch_seqNo :: Maybe Int64
batch_seqNo   = Maybe Int64
forall a. Maybe a
Nothing
    , batch_stats :: Maybe ClientStats
batch_stats   = Maybe ClientStats
forall a. Maybe a
Nothing
    }

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