{-# 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 forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool $c/= :: EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool == :: EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool $c== :: EmitZipkinBatch_Args -> EmitZipkinBatch_Args -> Bool Prelude.Eq, 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 $cto :: forall x. Rep EmitZipkinBatch_Args x -> EmitZipkinBatch_Args $cfrom :: forall x. EmitZipkinBatch_Args -> Rep EmitZipkinBatch_Args x GHC.Generics.Generic, Int -> EmitZipkinBatch_Args -> ShowS [EmitZipkinBatch_Args] -> ShowS EmitZipkinBatch_Args -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [EmitZipkinBatch_Args] -> ShowS $cshowList :: [EmitZipkinBatch_Args] -> ShowS show :: EmitZipkinBatch_Args -> String $cshow :: EmitZipkinBatch_Args -> String showsPrec :: Int -> EmitZipkinBatch_Args -> ShowS $cshowsPrec :: Int -> 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 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 = (forall (f :: * -> *) a. Applicative f => a -> f a Prelude.pure (Vector Span -> EmitZipkinBatch_Args EmitZipkinBatch_Args) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b Prelude.<*> (Value (Tag EmitZipkinBatch_Args) value 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 forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: EmitBatch_Args -> EmitBatch_Args -> Bool $c/= :: EmitBatch_Args -> EmitBatch_Args -> Bool == :: EmitBatch_Args -> EmitBatch_Args -> Bool $c== :: EmitBatch_Args -> EmitBatch_Args -> Bool Prelude.Eq, 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 $cto :: forall x. Rep EmitBatch_Args x -> EmitBatch_Args $cfrom :: forall x. EmitBatch_Args -> Rep EmitBatch_Args x GHC.Generics.Generic, Int -> EmitBatch_Args -> ShowS [EmitBatch_Args] -> ShowS EmitBatch_Args -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [EmitBatch_Args] -> ShowS $cshowList :: [EmitBatch_Args] -> ShowS show :: EmitBatch_Args -> String $cshow :: EmitBatch_Args -> String showsPrec :: Int -> EmitBatch_Args -> ShowS $cshowsPrec :: Int -> 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 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 = (forall (f :: * -> *) a. Applicative f => a -> f a Prelude.pure (Batch -> EmitBatch_Args EmitBatch_Args) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b Prelude.<*> (Value (Tag EmitBatch_Args) value forall a. Pinchable a => Value TStruct -> Int16 -> Parser a Pinch..: Int16 1))