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

module Zipkincore.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 ()

cLIENT_SEND :: Data.Text.Text
cLIENT_SEND :: Text
cLIENT_SEND = Text
"cs"
cLIENT_RECV :: Data.Text.Text
cLIENT_RECV :: Text
cLIENT_RECV = Text
"cr"
sERVER_SEND :: Data.Text.Text
sERVER_SEND :: Text
sERVER_SEND = Text
"ss"
sERVER_RECV :: Data.Text.Text
sERVER_RECV :: Text
sERVER_RECV = Text
"sr"
mESSAGE_SEND :: Data.Text.Text
mESSAGE_SEND :: Text
mESSAGE_SEND = Text
"ms"
mESSAGE_RECV :: Data.Text.Text
mESSAGE_RECV :: Text
mESSAGE_RECV = Text
"mr"
wIRE_SEND :: Data.Text.Text
wIRE_SEND :: Text
wIRE_SEND = Text
"ws"
wIRE_RECV :: Data.Text.Text
wIRE_RECV :: Text
wIRE_RECV = Text
"wr"
cLIENT_SEND_FRAGMENT :: Data.Text.Text
cLIENT_SEND_FRAGMENT :: Text
cLIENT_SEND_FRAGMENT = Text
"csf"
cLIENT_RECV_FRAGMENT :: Data.Text.Text
cLIENT_RECV_FRAGMENT :: Text
cLIENT_RECV_FRAGMENT = Text
"crf"
sERVER_SEND_FRAGMENT :: Data.Text.Text
sERVER_SEND_FRAGMENT :: Text
sERVER_SEND_FRAGMENT = Text
"ssf"
sERVER_RECV_FRAGMENT :: Data.Text.Text
sERVER_RECV_FRAGMENT :: Text
sERVER_RECV_FRAGMENT = Text
"srf"
lOCAL_COMPONENT :: Data.Text.Text
lOCAL_COMPONENT :: Text
lOCAL_COMPONENT = Text
"lc"
cLIENT_ADDR :: Data.Text.Text
cLIENT_ADDR :: Text
cLIENT_ADDR = Text
"ca"
sERVER_ADDR :: Data.Text.Text
sERVER_ADDR :: Text
sERVER_ADDR = Text
"sa"
mESSAGE_ADDR :: Data.Text.Text
mESSAGE_ADDR :: Text
mESSAGE_ADDR = Text
"ma"
data Endpoint
  = Endpoint { Endpoint -> Int32
endpoint_ipv4 :: Data.Int.Int32, Endpoint -> Int16
endpoint_port :: Data.Int.Int16, Endpoint -> Text
endpoint_service_name :: Data.Text.Text, Endpoint -> Maybe ByteString
endpoint_ipv6 :: (Prelude.Maybe Data.ByteString.ByteString) }
  deriving (Endpoint -> Endpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endpoint -> Endpoint -> Bool
$c/= :: Endpoint -> Endpoint -> Bool
== :: Endpoint -> Endpoint -> Bool
$c== :: Endpoint -> Endpoint -> Bool
Prelude.Eq, forall x. Rep Endpoint x -> Endpoint
forall x. Endpoint -> Rep Endpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Endpoint x -> Endpoint
$cfrom :: forall x. Endpoint -> Rep Endpoint x
GHC.Generics.Generic, Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endpoint] -> ShowS
$cshowList :: [Endpoint] -> ShowS
show :: Endpoint -> String
$cshow :: Endpoint -> String
showsPrec :: Int -> Endpoint -> ShowS
$cshowsPrec :: Int -> Endpoint -> ShowS
Prelude.Show)

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

  pinch :: Endpoint -> Value (Tag Endpoint)
pinch (Endpoint Int32
endpoint_ipv4 Int16
endpoint_port Text
endpoint_service_name Maybe ByteString
endpoint_ipv6) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int32
endpoint_ipv4), (Int16
2 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int16
endpoint_port), (Int16
3 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Text
endpoint_service_name), (Int16
4 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe ByteString
endpoint_ipv6) ])

  unpinch :: Value (Tag Endpoint) -> Parser Endpoint
unpinch Value (Tag Endpoint)
value = ((((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Int32 -> Int16 -> Text -> Maybe ByteString -> Endpoint
Endpoint) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Endpoint)
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 Endpoint)
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 Endpoint)
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 Endpoint)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
4))


instance Data.Hashable.Hashable Endpoint where

data Annotation
  = Annotation { Annotation -> Int64
annotation_timestamp :: Data.Int.Int64, Annotation -> Text
annotation_value :: Data.Text.Text, Annotation -> Maybe Endpoint
annotation_host :: (Prelude.Maybe Endpoint) }
  deriving (Annotation -> Annotation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Prelude.Eq, forall x. Rep Annotation x -> Annotation
forall x. Annotation -> Rep Annotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Annotation x -> Annotation
$cfrom :: forall x. Annotation -> Rep Annotation x
GHC.Generics.Generic, Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Prelude.Show)

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

  pinch :: Annotation -> Value (Tag Annotation)
pinch (Annotation Int64
annotation_timestamp Text
annotation_value Maybe Endpoint
annotation_host) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
annotation_timestamp), (Int16
2 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Text
annotation_value), (Int16
3 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Endpoint
annotation_host) ])

  unpinch :: Value (Tag Annotation) -> Parser Annotation
unpinch Value (Tag Annotation)
value = (((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Int64 -> Text -> Maybe Endpoint -> Annotation
Annotation) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag Annotation)
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 Annotation)
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 Annotation)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
3))


instance Data.Hashable.Hashable Annotation where

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

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

  pinch :: AnnotationType -> Value (Tag AnnotationType)
pinch AnnotationType
BOOL = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
0 :: Data.Int.Int32))
  pinch AnnotationType
BYTES = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
1 :: Data.Int.Int32))
  pinch AnnotationType
I16 = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
2 :: Data.Int.Int32))
  pinch AnnotationType
I32 = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
3 :: Data.Int.Int32))
  pinch AnnotationType
I64 = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
4 :: Data.Int.Int32))
  pinch AnnotationType
DOUBLE = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
5 :: Data.Int.Int32))
  pinch AnnotationType
STRING = forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
6 :: Data.Int.Int32))

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


instance Prelude.Enum AnnotationType where
  fromEnum :: AnnotationType -> Int
fromEnum AnnotationType
BOOL = Int
0
  fromEnum AnnotationType
BYTES = Int
1
  fromEnum AnnotationType
I16 = Int
2
  fromEnum AnnotationType
I32 = Int
3
  fromEnum AnnotationType
I64 = Int
4
  fromEnum AnnotationType
DOUBLE = Int
5
  fromEnum AnnotationType
STRING = Int
6

  toEnum :: Int -> AnnotationType
toEnum Int
0 = AnnotationType
BOOL
  toEnum Int
1 = AnnotationType
BYTES
  toEnum Int
2 = AnnotationType
I16
  toEnum Int
3 = AnnotationType
I32
  toEnum Int
4 = AnnotationType
I64
  toEnum Int
5 = AnnotationType
DOUBLE
  toEnum Int
6 = AnnotationType
STRING
  toEnum Int
_ = forall a. HasCallStack => String -> a
Prelude.error (String
"Unknown value for enum AnnotationType.")


instance Data.Hashable.Hashable AnnotationType where

data BinaryAnnotation
  = BinaryAnnotation { BinaryAnnotation -> Text
binaryAnnotation_key :: Data.Text.Text, BinaryAnnotation -> ByteString
binaryAnnotation_value :: Data.ByteString.ByteString, BinaryAnnotation -> AnnotationType
binaryAnnotation_annotation_type :: AnnotationType, BinaryAnnotation -> Maybe Endpoint
binaryAnnotation_host :: (Prelude.Maybe Endpoint) }
  deriving (BinaryAnnotation -> BinaryAnnotation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryAnnotation -> BinaryAnnotation -> Bool
$c/= :: BinaryAnnotation -> BinaryAnnotation -> Bool
== :: BinaryAnnotation -> BinaryAnnotation -> Bool
$c== :: BinaryAnnotation -> BinaryAnnotation -> Bool
Prelude.Eq, forall x. Rep BinaryAnnotation x -> BinaryAnnotation
forall x. BinaryAnnotation -> Rep BinaryAnnotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinaryAnnotation x -> BinaryAnnotation
$cfrom :: forall x. BinaryAnnotation -> Rep BinaryAnnotation x
GHC.Generics.Generic, Int -> BinaryAnnotation -> ShowS
[BinaryAnnotation] -> ShowS
BinaryAnnotation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryAnnotation] -> ShowS
$cshowList :: [BinaryAnnotation] -> ShowS
show :: BinaryAnnotation -> String
$cshow :: BinaryAnnotation -> String
showsPrec :: Int -> BinaryAnnotation -> ShowS
$cshowsPrec :: Int -> BinaryAnnotation -> ShowS
Prelude.Show)

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

  pinch :: BinaryAnnotation -> Value (Tag BinaryAnnotation)
pinch (BinaryAnnotation Text
binaryAnnotation_key ByteString
binaryAnnotation_value AnnotationType
binaryAnnotation_annotation_type Maybe Endpoint
binaryAnnotation_host) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Text
binaryAnnotation_key), (Int16
2 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= ByteString
binaryAnnotation_value), (Int16
3 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= AnnotationType
binaryAnnotation_annotation_type), (Int16
4 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Endpoint
binaryAnnotation_host) ])

  unpinch :: Value (Tag BinaryAnnotation) -> Parser BinaryAnnotation
unpinch Value (Tag BinaryAnnotation)
value = ((((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Text
-> ByteString
-> AnnotationType
-> Maybe Endpoint
-> BinaryAnnotation
BinaryAnnotation) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value (Tag BinaryAnnotation)
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 BinaryAnnotation)
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 BinaryAnnotation)
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 BinaryAnnotation)
value forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
4))


instance Data.Hashable.Hashable BinaryAnnotation where

data Span
  = Span { Span -> Int64
span_trace_id :: Data.Int.Int64, Span -> Text
span_name :: Data.Text.Text, Span -> Int64
span_id :: Data.Int.Int64, Span -> Maybe Int64
span_parent_id :: (Prelude.Maybe Data.Int.Int64), Span -> Vector Annotation
span_annotations :: (Data.Vector.Vector Annotation), Span -> Vector BinaryAnnotation
span_binary_annotations :: (Data.Vector.Vector BinaryAnnotation), Span -> Maybe Bool
span_debug :: (Prelude.Maybe Prelude.Bool), Span -> Maybe Int64
span_timestamp :: (Prelude.Maybe Data.Int.Int64), Span -> Maybe Int64
span_duration :: (Prelude.Maybe Data.Int.Int64), Span -> Maybe Int64
span_trace_id_high :: (Prelude.Maybe Data.Int.Int64) }
  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_trace_id Text
span_name Int64
span_id Maybe Int64
span_parent_id Vector Annotation
span_annotations Vector BinaryAnnotation
span_binary_annotations Maybe Bool
span_debug Maybe Int64
span_timestamp Maybe Int64
span_duration Maybe Int64
span_trace_id_high) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_trace_id), (Int16
3 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Text
span_name), (Int16
4 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_id), (Int16
5 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Int64
span_parent_id), (Int16
6 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Vector Annotation
span_annotations), (Int16
8 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Vector BinaryAnnotation
span_binary_annotations), (Int16
9 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Bool
span_debug), (Int16
10 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Int64
span_timestamp), (Int16
11 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Int64
span_duration), (Int16
12 forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Int64
span_trace_id_high) ])

  unpinch :: Value (Tag Span) -> Parser Span
unpinch Value (Tag Span)
value = ((((((((((forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Int64
-> Text
-> Int64
-> Maybe Int64
-> Vector Annotation
-> Vector BinaryAnnotation
-> Maybe Bool
-> Maybe Int64
-> Maybe Int64
-> Maybe Int64
-> 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
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 (Maybe 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 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
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 (Maybe 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)) 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
12))


instance Data.Hashable.Hashable Span where

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

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

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

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


instance Data.Hashable.Hashable Response where

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

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

  pinch :: SubmitZipkinBatch_Args -> Value (Tag SubmitZipkinBatch_Args)
pinch (SubmitZipkinBatch_Args Vector Span
submitZipkinBatch_Args_spans) = [FieldPair] -> Value TStruct
Pinch.struct ([ (Int16
1 forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Vector Span
submitZipkinBatch_Args_spans) ])

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


instance Pinch.Internal.RPC.ThriftResult SubmitZipkinBatch_Result where
  type (ResultType SubmitZipkinBatch_Result) = (Data.Vector.Vector Response)

  unwrap :: SubmitZipkinBatch_Result
-> IO (ResultType SubmitZipkinBatch_Result)
unwrap (SubmitZipkinBatch_Result_Success Vector Response
x) = forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Vector Response
x)

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


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

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

  pinch :: SubmitZipkinBatch_Result -> Value (Tag SubmitZipkinBatch_Result)
pinch (SubmitZipkinBatch_Result_Success Vector Response
x) = forall a. Pinchable a => Int16 -> a -> Value TStruct
Pinch.union (Int16
0) (Vector Response
x)

  unpinch :: Value (Tag SubmitZipkinBatch_Result)
-> Parser SubmitZipkinBatch_Result
unpinch Value (Tag SubmitZipkinBatch_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 Response -> SubmitZipkinBatch_Result
SubmitZipkinBatch_Result_Success forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Value (Tag SubmitZipkinBatch_Result)
v forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
0)))