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

module Agent.Types where

import qualified Jaeger.Types
import qualified Zipkincore.Types
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 EmitZipkinBatch_Args
  = EmitZipkinBatch_Args { EmitZipkinBatch_Args -> Vector Span
emitZipkinBatch_Args_spans :: (Data.Vector.Vector Zipkincore.Types.Span) }
  deriving (EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool
(EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool)
-> (EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool)
-> Eq EmitZipkinBatch_Args
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool
== :: EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool
$c/= :: EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool
/= :: EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool
Prelude.Eq, (forall x. EmitZipkinBatch_Args -> Rep EmitZipkinBatch_Args x)
-> (forall x. Rep EmitZipkinBatch_Args x -> EmitZipkinBatch_Args)
-> Generic EmitZipkinBatch_Args
forall x. Rep EmitZipkinBatch_Args x -> EmitZipkinBatch_Args
forall x. EmitZipkinBatch_Args -> Rep EmitZipkinBatch_Args x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EmitZipkinBatch_Args -> Rep EmitZipkinBatch_Args x
from :: forall x. EmitZipkinBatch_Args -> Rep EmitZipkinBatch_Args x
$cto :: forall x. Rep EmitZipkinBatch_Args x -> EmitZipkinBatch_Args
to :: forall x. Rep EmitZipkinBatch_Args x -> EmitZipkinBatch_Args
GHC.Generics.Generic, Int -> EmitZipkinBatch_Args -> ShowS
[EmitZipkinBatch_Args] -> ShowS
EmitZipkinBatch_Args -> String
(Int -> EmitZipkinBatch_Args -> ShowS)
-> (EmitZipkinBatch_Args -> String)
-> ([EmitZipkinBatch_Args] -> ShowS)
-> Show EmitZipkinBatch_Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EmitZipkinBatch_Args -> ShowS
showsPrec :: Int -> EmitZipkinBatch_Args -> ShowS
$cshow :: EmitZipkinBatch_Args -> String
show :: EmitZipkinBatch_Args -> String
$cshowList :: [EmitZipkinBatch_Args] -> ShowS
showList :: [EmitZipkinBatch_Args] -> ShowS
Prelude.Show)

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

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

  unpinch :: Value (Tag EmitZipkinBatch_Args) -> Parser EmitZipkinBatch_Args
unpinch Value (Tag EmitZipkinBatch_Args)
value = ((Vector Span -> EmitZipkinBatch_Args)
-> Parser (Vector Span -> EmitZipkinBatch_Args)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Vector Span -> EmitZipkinBatch_Args
EmitZipkinBatch_Args) Parser (Vector Span -> EmitZipkinBatch_Args)
-> Parser (Vector Span) -> Parser EmitZipkinBatch_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 EmitZipkinBatch_Args)
value Value TStruct -> Int16 -> Parser (Vector Span)
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1))


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

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

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

  unpinch :: Value (Tag EmitBatch_Args) -> Parser EmitBatch_Args
unpinch Value (Tag EmitBatch_Args)
value = ((Batch -> EmitBatch_Args) -> Parser (Batch -> EmitBatch_Args)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Batch -> EmitBatch_Args
EmitBatch_Args) Parser (Batch -> EmitBatch_Args)
-> Parser Batch -> Parser EmitBatch_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 EmitBatch_Args)
value Value TStruct -> Int16 -> Parser Batch
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
Pinch..: Int16
1))