{-# LANGUAGE TypeFamilies, DeriveGeneric, TypeApplications, OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-name-shadowing -Wno-unused-matches #-}

module Jaeger.Types where

import qualified Prelude
import qualified Control.Applicative
import qualified Control.Exception
import qualified Pinch
import qualified Pinch.Server
import qualified Pinch.Internal.RPC
import qualified Data.Text
import qualified Data.ByteString
import qualified Data.Int
import qualified Data.Vector
import qualified Data.HashMap.Strict
import qualified Data.HashSet
import qualified GHC.Generics
import qualified Data.Hashable
import  Data.Vector.Instances ()

data TagType
  = STRING
  | DOUBLE
  | BOOL
  | LONG
  | BINARY
  deriving (TagType -> TagType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagType -> TagType -> Bool
$c/= :: TagType -> TagType -> Bool
== :: TagType -> TagType -> Bool
$c== :: TagType -> TagType -> Bool
Prelude.Eq, Eq TagType
TagType -> TagType -> Bool
TagType -> TagType -> Ordering
TagType -> TagType -> TagType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TagType -> TagType -> TagType
$cmin :: TagType -> TagType -> TagType
max :: TagType -> TagType -> TagType
$cmax :: TagType -> TagType -> TagType
>= :: TagType -> TagType -> Bool
$c>= :: TagType -> TagType -> Bool
> :: TagType -> TagType -> Bool
$c> :: TagType -> TagType -> Bool
<= :: TagType -> TagType -> Bool
$c<= :: TagType -> TagType -> Bool
< :: TagType -> TagType -> Bool
$c< :: TagType -> TagType -> Bool
compare :: TagType -> TagType -> Ordering
$ccompare :: TagType -> TagType -> Ordering
Prelude.Ord, forall x. Rep TagType x -> TagType
forall x. TagType -> Rep TagType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagType x -> TagType
$cfrom :: forall x. TagType -> Rep TagType x
GHC.Generics.Generic, Int -> TagType -> ShowS
[TagType] -> ShowS
TagType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagType] -> ShowS
$cshowList :: [TagType] -> ShowS
show :: TagType -> String
$cshow :: TagType -> String
showsPrec :: Int -> TagType -> ShowS
$cshowsPrec :: Int -> TagType -> ShowS
Prelude.Show, TagType
forall a. a -> a -> Bounded a
maxBound :: TagType
$cmaxBound :: TagType
minBound :: TagType
$cminBound :: TagType
Prelude.Bounded)

instance Pinch.Pinchable TagType where
  type (Tag TagType) = Pinch.TEnum

  pinch :: TagType -> Value (Tag TagType)
pinch TagType
STRING = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
0 :: Data.Int.Int32))
  pinch TagType
DOUBLE = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
1 :: Data.Int.Int32))
  pinch TagType
BOOL = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
2 :: Data.Int.Int32))
  pinch TagType
LONG = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
3 :: Data.Int.Int32))
  pinch TagType
BINARY = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
4 :: Data.Int.Int32))

  unpinch :: Value (Tag TagType) -> Parser TagType
unpinch Value (Tag TagType)
v = do
    Int32
val <- forall a. Pinchable a => Value (Tag a) -> Parser a
Pinch.unpinch (Value (Tag TagType)
v)
    case (Int32
val :: Data.Int.Int32) of
      Int32
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (TagType
STRING)
      Int32
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (TagType
DOUBLE)
      Int32
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (TagType
BOOL)
      Int32
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (TagType
LONG)
      Int32
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (TagType
BINARY)
      Int32
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail ((String
"Unknown value for type TagType: " forall a. Semigroup a => a -> a -> a
Prelude.<> forall a. Show a => a -> String
Prelude.show (Int32
val)))


instance Prelude.Enum TagType where
  fromEnum :: TagType -> Int
fromEnum TagType
STRING = Int
0
  fromEnum TagType
DOUBLE = Int
1
  fromEnum TagType
BOOL = Int
2
  fromEnum TagType
LONG = Int
3
  fromEnum TagType
BINARY = Int
4

  toEnum :: Int -> TagType
toEnum Int
0 = TagType
STRING
  toEnum Int
1 = TagType
DOUBLE
  toEnum Int
2 = TagType
BOOL
  toEnum Int
3 = TagType
LONG
  toEnum Int
4 = TagType
BINARY
  toEnum Int
_ = forall a. HasCallStack => String -> a
Prelude.error (String
"Unknown value for enum TagType.")


instance Data.Hashable.Hashable TagType where

data Tag
  = Tag { Tag -> Text
tag_key :: Data.Text.Text, Tag -> TagType
tag_vType :: TagType, Tag -> Maybe Text
tag_vStr :: (Prelude.Maybe Data.Text.Text), Tag -> Maybe Double
tag_vDouble :: (Prelude.Maybe Prelude.Double), Tag -> Maybe Bool
tag_vBool :: (Prelude.Maybe Prelude.Bool), Tag -> Maybe Int64
tag_vLong :: (Prelude.Maybe Data.Int.Int64), Tag -> Maybe ByteString
tag_vBinary :: (Prelude.Maybe Data.ByteString.ByteString) }
  deriving (Tag -> Tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Prelude.Eq, forall x. Rep Tag x -> Tag
forall x. Tag -> Rep Tag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tag x -> Tag
$cfrom :: forall x. Tag -> Rep Tag x
GHC.Generics.Generic, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Prelude.Show)

instance Pinch.Pinchable Tag where
  type (Tag Tag) = Pinch.TStruct

  pinch :: Tag -> Value (Tag Tag)
pinch (Tag Text
tag_key TagType
tag_vType Maybe Text
tag_vStr Maybe Double
tag_vDouble Maybe Bool
tag_vBool Maybe Int64
tag_vLong Maybe ByteString
tag_vBinary) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Text
tag_key), (Int16
2 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= TagType
tag_vType), (Int16
3 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Text
tag_vStr), (Int16
4 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Double
tag_vDouble), (Int16
5 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Bool
tag_vBool), (Int16
6 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Int64
tag_vLong), (Int16
7 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe ByteString
tag_vBinary) ])

  unpinch :: Value (Tag Tag) -> Parser Tag
unpinch Value (Tag Tag)
value = (((((((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Text
-> TagType
-> Maybe Text
-> Maybe Double
-> Maybe Bool
-> Maybe Int64
-> Maybe ByteString
-> Tag
Tag) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Tag)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Tag)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Tag)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
3)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Tag)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Tag)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
5)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Tag)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Tag)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
7))


instance Data.Hashable.Hashable Tag where

data Log
  = Log { Log -> Int64
log_timestamp :: Data.Int.Int64, Log -> Vector Tag
log_fields :: (Data.Vector.Vector Tag) }
  deriving (Log -> Log -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Log -> Log -> Bool
$c/= :: Log -> Log -> Bool
== :: Log -> Log -> Bool
$c== :: Log -> Log -> Bool
Prelude.Eq, forall x. Rep Log x -> Log
forall x. Log -> Rep Log x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Log x -> Log
$cfrom :: forall x. Log -> Rep Log x
GHC.Generics.Generic, Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Prelude.Show)

instance Pinch.Pinchable Log where
  type (Tag Log) = Pinch.TStruct

  pinch :: Log -> Value (Tag Log)
pinch (Log Int64
log_timestamp Vector Tag
log_fields) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
log_timestamp), (Int16
2 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Vector Tag
log_fields) ])

  unpinch :: Value (Tag Log) -> Parser Log
unpinch Value (Tag Log)
value = ((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Int64 -> Vector Tag -> Log
Log) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Log)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Log)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2))


instance Data.Hashable.Hashable Log where

data SpanRefType
  = CHILD_OF
  | FOLLOWS_FROM
  deriving (SpanRefType -> SpanRefType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanRefType -> SpanRefType -> Bool
$c/= :: SpanRefType -> SpanRefType -> Bool
== :: SpanRefType -> SpanRefType -> Bool
$c== :: SpanRefType -> SpanRefType -> Bool
Prelude.Eq, Eq SpanRefType
SpanRefType -> SpanRefType -> Bool
SpanRefType -> SpanRefType -> Ordering
SpanRefType -> SpanRefType -> SpanRefType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SpanRefType -> SpanRefType -> SpanRefType
$cmin :: SpanRefType -> SpanRefType -> SpanRefType
max :: SpanRefType -> SpanRefType -> SpanRefType
$cmax :: SpanRefType -> SpanRefType -> SpanRefType
>= :: SpanRefType -> SpanRefType -> Bool
$c>= :: SpanRefType -> SpanRefType -> Bool
> :: SpanRefType -> SpanRefType -> Bool
$c> :: SpanRefType -> SpanRefType -> Bool
<= :: SpanRefType -> SpanRefType -> Bool
$c<= :: SpanRefType -> SpanRefType -> Bool
< :: SpanRefType -> SpanRefType -> Bool
$c< :: SpanRefType -> SpanRefType -> Bool
compare :: SpanRefType -> SpanRefType -> Ordering
$ccompare :: SpanRefType -> SpanRefType -> Ordering
Prelude.Ord, forall x. Rep SpanRefType x -> SpanRefType
forall x. SpanRefType -> Rep SpanRefType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpanRefType x -> SpanRefType
$cfrom :: forall x. SpanRefType -> Rep SpanRefType x
GHC.Generics.Generic, Int -> SpanRefType -> ShowS
[SpanRefType] -> ShowS
SpanRefType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanRefType] -> ShowS
$cshowList :: [SpanRefType] -> ShowS
show :: SpanRefType -> String
$cshow :: SpanRefType -> String
showsPrec :: Int -> SpanRefType -> ShowS
$cshowsPrec :: Int -> SpanRefType -> ShowS
Prelude.Show, SpanRefType
forall a. a -> a -> Bounded a
maxBound :: SpanRefType
$cmaxBound :: SpanRefType
minBound :: SpanRefType
$cminBound :: SpanRefType
Prelude.Bounded)

instance Pinch.Pinchable SpanRefType where
  type (Tag SpanRefType) = Pinch.TEnum

  pinch :: SpanRefType -> Value (Tag SpanRefType)
pinch SpanRefType
CHILD_OF = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
0 :: Data.Int.Int32))
  pinch SpanRefType
FOLLOWS_FROM = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
1 :: Data.Int.Int32))

  unpinch :: Value (Tag SpanRefType) -> Parser SpanRefType
unpinch Value (Tag SpanRefType)
v = do
    Int32
val <- forall a. Pinchable a => Value (Tag a) -> Parser a
Pinch.unpinch (Value (Tag SpanRefType)
v)
    case (Int32
val :: Data.Int.Int32) of
      Int32
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (SpanRefType
CHILD_OF)
      Int32
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (SpanRefType
FOLLOWS_FROM)
      Int32
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail ((String
"Unknown value for type SpanRefType: " forall a. Semigroup a => a -> a -> a
Prelude.<> forall a. Show a => a -> String
Prelude.show (Int32
val)))


instance Prelude.Enum SpanRefType where
  fromEnum :: SpanRefType -> Int
fromEnum SpanRefType
CHILD_OF = Int
0
  fromEnum SpanRefType
FOLLOWS_FROM = Int
1

  toEnum :: Int -> SpanRefType
toEnum Int
0 = SpanRefType
CHILD_OF
  toEnum Int
1 = SpanRefType
FOLLOWS_FROM
  toEnum Int
_ = forall a. HasCallStack => String -> a
Prelude.error (String
"Unknown value for enum SpanRefType.")


instance Data.Hashable.Hashable SpanRefType where

data SpanRef
  = SpanRef { SpanRef -> SpanRefType
spanRef_refType :: SpanRefType, SpanRef -> Int64
spanRef_traceIdLow :: Data.Int.Int64, SpanRef -> Int64
spanRef_traceIdHigh :: Data.Int.Int64, SpanRef -> Int64
spanRef_spanId :: Data.Int.Int64 }
  deriving (SpanRef -> SpanRef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanRef -> SpanRef -> Bool
$c/= :: SpanRef -> SpanRef -> Bool
== :: SpanRef -> SpanRef -> Bool
$c== :: SpanRef -> SpanRef -> Bool
Prelude.Eq, forall x. Rep SpanRef x -> SpanRef
forall x. SpanRef -> Rep SpanRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpanRef x -> SpanRef
$cfrom :: forall x. SpanRef -> Rep SpanRef x
GHC.Generics.Generic, Int -> SpanRef -> ShowS
[SpanRef] -> ShowS
SpanRef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanRef] -> ShowS
$cshowList :: [SpanRef] -> ShowS
show :: SpanRef -> String
$cshow :: SpanRef -> String
showsPrec :: Int -> SpanRef -> ShowS
$cshowsPrec :: Int -> SpanRef -> ShowS
Prelude.Show)

instance Pinch.Pinchable SpanRef where
  type (Tag SpanRef) = Pinch.TStruct

  pinch :: SpanRef -> Value (Tag SpanRef)
pinch (SpanRef SpanRefType
spanRef_refType Int64
spanRef_traceIdLow Int64
spanRef_traceIdHigh Int64
spanRef_spanId) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= SpanRefType
spanRef_refType), (Int16
2 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
spanRef_traceIdLow), (Int16
3 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
spanRef_traceIdHigh), (Int16
4 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
spanRef_spanId) ])

  unpinch :: Value (Tag SpanRef) -> Parser SpanRef
unpinch Value (Tag SpanRef)
value = ((((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (SpanRefType -> Int64 -> Int64 -> Int64 -> SpanRef
SpanRef) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag SpanRef)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag SpanRef)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag SpanRef)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
3)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag SpanRef)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
4))


instance Data.Hashable.Hashable SpanRef where

data Span
  = Span { Span -> Int64
span_traceIdLow :: Data.Int.Int64, Span -> Int64
span_traceIdHigh :: Data.Int.Int64, Span -> Int64
span_spanId :: Data.Int.Int64, Span -> Int64
span_parentSpanId :: Data.Int.Int64, Span -> Text
span_operationName :: Data.Text.Text, Span -> Maybe (Vector SpanRef)
span_references :: (Prelude.Maybe (Data.Vector.Vector SpanRef)), Span -> Int32
span_flags :: Data.Int.Int32, Span -> Int64
span_startTime :: Data.Int.Int64, Span -> Int64
span_duration :: Data.Int.Int64, Span -> Maybe (Vector Tag)
span_tags :: (Prelude.Maybe (Data.Vector.Vector Tag)), Span -> Maybe (Vector Log)
span_logs :: (Prelude.Maybe (Data.Vector.Vector Log)) }
  deriving (Span -> Span -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c== :: Span -> Span -> Bool
Prelude.Eq, forall x. Rep Span x -> Span
forall x. Span -> Rep Span x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Span x -> Span
$cfrom :: forall x. Span -> Rep Span x
GHC.Generics.Generic, Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Span] -> ShowS
$cshowList :: [Span] -> ShowS
show :: Span -> String
$cshow :: Span -> String
showsPrec :: Int -> Span -> ShowS
$cshowsPrec :: Int -> Span -> ShowS
Prelude.Show)

instance Pinch.Pinchable Span where
  type (Tag Span) = Pinch.TStruct

  pinch :: Span -> Value (Tag Span)
pinch (Span Int64
span_traceIdLow Int64
span_traceIdHigh Int64
span_spanId Int64
span_parentSpanId Text
span_operationName Maybe (Vector SpanRef)
span_references Int32
span_flags Int64
span_startTime Int64
span_duration Maybe (Vector Tag)
span_tags Maybe (Vector Log)
span_logs) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_traceIdLow), (Int16
2 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_traceIdHigh), (Int16
3 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_spanId), (Int16
4 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_parentSpanId), (Int16
5 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Text
span_operationName), (Int16
6 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe (Vector SpanRef)
span_references), (Int16
7 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int32
span_flags), (Int16
8 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_startTime), (Int16
9 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_duration), (Int16
10 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe (Vector Tag)
span_tags), (Int16
11 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe (Vector Log)
span_logs) ])

  unpinch :: Value (Tag Span) -> Parser Span
unpinch Value (Tag Span)
value = (((((((((((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Int64
-> Int64
-> Int64
-> Int64
-> Text
-> Maybe (Vector SpanRef)
-> Int32
-> Int64
-> Int64
-> Maybe (Vector Tag)
-> Maybe (Vector Log)
-> Span
Span) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
3)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
4)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
5)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
6)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
7)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
8)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
9)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
10)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Span)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
11))


instance Data.Hashable.Hashable Span where

data Process
  = Process { Process -> Text
process_serviceName :: Data.Text.Text, Process -> Maybe (Vector Tag)
process_tags :: (Prelude.Maybe (Data.Vector.Vector Tag)) }
  deriving (Process -> Process -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Process -> Process -> Bool
$c/= :: Process -> Process -> Bool
== :: Process -> Process -> Bool
$c== :: Process -> Process -> Bool
Prelude.Eq, forall x. Rep Process x -> Process
forall x. Process -> Rep Process x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Process x -> Process
$cfrom :: forall x. Process -> Rep Process x
GHC.Generics.Generic, Int -> Process -> ShowS
[Process] -> ShowS
Process -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Process] -> ShowS
$cshowList :: [Process] -> ShowS
show :: Process -> String
$cshow :: Process -> String
showsPrec :: Int -> Process -> ShowS
$cshowsPrec :: Int -> Process -> ShowS
Prelude.Show)

instance Pinch.Pinchable Process where
  type (Tag Process) = Pinch.TStruct

  pinch :: Process -> Value (Tag Process)
pinch (Process Text
process_serviceName Maybe (Vector Tag)
process_tags) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Text
process_serviceName), (Int16
2 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe (Vector Tag)
process_tags) ])

  unpinch :: Value (Tag Process) -> Parser Process
unpinch Value (Tag Process)
value = ((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Text -> Maybe (Vector Tag) -> Process
Process) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Process)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Process)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
2))


instance Data.Hashable.Hashable Process where

data ClientStats
  = ClientStats { ClientStats -> Int64
clientStats_fullQueueDroppedSpans :: Data.Int.Int64, ClientStats -> Int64
clientStats_tooLargeDroppedSpans :: Data.Int.Int64, ClientStats -> Int64
clientStats_failedToEmitSpans :: Data.Int.Int64 }
  deriving (ClientStats -> ClientStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientStats -> ClientStats -> Bool
$c/= :: ClientStats -> ClientStats -> Bool
== :: ClientStats -> ClientStats -> Bool
$c== :: ClientStats -> ClientStats -> Bool
Prelude.Eq, forall x. Rep ClientStats x -> ClientStats
forall x. ClientStats -> Rep ClientStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientStats x -> ClientStats
$cfrom :: forall x. ClientStats -> Rep ClientStats x
GHC.Generics.Generic, Int -> ClientStats -> ShowS
[ClientStats] -> ShowS
ClientStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientStats] -> ShowS
$cshowList :: [ClientStats] -> ShowS
show :: ClientStats -> String
$cshow :: ClientStats -> String
showsPrec :: Int -> ClientStats -> ShowS
$cshowsPrec :: Int -> ClientStats -> ShowS
Prelude.Show)

instance Pinch.Pinchable ClientStats where
  type (Tag ClientStats) = Pinch.TStruct

  pinch :: ClientStats -> Value (Tag ClientStats)
pinch (ClientStats Int64
clientStats_fullQueueDroppedSpans Int64
clientStats_tooLargeDroppedSpans Int64
clientStats_failedToEmitSpans) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
clientStats_fullQueueDroppedSpans), (Int16
2 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
clientStats_tooLargeDroppedSpans), (Int16
3 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
clientStats_failedToEmitSpans) ])

  unpinch :: Value (Tag ClientStats) -> Parser ClientStats
unpinch Value (Tag ClientStats)
value = (((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Int64 -> Int64 -> Int64 -> ClientStats
ClientStats) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag ClientStats)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag ClientStats)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag ClientStats)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
3))


instance Data.Hashable.Hashable ClientStats where

data Batch
  = Batch { Batch -> Process
batch_process :: Process, Batch -> Vector Span
batch_spans :: (Data.Vector.Vector Span), Batch -> Maybe Int64
batch_seqNo :: (Prelude.Maybe Data.Int.Int64), Batch -> Maybe ClientStats
batch_stats :: (Prelude.Maybe ClientStats) }
  deriving (Batch -> Batch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Batch -> Batch -> Bool
$c/= :: Batch -> Batch -> Bool
== :: Batch -> Batch -> Bool
$c== :: Batch -> Batch -> Bool
Prelude.Eq, forall x. Rep Batch x -> Batch
forall x. Batch -> Rep Batch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Batch x -> Batch
$cfrom :: forall x. Batch -> Rep Batch x
GHC.Generics.Generic, Int -> Batch -> ShowS
[Batch] -> ShowS
Batch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Batch] -> ShowS
$cshowList :: [Batch] -> ShowS
show :: Batch -> String
$cshow :: Batch -> String
showsPrec :: Int -> Batch -> ShowS
$cshowsPrec :: Int -> Batch -> ShowS
Prelude.Show)

instance Pinch.Pinchable Batch where
  type (Tag Batch) = Pinch.TStruct

  pinch :: Batch -> Value (Tag Batch)
pinch (Batch Process
batch_process Vector Span
batch_spans Maybe Int64
batch_seqNo Maybe ClientStats
batch_stats) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Process
batch_process), (Int16
2 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Vector Span
batch_spans), (Int16
3 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Int64
batch_seqNo), (Int16
4 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe ClientStats
batch_stats) ])

  unpinch :: Value (Tag Batch) -> Parser Batch
unpinch Value (Tag Batch)
value = ((((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Process -> Vector Span -> Maybe Int64 -> Maybe ClientStats -> Batch
Batch) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Batch)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Batch)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Batch)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
3)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Batch)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
4))


instance Data.Hashable.Hashable Batch where

data BatchSubmitResponse
  = BatchSubmitResponse { BatchSubmitResponse -> Bool
batchSubmitResponse_ok :: Prelude.Bool }
  deriving (BatchSubmitResponse -> BatchSubmitResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchSubmitResponse -> BatchSubmitResponse -> Bool
$c/= :: BatchSubmitResponse -> BatchSubmitResponse -> Bool
== :: BatchSubmitResponse -> BatchSubmitResponse -> Bool
$c== :: BatchSubmitResponse -> BatchSubmitResponse -> Bool
Prelude.Eq, forall x. Rep BatchSubmitResponse x -> BatchSubmitResponse
forall x. BatchSubmitResponse -> Rep BatchSubmitResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchSubmitResponse x -> BatchSubmitResponse
$cfrom :: forall x. BatchSubmitResponse -> Rep BatchSubmitResponse x
GHC.Generics.Generic, Int -> BatchSubmitResponse -> ShowS
[BatchSubmitResponse] -> ShowS
BatchSubmitResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchSubmitResponse] -> ShowS
$cshowList :: [BatchSubmitResponse] -> ShowS
show :: BatchSubmitResponse -> String
$cshow :: BatchSubmitResponse -> String
showsPrec :: Int -> BatchSubmitResponse -> ShowS
$cshowsPrec :: Int -> BatchSubmitResponse -> ShowS
Prelude.Show)

instance Pinch.Pinchable BatchSubmitResponse where
  type (Tag BatchSubmitResponse) = Pinch.TStruct

  pinch :: BatchSubmitResponse -> Value (Tag BatchSubmitResponse)
pinch (BatchSubmitResponse Bool
batchSubmitResponse_ok) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Bool
batchSubmitResponse_ok) ])

  unpinch :: Value (Tag BatchSubmitResponse) -> Parser BatchSubmitResponse
unpinch Value (Tag BatchSubmitResponse)
value = (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Bool -> BatchSubmitResponse
BatchSubmitResponse) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag BatchSubmitResponse)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1))


instance Data.Hashable.Hashable BatchSubmitResponse where

data SubmitBatches_Args
  = SubmitBatches_Args { SubmitBatches_Args -> Vector Batch
submitBatches_Args_batches :: (Data.Vector.Vector Batch) }
  deriving (SubmitBatches_Args -> SubmitBatches_Args -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubmitBatches_Args -> SubmitBatches_Args -> Bool
$c/= :: SubmitBatches_Args -> SubmitBatches_Args -> Bool
== :: SubmitBatches_Args -> SubmitBatches_Args -> Bool
$c== :: SubmitBatches_Args -> SubmitBatches_Args -> Bool
Prelude.Eq, forall x. Rep SubmitBatches_Args x -> SubmitBatches_Args
forall x. SubmitBatches_Args -> Rep SubmitBatches_Args x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubmitBatches_Args x -> SubmitBatches_Args
$cfrom :: forall x. SubmitBatches_Args -> Rep SubmitBatches_Args x
GHC.Generics.Generic, Int -> SubmitBatches_Args -> ShowS
[SubmitBatches_Args] -> ShowS
SubmitBatches_Args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubmitBatches_Args] -> ShowS
$cshowList :: [SubmitBatches_Args] -> ShowS
show :: SubmitBatches_Args -> String
$cshow :: SubmitBatches_Args -> String
showsPrec :: Int -> SubmitBatches_Args -> ShowS
$cshowsPrec :: Int -> SubmitBatches_Args -> ShowS
Prelude.Show)

instance Pinch.Pinchable SubmitBatches_Args where
  type (Tag SubmitBatches_Args) = Pinch.TStruct

  pinch :: SubmitBatches_Args -> Value (Tag SubmitBatches_Args)
pinch (SubmitBatches_Args Vector Batch
submitBatches_Args_batches) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Vector Batch
submitBatches_Args_batches) ])

  unpinch :: Value (Tag SubmitBatches_Args) -> Parser SubmitBatches_Args
unpinch Value (Tag SubmitBatches_Args)
value = (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Vector Batch -> SubmitBatches_Args
SubmitBatches_Args) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag SubmitBatches_Args)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1))


instance Pinch.Internal.RPC.ThriftResult SubmitBatches_Result where
  type (ResultType SubmitBatches_Result) = (Data.Vector.Vector BatchSubmitResponse)

  unwrap :: SubmitBatches_Result -> IO (ResultType SubmitBatches_Result)
unwrap (SubmitBatches_Result_Success Vector BatchSubmitResponse
x) = forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Vector BatchSubmitResponse
x)

  wrap :: IO (ResultType SubmitBatches_Result) -> IO SubmitBatches_Result
wrap IO (ResultType SubmitBatches_Result)
m = forall a. IO a -> [Handler a] -> IO a
Control.Exception.catches ((Vector BatchSubmitResponse -> SubmitBatches_Result
SubmitBatches_Result_Success forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> IO (ResultType SubmitBatches_Result)
m)) ([  ])


data SubmitBatches_Result
  = SubmitBatches_Result_Success (Data.Vector.Vector BatchSubmitResponse)
  deriving (SubmitBatches_Result -> SubmitBatches_Result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubmitBatches_Result -> SubmitBatches_Result -> Bool
$c/= :: SubmitBatches_Result -> SubmitBatches_Result -> Bool
== :: SubmitBatches_Result -> SubmitBatches_Result -> Bool
$c== :: SubmitBatches_Result -> SubmitBatches_Result -> Bool
Prelude.Eq, forall x. Rep SubmitBatches_Result x -> SubmitBatches_Result
forall x. SubmitBatches_Result -> Rep SubmitBatches_Result x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubmitBatches_Result x -> SubmitBatches_Result
$cfrom :: forall x. SubmitBatches_Result -> Rep SubmitBatches_Result x
GHC.Generics.Generic, Int -> SubmitBatches_Result -> ShowS
[SubmitBatches_Result] -> ShowS
SubmitBatches_Result -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubmitBatches_Result] -> ShowS
$cshowList :: [SubmitBatches_Result] -> ShowS
show :: SubmitBatches_Result -> String
$cshow :: SubmitBatches_Result -> String
showsPrec :: Int -> SubmitBatches_Result -> ShowS
$cshowsPrec :: Int -> SubmitBatches_Result -> ShowS
Prelude.Show)

instance Pinch.Pinchable SubmitBatches_Result where
  type (Tag SubmitBatches_Result) = Pinch.TUnion

  pinch :: SubmitBatches_Result -> Value (Tag SubmitBatches_Result)
pinch (SubmitBatches_Result_Success Vector BatchSubmitResponse
x) = forall a. Pinchable a => Int16 -> a -> Value TStruct
Pinch.union (Int16
0) (Vector BatchSubmitResponse
x)

  unpinch :: Value (Tag SubmitBatches_Result) -> Parser SubmitBatches_Result
unpinch Value (Tag SubmitBatches_Result)
v = (forall (f :: * -> *) a. Alternative f => f a
Control.Applicative.empty forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Control.Applicative.<|> (Vector BatchSubmitResponse -> SubmitBatches_Result
SubmitBatches_Result_Success forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Value (Tag SubmitBatches_Result)
v forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
0)))