{-# 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
(TagType -> TagType -> Bool)
-> (TagType -> TagType -> Bool) -> Eq TagType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TagType -> TagType -> Bool
== :: TagType -> TagType -> Bool
$c/= :: TagType -> TagType -> Bool
/= :: TagType -> TagType -> Bool
Prelude.Eq, Eq TagType
Eq TagType =>
(TagType -> TagType -> Ordering)
-> (TagType -> TagType -> Bool)
-> (TagType -> TagType -> Bool)
-> (TagType -> TagType -> Bool)
-> (TagType -> TagType -> Bool)
-> (TagType -> TagType -> TagType)
-> (TagType -> TagType -> TagType)
-> Ord 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
$ccompare :: TagType -> TagType -> Ordering
compare :: TagType -> TagType -> Ordering
$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
>= :: TagType -> TagType -> Bool
$cmax :: TagType -> TagType -> TagType
max :: TagType -> TagType -> TagType
$cmin :: TagType -> TagType -> TagType
min :: TagType -> TagType -> TagType
Prelude.Ord, (forall x. TagType -> Rep TagType x)
-> (forall x. Rep TagType x -> TagType) -> Generic TagType
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
$cfrom :: forall x. TagType -> Rep TagType x
from :: forall x. TagType -> Rep TagType x
$cto :: forall x. Rep TagType x -> TagType
to :: forall x. Rep TagType x -> TagType
GHC.Generics.Generic, Int -> TagType -> ShowS
[TagType] -> ShowS
TagType -> String
(Int -> TagType -> ShowS)
-> (TagType -> String) -> ([TagType] -> ShowS) -> Show TagType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TagType -> ShowS
showsPrec :: Int -> TagType -> ShowS
$cshow :: TagType -> String
show :: TagType -> String
$cshowList :: [TagType] -> ShowS
showList :: [TagType] -> ShowS
Prelude.Show, TagType
TagType -> TagType -> Bounded TagType
forall a. a -> a -> Bounded a
$cminBound :: TagType
minBound :: TagType
$cmaxBound :: TagType
maxBound :: TagType
Prelude.Bounded)

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

  pinch :: TagType -> Value (Tag TagType)
pinch TagType
STRING = Int32 -> Value (Tag Int32)
forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
0 :: Data.Int.Int32))
  pinch TagType
DOUBLE = Int32 -> Value (Tag Int32)
forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
1 :: Data.Int.Int32))
  pinch TagType
BOOL = Int32 -> Value (Tag Int32)
forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
2 :: Data.Int.Int32))
  pinch TagType
LONG = Int32 -> Value (Tag Int32)
forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
3 :: Data.Int.Int32))
  pinch TagType
BINARY = Int32 -> Value (Tag Int32)
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 <- Value (Tag Int32) -> Parser Int32
forall a. Pinchable a => Value (Tag a) -> Parser a
Pinch.unpinch (Value (Tag Int32)
Value (Tag TagType)
v)
    case (Int32
val :: Data.Int.Int32) of
      Int32
0 -> TagType -> Parser TagType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (TagType
STRING)
      Int32
1 -> TagType -> Parser TagType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (TagType
DOUBLE)
      Int32
2 -> TagType -> Parser TagType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (TagType
BOOL)
      Int32
3 -> TagType -> Parser TagType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (TagType
LONG)
      Int32
4 -> TagType -> Parser TagType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (TagType
BINARY)
      Int32
_ -> String -> Parser TagType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail ((String
"Unknown value for type TagType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
Prelude.<> Int32 -> String
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
_ = String -> TagType
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
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
/= :: Tag -> Tag -> Bool
Prelude.Eq, (forall x. Tag -> Rep Tag x)
-> (forall x. Rep Tag x -> Tag) -> Generic Tag
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
$cfrom :: forall x. Tag -> Rep Tag x
from :: forall x. Tag -> Rep Tag x
$cto :: forall x. Rep Tag x -> Tag
to :: forall x. Rep Tag x -> Tag
GHC.Generics.Generic, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tag -> ShowS
showsPrec :: Int -> Tag -> ShowS
$cshow :: Tag -> String
show :: Tag -> String
$cshowList :: [Tag] -> ShowS
showList :: [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 Int16 -> Text -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Text
tag_key), (Int16
2 Int16 -> TagType -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= TagType
tag_vType), (Int16
3 Int16 -> Maybe Text -> FieldPair
forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Text
tag_vStr), (Int16
4 Int16 -> Maybe Double -> FieldPair
forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Double
tag_vDouble), (Int16
5 Int16 -> Maybe Bool -> FieldPair
forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Bool
tag_vBool), (Int16
6 Int16 -> Maybe Int64 -> FieldPair
forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Int64
tag_vLong), (Int16
7 Int16 -> Maybe ByteString -> FieldPair
forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe ByteString
tag_vBinary) ])

  unpinch :: Value (Tag Tag) -> Parser Tag
unpinch Value (Tag Tag)
value = ((((((((Text
 -> TagType
 -> Maybe Text
 -> Maybe Double
 -> Maybe Bool
 -> Maybe Int64
 -> Maybe ByteString
 -> Tag)
-> Parser
     (Text
      -> TagType
      -> Maybe Text
      -> Maybe Double
      -> Maybe Bool
      -> Maybe Int64
      -> Maybe ByteString
      -> Tag)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Text
-> TagType
-> Maybe Text
-> Maybe Double
-> Maybe Bool
-> Maybe Int64
-> Maybe ByteString
-> Tag
Tag) Parser
  (Text
   -> TagType
   -> Maybe Text
   -> Maybe Double
   -> Maybe Bool
   -> Maybe Int64
   -> Maybe ByteString
   -> Tag)
-> Parser Text
-> Parser
     (TagType
      -> Maybe Text
      -> Maybe Double
      -> Maybe Bool
      -> Maybe Int64
      -> Maybe ByteString
      -> Tag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Tag)
value Value TStruct -> Int16 -> Parser Text
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) Parser
  (TagType
   -> Maybe Text
   -> Maybe Double
   -> Maybe Bool
   -> Maybe Int64
   -> Maybe ByteString
   -> Tag)
-> Parser TagType
-> Parser
     (Maybe Text
      -> Maybe Double
      -> Maybe Bool
      -> Maybe Int64
      -> Maybe ByteString
      -> Tag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Tag)
value Value TStruct -> Int16 -> Parser TagType
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2)) Parser
  (Maybe Text
   -> Maybe Double
   -> Maybe Bool
   -> Maybe Int64
   -> Maybe ByteString
   -> Tag)
-> Parser (Maybe Text)
-> Parser
     (Maybe Double
      -> Maybe Bool -> Maybe Int64 -> Maybe ByteString -> Tag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Tag)
value Value TStruct -> Int16 -> Parser (Maybe Text)
forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
3)) Parser
  (Maybe Double
   -> Maybe Bool -> Maybe Int64 -> Maybe ByteString -> Tag)
-> Parser (Maybe Double)
-> Parser (Maybe Bool -> Maybe Int64 -> Maybe ByteString -> Tag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Tag)
value Value TStruct -> Int16 -> Parser (Maybe Double)
forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
4)) Parser (Maybe Bool -> Maybe Int64 -> Maybe ByteString -> Tag)
-> Parser (Maybe Bool)
-> Parser (Maybe Int64 -> Maybe ByteString -> Tag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Tag)
value Value TStruct -> Int16 -> Parser (Maybe Bool)
forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
5)) Parser (Maybe Int64 -> Maybe ByteString -> Tag)
-> Parser (Maybe Int64) -> Parser (Maybe ByteString -> Tag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Tag)
value Value TStruct -> Int16 -> Parser (Maybe Int64)
forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
6)) Parser (Maybe ByteString -> Tag)
-> Parser (Maybe ByteString) -> Parser Tag
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Tag)
value Value TStruct -> Int16 -> Parser (Maybe ByteString)
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
(Log -> Log -> Bool) -> (Log -> Log -> Bool) -> Eq Log
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Log -> Log -> Bool
== :: Log -> Log -> Bool
$c/= :: Log -> Log -> Bool
/= :: Log -> Log -> Bool
Prelude.Eq, (forall x. Log -> Rep Log x)
-> (forall x. Rep Log x -> Log) -> Generic Log
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
$cfrom :: forall x. Log -> Rep Log x
from :: forall x. Log -> Rep Log x
$cto :: forall x. Rep Log x -> Log
to :: forall x. Rep Log x -> Log
GHC.Generics.Generic, Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [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 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
log_timestamp), (Int16
2 Int16 -> Vector Tag -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Vector Tag
log_fields) ])

  unpinch :: Value (Tag Log) -> Parser Log
unpinch Value (Tag Log)
value = (((Int64 -> Vector Tag -> Log) -> Parser (Int64 -> Vector Tag -> Log)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Int64 -> Vector Tag -> Log
Log) Parser (Int64 -> Vector Tag -> Log)
-> Parser Int64 -> Parser (Vector Tag -> Log)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Log)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) Parser (Vector Tag -> Log) -> Parser (Vector Tag) -> Parser Log
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Log)
value Value TStruct -> Int16 -> Parser (Vector Tag)
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
(SpanRefType -> SpanRefType -> Bool)
-> (SpanRefType -> SpanRefType -> Bool) -> Eq SpanRefType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanRefType -> SpanRefType -> Bool
== :: SpanRefType -> SpanRefType -> Bool
$c/= :: SpanRefType -> SpanRefType -> Bool
/= :: SpanRefType -> SpanRefType -> Bool
Prelude.Eq, Eq SpanRefType
Eq SpanRefType =>
(SpanRefType -> SpanRefType -> Ordering)
-> (SpanRefType -> SpanRefType -> Bool)
-> (SpanRefType -> SpanRefType -> Bool)
-> (SpanRefType -> SpanRefType -> Bool)
-> (SpanRefType -> SpanRefType -> Bool)
-> (SpanRefType -> SpanRefType -> SpanRefType)
-> (SpanRefType -> SpanRefType -> SpanRefType)
-> Ord 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
$ccompare :: SpanRefType -> SpanRefType -> Ordering
compare :: SpanRefType -> SpanRefType -> Ordering
$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
>= :: SpanRefType -> SpanRefType -> Bool
$cmax :: SpanRefType -> SpanRefType -> SpanRefType
max :: SpanRefType -> SpanRefType -> SpanRefType
$cmin :: SpanRefType -> SpanRefType -> SpanRefType
min :: SpanRefType -> SpanRefType -> SpanRefType
Prelude.Ord, (forall x. SpanRefType -> Rep SpanRefType x)
-> (forall x. Rep SpanRefType x -> SpanRefType)
-> Generic SpanRefType
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
$cfrom :: forall x. SpanRefType -> Rep SpanRefType x
from :: forall x. SpanRefType -> Rep SpanRefType x
$cto :: forall x. Rep SpanRefType x -> SpanRefType
to :: forall x. Rep SpanRefType x -> SpanRefType
GHC.Generics.Generic, Int -> SpanRefType -> ShowS
[SpanRefType] -> ShowS
SpanRefType -> String
(Int -> SpanRefType -> ShowS)
-> (SpanRefType -> String)
-> ([SpanRefType] -> ShowS)
-> Show SpanRefType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanRefType -> ShowS
showsPrec :: Int -> SpanRefType -> ShowS
$cshow :: SpanRefType -> String
show :: SpanRefType -> String
$cshowList :: [SpanRefType] -> ShowS
showList :: [SpanRefType] -> ShowS
Prelude.Show, SpanRefType
SpanRefType -> SpanRefType -> Bounded SpanRefType
forall a. a -> a -> Bounded a
$cminBound :: SpanRefType
minBound :: SpanRefType
$cmaxBound :: SpanRefType
maxBound :: SpanRefType
Prelude.Bounded)

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

  pinch :: SpanRefType -> Value (Tag SpanRefType)
pinch SpanRefType
CHILD_OF = Int32 -> Value (Tag Int32)
forall a. Pinchable a => a -> Value (Tag a)
Pinch.pinch ((Int32
0 :: Data.Int.Int32))
  pinch SpanRefType
FOLLOWS_FROM = Int32 -> Value (Tag Int32)
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 <- Value (Tag Int32) -> Parser Int32
forall a. Pinchable a => Value (Tag a) -> Parser a
Pinch.unpinch (Value (Tag Int32)
Value (Tag SpanRefType)
v)
    case (Int32
val :: Data.Int.Int32) of
      Int32
0 -> SpanRefType -> Parser SpanRefType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (SpanRefType
CHILD_OF)
      Int32
1 -> SpanRefType -> Parser SpanRefType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (SpanRefType
FOLLOWS_FROM)
      Int32
_ -> String -> Parser SpanRefType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail ((String
"Unknown value for type SpanRefType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
Prelude.<> Int32 -> String
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
_ = String -> SpanRefType
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
(SpanRef -> SpanRef -> Bool)
-> (SpanRef -> SpanRef -> Bool) -> Eq SpanRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanRef -> SpanRef -> Bool
== :: SpanRef -> SpanRef -> Bool
$c/= :: SpanRef -> SpanRef -> Bool
/= :: SpanRef -> SpanRef -> Bool
Prelude.Eq, (forall x. SpanRef -> Rep SpanRef x)
-> (forall x. Rep SpanRef x -> SpanRef) -> Generic SpanRef
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
$cfrom :: forall x. SpanRef -> Rep SpanRef x
from :: forall x. SpanRef -> Rep SpanRef x
$cto :: forall x. Rep SpanRef x -> SpanRef
to :: forall x. Rep SpanRef x -> SpanRef
GHC.Generics.Generic, Int -> SpanRef -> ShowS
[SpanRef] -> ShowS
SpanRef -> String
(Int -> SpanRef -> ShowS)
-> (SpanRef -> String) -> ([SpanRef] -> ShowS) -> Show SpanRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpanRef -> ShowS
showsPrec :: Int -> SpanRef -> ShowS
$cshow :: SpanRef -> String
show :: SpanRef -> String
$cshowList :: [SpanRef] -> ShowS
showList :: [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 Int16 -> SpanRefType -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= SpanRefType
spanRef_refType), (Int16
2 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
spanRef_traceIdLow), (Int16
3 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
spanRef_traceIdHigh), (Int16
4 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
spanRef_spanId) ])

  unpinch :: Value (Tag SpanRef) -> Parser SpanRef
unpinch Value (Tag SpanRef)
value = (((((SpanRefType -> Int64 -> Int64 -> Int64 -> SpanRef)
-> Parser (SpanRefType -> Int64 -> Int64 -> Int64 -> SpanRef)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (SpanRefType -> Int64 -> Int64 -> Int64 -> SpanRef
SpanRef) Parser (SpanRefType -> Int64 -> Int64 -> Int64 -> SpanRef)
-> Parser SpanRefType
-> Parser (Int64 -> Int64 -> Int64 -> SpanRef)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag SpanRef)
value Value TStruct -> Int16 -> Parser SpanRefType
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) Parser (Int64 -> Int64 -> Int64 -> SpanRef)
-> Parser Int64 -> Parser (Int64 -> Int64 -> SpanRef)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag SpanRef)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2)) Parser (Int64 -> Int64 -> SpanRef)
-> Parser Int64 -> Parser (Int64 -> SpanRef)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag SpanRef)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
3)) Parser (Int64 -> SpanRef) -> Parser Int64 -> Parser SpanRef
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag SpanRef)
value Value TStruct -> Int16 -> Parser Int64
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
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
/= :: Span -> Span -> Bool
Prelude.Eq, (forall x. Span -> Rep Span x)
-> (forall x. Rep Span x -> Span) -> Generic Span
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
$cfrom :: forall x. Span -> Rep Span x
from :: forall x. Span -> Rep Span x
$cto :: forall x. Rep Span x -> Span
to :: forall x. Rep Span x -> Span
GHC.Generics.Generic, Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
(Int -> Span -> ShowS)
-> (Span -> String) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Span -> ShowS
showsPrec :: Int -> Span -> ShowS
$cshow :: Span -> String
show :: Span -> String
$cshowList :: [Span] -> ShowS
showList :: [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 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_traceIdLow), (Int16
2 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_traceIdHigh), (Int16
3 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_spanId), (Int16
4 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_parentSpanId), (Int16
5 Int16 -> Text -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Text
span_operationName), (Int16
6 Int16 -> Maybe (Vector SpanRef) -> FieldPair
forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe (Vector SpanRef)
span_references), (Int16
7 Int16 -> Int32 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int32
span_flags), (Int16
8 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_startTime), (Int16
9 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
span_duration), (Int16
10 Int16 -> Maybe (Vector Tag) -> FieldPair
forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe (Vector Tag)
span_tags), (Int16
11 Int16 -> Maybe (Vector Log) -> FieldPair
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 = ((((((((((((Int64
 -> Int64
 -> Int64
 -> Int64
 -> Text
 -> Maybe (Vector SpanRef)
 -> Int32
 -> Int64
 -> Int64
 -> Maybe (Vector Tag)
 -> Maybe (Vector Log)
 -> Span)
-> Parser
     (Int64
      -> Int64
      -> Int64
      -> Int64
      -> Text
      -> Maybe (Vector SpanRef)
      -> Int32
      -> Int64
      -> Int64
      -> Maybe (Vector Tag)
      -> Maybe (Vector Log)
      -> Span)
forall a. a -> Parser a
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) Parser
  (Int64
   -> Int64
   -> Int64
   -> Int64
   -> Text
   -> Maybe (Vector SpanRef)
   -> Int32
   -> Int64
   -> Int64
   -> Maybe (Vector Tag)
   -> Maybe (Vector Log)
   -> Span)
-> Parser Int64
-> Parser
     (Int64
      -> Int64
      -> Int64
      -> Text
      -> Maybe (Vector SpanRef)
      -> Int32
      -> Int64
      -> Int64
      -> Maybe (Vector Tag)
      -> Maybe (Vector Log)
      -> Span)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) Parser
  (Int64
   -> Int64
   -> Int64
   -> Text
   -> Maybe (Vector SpanRef)
   -> Int32
   -> Int64
   -> Int64
   -> Maybe (Vector Tag)
   -> Maybe (Vector Log)
   -> Span)
-> Parser Int64
-> Parser
     (Int64
      -> Int64
      -> Text
      -> Maybe (Vector SpanRef)
      -> Int32
      -> Int64
      -> Int64
      -> Maybe (Vector Tag)
      -> Maybe (Vector Log)
      -> Span)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2)) Parser
  (Int64
   -> Int64
   -> Text
   -> Maybe (Vector SpanRef)
   -> Int32
   -> Int64
   -> Int64
   -> Maybe (Vector Tag)
   -> Maybe (Vector Log)
   -> Span)
-> Parser Int64
-> Parser
     (Int64
      -> Text
      -> Maybe (Vector SpanRef)
      -> Int32
      -> Int64
      -> Int64
      -> Maybe (Vector Tag)
      -> Maybe (Vector Log)
      -> Span)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
3)) Parser
  (Int64
   -> Text
   -> Maybe (Vector SpanRef)
   -> Int32
   -> Int64
   -> Int64
   -> Maybe (Vector Tag)
   -> Maybe (Vector Log)
   -> Span)
-> Parser Int64
-> Parser
     (Text
      -> Maybe (Vector SpanRef)
      -> Int32
      -> Int64
      -> Int64
      -> Maybe (Vector Tag)
      -> Maybe (Vector Log)
      -> Span)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
4)) Parser
  (Text
   -> Maybe (Vector SpanRef)
   -> Int32
   -> Int64
   -> Int64
   -> Maybe (Vector Tag)
   -> Maybe (Vector Log)
   -> Span)
-> Parser Text
-> Parser
     (Maybe (Vector SpanRef)
      -> Int32
      -> Int64
      -> Int64
      -> Maybe (Vector Tag)
      -> Maybe (Vector Log)
      -> Span)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser Text
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
5)) Parser
  (Maybe (Vector SpanRef)
   -> Int32
   -> Int64
   -> Int64
   -> Maybe (Vector Tag)
   -> Maybe (Vector Log)
   -> Span)
-> Parser (Maybe (Vector SpanRef))
-> Parser
     (Int32
      -> Int64
      -> Int64
      -> Maybe (Vector Tag)
      -> Maybe (Vector Log)
      -> Span)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser (Maybe (Vector SpanRef))
forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
6)) Parser
  (Int32
   -> Int64
   -> Int64
   -> Maybe (Vector Tag)
   -> Maybe (Vector Log)
   -> Span)
-> Parser Int32
-> Parser
     (Int64
      -> Int64 -> Maybe (Vector Tag) -> Maybe (Vector Log) -> Span)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser Int32
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
7)) Parser
  (Int64
   -> Int64 -> Maybe (Vector Tag) -> Maybe (Vector Log) -> Span)
-> Parser Int64
-> Parser
     (Int64 -> Maybe (Vector Tag) -> Maybe (Vector Log) -> Span)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
8)) Parser (Int64 -> Maybe (Vector Tag) -> Maybe (Vector Log) -> Span)
-> Parser Int64
-> Parser (Maybe (Vector Tag) -> Maybe (Vector Log) -> Span)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
9)) Parser (Maybe (Vector Tag) -> Maybe (Vector Log) -> Span)
-> Parser (Maybe (Vector Tag))
-> Parser (Maybe (Vector Log) -> Span)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser (Maybe (Vector Tag))
forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
10)) Parser (Maybe (Vector Log) -> Span)
-> Parser (Maybe (Vector Log)) -> Parser Span
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Span)
value Value TStruct -> Int16 -> Parser (Maybe (Vector Log))
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
(Process -> Process -> Bool)
-> (Process -> Process -> Bool) -> Eq Process
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Process -> Process -> Bool
== :: Process -> Process -> Bool
$c/= :: Process -> Process -> Bool
/= :: Process -> Process -> Bool
Prelude.Eq, (forall x. Process -> Rep Process x)
-> (forall x. Rep Process x -> Process) -> Generic Process
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
$cfrom :: forall x. Process -> Rep Process x
from :: forall x. Process -> Rep Process x
$cto :: forall x. Rep Process x -> Process
to :: forall x. Rep Process x -> Process
GHC.Generics.Generic, Int -> Process -> ShowS
[Process] -> ShowS
Process -> String
(Int -> Process -> ShowS)
-> (Process -> String) -> ([Process] -> ShowS) -> Show Process
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Process -> ShowS
showsPrec :: Int -> Process -> ShowS
$cshow :: Process -> String
show :: Process -> String
$cshowList :: [Process] -> ShowS
showList :: [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 Int16 -> Text -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Text
process_serviceName), (Int16
2 Int16 -> Maybe (Vector Tag) -> FieldPair
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 = (((Text -> Maybe (Vector Tag) -> Process)
-> Parser (Text -> Maybe (Vector Tag) -> Process)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Text -> Maybe (Vector Tag) -> Process
Process) Parser (Text -> Maybe (Vector Tag) -> Process)
-> Parser Text -> Parser (Maybe (Vector Tag) -> Process)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Process)
value Value TStruct -> Int16 -> Parser Text
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) Parser (Maybe (Vector Tag) -> Process)
-> Parser (Maybe (Vector Tag)) -> Parser Process
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Process)
value Value TStruct -> Int16 -> Parser (Maybe (Vector Tag))
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
(ClientStats -> ClientStats -> Bool)
-> (ClientStats -> ClientStats -> Bool) -> Eq ClientStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientStats -> ClientStats -> Bool
== :: ClientStats -> ClientStats -> Bool
$c/= :: ClientStats -> ClientStats -> Bool
/= :: ClientStats -> ClientStats -> Bool
Prelude.Eq, (forall x. ClientStats -> Rep ClientStats x)
-> (forall x. Rep ClientStats x -> ClientStats)
-> Generic ClientStats
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
$cfrom :: forall x. ClientStats -> Rep ClientStats x
from :: forall x. ClientStats -> Rep ClientStats x
$cto :: forall x. Rep ClientStats x -> ClientStats
to :: forall x. Rep ClientStats x -> ClientStats
GHC.Generics.Generic, Int -> ClientStats -> ShowS
[ClientStats] -> ShowS
ClientStats -> String
(Int -> ClientStats -> ShowS)
-> (ClientStats -> String)
-> ([ClientStats] -> ShowS)
-> Show ClientStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientStats -> ShowS
showsPrec :: Int -> ClientStats -> ShowS
$cshow :: ClientStats -> String
show :: ClientStats -> String
$cshowList :: [ClientStats] -> ShowS
showList :: [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 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
clientStats_fullQueueDroppedSpans), (Int16
2 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
clientStats_tooLargeDroppedSpans), (Int16
3 Int16 -> Int64 -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Int64
clientStats_failedToEmitSpans) ])

  unpinch :: Value (Tag ClientStats) -> Parser ClientStats
unpinch Value (Tag ClientStats)
value = ((((Int64 -> Int64 -> Int64 -> ClientStats)
-> Parser (Int64 -> Int64 -> Int64 -> ClientStats)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Int64 -> Int64 -> Int64 -> ClientStats
ClientStats) Parser (Int64 -> Int64 -> Int64 -> ClientStats)
-> Parser Int64 -> Parser (Int64 -> Int64 -> ClientStats)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag ClientStats)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) Parser (Int64 -> Int64 -> ClientStats)
-> Parser Int64 -> Parser (Int64 -> ClientStats)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag ClientStats)
value Value TStruct -> Int16 -> Parser Int64
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2)) Parser (Int64 -> ClientStats) -> Parser Int64 -> Parser ClientStats
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag ClientStats)
value Value TStruct -> Int16 -> Parser Int64
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
(Batch -> Batch -> Bool) -> (Batch -> Batch -> Bool) -> Eq Batch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Batch -> Batch -> Bool
== :: Batch -> Batch -> Bool
$c/= :: Batch -> Batch -> Bool
/= :: Batch -> Batch -> Bool
Prelude.Eq, (forall x. Batch -> Rep Batch x)
-> (forall x. Rep Batch x -> Batch) -> Generic Batch
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
$cfrom :: forall x. Batch -> Rep Batch x
from :: forall x. Batch -> Rep Batch x
$cto :: forall x. Rep Batch x -> Batch
to :: forall x. Rep Batch x -> Batch
GHC.Generics.Generic, Int -> Batch -> ShowS
[Batch] -> ShowS
Batch -> String
(Int -> Batch -> ShowS)
-> (Batch -> String) -> ([Batch] -> ShowS) -> Show Batch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Batch -> ShowS
showsPrec :: Int -> Batch -> ShowS
$cshow :: Batch -> String
show :: Batch -> String
$cshowList :: [Batch] -> ShowS
showList :: [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 Int16 -> Process -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Process
batch_process), (Int16
2 Int16 -> Vector Span -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Vector Span
batch_spans), (Int16
3 Int16 -> Maybe Int64 -> FieldPair
forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe Int64
batch_seqNo), (Int16
4 Int16 -> Maybe ClientStats -> FieldPair
forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
Pinch.?= Maybe ClientStats
batch_stats) ])

  unpinch :: Value (Tag Batch) -> Parser Batch
unpinch Value (Tag Batch)
value = (((((Process
 -> Vector Span -> Maybe Int64 -> Maybe ClientStats -> Batch)
-> Parser
     (Process
      -> Vector Span -> Maybe Int64 -> Maybe ClientStats -> Batch)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Process -> Vector Span -> Maybe Int64 -> Maybe ClientStats -> Batch
Batch) Parser
  (Process
   -> Vector Span -> Maybe Int64 -> Maybe ClientStats -> Batch)
-> Parser Process
-> Parser
     (Vector Span -> Maybe Int64 -> Maybe ClientStats -> Batch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Batch)
value Value TStruct -> Int16 -> Parser Process
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1)) Parser (Vector Span -> Maybe Int64 -> Maybe ClientStats -> Batch)
-> Parser (Vector Span)
-> Parser (Maybe Int64 -> Maybe ClientStats -> Batch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Batch)
value Value TStruct -> Int16 -> Parser (Vector Span)
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
2)) Parser (Maybe Int64 -> Maybe ClientStats -> Batch)
-> Parser (Maybe Int64) -> Parser (Maybe ClientStats -> Batch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Batch)
value Value TStruct -> Int16 -> Parser (Maybe Int64)
forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
Pinch..:? Int16
3)) Parser (Maybe ClientStats -> Batch)
-> Parser (Maybe ClientStats) -> Parser Batch
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag Batch)
value Value TStruct -> Int16 -> Parser (Maybe ClientStats)
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
(BatchSubmitResponse -> BatchSubmitResponse -> Bool)
-> (BatchSubmitResponse -> BatchSubmitResponse -> Bool)
-> Eq BatchSubmitResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BatchSubmitResponse -> BatchSubmitResponse -> Bool
== :: BatchSubmitResponse -> BatchSubmitResponse -> Bool
$c/= :: BatchSubmitResponse -> BatchSubmitResponse -> Bool
/= :: BatchSubmitResponse -> BatchSubmitResponse -> Bool
Prelude.Eq, (forall x. BatchSubmitResponse -> Rep BatchSubmitResponse x)
-> (forall x. Rep BatchSubmitResponse x -> BatchSubmitResponse)
-> Generic BatchSubmitResponse
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
$cfrom :: forall x. BatchSubmitResponse -> Rep BatchSubmitResponse x
from :: forall x. BatchSubmitResponse -> Rep BatchSubmitResponse x
$cto :: forall x. Rep BatchSubmitResponse x -> BatchSubmitResponse
to :: forall x. Rep BatchSubmitResponse x -> BatchSubmitResponse
GHC.Generics.Generic, Int -> BatchSubmitResponse -> ShowS
[BatchSubmitResponse] -> ShowS
BatchSubmitResponse -> String
(Int -> BatchSubmitResponse -> ShowS)
-> (BatchSubmitResponse -> String)
-> ([BatchSubmitResponse] -> ShowS)
-> Show BatchSubmitResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BatchSubmitResponse -> ShowS
showsPrec :: Int -> BatchSubmitResponse -> ShowS
$cshow :: BatchSubmitResponse -> String
show :: BatchSubmitResponse -> String
$cshowList :: [BatchSubmitResponse] -> ShowS
showList :: [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 Int16 -> Bool -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
Pinch..= Bool
batchSubmitResponse_ok) ])

  unpinch :: Value (Tag BatchSubmitResponse) -> Parser BatchSubmitResponse
unpinch Value (Tag BatchSubmitResponse)
value = ((Bool -> BatchSubmitResponse)
-> Parser (Bool -> BatchSubmitResponse)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Bool -> BatchSubmitResponse
BatchSubmitResponse) Parser (Bool -> BatchSubmitResponse)
-> Parser Bool -> Parser BatchSubmitResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag BatchSubmitResponse)
value Value TStruct -> Int16 -> Parser Bool
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
(SubmitBatches_Args -> SubmitBatches_Args -> Bool)
-> (SubmitBatches_Args -> SubmitBatches_Args -> Bool)
-> Eq SubmitBatches_Args
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubmitBatches_Args -> SubmitBatches_Args -> Bool
== :: SubmitBatches_Args -> SubmitBatches_Args -> Bool
$c/= :: SubmitBatches_Args -> SubmitBatches_Args -> Bool
/= :: SubmitBatches_Args -> SubmitBatches_Args -> Bool
Prelude.Eq, (forall x. SubmitBatches_Args -> Rep SubmitBatches_Args x)
-> (forall x. Rep SubmitBatches_Args x -> SubmitBatches_Args)
-> Generic SubmitBatches_Args
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
$cfrom :: forall x. SubmitBatches_Args -> Rep SubmitBatches_Args x
from :: forall x. SubmitBatches_Args -> Rep SubmitBatches_Args x
$cto :: forall x. Rep SubmitBatches_Args x -> SubmitBatches_Args
to :: forall x. Rep SubmitBatches_Args x -> SubmitBatches_Args
GHC.Generics.Generic, Int -> SubmitBatches_Args -> ShowS
[SubmitBatches_Args] -> ShowS
SubmitBatches_Args -> String
(Int -> SubmitBatches_Args -> ShowS)
-> (SubmitBatches_Args -> String)
-> ([SubmitBatches_Args] -> ShowS)
-> Show SubmitBatches_Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubmitBatches_Args -> ShowS
showsPrec :: Int -> SubmitBatches_Args -> ShowS
$cshow :: SubmitBatches_Args -> String
show :: SubmitBatches_Args -> String
$cshowList :: [SubmitBatches_Args] -> ShowS
showList :: [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 Int16 -> Vector Batch -> FieldPair
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 = ((Vector Batch -> SubmitBatches_Args)
-> Parser (Vector Batch -> SubmitBatches_Args)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Vector Batch -> SubmitBatches_Args
SubmitBatches_Args) Parser (Vector Batch -> SubmitBatches_Args)
-> Parser (Vector Batch) -> Parser SubmitBatches_Args
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Value TStruct
Value (Tag SubmitBatches_Args)
value Value TStruct -> Int16 -> Parser (Vector Batch)
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) = Vector BatchSubmitResponse -> IO (Vector BatchSubmitResponse)
forall a. a -> IO a
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 = IO SubmitBatches_Result
-> [Handler SubmitBatches_Result] -> IO SubmitBatches_Result
forall a. IO a -> [Handler a] -> IO a
Control.Exception.catches ((Vector BatchSubmitResponse -> SubmitBatches_Result
SubmitBatches_Result_Success (Vector BatchSubmitResponse -> SubmitBatches_Result)
-> IO (Vector BatchSubmitResponse) -> IO SubmitBatches_Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> IO (Vector BatchSubmitResponse)
IO (ResultType SubmitBatches_Result)
m)) ([  ])


data SubmitBatches_Result
  = SubmitBatches_Result_Success (Data.Vector.Vector BatchSubmitResponse)
  deriving (SubmitBatches_Result -> SubmitBatches_Result -> Bool
(SubmitBatches_Result -> SubmitBatches_Result -> Bool)
-> (SubmitBatches_Result -> SubmitBatches_Result -> Bool)
-> Eq SubmitBatches_Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubmitBatches_Result -> SubmitBatches_Result -> Bool
== :: SubmitBatches_Result -> SubmitBatches_Result -> Bool
$c/= :: SubmitBatches_Result -> SubmitBatches_Result -> Bool
/= :: SubmitBatches_Result -> SubmitBatches_Result -> Bool
Prelude.Eq, (forall x. SubmitBatches_Result -> Rep SubmitBatches_Result x)
-> (forall x. Rep SubmitBatches_Result x -> SubmitBatches_Result)
-> Generic SubmitBatches_Result
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
$cfrom :: forall x. SubmitBatches_Result -> Rep SubmitBatches_Result x
from :: forall x. SubmitBatches_Result -> Rep SubmitBatches_Result x
$cto :: forall x. Rep SubmitBatches_Result x -> SubmitBatches_Result
to :: forall x. Rep SubmitBatches_Result x -> SubmitBatches_Result
GHC.Generics.Generic, Int -> SubmitBatches_Result -> ShowS
[SubmitBatches_Result] -> ShowS
SubmitBatches_Result -> String
(Int -> SubmitBatches_Result -> ShowS)
-> (SubmitBatches_Result -> String)
-> ([SubmitBatches_Result] -> ShowS)
-> Show SubmitBatches_Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubmitBatches_Result -> ShowS
showsPrec :: Int -> SubmitBatches_Result -> ShowS
$cshow :: SubmitBatches_Result -> String
show :: SubmitBatches_Result -> String
$cshowList :: [SubmitBatches_Result] -> ShowS
showList :: [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) = Int16 -> Vector BatchSubmitResponse -> Value TStruct
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 = (Parser SubmitBatches_Result
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
Control.Applicative.empty Parser SubmitBatches_Result
-> Parser SubmitBatches_Result -> Parser SubmitBatches_Result
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Control.Applicative.<|> (Vector BatchSubmitResponse -> SubmitBatches_Result
SubmitBatches_Result_Success (Vector BatchSubmitResponse -> SubmitBatches_Result)
-> Parser (Vector BatchSubmitResponse)
-> Parser SubmitBatches_Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Value TStruct
Value (Tag SubmitBatches_Result)
v Value TStruct -> Int16 -> Parser (Vector BatchSubmitResponse)
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
0)))