{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-----------------------------------------------------------------
-- Autogenerated by Thrift Compiler (0.11.0)                      --
--                                                             --
-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --
-----------------------------------------------------------------

module ZipkinCore_Types where
import Prelude (($), (.), (>>=), (==), (++))
import qualified Prelude as P
import qualified Control.Exception as X
import qualified Control.Monad as M ( liftM, ap, when )
import Data.Functor ( (<$>) )
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Hashable as H
import qualified Data.Int as I
import qualified Data.Maybe as M (catMaybes)
import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )
import qualified Data.Text.Lazy as LT
import qualified GHC.Generics as G (Generic)
import qualified Data.Typeable as TY ( Typeable )
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import qualified Data.Vector as Vector
import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )
import qualified Test.QuickCheck as QC ( elements )

import qualified Thrift as T
import qualified Thrift.Types as T
import qualified Thrift.Arbitraries as T


data AnnotationType = BOOL|BYTES|I16|I32|I64|DOUBLE|STRING  deriving (Int -> AnnotationType -> ShowS
[AnnotationType] -> ShowS
AnnotationType -> String
(Int -> AnnotationType -> ShowS)
-> (AnnotationType -> String)
-> ([AnnotationType] -> ShowS)
-> Show AnnotationType
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
P.Show, AnnotationType -> AnnotationType -> Bool
(AnnotationType -> AnnotationType -> Bool)
-> (AnnotationType -> AnnotationType -> Bool) -> Eq AnnotationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotationType -> AnnotationType -> Bool
$c/= :: AnnotationType -> AnnotationType -> Bool
== :: AnnotationType -> AnnotationType -> Bool
$c== :: AnnotationType -> AnnotationType -> Bool
P.Eq, (forall x. AnnotationType -> Rep AnnotationType x)
-> (forall x. Rep AnnotationType x -> AnnotationType)
-> Generic AnnotationType
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
G.Generic, TY.Typeable, Eq AnnotationType
Eq AnnotationType
-> (AnnotationType -> AnnotationType -> Ordering)
-> (AnnotationType -> AnnotationType -> Bool)
-> (AnnotationType -> AnnotationType -> Bool)
-> (AnnotationType -> AnnotationType -> Bool)
-> (AnnotationType -> AnnotationType -> Bool)
-> (AnnotationType -> AnnotationType -> AnnotationType)
-> (AnnotationType -> AnnotationType -> AnnotationType)
-> Ord 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
$cp1Ord :: Eq AnnotationType
P.Ord, AnnotationType
AnnotationType -> AnnotationType -> Bounded AnnotationType
forall a. a -> a -> Bounded a
maxBound :: AnnotationType
$cmaxBound :: AnnotationType
minBound :: AnnotationType
$cminBound :: AnnotationType
P.Bounded)
instance P.Enum AnnotationType where
  fromEnum :: AnnotationType -> Int
fromEnum AnnotationType
t = case AnnotationType
t of
    AnnotationType
BOOL -> Int
0
    AnnotationType
BYTES -> Int
1
    AnnotationType
I16 -> Int
2
    AnnotationType
I32 -> Int
3
    AnnotationType
I64 -> Int
4
    AnnotationType
DOUBLE -> Int
5
    AnnotationType
STRING -> Int
6
  toEnum :: Int -> AnnotationType
toEnum Int
t = case Int
t of
    Int
0 -> AnnotationType
BOOL
    Int
1 -> AnnotationType
BYTES
    Int
2 -> AnnotationType
I16
    Int
3 -> AnnotationType
I32
    Int
4 -> AnnotationType
I64
    Int
5 -> AnnotationType
DOUBLE
    Int
6 -> AnnotationType
STRING
    Int
_ -> ThriftException -> AnnotationType
forall a e. Exception e => e -> a
X.throw ThriftException
T.ThriftException
instance H.Hashable AnnotationType where
  hashWithSalt :: Int -> AnnotationType -> Int
hashWithSalt Int
salt = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
H.hashWithSalt Int
salt (Int -> Int) -> (AnnotationType -> Int) -> AnnotationType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
P.. AnnotationType -> Int
forall a. Enum a => a -> Int
P.fromEnum
instance QC.Arbitrary AnnotationType where
  arbitrary :: Gen AnnotationType
arbitrary = [AnnotationType] -> Gen AnnotationType
forall a. [a] -> Gen a
QC.elements (AnnotationType -> AnnotationType -> [AnnotationType]
forall a. Enum a => a -> a -> [a]
P.enumFromTo AnnotationType
forall a. Bounded a => a
P.minBound AnnotationType
forall a. Bounded a => a
P.maxBound)
data Endpoint = Endpoint  { Endpoint -> Int32
endpoint_ipv4 :: I.Int32
  , Endpoint -> Int16
endpoint_port :: I.Int16
  , Endpoint -> Text
endpoint_service_name :: LT.Text
  , Endpoint -> Maybe ByteString
endpoint_ipv6 :: P.Maybe LBS.ByteString
  } deriving (Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
(Int -> Endpoint -> ShowS)
-> (Endpoint -> String) -> ([Endpoint] -> ShowS) -> Show Endpoint
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
P.Show,Endpoint -> Endpoint -> Bool
(Endpoint -> Endpoint -> Bool)
-> (Endpoint -> Endpoint -> Bool) -> Eq Endpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endpoint -> Endpoint -> Bool
$c/= :: Endpoint -> Endpoint -> Bool
== :: Endpoint -> Endpoint -> Bool
$c== :: Endpoint -> Endpoint -> Bool
P.Eq,(forall x. Endpoint -> Rep Endpoint x)
-> (forall x. Rep Endpoint x -> Endpoint) -> Generic Endpoint
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
G.Generic,TY.Typeable)
instance H.Hashable Endpoint where
  hashWithSalt :: Int -> Endpoint -> Int
hashWithSalt Int
salt Endpoint
record = Int
salt   Int -> Int32 -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Endpoint -> Int32
endpoint_ipv4 Endpoint
record   Int -> Int16 -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Endpoint -> Int16
endpoint_port Endpoint
record   Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Endpoint -> Text
endpoint_service_name Endpoint
record   Int -> Maybe ByteString -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Endpoint -> Maybe ByteString
endpoint_ipv6 Endpoint
record  
instance QC.Arbitrary Endpoint where 
  arbitrary :: Gen Endpoint
arbitrary = (Int32 -> Int16 -> Text -> Maybe ByteString -> Endpoint)
-> Gen Int32 -> Gen (Int16 -> Text -> Maybe ByteString -> Endpoint)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Int32 -> Int16 -> Text -> Maybe ByteString -> Endpoint
Endpoint (Gen Int32
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen (Int16 -> Text -> Maybe ByteString -> Endpoint)
-> Gen Int16 -> Gen (Text -> Maybe ByteString -> Endpoint)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`(Gen Int16
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen (Text -> Maybe ByteString -> Endpoint)
-> Gen Text -> Gen (Maybe ByteString -> Endpoint)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`(Gen Text
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen (Maybe ByteString -> Endpoint)
-> Gen (Maybe ByteString) -> Gen Endpoint
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`((ByteString -> Maybe ByteString)
-> Gen ByteString -> Gen (Maybe ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM ByteString -> Maybe ByteString
forall a. a -> Maybe a
P.Just Gen ByteString
forall a. Arbitrary a => Gen a
QC.arbitrary)
  shrink :: Endpoint -> [Endpoint]
shrink Endpoint
obj | Endpoint
obj Endpoint -> Endpoint -> Bool
forall a. Eq a => a -> a -> Bool
== Endpoint
default_Endpoint = []
             | Bool
P.otherwise = [Maybe Endpoint] -> [Endpoint]
forall a. [Maybe a] -> [a]
M.catMaybes
    [ if Endpoint
obj Endpoint -> Endpoint -> Bool
forall a. Eq a => a -> a -> Bool
== Endpoint
default_Endpoint{endpoint_ipv4 :: Int32
endpoint_ipv4 = Endpoint -> Int32
endpoint_ipv4 Endpoint
obj} then Maybe Endpoint
forall a. Maybe a
P.Nothing else Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
P.Just (Endpoint -> Maybe Endpoint) -> Endpoint -> Maybe Endpoint
forall a b. (a -> b) -> a -> b
$ Endpoint
default_Endpoint{endpoint_ipv4 :: Int32
endpoint_ipv4 = Endpoint -> Int32
endpoint_ipv4 Endpoint
obj}
    , if Endpoint
obj Endpoint -> Endpoint -> Bool
forall a. Eq a => a -> a -> Bool
== Endpoint
default_Endpoint{endpoint_port :: Int16
endpoint_port = Endpoint -> Int16
endpoint_port Endpoint
obj} then Maybe Endpoint
forall a. Maybe a
P.Nothing else Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
P.Just (Endpoint -> Maybe Endpoint) -> Endpoint -> Maybe Endpoint
forall a b. (a -> b) -> a -> b
$ Endpoint
default_Endpoint{endpoint_port :: Int16
endpoint_port = Endpoint -> Int16
endpoint_port Endpoint
obj}
    , if Endpoint
obj Endpoint -> Endpoint -> Bool
forall a. Eq a => a -> a -> Bool
== Endpoint
default_Endpoint{endpoint_service_name :: Text
endpoint_service_name = Endpoint -> Text
endpoint_service_name Endpoint
obj} then Maybe Endpoint
forall a. Maybe a
P.Nothing else Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
P.Just (Endpoint -> Maybe Endpoint) -> Endpoint -> Maybe Endpoint
forall a b. (a -> b) -> a -> b
$ Endpoint
default_Endpoint{endpoint_service_name :: Text
endpoint_service_name = Endpoint -> Text
endpoint_service_name Endpoint
obj}
    , if Endpoint
obj Endpoint -> Endpoint -> Bool
forall a. Eq a => a -> a -> Bool
== Endpoint
default_Endpoint{endpoint_ipv6 :: Maybe ByteString
endpoint_ipv6 = Endpoint -> Maybe ByteString
endpoint_ipv6 Endpoint
obj} then Maybe Endpoint
forall a. Maybe a
P.Nothing else Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
P.Just (Endpoint -> Maybe Endpoint) -> Endpoint -> Maybe Endpoint
forall a b. (a -> b) -> a -> b
$ Endpoint
default_Endpoint{endpoint_ipv6 :: Maybe ByteString
endpoint_ipv6 = Endpoint -> Maybe ByteString
endpoint_ipv6 Endpoint
obj}
    ]
from_Endpoint :: Endpoint -> T.ThriftVal
from_Endpoint :: Endpoint -> ThriftVal
from_Endpoint Endpoint
record = HashMap Int16 (Text, ThriftVal) -> ThriftVal
T.TStruct (HashMap Int16 (Text, ThriftVal) -> ThriftVal)
-> HashMap Int16 (Text, ThriftVal) -> ThriftVal
forall a b. (a -> b) -> a -> b
$ [(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal))
-> [(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal)
forall a b. (a -> b) -> a -> b
$ [Maybe (Int16, (Text, ThriftVal))] -> [(Int16, (Text, ThriftVal))]
forall a. [Maybe a] -> [a]
M.catMaybes
  [ (\Int32
_v2 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
1, (Text
"ipv4",Int32 -> ThriftVal
T.TI32 Int32
_v2))) (Int32 -> Maybe (Int16, (Text, ThriftVal)))
-> Int32 -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ Endpoint -> Int32
endpoint_ipv4 Endpoint
record
  , (\Int16
_v2 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
2, (Text
"port",Int16 -> ThriftVal
T.TI16 Int16
_v2))) (Int16 -> Maybe (Int16, (Text, ThriftVal)))
-> Int16 -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ Endpoint -> Int16
endpoint_port Endpoint
record
  , (\Text
_v2 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
3, (Text
"service_name",ByteString -> ThriftVal
T.TString (ByteString -> ThriftVal) -> ByteString -> ThriftVal
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
_v2))) (Text -> Maybe (Int16, (Text, ThriftVal)))
-> Text -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ Endpoint -> Text
endpoint_service_name Endpoint
record
  , (\ByteString
_v2 -> (Int16
4, (Text
"ipv6",ByteString -> ThriftVal
T.TBinary ByteString
_v2))) (ByteString -> (Int16, (Text, ThriftVal)))
-> Maybe ByteString -> Maybe (Int16, (Text, ThriftVal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endpoint -> Maybe ByteString
endpoint_ipv6 Endpoint
record
  ]
write_Endpoint :: T.Protocol p => p -> Endpoint -> P.IO ()
write_Endpoint :: p -> Endpoint -> IO ()
write_Endpoint p
oprot Endpoint
record = p -> ThriftVal -> IO ()
forall a. Protocol a => a -> ThriftVal -> IO ()
T.writeVal p
oprot (ThriftVal -> IO ()) -> ThriftVal -> IO ()
forall a b. (a -> b) -> a -> b
$ Endpoint -> ThriftVal
from_Endpoint Endpoint
record
encode_Endpoint :: T.StatelessProtocol p => p -> Endpoint -> LBS.ByteString
encode_Endpoint :: p -> Endpoint -> ByteString
encode_Endpoint p
oprot Endpoint
record = p -> ThriftVal -> ByteString
forall a. StatelessProtocol a => a -> ThriftVal -> ByteString
T.serializeVal p
oprot (ThriftVal -> ByteString) -> ThriftVal -> ByteString
forall a b. (a -> b) -> a -> b
$ Endpoint -> ThriftVal
from_Endpoint Endpoint
record
to_Endpoint :: T.ThriftVal -> Endpoint
to_Endpoint :: ThriftVal -> Endpoint
to_Endpoint (T.TStruct HashMap Int16 (Text, ThriftVal)
fields) = Endpoint :: Int32 -> Int16 -> Text -> Maybe ByteString -> Endpoint
Endpoint{
  endpoint_ipv4 :: Int32
endpoint_ipv4 = Int32
-> ((Text, ThriftVal) -> Int32) -> Maybe (Text, ThriftVal) -> Int32
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Endpoint -> Int32
endpoint_ipv4 Endpoint
default_Endpoint) (\(Text
_,ThriftVal
_val4) -> (case ThriftVal
_val4 of {T.TI32 Int32
_val5 -> Int32
_val5; ThriftVal
_ -> String -> Int32
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
1) HashMap Int16 (Text, ThriftVal)
fields),
  endpoint_port :: Int16
endpoint_port = Int16
-> ((Text, ThriftVal) -> Int16) -> Maybe (Text, ThriftVal) -> Int16
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Endpoint -> Int16
endpoint_port Endpoint
default_Endpoint) (\(Text
_,ThriftVal
_val4) -> (case ThriftVal
_val4 of {T.TI16 Int16
_val6 -> Int16
_val6; ThriftVal
_ -> String -> Int16
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
2) HashMap Int16 (Text, ThriftVal)
fields),
  endpoint_service_name :: Text
endpoint_service_name = Text
-> ((Text, ThriftVal) -> Text) -> Maybe (Text, ThriftVal) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Endpoint -> Text
endpoint_service_name Endpoint
default_Endpoint) (\(Text
_,ThriftVal
_val4) -> (case ThriftVal
_val4 of {T.TString ByteString
_val7 -> ByteString -> Text
E.decodeUtf8 ByteString
_val7; ThriftVal
_ -> String -> Text
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
3) HashMap Int16 (Text, ThriftVal)
fields),
  endpoint_ipv6 :: Maybe ByteString
endpoint_ipv6 = Maybe ByteString
-> ((Text, ThriftVal) -> Maybe ByteString)
-> Maybe (Text, ThriftVal)
-> Maybe ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Maybe ByteString
forall a. Maybe a
P.Nothing) (\(Text
_,ThriftVal
_val4) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
P.Just (case ThriftVal
_val4 of {T.TBinary ByteString
_val8 -> ByteString
_val8; T.TString ByteString
_val8 -> ByteString
_val8; ThriftVal
_ -> String -> ByteString
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
4) HashMap Int16 (Text, ThriftVal)
fields)
  }
to_Endpoint ThriftVal
_ = String -> Endpoint
forall a. HasCallStack => String -> a
P.error String
"not a struct"
read_Endpoint :: T.Protocol p => p -> P.IO Endpoint
read_Endpoint :: p -> IO Endpoint
read_Endpoint p
iprot = ThriftVal -> Endpoint
to_Endpoint (ThriftVal -> Endpoint) -> IO ThriftVal -> IO Endpoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> ThriftType -> IO ThriftVal
forall a. Protocol a => a -> ThriftType -> IO ThriftVal
T.readVal p
iprot (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_Endpoint)
decode_Endpoint :: T.StatelessProtocol p => p -> LBS.ByteString -> Endpoint
decode_Endpoint :: p -> ByteString -> Endpoint
decode_Endpoint p
iprot ByteString
bs = ThriftVal -> Endpoint
to_Endpoint (ThriftVal -> Endpoint) -> ThriftVal -> Endpoint
forall a b. (a -> b) -> a -> b
$ p -> ThriftType -> ByteString -> ThriftVal
forall a.
StatelessProtocol a =>
a -> ThriftType -> ByteString -> ThriftVal
T.deserializeVal p
iprot (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_Endpoint) ByteString
bs
typemap_Endpoint :: T.TypeMap
typemap_Endpoint :: TypeMap
typemap_Endpoint = [(Int16, (Text, ThriftType))] -> TypeMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [(Int16
1,(Text
"ipv4",ThriftType
T.T_I32)),(Int16
2,(Text
"port",ThriftType
T.T_I16)),(Int16
3,(Text
"service_name",ThriftType
T.T_STRING)),(Int16
4,(Text
"ipv6",ThriftType
T.T_BINARY))]
default_Endpoint :: Endpoint
default_Endpoint :: Endpoint
default_Endpoint = Endpoint :: Int32 -> Int16 -> Text -> Maybe ByteString -> Endpoint
Endpoint{
  endpoint_ipv4 :: Int32
endpoint_ipv4 = Int32
0,
  endpoint_port :: Int16
endpoint_port = Int16
0,
  endpoint_service_name :: Text
endpoint_service_name = Text
"",
  endpoint_ipv6 :: Maybe ByteString
endpoint_ipv6 = Maybe ByteString
forall a. Maybe a
P.Nothing}
data Annotation = Annotation  { Annotation -> Int64
annotation_timestamp :: I.Int64
  , Annotation -> Text
annotation_value :: LT.Text
  , Annotation -> Maybe Endpoint
annotation_host :: P.Maybe Endpoint
  } deriving (Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
(Int -> Annotation -> ShowS)
-> (Annotation -> String)
-> ([Annotation] -> ShowS)
-> Show Annotation
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
P.Show,Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
P.Eq,(forall x. Annotation -> Rep Annotation x)
-> (forall x. Rep Annotation x -> Annotation) -> Generic Annotation
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
G.Generic,TY.Typeable)
instance H.Hashable Annotation where
  hashWithSalt :: Int -> Annotation -> Int
hashWithSalt Int
salt Annotation
record = Int
salt   Int -> Int64 -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Annotation -> Int64
annotation_timestamp Annotation
record   Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Annotation -> Text
annotation_value Annotation
record   Int -> Maybe Endpoint -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Annotation -> Maybe Endpoint
annotation_host Annotation
record  
instance QC.Arbitrary Annotation where 
  arbitrary :: Gen Annotation
arbitrary = (Int64 -> Text -> Maybe Endpoint -> Annotation)
-> Gen Int64 -> Gen (Text -> Maybe Endpoint -> Annotation)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Int64 -> Text -> Maybe Endpoint -> Annotation
Annotation (Gen Int64
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen (Text -> Maybe Endpoint -> Annotation)
-> Gen Text -> Gen (Maybe Endpoint -> Annotation)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`(Gen Text
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen (Maybe Endpoint -> Annotation)
-> Gen (Maybe Endpoint) -> Gen Annotation
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`((Endpoint -> Maybe Endpoint)
-> Gen Endpoint -> Gen (Maybe Endpoint)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
P.Just Gen Endpoint
forall a. Arbitrary a => Gen a
QC.arbitrary)
  shrink :: Annotation -> [Annotation]
shrink Annotation
obj | Annotation
obj Annotation -> Annotation -> Bool
forall a. Eq a => a -> a -> Bool
== Annotation
default_Annotation = []
             | Bool
P.otherwise = [Maybe Annotation] -> [Annotation]
forall a. [Maybe a] -> [a]
M.catMaybes
    [ if Annotation
obj Annotation -> Annotation -> Bool
forall a. Eq a => a -> a -> Bool
== Annotation
default_Annotation{annotation_timestamp :: Int64
annotation_timestamp = Annotation -> Int64
annotation_timestamp Annotation
obj} then Maybe Annotation
forall a. Maybe a
P.Nothing else Annotation -> Maybe Annotation
forall a. a -> Maybe a
P.Just (Annotation -> Maybe Annotation) -> Annotation -> Maybe Annotation
forall a b. (a -> b) -> a -> b
$ Annotation
default_Annotation{annotation_timestamp :: Int64
annotation_timestamp = Annotation -> Int64
annotation_timestamp Annotation
obj}
    , if Annotation
obj Annotation -> Annotation -> Bool
forall a. Eq a => a -> a -> Bool
== Annotation
default_Annotation{annotation_value :: Text
annotation_value = Annotation -> Text
annotation_value Annotation
obj} then Maybe Annotation
forall a. Maybe a
P.Nothing else Annotation -> Maybe Annotation
forall a. a -> Maybe a
P.Just (Annotation -> Maybe Annotation) -> Annotation -> Maybe Annotation
forall a b. (a -> b) -> a -> b
$ Annotation
default_Annotation{annotation_value :: Text
annotation_value = Annotation -> Text
annotation_value Annotation
obj}
    , if Annotation
obj Annotation -> Annotation -> Bool
forall a. Eq a => a -> a -> Bool
== Annotation
default_Annotation{annotation_host :: Maybe Endpoint
annotation_host = Annotation -> Maybe Endpoint
annotation_host Annotation
obj} then Maybe Annotation
forall a. Maybe a
P.Nothing else Annotation -> Maybe Annotation
forall a. a -> Maybe a
P.Just (Annotation -> Maybe Annotation) -> Annotation -> Maybe Annotation
forall a b. (a -> b) -> a -> b
$ Annotation
default_Annotation{annotation_host :: Maybe Endpoint
annotation_host = Annotation -> Maybe Endpoint
annotation_host Annotation
obj}
    ]
from_Annotation :: Annotation -> T.ThriftVal
from_Annotation :: Annotation -> ThriftVal
from_Annotation Annotation
record = HashMap Int16 (Text, ThriftVal) -> ThriftVal
T.TStruct (HashMap Int16 (Text, ThriftVal) -> ThriftVal)
-> HashMap Int16 (Text, ThriftVal) -> ThriftVal
forall a b. (a -> b) -> a -> b
$ [(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal))
-> [(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal)
forall a b. (a -> b) -> a -> b
$ [Maybe (Int16, (Text, ThriftVal))] -> [(Int16, (Text, ThriftVal))]
forall a. [Maybe a] -> [a]
M.catMaybes
  [ (\Int64
_v11 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
1, (Text
"timestamp",Int64 -> ThriftVal
T.TI64 Int64
_v11))) (Int64 -> Maybe (Int16, (Text, ThriftVal)))
-> Int64 -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ Annotation -> Int64
annotation_timestamp Annotation
record
  , (\Text
_v11 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
2, (Text
"value",ByteString -> ThriftVal
T.TString (ByteString -> ThriftVal) -> ByteString -> ThriftVal
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
_v11))) (Text -> Maybe (Int16, (Text, ThriftVal)))
-> Text -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ Annotation -> Text
annotation_value Annotation
record
  , (\Endpoint
_v11 -> (Int16
3, (Text
"host",Endpoint -> ThriftVal
from_Endpoint Endpoint
_v11))) (Endpoint -> (Int16, (Text, ThriftVal)))
-> Maybe Endpoint -> Maybe (Int16, (Text, ThriftVal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotation -> Maybe Endpoint
annotation_host Annotation
record
  ]
write_Annotation :: T.Protocol p => p -> Annotation -> P.IO ()
write_Annotation :: p -> Annotation -> IO ()
write_Annotation p
oprot Annotation
record = p -> ThriftVal -> IO ()
forall a. Protocol a => a -> ThriftVal -> IO ()
T.writeVal p
oprot (ThriftVal -> IO ()) -> ThriftVal -> IO ()
forall a b. (a -> b) -> a -> b
$ Annotation -> ThriftVal
from_Annotation Annotation
record
encode_Annotation :: T.StatelessProtocol p => p -> Annotation -> LBS.ByteString
encode_Annotation :: p -> Annotation -> ByteString
encode_Annotation p
oprot Annotation
record = p -> ThriftVal -> ByteString
forall a. StatelessProtocol a => a -> ThriftVal -> ByteString
T.serializeVal p
oprot (ThriftVal -> ByteString) -> ThriftVal -> ByteString
forall a b. (a -> b) -> a -> b
$ Annotation -> ThriftVal
from_Annotation Annotation
record
to_Annotation :: T.ThriftVal -> Annotation
to_Annotation :: ThriftVal -> Annotation
to_Annotation (T.TStruct HashMap Int16 (Text, ThriftVal)
fields) = Annotation :: Int64 -> Text -> Maybe Endpoint -> Annotation
Annotation{
  annotation_timestamp :: Int64
annotation_timestamp = Int64
-> ((Text, ThriftVal) -> Int64) -> Maybe (Text, ThriftVal) -> Int64
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Annotation -> Int64
annotation_timestamp Annotation
default_Annotation) (\(Text
_,ThriftVal
_val13) -> (case ThriftVal
_val13 of {T.TI64 Int64
_val14 -> Int64
_val14; ThriftVal
_ -> String -> Int64
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
1) HashMap Int16 (Text, ThriftVal)
fields),
  annotation_value :: Text
annotation_value = Text
-> ((Text, ThriftVal) -> Text) -> Maybe (Text, ThriftVal) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Annotation -> Text
annotation_value Annotation
default_Annotation) (\(Text
_,ThriftVal
_val13) -> (case ThriftVal
_val13 of {T.TString ByteString
_val15 -> ByteString -> Text
E.decodeUtf8 ByteString
_val15; ThriftVal
_ -> String -> Text
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
2) HashMap Int16 (Text, ThriftVal)
fields),
  annotation_host :: Maybe Endpoint
annotation_host = Maybe Endpoint
-> ((Text, ThriftVal) -> Maybe Endpoint)
-> Maybe (Text, ThriftVal)
-> Maybe Endpoint
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Maybe Endpoint
forall a. Maybe a
P.Nothing) (\(Text
_,ThriftVal
_val13) -> Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
P.Just (case ThriftVal
_val13 of {T.TStruct HashMap Int16 (Text, ThriftVal)
_val16 -> (ThriftVal -> Endpoint
to_Endpoint (HashMap Int16 (Text, ThriftVal) -> ThriftVal
T.TStruct HashMap Int16 (Text, ThriftVal)
_val16)); ThriftVal
_ -> String -> Endpoint
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
3) HashMap Int16 (Text, ThriftVal)
fields)
  }
to_Annotation ThriftVal
_ = String -> Annotation
forall a. HasCallStack => String -> a
P.error String
"not a struct"
read_Annotation :: T.Protocol p => p -> P.IO Annotation
read_Annotation :: p -> IO Annotation
read_Annotation p
iprot = ThriftVal -> Annotation
to_Annotation (ThriftVal -> Annotation) -> IO ThriftVal -> IO Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> ThriftType -> IO ThriftVal
forall a. Protocol a => a -> ThriftType -> IO ThriftVal
T.readVal p
iprot (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_Annotation)
decode_Annotation :: T.StatelessProtocol p => p -> LBS.ByteString -> Annotation
decode_Annotation :: p -> ByteString -> Annotation
decode_Annotation p
iprot ByteString
bs = ThriftVal -> Annotation
to_Annotation (ThriftVal -> Annotation) -> ThriftVal -> Annotation
forall a b. (a -> b) -> a -> b
$ p -> ThriftType -> ByteString -> ThriftVal
forall a.
StatelessProtocol a =>
a -> ThriftType -> ByteString -> ThriftVal
T.deserializeVal p
iprot (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_Annotation) ByteString
bs
typemap_Annotation :: T.TypeMap
typemap_Annotation :: TypeMap
typemap_Annotation = [(Int16, (Text, ThriftType))] -> TypeMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [(Int16
1,(Text
"timestamp",ThriftType
T.T_I64)),(Int16
2,(Text
"value",ThriftType
T.T_STRING)),(Int16
3,(Text
"host",(TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_Endpoint)))]
default_Annotation :: Annotation
default_Annotation :: Annotation
default_Annotation = Annotation :: Int64 -> Text -> Maybe Endpoint -> Annotation
Annotation{
  annotation_timestamp :: Int64
annotation_timestamp = Int64
0,
  annotation_value :: Text
annotation_value = Text
"",
  annotation_host :: Maybe Endpoint
annotation_host = Maybe Endpoint
forall a. Maybe a
P.Nothing}
data BinaryAnnotation = BinaryAnnotation  { BinaryAnnotation -> Text
binaryAnnotation_key :: LT.Text
  , BinaryAnnotation -> ByteString
binaryAnnotation_value :: LBS.ByteString
  , BinaryAnnotation -> AnnotationType
binaryAnnotation_annotation_type :: AnnotationType
  , BinaryAnnotation -> Maybe Endpoint
binaryAnnotation_host :: P.Maybe Endpoint
  } deriving (Int -> BinaryAnnotation -> ShowS
[BinaryAnnotation] -> ShowS
BinaryAnnotation -> String
(Int -> BinaryAnnotation -> ShowS)
-> (BinaryAnnotation -> String)
-> ([BinaryAnnotation] -> ShowS)
-> Show BinaryAnnotation
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
P.Show,BinaryAnnotation -> BinaryAnnotation -> Bool
(BinaryAnnotation -> BinaryAnnotation -> Bool)
-> (BinaryAnnotation -> BinaryAnnotation -> Bool)
-> Eq BinaryAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryAnnotation -> BinaryAnnotation -> Bool
$c/= :: BinaryAnnotation -> BinaryAnnotation -> Bool
== :: BinaryAnnotation -> BinaryAnnotation -> Bool
$c== :: BinaryAnnotation -> BinaryAnnotation -> Bool
P.Eq,(forall x. BinaryAnnotation -> Rep BinaryAnnotation x)
-> (forall x. Rep BinaryAnnotation x -> BinaryAnnotation)
-> Generic BinaryAnnotation
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
G.Generic,TY.Typeable)
instance H.Hashable BinaryAnnotation where
  hashWithSalt :: Int -> BinaryAnnotation -> Int
hashWithSalt Int
salt BinaryAnnotation
record = Int
salt   Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` BinaryAnnotation -> Text
binaryAnnotation_key BinaryAnnotation
record   Int -> ByteString -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` BinaryAnnotation -> ByteString
binaryAnnotation_value BinaryAnnotation
record   Int -> AnnotationType -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` BinaryAnnotation -> AnnotationType
binaryAnnotation_annotation_type BinaryAnnotation
record   Int -> Maybe Endpoint -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` BinaryAnnotation -> Maybe Endpoint
binaryAnnotation_host BinaryAnnotation
record  
instance QC.Arbitrary BinaryAnnotation where 
  arbitrary :: Gen BinaryAnnotation
arbitrary = (Text
 -> ByteString
 -> AnnotationType
 -> Maybe Endpoint
 -> BinaryAnnotation)
-> Gen Text
-> Gen
     (ByteString
      -> AnnotationType -> Maybe Endpoint -> BinaryAnnotation)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Text
-> ByteString
-> AnnotationType
-> Maybe Endpoint
-> BinaryAnnotation
BinaryAnnotation (Gen Text
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen
  (ByteString
   -> AnnotationType -> Maybe Endpoint -> BinaryAnnotation)
-> Gen ByteString
-> Gen (AnnotationType -> Maybe Endpoint -> BinaryAnnotation)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`(Gen ByteString
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen (AnnotationType -> Maybe Endpoint -> BinaryAnnotation)
-> Gen AnnotationType -> Gen (Maybe Endpoint -> BinaryAnnotation)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`(Gen AnnotationType
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen (Maybe Endpoint -> BinaryAnnotation)
-> Gen (Maybe Endpoint) -> Gen BinaryAnnotation
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`((Endpoint -> Maybe Endpoint)
-> Gen Endpoint -> Gen (Maybe Endpoint)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
P.Just Gen Endpoint
forall a. Arbitrary a => Gen a
QC.arbitrary)
  shrink :: BinaryAnnotation -> [BinaryAnnotation]
shrink BinaryAnnotation
obj | BinaryAnnotation
obj BinaryAnnotation -> BinaryAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryAnnotation
default_BinaryAnnotation = []
             | Bool
P.otherwise = [Maybe BinaryAnnotation] -> [BinaryAnnotation]
forall a. [Maybe a] -> [a]
M.catMaybes
    [ if BinaryAnnotation
obj BinaryAnnotation -> BinaryAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryAnnotation
default_BinaryAnnotation{binaryAnnotation_key :: Text
binaryAnnotation_key = BinaryAnnotation -> Text
binaryAnnotation_key BinaryAnnotation
obj} then Maybe BinaryAnnotation
forall a. Maybe a
P.Nothing else BinaryAnnotation -> Maybe BinaryAnnotation
forall a. a -> Maybe a
P.Just (BinaryAnnotation -> Maybe BinaryAnnotation)
-> BinaryAnnotation -> Maybe BinaryAnnotation
forall a b. (a -> b) -> a -> b
$ BinaryAnnotation
default_BinaryAnnotation{binaryAnnotation_key :: Text
binaryAnnotation_key = BinaryAnnotation -> Text
binaryAnnotation_key BinaryAnnotation
obj}
    , if BinaryAnnotation
obj BinaryAnnotation -> BinaryAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryAnnotation
default_BinaryAnnotation{binaryAnnotation_value :: ByteString
binaryAnnotation_value = BinaryAnnotation -> ByteString
binaryAnnotation_value BinaryAnnotation
obj} then Maybe BinaryAnnotation
forall a. Maybe a
P.Nothing else BinaryAnnotation -> Maybe BinaryAnnotation
forall a. a -> Maybe a
P.Just (BinaryAnnotation -> Maybe BinaryAnnotation)
-> BinaryAnnotation -> Maybe BinaryAnnotation
forall a b. (a -> b) -> a -> b
$ BinaryAnnotation
default_BinaryAnnotation{binaryAnnotation_value :: ByteString
binaryAnnotation_value = BinaryAnnotation -> ByteString
binaryAnnotation_value BinaryAnnotation
obj}
    , if BinaryAnnotation
obj BinaryAnnotation -> BinaryAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryAnnotation
default_BinaryAnnotation{binaryAnnotation_annotation_type :: AnnotationType
binaryAnnotation_annotation_type = BinaryAnnotation -> AnnotationType
binaryAnnotation_annotation_type BinaryAnnotation
obj} then Maybe BinaryAnnotation
forall a. Maybe a
P.Nothing else BinaryAnnotation -> Maybe BinaryAnnotation
forall a. a -> Maybe a
P.Just (BinaryAnnotation -> Maybe BinaryAnnotation)
-> BinaryAnnotation -> Maybe BinaryAnnotation
forall a b. (a -> b) -> a -> b
$ BinaryAnnotation
default_BinaryAnnotation{binaryAnnotation_annotation_type :: AnnotationType
binaryAnnotation_annotation_type = BinaryAnnotation -> AnnotationType
binaryAnnotation_annotation_type BinaryAnnotation
obj}
    , if BinaryAnnotation
obj BinaryAnnotation -> BinaryAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryAnnotation
default_BinaryAnnotation{binaryAnnotation_host :: Maybe Endpoint
binaryAnnotation_host = BinaryAnnotation -> Maybe Endpoint
binaryAnnotation_host BinaryAnnotation
obj} then Maybe BinaryAnnotation
forall a. Maybe a
P.Nothing else BinaryAnnotation -> Maybe BinaryAnnotation
forall a. a -> Maybe a
P.Just (BinaryAnnotation -> Maybe BinaryAnnotation)
-> BinaryAnnotation -> Maybe BinaryAnnotation
forall a b. (a -> b) -> a -> b
$ BinaryAnnotation
default_BinaryAnnotation{binaryAnnotation_host :: Maybe Endpoint
binaryAnnotation_host = BinaryAnnotation -> Maybe Endpoint
binaryAnnotation_host BinaryAnnotation
obj}
    ]
from_BinaryAnnotation :: BinaryAnnotation -> T.ThriftVal
from_BinaryAnnotation :: BinaryAnnotation -> ThriftVal
from_BinaryAnnotation BinaryAnnotation
record = HashMap Int16 (Text, ThriftVal) -> ThriftVal
T.TStruct (HashMap Int16 (Text, ThriftVal) -> ThriftVal)
-> HashMap Int16 (Text, ThriftVal) -> ThriftVal
forall a b. (a -> b) -> a -> b
$ [(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal))
-> [(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal)
forall a b. (a -> b) -> a -> b
$ [Maybe (Int16, (Text, ThriftVal))] -> [(Int16, (Text, ThriftVal))]
forall a. [Maybe a] -> [a]
M.catMaybes
  [ (\Text
_v19 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
1, (Text
"key",ByteString -> ThriftVal
T.TString (ByteString -> ThriftVal) -> ByteString -> ThriftVal
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
_v19))) (Text -> Maybe (Int16, (Text, ThriftVal)))
-> Text -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ BinaryAnnotation -> Text
binaryAnnotation_key BinaryAnnotation
record
  , (\ByteString
_v19 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
2, (Text
"value",ByteString -> ThriftVal
T.TBinary ByteString
_v19))) (ByteString -> Maybe (Int16, (Text, ThriftVal)))
-> ByteString -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ BinaryAnnotation -> ByteString
binaryAnnotation_value BinaryAnnotation
record
  , (\AnnotationType
_v19 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
3, (Text
"annotation_type",Int32 -> ThriftVal
T.TI32 (Int32 -> ThriftVal) -> Int32 -> ThriftVal
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ AnnotationType -> Int
forall a. Enum a => a -> Int
P.fromEnum AnnotationType
_v19))) (AnnotationType -> Maybe (Int16, (Text, ThriftVal)))
-> AnnotationType -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ BinaryAnnotation -> AnnotationType
binaryAnnotation_annotation_type BinaryAnnotation
record
  , (\Endpoint
_v19 -> (Int16
4, (Text
"host",Endpoint -> ThriftVal
from_Endpoint Endpoint
_v19))) (Endpoint -> (Int16, (Text, ThriftVal)))
-> Maybe Endpoint -> Maybe (Int16, (Text, ThriftVal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinaryAnnotation -> Maybe Endpoint
binaryAnnotation_host BinaryAnnotation
record
  ]
write_BinaryAnnotation :: T.Protocol p => p -> BinaryAnnotation -> P.IO ()
write_BinaryAnnotation :: p -> BinaryAnnotation -> IO ()
write_BinaryAnnotation p
oprot BinaryAnnotation
record = p -> ThriftVal -> IO ()
forall a. Protocol a => a -> ThriftVal -> IO ()
T.writeVal p
oprot (ThriftVal -> IO ()) -> ThriftVal -> IO ()
forall a b. (a -> b) -> a -> b
$ BinaryAnnotation -> ThriftVal
from_BinaryAnnotation BinaryAnnotation
record
encode_BinaryAnnotation :: T.StatelessProtocol p => p -> BinaryAnnotation -> LBS.ByteString
encode_BinaryAnnotation :: p -> BinaryAnnotation -> ByteString
encode_BinaryAnnotation p
oprot BinaryAnnotation
record = p -> ThriftVal -> ByteString
forall a. StatelessProtocol a => a -> ThriftVal -> ByteString
T.serializeVal p
oprot (ThriftVal -> ByteString) -> ThriftVal -> ByteString
forall a b. (a -> b) -> a -> b
$ BinaryAnnotation -> ThriftVal
from_BinaryAnnotation BinaryAnnotation
record
to_BinaryAnnotation :: T.ThriftVal -> BinaryAnnotation
to_BinaryAnnotation :: ThriftVal -> BinaryAnnotation
to_BinaryAnnotation (T.TStruct HashMap Int16 (Text, ThriftVal)
fields) = BinaryAnnotation :: Text
-> ByteString
-> AnnotationType
-> Maybe Endpoint
-> BinaryAnnotation
BinaryAnnotation{
  binaryAnnotation_key :: Text
binaryAnnotation_key = Text
-> ((Text, ThriftVal) -> Text) -> Maybe (Text, ThriftVal) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (BinaryAnnotation -> Text
binaryAnnotation_key BinaryAnnotation
default_BinaryAnnotation) (\(Text
_,ThriftVal
_val21) -> (case ThriftVal
_val21 of {T.TString ByteString
_val22 -> ByteString -> Text
E.decodeUtf8 ByteString
_val22; ThriftVal
_ -> String -> Text
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
1) HashMap Int16 (Text, ThriftVal)
fields),
  binaryAnnotation_value :: ByteString
binaryAnnotation_value = ByteString
-> ((Text, ThriftVal) -> ByteString)
-> Maybe (Text, ThriftVal)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (BinaryAnnotation -> ByteString
binaryAnnotation_value BinaryAnnotation
default_BinaryAnnotation) (\(Text
_,ThriftVal
_val21) -> (case ThriftVal
_val21 of {T.TBinary ByteString
_val23 -> ByteString
_val23; T.TString ByteString
_val23 -> ByteString
_val23; ThriftVal
_ -> String -> ByteString
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
2) HashMap Int16 (Text, ThriftVal)
fields),
  binaryAnnotation_annotation_type :: AnnotationType
binaryAnnotation_annotation_type = AnnotationType
-> ((Text, ThriftVal) -> AnnotationType)
-> Maybe (Text, ThriftVal)
-> AnnotationType
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (BinaryAnnotation -> AnnotationType
binaryAnnotation_annotation_type BinaryAnnotation
default_BinaryAnnotation) (\(Text
_,ThriftVal
_val21) -> (case ThriftVal
_val21 of {T.TI32 Int32
_val24 -> Int -> AnnotationType
forall a. Enum a => Int -> a
P.toEnum (Int -> AnnotationType) -> Int -> AnnotationType
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral Int32
_val24; ThriftVal
_ -> String -> AnnotationType
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
3) HashMap Int16 (Text, ThriftVal)
fields),
  binaryAnnotation_host :: Maybe Endpoint
binaryAnnotation_host = Maybe Endpoint
-> ((Text, ThriftVal) -> Maybe Endpoint)
-> Maybe (Text, ThriftVal)
-> Maybe Endpoint
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Maybe Endpoint
forall a. Maybe a
P.Nothing) (\(Text
_,ThriftVal
_val21) -> Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
P.Just (case ThriftVal
_val21 of {T.TStruct HashMap Int16 (Text, ThriftVal)
_val25 -> (ThriftVal -> Endpoint
to_Endpoint (HashMap Int16 (Text, ThriftVal) -> ThriftVal
T.TStruct HashMap Int16 (Text, ThriftVal)
_val25)); ThriftVal
_ -> String -> Endpoint
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
4) HashMap Int16 (Text, ThriftVal)
fields)
  }
to_BinaryAnnotation ThriftVal
_ = String -> BinaryAnnotation
forall a. HasCallStack => String -> a
P.error String
"not a struct"
read_BinaryAnnotation :: T.Protocol p => p -> P.IO BinaryAnnotation
read_BinaryAnnotation :: p -> IO BinaryAnnotation
read_BinaryAnnotation p
iprot = ThriftVal -> BinaryAnnotation
to_BinaryAnnotation (ThriftVal -> BinaryAnnotation)
-> IO ThriftVal -> IO BinaryAnnotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> ThriftType -> IO ThriftVal
forall a. Protocol a => a -> ThriftType -> IO ThriftVal
T.readVal p
iprot (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_BinaryAnnotation)
decode_BinaryAnnotation :: T.StatelessProtocol p => p -> LBS.ByteString -> BinaryAnnotation
decode_BinaryAnnotation :: p -> ByteString -> BinaryAnnotation
decode_BinaryAnnotation p
iprot ByteString
bs = ThriftVal -> BinaryAnnotation
to_BinaryAnnotation (ThriftVal -> BinaryAnnotation) -> ThriftVal -> BinaryAnnotation
forall a b. (a -> b) -> a -> b
$ p -> ThriftType -> ByteString -> ThriftVal
forall a.
StatelessProtocol a =>
a -> ThriftType -> ByteString -> ThriftVal
T.deserializeVal p
iprot (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_BinaryAnnotation) ByteString
bs
typemap_BinaryAnnotation :: T.TypeMap
typemap_BinaryAnnotation :: TypeMap
typemap_BinaryAnnotation = [(Int16, (Text, ThriftType))] -> TypeMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [(Int16
1,(Text
"key",ThriftType
T.T_STRING)),(Int16
2,(Text
"value",ThriftType
T.T_BINARY)),(Int16
3,(Text
"annotation_type",ThriftType
T.T_I32)),(Int16
4,(Text
"host",(TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_Endpoint)))]
default_BinaryAnnotation :: BinaryAnnotation
default_BinaryAnnotation :: BinaryAnnotation
default_BinaryAnnotation = BinaryAnnotation :: Text
-> ByteString
-> AnnotationType
-> Maybe Endpoint
-> BinaryAnnotation
BinaryAnnotation{
  binaryAnnotation_key :: Text
binaryAnnotation_key = Text
"",
  binaryAnnotation_value :: ByteString
binaryAnnotation_value = ByteString
"",
  binaryAnnotation_annotation_type :: AnnotationType
binaryAnnotation_annotation_type = (Int -> AnnotationType
forall a. Enum a => Int -> a
P.toEnum Int
0),
  binaryAnnotation_host :: Maybe Endpoint
binaryAnnotation_host = Maybe Endpoint
forall a. Maybe a
P.Nothing}
data Span = Span  { Span -> Int64
span_trace_id :: I.Int64
  , Span -> Text
span_name :: LT.Text
  , Span -> Int64
span_id :: I.Int64
  , Span -> Maybe Int64
span_parent_id :: P.Maybe I.Int64
  , Span -> Vector Annotation
span_annotations :: (Vector.Vector Annotation)
  , Span -> Vector BinaryAnnotation
span_binary_annotations :: (Vector.Vector BinaryAnnotation)
  , Span -> Maybe Bool
span_debug :: P.Maybe P.Bool
  , Span -> Maybe Int64
span_timestamp :: P.Maybe I.Int64
  , Span -> Maybe Int64
span_duration :: P.Maybe I.Int64
  , Span -> Maybe Int64
span_trace_id_high :: P.Maybe I.Int64
  } deriving (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
showList :: [Span] -> ShowS
$cshowList :: [Span] -> ShowS
show :: Span -> String
$cshow :: Span -> String
showsPrec :: Int -> Span -> ShowS
$cshowsPrec :: Int -> Span -> ShowS
P.Show,Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c== :: Span -> Span -> Bool
P.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
$cto :: forall x. Rep Span x -> Span
$cfrom :: forall x. Span -> Rep Span x
G.Generic,TY.Typeable)
instance H.Hashable Span where
  hashWithSalt :: Int -> Span -> Int
hashWithSalt Int
salt Span
record = Int
salt   Int -> Int64 -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Span -> Int64
span_trace_id Span
record   Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Span -> Text
span_name Span
record   Int -> Int64 -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Span -> Int64
span_id Span
record   Int -> Maybe Int64 -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Span -> Maybe Int64
span_parent_id Span
record   Int -> Vector Annotation -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Span -> Vector Annotation
span_annotations Span
record   Int -> Vector BinaryAnnotation -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Span -> Vector BinaryAnnotation
span_binary_annotations Span
record   Int -> Maybe Bool -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Span -> Maybe Bool
span_debug Span
record   Int -> Maybe Int64 -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Span -> Maybe Int64
span_timestamp Span
record   Int -> Maybe Int64 -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Span -> Maybe Int64
span_duration Span
record   Int -> Maybe Int64 -> Int
forall a. Hashable a => Int -> a -> Int
`H.hashWithSalt` Span -> Maybe Int64
span_trace_id_high Span
record  
instance QC.Arbitrary Span where 
  arbitrary :: Gen Span
arbitrary = (Int64
 -> Text
 -> Int64
 -> Maybe Int64
 -> Vector Annotation
 -> Vector BinaryAnnotation
 -> Maybe Bool
 -> Maybe Int64
 -> Maybe Int64
 -> Maybe Int64
 -> Span)
-> Gen Int64
-> Gen
     (Text
      -> Int64
      -> Maybe Int64
      -> Vector Annotation
      -> Vector BinaryAnnotation
      -> Maybe Bool
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int64
      -> Span)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Int64
-> Text
-> Int64
-> Maybe Int64
-> Vector Annotation
-> Vector BinaryAnnotation
-> Maybe Bool
-> Maybe Int64
-> Maybe Int64
-> Maybe Int64
-> Span
Span (Gen Int64
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen
  (Text
   -> Int64
   -> Maybe Int64
   -> Vector Annotation
   -> Vector BinaryAnnotation
   -> Maybe Bool
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int64
   -> Span)
-> Gen Text
-> Gen
     (Int64
      -> Maybe Int64
      -> Vector Annotation
      -> Vector BinaryAnnotation
      -> Maybe Bool
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int64
      -> Span)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`(Gen Text
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen
  (Int64
   -> Maybe Int64
   -> Vector Annotation
   -> Vector BinaryAnnotation
   -> Maybe Bool
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int64
   -> Span)
-> Gen Int64
-> Gen
     (Maybe Int64
      -> Vector Annotation
      -> Vector BinaryAnnotation
      -> Maybe Bool
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int64
      -> Span)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`(Gen Int64
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen
  (Maybe Int64
   -> Vector Annotation
   -> Vector BinaryAnnotation
   -> Maybe Bool
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int64
   -> Span)
-> Gen (Maybe Int64)
-> Gen
     (Vector Annotation
      -> Vector BinaryAnnotation
      -> Maybe Bool
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int64
      -> Span)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`((Int64 -> Maybe Int64) -> Gen Int64 -> Gen (Maybe Int64)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Int64 -> Maybe Int64
forall a. a -> Maybe a
P.Just Gen Int64
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen
  (Vector Annotation
   -> Vector BinaryAnnotation
   -> Maybe Bool
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int64
   -> Span)
-> Gen (Vector Annotation)
-> Gen
     (Vector BinaryAnnotation
      -> Maybe Bool -> Maybe Int64 -> Maybe Int64 -> Maybe Int64 -> Span)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`(Gen (Vector Annotation)
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen
  (Vector BinaryAnnotation
   -> Maybe Bool -> Maybe Int64 -> Maybe Int64 -> Maybe Int64 -> Span)
-> Gen (Vector BinaryAnnotation)
-> Gen
     (Maybe Bool -> Maybe Int64 -> Maybe Int64 -> Maybe Int64 -> Span)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`(Gen (Vector BinaryAnnotation)
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen
  (Maybe Bool -> Maybe Int64 -> Maybe Int64 -> Maybe Int64 -> Span)
-> Gen (Maybe Bool)
-> Gen (Maybe Int64 -> Maybe Int64 -> Maybe Int64 -> Span)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`((Bool -> Maybe Bool) -> Gen Bool -> Gen (Maybe Bool)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Bool -> Maybe Bool
forall a. a -> Maybe a
P.Just Gen Bool
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen (Maybe Int64 -> Maybe Int64 -> Maybe Int64 -> Span)
-> Gen (Maybe Int64) -> Gen (Maybe Int64 -> Maybe Int64 -> Span)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`((Int64 -> Maybe Int64) -> Gen Int64 -> Gen (Maybe Int64)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Int64 -> Maybe Int64
forall a. a -> Maybe a
P.Just Gen Int64
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen (Maybe Int64 -> Maybe Int64 -> Span)
-> Gen (Maybe Int64) -> Gen (Maybe Int64 -> Span)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`((Int64 -> Maybe Int64) -> Gen Int64 -> Gen (Maybe Int64)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Int64 -> Maybe Int64
forall a. a -> Maybe a
P.Just Gen Int64
forall a. Arbitrary a => Gen a
QC.arbitrary)
          Gen (Maybe Int64 -> Span) -> Gen (Maybe Int64) -> Gen Span
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`M.ap`((Int64 -> Maybe Int64) -> Gen Int64 -> Gen (Maybe Int64)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
M.liftM Int64 -> Maybe Int64
forall a. a -> Maybe a
P.Just Gen Int64
forall a. Arbitrary a => Gen a
QC.arbitrary)
  shrink :: Span -> [Span]
shrink Span
obj | Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span = []
             | Bool
P.otherwise = [Maybe Span] -> [Span]
forall a. [Maybe a] -> [a]
M.catMaybes
    [ if Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span{span_trace_id :: Int64
span_trace_id = Span -> Int64
span_trace_id Span
obj} then Maybe Span
forall a. Maybe a
P.Nothing else Span -> Maybe Span
forall a. a -> Maybe a
P.Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Span
default_Span{span_trace_id :: Int64
span_trace_id = Span -> Int64
span_trace_id Span
obj}
    , if Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span{span_name :: Text
span_name = Span -> Text
span_name Span
obj} then Maybe Span
forall a. Maybe a
P.Nothing else Span -> Maybe Span
forall a. a -> Maybe a
P.Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Span
default_Span{span_name :: Text
span_name = Span -> Text
span_name Span
obj}
    , if Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span{span_id :: Int64
span_id = Span -> Int64
span_id Span
obj} then Maybe Span
forall a. Maybe a
P.Nothing else Span -> Maybe Span
forall a. a -> Maybe a
P.Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Span
default_Span{span_id :: Int64
span_id = Span -> Int64
span_id Span
obj}
    , if Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span{span_parent_id :: Maybe Int64
span_parent_id = Span -> Maybe Int64
span_parent_id Span
obj} then Maybe Span
forall a. Maybe a
P.Nothing else Span -> Maybe Span
forall a. a -> Maybe a
P.Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Span
default_Span{span_parent_id :: Maybe Int64
span_parent_id = Span -> Maybe Int64
span_parent_id Span
obj}
    , if Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span{span_annotations :: Vector Annotation
span_annotations = Span -> Vector Annotation
span_annotations Span
obj} then Maybe Span
forall a. Maybe a
P.Nothing else Span -> Maybe Span
forall a. a -> Maybe a
P.Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Span
default_Span{span_annotations :: Vector Annotation
span_annotations = Span -> Vector Annotation
span_annotations Span
obj}
    , if Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span{span_binary_annotations :: Vector BinaryAnnotation
span_binary_annotations = Span -> Vector BinaryAnnotation
span_binary_annotations Span
obj} then Maybe Span
forall a. Maybe a
P.Nothing else Span -> Maybe Span
forall a. a -> Maybe a
P.Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Span
default_Span{span_binary_annotations :: Vector BinaryAnnotation
span_binary_annotations = Span -> Vector BinaryAnnotation
span_binary_annotations Span
obj}
    , if Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span{span_debug :: Maybe Bool
span_debug = Span -> Maybe Bool
span_debug Span
obj} then Maybe Span
forall a. Maybe a
P.Nothing else Span -> Maybe Span
forall a. a -> Maybe a
P.Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Span
default_Span{span_debug :: Maybe Bool
span_debug = Span -> Maybe Bool
span_debug Span
obj}
    , if Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span{span_timestamp :: Maybe Int64
span_timestamp = Span -> Maybe Int64
span_timestamp Span
obj} then Maybe Span
forall a. Maybe a
P.Nothing else Span -> Maybe Span
forall a. a -> Maybe a
P.Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Span
default_Span{span_timestamp :: Maybe Int64
span_timestamp = Span -> Maybe Int64
span_timestamp Span
obj}
    , if Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span{span_duration :: Maybe Int64
span_duration = Span -> Maybe Int64
span_duration Span
obj} then Maybe Span
forall a. Maybe a
P.Nothing else Span -> Maybe Span
forall a. a -> Maybe a
P.Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Span
default_Span{span_duration :: Maybe Int64
span_duration = Span -> Maybe Int64
span_duration Span
obj}
    , if Span
obj Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
default_Span{span_trace_id_high :: Maybe Int64
span_trace_id_high = Span -> Maybe Int64
span_trace_id_high Span
obj} then Maybe Span
forall a. Maybe a
P.Nothing else Span -> Maybe Span
forall a. a -> Maybe a
P.Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Span
default_Span{span_trace_id_high :: Maybe Int64
span_trace_id_high = Span -> Maybe Int64
span_trace_id_high Span
obj}
    ]
from_Span :: Span -> T.ThriftVal
from_Span :: Span -> ThriftVal
from_Span Span
record = HashMap Int16 (Text, ThriftVal) -> ThriftVal
T.TStruct (HashMap Int16 (Text, ThriftVal) -> ThriftVal)
-> HashMap Int16 (Text, ThriftVal) -> ThriftVal
forall a b. (a -> b) -> a -> b
$ [(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal))
-> [(Int16, (Text, ThriftVal))] -> HashMap Int16 (Text, ThriftVal)
forall a b. (a -> b) -> a -> b
$ [Maybe (Int16, (Text, ThriftVal))] -> [(Int16, (Text, ThriftVal))]
forall a. [Maybe a] -> [a]
M.catMaybes
  [ (\Int64
_v28 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
1, (Text
"trace_id",Int64 -> ThriftVal
T.TI64 Int64
_v28))) (Int64 -> Maybe (Int16, (Text, ThriftVal)))
-> Int64 -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ Span -> Int64
span_trace_id Span
record
  , (\Text
_v28 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
3, (Text
"name",ByteString -> ThriftVal
T.TString (ByteString -> ThriftVal) -> ByteString -> ThriftVal
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
_v28))) (Text -> Maybe (Int16, (Text, ThriftVal)))
-> Text -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ Span -> Text
span_name Span
record
  , (\Int64
_v28 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
4, (Text
"id",Int64 -> ThriftVal
T.TI64 Int64
_v28))) (Int64 -> Maybe (Int16, (Text, ThriftVal)))
-> Int64 -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ Span -> Int64
span_id Span
record
  , (\Int64
_v28 -> (Int16
5, (Text
"parent_id",Int64 -> ThriftVal
T.TI64 Int64
_v28))) (Int64 -> (Int16, (Text, ThriftVal)))
-> Maybe Int64 -> Maybe (Int16, (Text, ThriftVal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Span -> Maybe Int64
span_parent_id Span
record
  , (\Vector Annotation
_v28 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
6, (Text
"annotations",ThriftType -> [ThriftVal] -> ThriftVal
T.TList (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_Annotation) ([ThriftVal] -> ThriftVal) -> [ThriftVal] -> ThriftVal
forall a b. (a -> b) -> a -> b
$ (Annotation -> ThriftVal) -> [Annotation] -> [ThriftVal]
forall a b. (a -> b) -> [a] -> [b]
P.map (\Annotation
_v30 -> Annotation -> ThriftVal
from_Annotation Annotation
_v30) ([Annotation] -> [ThriftVal]) -> [Annotation] -> [ThriftVal]
forall a b. (a -> b) -> a -> b
$ Vector Annotation -> [Annotation]
forall a. Vector a -> [a]
Vector.toList Vector Annotation
_v28))) (Vector Annotation -> Maybe (Int16, (Text, ThriftVal)))
-> Vector Annotation -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ Span -> Vector Annotation
span_annotations Span
record
  , (\Vector BinaryAnnotation
_v28 -> (Int16, (Text, ThriftVal)) -> Maybe (Int16, (Text, ThriftVal))
forall a. a -> Maybe a
P.Just (Int16
8, (Text
"binary_annotations",ThriftType -> [ThriftVal] -> ThriftVal
T.TList (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_BinaryAnnotation) ([ThriftVal] -> ThriftVal) -> [ThriftVal] -> ThriftVal
forall a b. (a -> b) -> a -> b
$ (BinaryAnnotation -> ThriftVal)
-> [BinaryAnnotation] -> [ThriftVal]
forall a b. (a -> b) -> [a] -> [b]
P.map (\BinaryAnnotation
_v32 -> BinaryAnnotation -> ThriftVal
from_BinaryAnnotation BinaryAnnotation
_v32) ([BinaryAnnotation] -> [ThriftVal])
-> [BinaryAnnotation] -> [ThriftVal]
forall a b. (a -> b) -> a -> b
$ Vector BinaryAnnotation -> [BinaryAnnotation]
forall a. Vector a -> [a]
Vector.toList Vector BinaryAnnotation
_v28))) (Vector BinaryAnnotation -> Maybe (Int16, (Text, ThriftVal)))
-> Vector BinaryAnnotation -> Maybe (Int16, (Text, ThriftVal))
forall a b. (a -> b) -> a -> b
$ Span -> Vector BinaryAnnotation
span_binary_annotations Span
record
  , (\Bool
_v28 -> (Int16
9, (Text
"debug",Bool -> ThriftVal
T.TBool Bool
_v28))) (Bool -> (Int16, (Text, ThriftVal)))
-> Maybe Bool -> Maybe (Int16, (Text, ThriftVal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Span -> Maybe Bool
span_debug Span
record
  , (\Int64
_v28 -> (Int16
10, (Text
"timestamp",Int64 -> ThriftVal
T.TI64 Int64
_v28))) (Int64 -> (Int16, (Text, ThriftVal)))
-> Maybe Int64 -> Maybe (Int16, (Text, ThriftVal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Span -> Maybe Int64
span_timestamp Span
record
  , (\Int64
_v28 -> (Int16
11, (Text
"duration",Int64 -> ThriftVal
T.TI64 Int64
_v28))) (Int64 -> (Int16, (Text, ThriftVal)))
-> Maybe Int64 -> Maybe (Int16, (Text, ThriftVal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Span -> Maybe Int64
span_duration Span
record
  , (\Int64
_v28 -> (Int16
12, (Text
"trace_id_high",Int64 -> ThriftVal
T.TI64 Int64
_v28))) (Int64 -> (Int16, (Text, ThriftVal)))
-> Maybe Int64 -> Maybe (Int16, (Text, ThriftVal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Span -> Maybe Int64
span_trace_id_high Span
record
  ]
write_Span :: T.Protocol p => p -> Span -> P.IO ()
write_Span :: p -> Span -> IO ()
write_Span p
oprot Span
record = p -> ThriftVal -> IO ()
forall a. Protocol a => a -> ThriftVal -> IO ()
T.writeVal p
oprot (ThriftVal -> IO ()) -> ThriftVal -> IO ()
forall a b. (a -> b) -> a -> b
$ Span -> ThriftVal
from_Span Span
record
encode_Span :: T.StatelessProtocol p => p -> Span -> LBS.ByteString
encode_Span :: p -> Span -> ByteString
encode_Span p
oprot Span
record = p -> ThriftVal -> ByteString
forall a. StatelessProtocol a => a -> ThriftVal -> ByteString
T.serializeVal p
oprot (ThriftVal -> ByteString) -> ThriftVal -> ByteString
forall a b. (a -> b) -> a -> b
$ Span -> ThriftVal
from_Span Span
record
to_Span :: T.ThriftVal -> Span
to_Span :: ThriftVal -> Span
to_Span (T.TStruct HashMap Int16 (Text, ThriftVal)
fields) = Span :: Int64
-> Text
-> Int64
-> Maybe Int64
-> Vector Annotation
-> Vector BinaryAnnotation
-> Maybe Bool
-> Maybe Int64
-> Maybe Int64
-> Maybe Int64
-> Span
Span{
  span_trace_id :: Int64
span_trace_id = Int64
-> ((Text, ThriftVal) -> Int64) -> Maybe (Text, ThriftVal) -> Int64
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Span -> Int64
span_trace_id Span
default_Span) (\(Text
_,ThriftVal
_val34) -> (case ThriftVal
_val34 of {T.TI64 Int64
_val35 -> Int64
_val35; ThriftVal
_ -> String -> Int64
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
1) HashMap Int16 (Text, ThriftVal)
fields),
  span_name :: Text
span_name = Text
-> ((Text, ThriftVal) -> Text) -> Maybe (Text, ThriftVal) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Span -> Text
span_name Span
default_Span) (\(Text
_,ThriftVal
_val34) -> (case ThriftVal
_val34 of {T.TString ByteString
_val36 -> ByteString -> Text
E.decodeUtf8 ByteString
_val36; ThriftVal
_ -> String -> Text
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
3) HashMap Int16 (Text, ThriftVal)
fields),
  span_id :: Int64
span_id = Int64
-> ((Text, ThriftVal) -> Int64) -> Maybe (Text, ThriftVal) -> Int64
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Span -> Int64
span_id Span
default_Span) (\(Text
_,ThriftVal
_val34) -> (case ThriftVal
_val34 of {T.TI64 Int64
_val37 -> Int64
_val37; ThriftVal
_ -> String -> Int64
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
4) HashMap Int16 (Text, ThriftVal)
fields),
  span_parent_id :: Maybe Int64
span_parent_id = Maybe Int64
-> ((Text, ThriftVal) -> Maybe Int64)
-> Maybe (Text, ThriftVal)
-> Maybe Int64
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Maybe Int64
forall a. Maybe a
P.Nothing) (\(Text
_,ThriftVal
_val34) -> Int64 -> Maybe Int64
forall a. a -> Maybe a
P.Just (case ThriftVal
_val34 of {T.TI64 Int64
_val38 -> Int64
_val38; ThriftVal
_ -> String -> Int64
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
5) HashMap Int16 (Text, ThriftVal)
fields),
  span_annotations :: Vector Annotation
span_annotations = Vector Annotation
-> ((Text, ThriftVal) -> Vector Annotation)
-> Maybe (Text, ThriftVal)
-> Vector Annotation
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Span -> Vector Annotation
span_annotations Span
default_Span) (\(Text
_,ThriftVal
_val34) -> (case ThriftVal
_val34 of {T.TList ThriftType
_ [ThriftVal]
_val39 -> ([Annotation] -> Vector Annotation
forall a. [a] -> Vector a
Vector.fromList ([Annotation] -> Vector Annotation)
-> [Annotation] -> Vector Annotation
forall a b. (a -> b) -> a -> b
$ (ThriftVal -> Annotation) -> [ThriftVal] -> [Annotation]
forall a b. (a -> b) -> [a] -> [b]
P.map (\ThriftVal
_v40 -> (case ThriftVal
_v40 of {T.TStruct HashMap Int16 (Text, ThriftVal)
_val41 -> (ThriftVal -> Annotation
to_Annotation (HashMap Int16 (Text, ThriftVal) -> ThriftVal
T.TStruct HashMap Int16 (Text, ThriftVal)
_val41)); ThriftVal
_ -> String -> Annotation
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) [ThriftVal]
_val39); ThriftVal
_ -> String -> Vector Annotation
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
6) HashMap Int16 (Text, ThriftVal)
fields),
  span_binary_annotations :: Vector BinaryAnnotation
span_binary_annotations = Vector BinaryAnnotation
-> ((Text, ThriftVal) -> Vector BinaryAnnotation)
-> Maybe (Text, ThriftVal)
-> Vector BinaryAnnotation
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Span -> Vector BinaryAnnotation
span_binary_annotations Span
default_Span) (\(Text
_,ThriftVal
_val34) -> (case ThriftVal
_val34 of {T.TList ThriftType
_ [ThriftVal]
_val42 -> ([BinaryAnnotation] -> Vector BinaryAnnotation
forall a. [a] -> Vector a
Vector.fromList ([BinaryAnnotation] -> Vector BinaryAnnotation)
-> [BinaryAnnotation] -> Vector BinaryAnnotation
forall a b. (a -> b) -> a -> b
$ (ThriftVal -> BinaryAnnotation)
-> [ThriftVal] -> [BinaryAnnotation]
forall a b. (a -> b) -> [a] -> [b]
P.map (\ThriftVal
_v43 -> (case ThriftVal
_v43 of {T.TStruct HashMap Int16 (Text, ThriftVal)
_val44 -> (ThriftVal -> BinaryAnnotation
to_BinaryAnnotation (HashMap Int16 (Text, ThriftVal) -> ThriftVal
T.TStruct HashMap Int16 (Text, ThriftVal)
_val44)); ThriftVal
_ -> String -> BinaryAnnotation
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) [ThriftVal]
_val42); ThriftVal
_ -> String -> Vector BinaryAnnotation
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
8) HashMap Int16 (Text, ThriftVal)
fields),
  span_debug :: Maybe Bool
span_debug = Maybe Bool
-> ((Text, ThriftVal) -> Maybe Bool)
-> Maybe (Text, ThriftVal)
-> Maybe Bool
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Span -> Maybe Bool
span_debug Span
default_Span) (\(Text
_,ThriftVal
_val34) -> Bool -> Maybe Bool
forall a. a -> Maybe a
P.Just (case ThriftVal
_val34 of {T.TBool Bool
_val45 -> Bool
_val45; ThriftVal
_ -> String -> Bool
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
9) HashMap Int16 (Text, ThriftVal)
fields),
  span_timestamp :: Maybe Int64
span_timestamp = Maybe Int64
-> ((Text, ThriftVal) -> Maybe Int64)
-> Maybe (Text, ThriftVal)
-> Maybe Int64
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Maybe Int64
forall a. Maybe a
P.Nothing) (\(Text
_,ThriftVal
_val34) -> Int64 -> Maybe Int64
forall a. a -> Maybe a
P.Just (case ThriftVal
_val34 of {T.TI64 Int64
_val46 -> Int64
_val46; ThriftVal
_ -> String -> Int64
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
10) HashMap Int16 (Text, ThriftVal)
fields),
  span_duration :: Maybe Int64
span_duration = Maybe Int64
-> ((Text, ThriftVal) -> Maybe Int64)
-> Maybe (Text, ThriftVal)
-> Maybe Int64
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Maybe Int64
forall a. Maybe a
P.Nothing) (\(Text
_,ThriftVal
_val34) -> Int64 -> Maybe Int64
forall a. a -> Maybe a
P.Just (case ThriftVal
_val34 of {T.TI64 Int64
_val47 -> Int64
_val47; ThriftVal
_ -> String -> Int64
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
11) HashMap Int16 (Text, ThriftVal)
fields),
  span_trace_id_high :: Maybe Int64
span_trace_id_high = Maybe Int64
-> ((Text, ThriftVal) -> Maybe Int64)
-> Maybe (Text, ThriftVal)
-> Maybe Int64
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe (Maybe Int64
forall a. Maybe a
P.Nothing) (\(Text
_,ThriftVal
_val34) -> Int64 -> Maybe Int64
forall a. a -> Maybe a
P.Just (case ThriftVal
_val34 of {T.TI64 Int64
_val48 -> Int64
_val48; ThriftVal
_ -> String -> Int64
forall a. HasCallStack => String -> a
P.error String
"wrong type"})) (Int16 -> HashMap Int16 (Text, ThriftVal) -> Maybe (Text, ThriftVal)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Int16
12) HashMap Int16 (Text, ThriftVal)
fields)
  }
to_Span ThriftVal
_ = String -> Span
forall a. HasCallStack => String -> a
P.error String
"not a struct"
read_Span :: T.Protocol p => p -> P.IO Span
read_Span :: p -> IO Span
read_Span p
iprot = ThriftVal -> Span
to_Span (ThriftVal -> Span) -> IO ThriftVal -> IO Span
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> ThriftType -> IO ThriftVal
forall a. Protocol a => a -> ThriftType -> IO ThriftVal
T.readVal p
iprot (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_Span)
decode_Span :: T.StatelessProtocol p => p -> LBS.ByteString -> Span
decode_Span :: p -> ByteString -> Span
decode_Span p
iprot ByteString
bs = ThriftVal -> Span
to_Span (ThriftVal -> Span) -> ThriftVal -> Span
forall a b. (a -> b) -> a -> b
$ p -> ThriftType -> ByteString -> ThriftVal
forall a.
StatelessProtocol a =>
a -> ThriftType -> ByteString -> ThriftVal
T.deserializeVal p
iprot (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_Span) ByteString
bs
typemap_Span :: T.TypeMap
typemap_Span :: TypeMap
typemap_Span = [(Int16, (Text, ThriftType))] -> TypeMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [(Int16
1,(Text
"trace_id",ThriftType
T.T_I64)),(Int16
3,(Text
"name",ThriftType
T.T_STRING)),(Int16
4,(Text
"id",ThriftType
T.T_I64)),(Int16
5,(Text
"parent_id",ThriftType
T.T_I64)),(Int16
6,(Text
"annotations",(ThriftType -> ThriftType
T.T_LIST (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_Annotation)))),(Int16
8,(Text
"binary_annotations",(ThriftType -> ThriftType
T.T_LIST (TypeMap -> ThriftType
T.T_STRUCT TypeMap
typemap_BinaryAnnotation)))),(Int16
9,(Text
"debug",ThriftType
T.T_BOOL)),(Int16
10,(Text
"timestamp",ThriftType
T.T_I64)),(Int16
11,(Text
"duration",ThriftType
T.T_I64)),(Int16
12,(Text
"trace_id_high",ThriftType
T.T_I64))]
default_Span :: Span
default_Span :: Span
default_Span = Span :: Int64
-> Text
-> Int64
-> Maybe Int64
-> Vector Annotation
-> Vector BinaryAnnotation
-> Maybe Bool
-> Maybe Int64
-> Maybe Int64
-> Maybe Int64
-> Span
Span{
  span_trace_id :: Int64
span_trace_id = Int64
0,
  span_name :: Text
span_name = Text
"",
  span_id :: Int64
span_id = Int64
0,
  span_parent_id :: Maybe Int64
span_parent_id = Maybe Int64
forall a. Maybe a
P.Nothing,
  span_annotations :: Vector Annotation
span_annotations = Vector Annotation
forall a. Vector a
Vector.empty,
  span_binary_annotations :: Vector BinaryAnnotation
span_binary_annotations = Vector BinaryAnnotation
forall a. Vector a
Vector.empty,
  span_debug :: Maybe Bool
span_debug = Bool -> Maybe Bool
forall a. a -> Maybe a
P.Just Bool
P.False,
  span_timestamp :: Maybe Int64
span_timestamp = Maybe Int64
forall a. Maybe a
P.Nothing,
  span_duration :: Maybe Int64
span_duration = Maybe Int64
forall a. Maybe a
P.Nothing,
  span_trace_id_high :: Maybe Int64
span_trace_id_high = Maybe Int64
forall a. Maybe a
P.Nothing}