opentracing-jaeger 0.1.0.0 → 0.2.0

raw patch · 21 files changed

+699/−1211 lines, 21 filesdep +pinchdep +vector-instancesdep −thriftPVP ok

version bump matches the API change (PVP)

Dependencies added: pinch, vector-instances

Dependencies removed: thrift

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−2
• gen-src/Agent.hs +0/−190
• gen-src/Agent/Client.hs +30/−0
• gen-src/Agent/Server.hs +33/−0
• gen-src/Agent/Types.hs +45/−0
• gen-src/Agent_Client.hs +0/−61
• gen-src/Agent_Iface.hs +0/−48
• gen-src/Agent_Types.hs +0/−43
• gen-src/Jaeger/Client.hs +25/−0
• gen-src/Jaeger/Server.hs +30/−0
• gen-src/Jaeger/Types.hs +238/−0
• gen-src/Jaeger_Consts.hs +0/−41
• gen-src/Jaeger_Types.hs +0/−434
• gen-src/Zipkincore/Server.hs +30/−0
• gen-src/Zipkincore/Types.hs +176/−0
• gen-src/Zipkincore_Types.hs +0/−325
• opentracing-jaeger.cabal +11/−9
• src/OpenTracing/Jaeger/AgentReporter.hs +24/−35
• src/OpenTracing/Jaeger/CollectorReporter.hs +5/−7
• src/OpenTracing/Jaeger/Propagation.hs +0/−1
• src/OpenTracing/Jaeger/Thrift.hs +40/−15

@@ -1,3 +1,13 @@-* 0.1.0.0 (2012-04-20)+* 0.2.0 (2021-06-03) -After years of friendly reminders, a zero version gets finally released =]+  - Drop support for GHC 8.0 (#35)+  - Add support for GHC 9.0 (#36)+  - Replace the unmaintained `thrift` package with `pinch` (#34)+  - wai: Better default operation name, and allow customising it (#33, #37)++  The major version is bumped because the packages won't compile with GHC 8.0+  anymore.++* 0.1.0.0 (2021-04-20)++  After years of friendly reminders, a zero version gets finally released =]

@@ -1,190 +0,0 @@-{-# 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 Agent 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--import qualified Jaeger_Types-import qualified Zipkincore_Types---import Agent_Types-import qualified Agent_Iface as Iface--- HELPER FUNCTIONS AND STRUCTURES ----data EmitZipkinBatch_args = EmitZipkinBatch_args  { emitZipkinBatch_args_spans :: (Vector.Vector Zipkincore_Types.Span)-  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable EmitZipkinBatch_args where-  hashWithSalt salt record = salt   `H.hashWithSalt` emitZipkinBatch_args_spans record  -instance QC.Arbitrary EmitZipkinBatch_args where -  arbitrary = M.liftM EmitZipkinBatch_args (QC.arbitrary)-  shrink obj | obj == default_EmitZipkinBatch_args = []-             | P.otherwise = M.catMaybes-    [ if obj == default_EmitZipkinBatch_args{emitZipkinBatch_args_spans = emitZipkinBatch_args_spans obj} then P.Nothing else P.Just $ default_EmitZipkinBatch_args{emitZipkinBatch_args_spans = emitZipkinBatch_args_spans obj}-    ]-from_EmitZipkinBatch_args :: EmitZipkinBatch_args -> T.ThriftVal-from_EmitZipkinBatch_args record = T.TStruct $ Map.fromList $ M.catMaybes-  [ (\_v2 -> P.Just (1, ("spans",T.TList (T.T_STRUCT Zipkincore_Types.typemap_Span) $ P.map (\_v4 -> Zipkincore_Types.from_Span _v4) $ Vector.toList _v2))) $ emitZipkinBatch_args_spans record-  ]-write_EmitZipkinBatch_args :: T.Protocol p => p -> EmitZipkinBatch_args -> P.IO ()-write_EmitZipkinBatch_args oprot record = T.writeVal oprot $ from_EmitZipkinBatch_args record-encode_EmitZipkinBatch_args :: T.StatelessProtocol p => p -> EmitZipkinBatch_args -> LBS.ByteString-encode_EmitZipkinBatch_args oprot record = T.serializeVal oprot $ from_EmitZipkinBatch_args record-to_EmitZipkinBatch_args :: T.ThriftVal -> EmitZipkinBatch_args-to_EmitZipkinBatch_args (T.TStruct fields) = EmitZipkinBatch_args{-  emitZipkinBatch_args_spans = P.maybe (emitZipkinBatch_args_spans default_EmitZipkinBatch_args) (\(_,_val6) -> (case _val6 of {T.TList _ _val7 -> (Vector.fromList $ P.map (\_v8 -> (case _v8 of {T.TStruct _val9 -> (Zipkincore_Types.to_Span (T.TStruct _val9)); _ -> P.error "wrong type"})) _val7); _ -> P.error "wrong type"})) (Map.lookup (1) fields)-  }-to_EmitZipkinBatch_args _ = P.error "not a struct"-read_EmitZipkinBatch_args :: T.Protocol p => p -> P.IO EmitZipkinBatch_args-read_EmitZipkinBatch_args iprot = to_EmitZipkinBatch_args <$> T.readVal iprot (T.T_STRUCT typemap_EmitZipkinBatch_args)-decode_EmitZipkinBatch_args :: T.StatelessProtocol p => p -> LBS.ByteString -> EmitZipkinBatch_args-decode_EmitZipkinBatch_args iprot bs = to_EmitZipkinBatch_args $ T.deserializeVal iprot (T.T_STRUCT typemap_EmitZipkinBatch_args) bs-typemap_EmitZipkinBatch_args :: T.TypeMap-typemap_EmitZipkinBatch_args = Map.fromList [(1,("spans",(T.T_LIST (T.T_STRUCT Zipkincore_Types.typemap_Span))))]-default_EmitZipkinBatch_args :: EmitZipkinBatch_args-default_EmitZipkinBatch_args = EmitZipkinBatch_args{-  emitZipkinBatch_args_spans = Vector.empty}-data EmitZipkinBatch_result = EmitZipkinBatch_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable EmitZipkinBatch_result where-  hashWithSalt salt record = salt  -instance QC.Arbitrary EmitZipkinBatch_result where -  arbitrary = QC.elements [EmitZipkinBatch_result]-from_EmitZipkinBatch_result :: EmitZipkinBatch_result -> T.ThriftVal-from_EmitZipkinBatch_result record = T.TStruct $ Map.fromList $ M.catMaybes-  []-write_EmitZipkinBatch_result :: T.Protocol p => p -> EmitZipkinBatch_result -> P.IO ()-write_EmitZipkinBatch_result oprot record = T.writeVal oprot $ from_EmitZipkinBatch_result record-encode_EmitZipkinBatch_result :: T.StatelessProtocol p => p -> EmitZipkinBatch_result -> LBS.ByteString-encode_EmitZipkinBatch_result oprot record = T.serializeVal oprot $ from_EmitZipkinBatch_result record-to_EmitZipkinBatch_result :: T.ThriftVal -> EmitZipkinBatch_result-to_EmitZipkinBatch_result (T.TStruct fields) = EmitZipkinBatch_result{--  }-to_EmitZipkinBatch_result _ = P.error "not a struct"-read_EmitZipkinBatch_result :: T.Protocol p => p -> P.IO EmitZipkinBatch_result-read_EmitZipkinBatch_result iprot = to_EmitZipkinBatch_result <$> T.readVal iprot (T.T_STRUCT typemap_EmitZipkinBatch_result)-decode_EmitZipkinBatch_result :: T.StatelessProtocol p => p -> LBS.ByteString -> EmitZipkinBatch_result-decode_EmitZipkinBatch_result iprot bs = to_EmitZipkinBatch_result $ T.deserializeVal iprot (T.T_STRUCT typemap_EmitZipkinBatch_result) bs-typemap_EmitZipkinBatch_result :: T.TypeMap-typemap_EmitZipkinBatch_result = Map.fromList []-default_EmitZipkinBatch_result :: EmitZipkinBatch_result-default_EmitZipkinBatch_result = EmitZipkinBatch_result{-}-data EmitBatch_args = EmitBatch_args  { emitBatch_args_batch :: Jaeger_Types.Batch-  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable EmitBatch_args where-  hashWithSalt salt record = salt   `H.hashWithSalt` emitBatch_args_batch record  -instance QC.Arbitrary EmitBatch_args where -  arbitrary = M.liftM EmitBatch_args (QC.arbitrary)-  shrink obj | obj == default_EmitBatch_args = []-             | P.otherwise = M.catMaybes-    [ if obj == default_EmitBatch_args{emitBatch_args_batch = emitBatch_args_batch obj} then P.Nothing else P.Just $ default_EmitBatch_args{emitBatch_args_batch = emitBatch_args_batch obj}-    ]-from_EmitBatch_args :: EmitBatch_args -> T.ThriftVal-from_EmitBatch_args record = T.TStruct $ Map.fromList $ M.catMaybes-  [ (\_v17 -> P.Just (1, ("batch",Jaeger_Types.from_Batch _v17))) $ emitBatch_args_batch record-  ]-write_EmitBatch_args :: T.Protocol p => p -> EmitBatch_args -> P.IO ()-write_EmitBatch_args oprot record = T.writeVal oprot $ from_EmitBatch_args record-encode_EmitBatch_args :: T.StatelessProtocol p => p -> EmitBatch_args -> LBS.ByteString-encode_EmitBatch_args oprot record = T.serializeVal oprot $ from_EmitBatch_args record-to_EmitBatch_args :: T.ThriftVal -> EmitBatch_args-to_EmitBatch_args (T.TStruct fields) = EmitBatch_args{-  emitBatch_args_batch = P.maybe (emitBatch_args_batch default_EmitBatch_args) (\(_,_val19) -> (case _val19 of {T.TStruct _val20 -> (Jaeger_Types.to_Batch (T.TStruct _val20)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)-  }-to_EmitBatch_args _ = P.error "not a struct"-read_EmitBatch_args :: T.Protocol p => p -> P.IO EmitBatch_args-read_EmitBatch_args iprot = to_EmitBatch_args <$> T.readVal iprot (T.T_STRUCT typemap_EmitBatch_args)-decode_EmitBatch_args :: T.StatelessProtocol p => p -> LBS.ByteString -> EmitBatch_args-decode_EmitBatch_args iprot bs = to_EmitBatch_args $ T.deserializeVal iprot (T.T_STRUCT typemap_EmitBatch_args) bs-typemap_EmitBatch_args :: T.TypeMap-typemap_EmitBatch_args = Map.fromList [(1,("batch",(T.T_STRUCT Jaeger_Types.typemap_Batch)))]-default_EmitBatch_args :: EmitBatch_args-default_EmitBatch_args = EmitBatch_args{-  emitBatch_args_batch = Jaeger_Types.default_Batch}-data EmitBatch_result = EmitBatch_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable EmitBatch_result where-  hashWithSalt salt record = salt  -instance QC.Arbitrary EmitBatch_result where -  arbitrary = QC.elements [EmitBatch_result]-from_EmitBatch_result :: EmitBatch_result -> T.ThriftVal-from_EmitBatch_result record = T.TStruct $ Map.fromList $ M.catMaybes-  []-write_EmitBatch_result :: T.Protocol p => p -> EmitBatch_result -> P.IO ()-write_EmitBatch_result oprot record = T.writeVal oprot $ from_EmitBatch_result record-encode_EmitBatch_result :: T.StatelessProtocol p => p -> EmitBatch_result -> LBS.ByteString-encode_EmitBatch_result oprot record = T.serializeVal oprot $ from_EmitBatch_result record-to_EmitBatch_result :: T.ThriftVal -> EmitBatch_result-to_EmitBatch_result (T.TStruct fields) = EmitBatch_result{--  }-to_EmitBatch_result _ = P.error "not a struct"-read_EmitBatch_result :: T.Protocol p => p -> P.IO EmitBatch_result-read_EmitBatch_result iprot = to_EmitBatch_result <$> T.readVal iprot (T.T_STRUCT typemap_EmitBatch_result)-decode_EmitBatch_result :: T.StatelessProtocol p => p -> LBS.ByteString -> EmitBatch_result-decode_EmitBatch_result iprot bs = to_EmitBatch_result $ T.deserializeVal iprot (T.T_STRUCT typemap_EmitBatch_result) bs-typemap_EmitBatch_result :: T.TypeMap-typemap_EmitBatch_result = Map.fromList []-default_EmitBatch_result :: EmitBatch_result-default_EmitBatch_result = EmitBatch_result{-}-process_emitZipkinBatch (seqid, iprot, oprot, handler) = do-  args <- read_EmitZipkinBatch_args iprot-  (X.catch-    (do-      Iface.emitZipkinBatch handler (emitZipkinBatch_args_spans args)-      P.return ())-    ((\_ -> do-      P.return ()) :: X.SomeException -> P.IO ()))-process_emitBatch (seqid, iprot, oprot, handler) = do-  args <- read_EmitBatch_args iprot-  (X.catch-    (do-      Iface.emitBatch handler (emitBatch_args_batch args)-      P.return ())-    ((\_ -> do-      P.return ()) :: X.SomeException -> P.IO ()))-proc_ handler (iprot,oprot) (name,typ,seqid) = case name of-  "emitZipkinBatch" -> process_emitZipkinBatch (seqid,iprot,oprot,handler)-  "emitBatch" -> process_emitBatch (seqid,iprot,oprot,handler)-  _ -> do-    _ <- T.readVal iprot (T.T_STRUCT Map.empty)-    T.writeMessage oprot (name,T.M_EXCEPTION,seqid) $-      T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN_METHOD ("Unknown function " ++ LT.unpack name))-process handler (iprot, oprot) = do-  T.readMessage iprot (-    proc_ handler (iprot,oprot))-  P.return P.True

@@ -0,0 +1,30 @@+{-# LANGUAGE TypeFamilies, DeriveGeneric, TypeApplications, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-name-shadowing -fno-warn-unused-matches #-}++module Agent.Client where++import  Agent.Types+import qualified Pinch.Client+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 ()++emitZipkinBatch :: ((Data.Vector.Vector Zipkincore.Types.Span)) -> (Pinch.Client.ThriftCall ())+emitZipkinBatch spans = Pinch.Client.TOneway ("emitZipkinBatch") (EmitZipkinBatch_Args (spans))++emitBatch :: (Jaeger.Types.Batch) -> (Pinch.Client.ThriftCall ())+emitBatch batch = Pinch.Client.TOneway ("emitBatch") (EmitBatch_Args (batch))

@@ -0,0 +1,33 @@+{-# LANGUAGE TypeFamilies, DeriveGeneric, TypeApplications, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-name-shadowing -fno-warn-unused-matches #-}++module Agent.Server where++import  Agent.Types+import qualified Pinch.Server+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 Agent+  = Agent { emitZipkinBatch :: (Pinch.Server.Context) -> ((Data.Vector.Vector Zipkincore.Types.Span)) -> (Prelude.IO ()), emitBatch :: (Pinch.Server.Context) -> (Jaeger.Types.Batch) -> (Prelude.IO ()) }+++agent_mkServer :: (Agent) -> Pinch.Server.ThriftServer+agent_mkServer server = let functions =   Data.HashMap.Strict.fromList ([ ( "emitZipkinBatch"+                                            , Pinch.Server.OnewayHandler ((\ctx (EmitZipkinBatch_Args a) -> emitZipkinBatch (server) (ctx) (a))) ), ( "emitBatch"+                                            , Pinch.Server.OnewayHandler ((\ctx (EmitBatch_Args a) -> emitBatch (server) (ctx) (a))) ) ]) in Pinch.Server.createServer ((\nm -> Data.HashMap.Strict.lookup (nm) (functions)))

@@ -0,0 +1,45 @@+{-# LANGUAGE TypeFamilies, DeriveGeneric, TypeApplications, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-name-shadowing -fno-warn-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_spans :: (Data.Vector.Vector Zipkincore.Types.Span) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable EmitZipkinBatch_Args where+  type (Tag EmitZipkinBatch_Args) = Pinch.TStruct++  pinch (EmitZipkinBatch_Args emitZipkinBatch_Args_spans) = Pinch.struct ([ (1 Pinch..= emitZipkinBatch_Args_spans) ])++  unpinch value = (Prelude.pure (EmitZipkinBatch_Args) Prelude.<*> (value Pinch..: 1))+++data EmitBatch_Args+  = EmitBatch_Args { emitBatch_Args_batch :: Jaeger.Types.Batch }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable EmitBatch_Args where+  type (Tag EmitBatch_Args) = Pinch.TStruct++  pinch (EmitBatch_Args emitBatch_Args_batch) = Pinch.struct ([ (1 Pinch..= emitBatch_Args_batch) ])++  unpinch value = (Prelude.pure (EmitBatch_Args) Prelude.<*> (value Pinch..: 1))

@@ -1,61 +0,0 @@-{-# 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 Agent_Client(emitZipkinBatch,emitBatch) where-import qualified Data.IORef as R-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--import qualified Jaeger_Types-import qualified Zipkincore_Types---import Agent_Types-import Agent-seqid = R.newIORef 0-emitZipkinBatch (ip,op) arg_spans = do-  send_emitZipkinBatch op arg_spans-send_emitZipkinBatch op arg_spans = do-  seq <- seqid-  seqn <- R.readIORef seq-  T.writeMessage op ("emitZipkinBatch", T.M_ONEWAY, seqn) $-    write_EmitZipkinBatch_args op (EmitZipkinBatch_args{emitZipkinBatch_args_spans=arg_spans})-emitBatch (ip,op) arg_batch = do-  send_emitBatch op arg_batch-send_emitBatch op arg_batch = do-  seq <- seqid-  seqn <- R.readIORef seq-  T.writeMessage op ("emitBatch", T.M_ONEWAY, seqn) $-    write_EmitBatch_args op (EmitBatch_args{emitBatch_args_batch=arg_batch})

@@ -1,48 +0,0 @@-{-# 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 Agent_Iface 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--import qualified Jaeger_Types-import qualified Zipkincore_Types---import Agent_Types--class Agent_Iface a where-  emitZipkinBatch :: a -> (Vector.Vector Zipkincore_Types.Span) -> P.IO ()-  emitBatch :: a -> Jaeger_Types.Batch -> P.IO ()

@@ -1,43 +0,0 @@-{-# 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 Agent_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--import qualified Jaeger_Types-import qualified Zipkincore_Types--

@@ -0,0 +1,25 @@+{-# LANGUAGE TypeFamilies, DeriveGeneric, TypeApplications, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-name-shadowing -fno-warn-unused-matches #-}++module Jaeger.Client where++import  Jaeger.Types+import qualified Pinch.Client+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 ()++submitBatches :: ((Data.Vector.Vector Batch)) -> (Pinch.Client.ThriftCall SubmitBatches_Result)+submitBatches batches = Pinch.Client.TCall ("submitBatches") (SubmitBatches_Args (batches))

@@ -0,0 +1,30 @@+{-# LANGUAGE TypeFamilies, DeriveGeneric, TypeApplications, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-name-shadowing -fno-warn-unused-matches #-}++module Jaeger.Server where++import  Jaeger.Types+import qualified Pinch.Server+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 Collector+  = Collector { submitBatches :: (Pinch.Server.Context) -> ((Data.Vector.Vector Batch)) -> (Prelude.IO (Data.Vector.Vector BatchSubmitResponse)) }+++collector_mkServer :: (Collector) -> Pinch.Server.ThriftServer+collector_mkServer server = let functions =   Data.HashMap.Strict.fromList ([ ( "submitBatches"+                                                , Pinch.Server.CallHandler ((\ctx (SubmitBatches_Args a) -> Pinch.Internal.RPC.wrap @(SubmitBatches_Result) (submitBatches (server) (ctx) (a)))) ) ]) in Pinch.Server.createServer ((\nm -> Data.HashMap.Strict.lookup (nm) (functions)))

@@ -0,0 +1,238 @@+{-# LANGUAGE TypeFamilies, DeriveGeneric, TypeApplications, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-name-shadowing -fno-warn-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 (Prelude.Eq, Prelude.Ord, GHC.Generics.Generic, Prelude.Show, Prelude.Bounded)++instance Pinch.Pinchable TagType where+  type (Tag TagType) = Pinch.TEnum++  pinch STRING = Pinch.pinch ((0 :: Data.Int.Int32))+  pinch DOUBLE = Pinch.pinch ((1 :: Data.Int.Int32))+  pinch BOOL = Pinch.pinch ((2 :: Data.Int.Int32))+  pinch LONG = Pinch.pinch ((3 :: Data.Int.Int32))+  pinch BINARY = Pinch.pinch ((4 :: Data.Int.Int32))++  unpinch v = do+    val <- Pinch.unpinch (v)+    case (val :: Data.Int.Int32) of+      0 -> Prelude.pure (STRING)+      1 -> Prelude.pure (DOUBLE)+      2 -> Prelude.pure (BOOL)+      3 -> Prelude.pure (LONG)+      4 -> Prelude.pure (BINARY)+      _ -> Prelude.fail (("Unknown value for type TagType: " Prelude.<> Prelude.show (val)))+++instance Prelude.Enum TagType where+  fromEnum STRING = 0+  fromEnum DOUBLE = 1+  fromEnum BOOL = 2+  fromEnum LONG = 3+  fromEnum BINARY = 4++  toEnum 0 = STRING+  toEnum 1 = DOUBLE+  toEnum 2 = BOOL+  toEnum 3 = LONG+  toEnum 4 = BINARY+  toEnum _ = Prelude.error ("Unknown value for enum TagType.")+++instance Data.Hashable.Hashable TagType where++data Tag+  = Tag { tag_key :: Data.Text.Text, tag_vType :: TagType, tag_vStr :: (Prelude.Maybe Data.Text.Text), tag_vDouble :: (Prelude.Maybe Prelude.Double), tag_vBool :: (Prelude.Maybe Prelude.Bool), tag_vLong :: (Prelude.Maybe Data.Int.Int64), tag_vBinary :: (Prelude.Maybe Data.ByteString.ByteString) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable Tag where+  type (Tag Tag) = Pinch.TStruct++  pinch (Tag tag_key tag_vType tag_vStr tag_vDouble tag_vBool tag_vLong tag_vBinary) = Pinch.struct ([ (1 Pinch..= tag_key), (2 Pinch..= tag_vType), (3 Pinch.?= tag_vStr), (4 Pinch.?= tag_vDouble), (5 Pinch.?= tag_vBool), (6 Pinch.?= tag_vLong), (7 Pinch.?= tag_vBinary) ])++  unpinch value = (((((((Prelude.pure (Tag) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..: 2)) Prelude.<*> (value Pinch..:? 3)) Prelude.<*> (value Pinch..:? 4)) Prelude.<*> (value Pinch..:? 5)) Prelude.<*> (value Pinch..:? 6)) Prelude.<*> (value Pinch..:? 7))+++instance Data.Hashable.Hashable Tag where++data Log+  = Log { log_timestamp :: Data.Int.Int64, log_fields :: (Data.Vector.Vector Tag) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable Log where+  type (Tag Log) = Pinch.TStruct++  pinch (Log log_timestamp log_fields) = Pinch.struct ([ (1 Pinch..= log_timestamp), (2 Pinch..= log_fields) ])++  unpinch value = ((Prelude.pure (Log) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..: 2))+++instance Data.Hashable.Hashable Log where++data SpanRefType+  = CHILD_OF+  | FOLLOWS_FROM+  deriving (Prelude.Eq, Prelude.Ord, GHC.Generics.Generic, Prelude.Show, Prelude.Bounded)++instance Pinch.Pinchable SpanRefType where+  type (Tag SpanRefType) = Pinch.TEnum++  pinch CHILD_OF = Pinch.pinch ((0 :: Data.Int.Int32))+  pinch FOLLOWS_FROM = Pinch.pinch ((1 :: Data.Int.Int32))++  unpinch v = do+    val <- Pinch.unpinch (v)+    case (val :: Data.Int.Int32) of+      0 -> Prelude.pure (CHILD_OF)+      1 -> Prelude.pure (FOLLOWS_FROM)+      _ -> Prelude.fail (("Unknown value for type SpanRefType: " Prelude.<> Prelude.show (val)))+++instance Prelude.Enum SpanRefType where+  fromEnum CHILD_OF = 0+  fromEnum FOLLOWS_FROM = 1++  toEnum 0 = CHILD_OF+  toEnum 1 = FOLLOWS_FROM+  toEnum _ = Prelude.error ("Unknown value for enum SpanRefType.")+++instance Data.Hashable.Hashable SpanRefType where++data SpanRef+  = SpanRef { spanRef_refType :: SpanRefType, spanRef_traceIdLow :: Data.Int.Int64, spanRef_traceIdHigh :: Data.Int.Int64, spanRef_spanId :: Data.Int.Int64 }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable SpanRef where+  type (Tag SpanRef) = Pinch.TStruct++  pinch (SpanRef spanRef_refType spanRef_traceIdLow spanRef_traceIdHigh spanRef_spanId) = Pinch.struct ([ (1 Pinch..= spanRef_refType), (2 Pinch..= spanRef_traceIdLow), (3 Pinch..= spanRef_traceIdHigh), (4 Pinch..= spanRef_spanId) ])++  unpinch value = ((((Prelude.pure (SpanRef) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..: 2)) Prelude.<*> (value Pinch..: 3)) Prelude.<*> (value Pinch..: 4))+++instance Data.Hashable.Hashable SpanRef where++data Span+  = Span { span_traceIdLow :: Data.Int.Int64, span_traceIdHigh :: Data.Int.Int64, span_spanId :: Data.Int.Int64, span_parentSpanId :: Data.Int.Int64, span_operationName :: Data.Text.Text, span_references :: (Prelude.Maybe (Data.Vector.Vector SpanRef)), span_flags :: Data.Int.Int32, span_startTime :: Data.Int.Int64, span_duration :: Data.Int.Int64, span_tags :: (Prelude.Maybe (Data.Vector.Vector Tag)), span_logs :: (Prelude.Maybe (Data.Vector.Vector Log)) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable Span where+  type (Tag Span) = Pinch.TStruct++  pinch (Span span_traceIdLow span_traceIdHigh span_spanId span_parentSpanId span_operationName span_references span_flags span_startTime span_duration span_tags span_logs) = Pinch.struct ([ (1 Pinch..= span_traceIdLow), (2 Pinch..= span_traceIdHigh), (3 Pinch..= span_spanId), (4 Pinch..= span_parentSpanId), (5 Pinch..= span_operationName), (6 Pinch.?= span_references), (7 Pinch..= span_flags), (8 Pinch..= span_startTime), (9 Pinch..= span_duration), (10 Pinch.?= span_tags), (11 Pinch.?= span_logs) ])++  unpinch value = (((((((((((Prelude.pure (Span) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..: 2)) Prelude.<*> (value Pinch..: 3)) Prelude.<*> (value Pinch..: 4)) Prelude.<*> (value Pinch..: 5)) Prelude.<*> (value Pinch..:? 6)) Prelude.<*> (value Pinch..: 7)) Prelude.<*> (value Pinch..: 8)) Prelude.<*> (value Pinch..: 9)) Prelude.<*> (value Pinch..:? 10)) Prelude.<*> (value Pinch..:? 11))+++instance Data.Hashable.Hashable Span where++data Process+  = Process { process_serviceName :: Data.Text.Text, process_tags :: (Prelude.Maybe (Data.Vector.Vector Tag)) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable Process where+  type (Tag Process) = Pinch.TStruct++  pinch (Process process_serviceName process_tags) = Pinch.struct ([ (1 Pinch..= process_serviceName), (2 Pinch.?= process_tags) ])++  unpinch value = ((Prelude.pure (Process) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..:? 2))+++instance Data.Hashable.Hashable Process where++data ClientStats+  = ClientStats { clientStats_fullQueueDroppedSpans :: Data.Int.Int64, clientStats_tooLargeDroppedSpans :: Data.Int.Int64, clientStats_failedToEmitSpans :: Data.Int.Int64 }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable ClientStats where+  type (Tag ClientStats) = Pinch.TStruct++  pinch (ClientStats clientStats_fullQueueDroppedSpans clientStats_tooLargeDroppedSpans clientStats_failedToEmitSpans) = Pinch.struct ([ (1 Pinch..= clientStats_fullQueueDroppedSpans), (2 Pinch..= clientStats_tooLargeDroppedSpans), (3 Pinch..= clientStats_failedToEmitSpans) ])++  unpinch value = (((Prelude.pure (ClientStats) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..: 2)) Prelude.<*> (value Pinch..: 3))+++instance Data.Hashable.Hashable ClientStats where++data Batch+  = Batch { batch_process :: Process, batch_spans :: (Data.Vector.Vector Span), batch_seqNo :: (Prelude.Maybe Data.Int.Int64), batch_stats :: (Prelude.Maybe ClientStats) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable Batch where+  type (Tag Batch) = Pinch.TStruct++  pinch (Batch batch_process batch_spans batch_seqNo batch_stats) = Pinch.struct ([ (1 Pinch..= batch_process), (2 Pinch..= batch_spans), (3 Pinch.?= batch_seqNo), (4 Pinch.?= batch_stats) ])++  unpinch value = ((((Prelude.pure (Batch) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..: 2)) Prelude.<*> (value Pinch..:? 3)) Prelude.<*> (value Pinch..:? 4))+++instance Data.Hashable.Hashable Batch where++data BatchSubmitResponse+  = BatchSubmitResponse { batchSubmitResponse_ok :: Prelude.Bool }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable BatchSubmitResponse where+  type (Tag BatchSubmitResponse) = Pinch.TStruct++  pinch (BatchSubmitResponse batchSubmitResponse_ok) = Pinch.struct ([ (1 Pinch..= batchSubmitResponse_ok) ])++  unpinch value = (Prelude.pure (BatchSubmitResponse) Prelude.<*> (value Pinch..: 1))+++instance Data.Hashable.Hashable BatchSubmitResponse where++data SubmitBatches_Args+  = SubmitBatches_Args { submitBatches_Args_batches :: (Data.Vector.Vector Batch) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable SubmitBatches_Args where+  type (Tag SubmitBatches_Args) = Pinch.TStruct++  pinch (SubmitBatches_Args submitBatches_Args_batches) = Pinch.struct ([ (1 Pinch..= submitBatches_Args_batches) ])++  unpinch value = (Prelude.pure (SubmitBatches_Args) Prelude.<*> (value Pinch..: 1))+++instance Pinch.Internal.RPC.ThriftResult SubmitBatches_Result where+  type (ResultType SubmitBatches_Result) = (Data.Vector.Vector BatchSubmitResponse)++  unwrap (SubmitBatches_Result_Success x) = Prelude.pure (x)++  wrap m = Control.Exception.catches ((SubmitBatches_Result_Success Prelude.<$> m)) ([  ])+++data SubmitBatches_Result+  = SubmitBatches_Result_Success (Data.Vector.Vector BatchSubmitResponse)+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable SubmitBatches_Result where+  type (Tag SubmitBatches_Result) = Pinch.TUnion++  pinch (SubmitBatches_Result_Success x) = Pinch.union (0) (x)++  unpinch v = (Control.Applicative.empty Control.Applicative.<|> (SubmitBatches_Result_Success Prelude.<$> (v Pinch..: 0)))

@@ -1,41 +0,0 @@-{-# 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 Jaeger_Consts 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---import Jaeger_Types

@@ -1,434 +0,0 @@-{-# 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 Jaeger_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 TagType = STRING|DOUBLE|BOOL|LONG|BINARY  deriving (P.Show, P.Eq, G.Generic, TY.Typeable, P.Ord, P.Bounded)-instance P.Enum TagType where-  fromEnum t = case t of-    STRING -> 0-    DOUBLE -> 1-    BOOL -> 2-    LONG -> 3-    BINARY -> 4-  toEnum t = case t of-    0 -> STRING-    1 -> DOUBLE-    2 -> BOOL-    3 -> LONG-    4 -> BINARY-    _ -> X.throw T.ThriftException-instance H.Hashable TagType where-  hashWithSalt salt = H.hashWithSalt salt P.. P.fromEnum-instance QC.Arbitrary TagType where-  arbitrary = QC.elements (P.enumFromTo P.minBound P.maxBound)-data SpanRefType = CHILD_OF|FOLLOWS_FROM  deriving (P.Show, P.Eq, G.Generic, TY.Typeable, P.Ord, P.Bounded)-instance P.Enum SpanRefType where-  fromEnum t = case t of-    CHILD_OF -> 0-    FOLLOWS_FROM -> 1-  toEnum t = case t of-    0 -> CHILD_OF-    1 -> FOLLOWS_FROM-    _ -> X.throw T.ThriftException-instance H.Hashable SpanRefType where-  hashWithSalt salt = H.hashWithSalt salt P.. P.fromEnum-instance QC.Arbitrary SpanRefType where-  arbitrary = QC.elements (P.enumFromTo P.minBound P.maxBound)-data Tag = Tag  { tag_key :: LT.Text-  , tag_vType :: TagType-  , tag_vStr :: P.Maybe LT.Text-  , tag_vDouble :: P.Maybe P.Double-  , tag_vBool :: P.Maybe P.Bool-  , tag_vLong :: P.Maybe I.Int64-  , tag_vBinary :: P.Maybe LBS.ByteString-  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable Tag where-  hashWithSalt salt record = salt   `H.hashWithSalt` tag_key record   `H.hashWithSalt` tag_vType record   `H.hashWithSalt` tag_vStr record   `H.hashWithSalt` tag_vDouble record   `H.hashWithSalt` tag_vBool record   `H.hashWithSalt` tag_vLong record   `H.hashWithSalt` tag_vBinary record  -instance QC.Arbitrary Tag where -  arbitrary = M.liftM Tag (QC.arbitrary)-          `M.ap`(QC.arbitrary)-          `M.ap`(M.liftM P.Just QC.arbitrary)-          `M.ap`(M.liftM P.Just QC.arbitrary)-          `M.ap`(M.liftM P.Just QC.arbitrary)-          `M.ap`(M.liftM P.Just QC.arbitrary)-          `M.ap`(M.liftM P.Just QC.arbitrary)-  shrink obj | obj == default_Tag = []-             | P.otherwise = M.catMaybes-    [ if obj == default_Tag{tag_key = tag_key obj} then P.Nothing else P.Just $ default_Tag{tag_key = tag_key obj}-    , if obj == default_Tag{tag_vType = tag_vType obj} then P.Nothing else P.Just $ default_Tag{tag_vType = tag_vType obj}-    , if obj == default_Tag{tag_vStr = tag_vStr obj} then P.Nothing else P.Just $ default_Tag{tag_vStr = tag_vStr obj}-    , if obj == default_Tag{tag_vDouble = tag_vDouble obj} then P.Nothing else P.Just $ default_Tag{tag_vDouble = tag_vDouble obj}-    , if obj == default_Tag{tag_vBool = tag_vBool obj} then P.Nothing else P.Just $ default_Tag{tag_vBool = tag_vBool obj}-    , if obj == default_Tag{tag_vLong = tag_vLong obj} then P.Nothing else P.Just $ default_Tag{tag_vLong = tag_vLong obj}-    , if obj == default_Tag{tag_vBinary = tag_vBinary obj} then P.Nothing else P.Just $ default_Tag{tag_vBinary = tag_vBinary obj}-    ]-from_Tag :: Tag -> T.ThriftVal-from_Tag record = T.TStruct $ Map.fromList $ M.catMaybes-  [ (\_v2 -> P.Just (1, ("key",T.TString $ E.encodeUtf8 _v2))) $ tag_key record-  , (\_v2 -> P.Just (2, ("vType",T.TI32 $ P.fromIntegral $ P.fromEnum _v2))) $ tag_vType record-  , (\_v2 -> (3, ("vStr",T.TString $ E.encodeUtf8 _v2))) <$> tag_vStr record-  , (\_v2 -> (4, ("vDouble",T.TDouble _v2))) <$> tag_vDouble record-  , (\_v2 -> (5, ("vBool",T.TBool _v2))) <$> tag_vBool record-  , (\_v2 -> (6, ("vLong",T.TI64 _v2))) <$> tag_vLong record-  , (\_v2 -> (7, ("vBinary",T.TBinary _v2))) <$> tag_vBinary record-  ]-write_Tag :: T.Protocol p => p -> Tag -> P.IO ()-write_Tag oprot record = T.writeVal oprot $ from_Tag record-encode_Tag :: T.StatelessProtocol p => p -> Tag -> LBS.ByteString-encode_Tag oprot record = T.serializeVal oprot $ from_Tag record-to_Tag :: T.ThriftVal -> Tag-to_Tag (T.TStruct fields) = Tag{-  tag_key = P.maybe (P.error "Missing required field: key") (\(_,_val4) -> (case _val4 of {T.TString _val5 -> E.decodeUtf8 _val5; _ -> P.error "wrong type"})) (Map.lookup (1) fields),-  tag_vType = P.maybe (P.error "Missing required field: vType") (\(_,_val4) -> (case _val4 of {T.TI32 _val6 -> P.toEnum $ P.fromIntegral _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields),-  tag_vStr = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TString _val7 -> E.decodeUtf8 _val7; _ -> P.error "wrong type"})) (Map.lookup (3) fields),-  tag_vDouble = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TDouble _val8 -> _val8; _ -> P.error "wrong type"})) (Map.lookup (4) fields),-  tag_vBool = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TBool _val9 -> _val9; _ -> P.error "wrong type"})) (Map.lookup (5) fields),-  tag_vLong = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TI64 _val10 -> _val10; _ -> P.error "wrong type"})) (Map.lookup (6) fields),-  tag_vBinary = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TBinary _val11 -> _val11; T.TString _val11 -> _val11; _ -> P.error "wrong type"})) (Map.lookup (7) fields)-  }-to_Tag _ = P.error "not a struct"-read_Tag :: T.Protocol p => p -> P.IO Tag-read_Tag iprot = to_Tag <$> T.readVal iprot (T.T_STRUCT typemap_Tag)-decode_Tag :: T.StatelessProtocol p => p -> LBS.ByteString -> Tag-decode_Tag iprot bs = to_Tag $ T.deserializeVal iprot (T.T_STRUCT typemap_Tag) bs-typemap_Tag :: T.TypeMap-typemap_Tag = Map.fromList [(1,("key",T.T_STRING)),(2,("vType",T.T_I32)),(3,("vStr",T.T_STRING)),(4,("vDouble",T.T_DOUBLE)),(5,("vBool",T.T_BOOL)),(6,("vLong",T.T_I64)),(7,("vBinary",T.T_BINARY))]-default_Tag :: Tag-default_Tag = Tag{-  tag_key = "",-  tag_vType = (P.toEnum 0),-  tag_vStr = P.Nothing,-  tag_vDouble = P.Nothing,-  tag_vBool = P.Nothing,-  tag_vLong = P.Nothing,-  tag_vBinary = P.Nothing}-data Log = Log  { log_timestamp :: I.Int64-  , log_fields :: (Vector.Vector Tag)-  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable Log where-  hashWithSalt salt record = salt   `H.hashWithSalt` log_timestamp record   `H.hashWithSalt` log_fields record  -instance QC.Arbitrary Log where -  arbitrary = M.liftM Log (QC.arbitrary)-          `M.ap`(QC.arbitrary)-  shrink obj | obj == default_Log = []-             | P.otherwise = M.catMaybes-    [ if obj == default_Log{log_timestamp = log_timestamp obj} then P.Nothing else P.Just $ default_Log{log_timestamp = log_timestamp obj}-    , if obj == default_Log{log_fields = log_fields obj} then P.Nothing else P.Just $ default_Log{log_fields = log_fields obj}-    ]-from_Log :: Log -> T.ThriftVal-from_Log record = T.TStruct $ Map.fromList $ M.catMaybes-  [ (\_v14 -> P.Just (1, ("timestamp",T.TI64 _v14))) $ log_timestamp record-  , (\_v14 -> P.Just (2, ("fields",T.TList (T.T_STRUCT typemap_Tag) $ P.map (\_v16 -> from_Tag _v16) $ Vector.toList _v14))) $ log_fields record-  ]-write_Log :: T.Protocol p => p -> Log -> P.IO ()-write_Log oprot record = T.writeVal oprot $ from_Log record-encode_Log :: T.StatelessProtocol p => p -> Log -> LBS.ByteString-encode_Log oprot record = T.serializeVal oprot $ from_Log record-to_Log :: T.ThriftVal -> Log-to_Log (T.TStruct fields) = Log{-  log_timestamp = P.maybe (P.error "Missing required field: timestamp") (\(_,_val18) -> (case _val18 of {T.TI64 _val19 -> _val19; _ -> P.error "wrong type"})) (Map.lookup (1) fields),-  log_fields = P.maybe (P.error "Missing required field: fields") (\(_,_val18) -> (case _val18 of {T.TList _ _val20 -> (Vector.fromList $ P.map (\_v21 -> (case _v21 of {T.TStruct _val22 -> (to_Tag (T.TStruct _val22)); _ -> P.error "wrong type"})) _val20); _ -> P.error "wrong type"})) (Map.lookup (2) fields)-  }-to_Log _ = P.error "not a struct"-read_Log :: T.Protocol p => p -> P.IO Log-read_Log iprot = to_Log <$> T.readVal iprot (T.T_STRUCT typemap_Log)-decode_Log :: T.StatelessProtocol p => p -> LBS.ByteString -> Log-decode_Log iprot bs = to_Log $ T.deserializeVal iprot (T.T_STRUCT typemap_Log) bs-typemap_Log :: T.TypeMap-typemap_Log = Map.fromList [(1,("timestamp",T.T_I64)),(2,("fields",(T.T_LIST (T.T_STRUCT typemap_Tag))))]-default_Log :: Log-default_Log = Log{-  log_timestamp = 0,-  log_fields = Vector.empty}-data SpanRef = SpanRef  { spanRef_refType :: SpanRefType-  , spanRef_traceIdLow :: I.Int64-  , spanRef_traceIdHigh :: I.Int64-  , spanRef_spanId :: I.Int64-  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable SpanRef where-  hashWithSalt salt record = salt   `H.hashWithSalt` spanRef_refType record   `H.hashWithSalt` spanRef_traceIdLow record   `H.hashWithSalt` spanRef_traceIdHigh record   `H.hashWithSalt` spanRef_spanId record  -instance QC.Arbitrary SpanRef where -  arbitrary = M.liftM SpanRef (QC.arbitrary)-          `M.ap`(QC.arbitrary)-          `M.ap`(QC.arbitrary)-          `M.ap`(QC.arbitrary)-  shrink obj | obj == default_SpanRef = []-             | P.otherwise = M.catMaybes-    [ if obj == default_SpanRef{spanRef_refType = spanRef_refType obj} then P.Nothing else P.Just $ default_SpanRef{spanRef_refType = spanRef_refType obj}-    , if obj == default_SpanRef{spanRef_traceIdLow = spanRef_traceIdLow obj} then P.Nothing else P.Just $ default_SpanRef{spanRef_traceIdLow = spanRef_traceIdLow obj}-    , if obj == default_SpanRef{spanRef_traceIdHigh = spanRef_traceIdHigh obj} then P.Nothing else P.Just $ default_SpanRef{spanRef_traceIdHigh = spanRef_traceIdHigh obj}-    , if obj == default_SpanRef{spanRef_spanId = spanRef_spanId obj} then P.Nothing else P.Just $ default_SpanRef{spanRef_spanId = spanRef_spanId obj}-    ]-from_SpanRef :: SpanRef -> T.ThriftVal-from_SpanRef record = T.TStruct $ Map.fromList $ M.catMaybes-  [ (\_v25 -> P.Just (1, ("refType",T.TI32 $ P.fromIntegral $ P.fromEnum _v25))) $ spanRef_refType record-  , (\_v25 -> P.Just (2, ("traceIdLow",T.TI64 _v25))) $ spanRef_traceIdLow record-  , (\_v25 -> P.Just (3, ("traceIdHigh",T.TI64 _v25))) $ spanRef_traceIdHigh record-  , (\_v25 -> P.Just (4, ("spanId",T.TI64 _v25))) $ spanRef_spanId record-  ]-write_SpanRef :: T.Protocol p => p -> SpanRef -> P.IO ()-write_SpanRef oprot record = T.writeVal oprot $ from_SpanRef record-encode_SpanRef :: T.StatelessProtocol p => p -> SpanRef -> LBS.ByteString-encode_SpanRef oprot record = T.serializeVal oprot $ from_SpanRef record-to_SpanRef :: T.ThriftVal -> SpanRef-to_SpanRef (T.TStruct fields) = SpanRef{-  spanRef_refType = P.maybe (P.error "Missing required field: refType") (\(_,_val27) -> (case _val27 of {T.TI32 _val28 -> P.toEnum $ P.fromIntegral _val28; _ -> P.error "wrong type"})) (Map.lookup (1) fields),-  spanRef_traceIdLow = P.maybe (P.error "Missing required field: traceIdLow") (\(_,_val27) -> (case _val27 of {T.TI64 _val29 -> _val29; _ -> P.error "wrong type"})) (Map.lookup (2) fields),-  spanRef_traceIdHigh = P.maybe (P.error "Missing required field: traceIdHigh") (\(_,_val27) -> (case _val27 of {T.TI64 _val30 -> _val30; _ -> P.error "wrong type"})) (Map.lookup (3) fields),-  spanRef_spanId = P.maybe (P.error "Missing required field: spanId") (\(_,_val27) -> (case _val27 of {T.TI64 _val31 -> _val31; _ -> P.error "wrong type"})) (Map.lookup (4) fields)-  }-to_SpanRef _ = P.error "not a struct"-read_SpanRef :: T.Protocol p => p -> P.IO SpanRef-read_SpanRef iprot = to_SpanRef <$> T.readVal iprot (T.T_STRUCT typemap_SpanRef)-decode_SpanRef :: T.StatelessProtocol p => p -> LBS.ByteString -> SpanRef-decode_SpanRef iprot bs = to_SpanRef $ T.deserializeVal iprot (T.T_STRUCT typemap_SpanRef) bs-typemap_SpanRef :: T.TypeMap-typemap_SpanRef = Map.fromList [(1,("refType",T.T_I32)),(2,("traceIdLow",T.T_I64)),(3,("traceIdHigh",T.T_I64)),(4,("spanId",T.T_I64))]-default_SpanRef :: SpanRef-default_SpanRef = SpanRef{-  spanRef_refType = (P.toEnum 0),-  spanRef_traceIdLow = 0,-  spanRef_traceIdHigh = 0,-  spanRef_spanId = 0}-data Span = Span  { span_traceIdLow :: I.Int64-  , span_traceIdHigh :: I.Int64-  , span_spanId :: I.Int64-  , span_parentSpanId :: I.Int64-  , span_operationName :: LT.Text-  , span_references :: P.Maybe (Vector.Vector SpanRef)-  , span_flags :: I.Int32-  , span_startTime :: I.Int64-  , span_duration :: I.Int64-  , span_tags :: P.Maybe (Vector.Vector Tag)-  , span_logs :: P.Maybe (Vector.Vector Log)-  , span_incomplete :: P.Maybe P.Bool-  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable Span where-  hashWithSalt salt record = salt   `H.hashWithSalt` span_traceIdLow record   `H.hashWithSalt` span_traceIdHigh record   `H.hashWithSalt` span_spanId record   `H.hashWithSalt` span_parentSpanId record   `H.hashWithSalt` span_operationName record   `H.hashWithSalt` span_references record   `H.hashWithSalt` span_flags record   `H.hashWithSalt` span_startTime record   `H.hashWithSalt` span_duration record   `H.hashWithSalt` span_tags record   `H.hashWithSalt` span_logs record   `H.hashWithSalt` span_incomplete record  -instance QC.Arbitrary Span where -  arbitrary = M.liftM Span (QC.arbitrary)-          `M.ap`(QC.arbitrary)-          `M.ap`(QC.arbitrary)-          `M.ap`(QC.arbitrary)-          `M.ap`(QC.arbitrary)-          `M.ap`(M.liftM P.Just QC.arbitrary)-          `M.ap`(QC.arbitrary)-          `M.ap`(QC.arbitrary)-          `M.ap`(QC.arbitrary)-          `M.ap`(M.liftM P.Just QC.arbitrary)-          `M.ap`(M.liftM P.Just QC.arbitrary)-          `M.ap`(M.liftM P.Just QC.arbitrary)-  shrink obj | obj == default_Span = []-             | P.otherwise = M.catMaybes-    [ if obj == default_Span{span_traceIdLow = span_traceIdLow obj} then P.Nothing else P.Just $ default_Span{span_traceIdLow = span_traceIdLow obj}-    , if obj == default_Span{span_traceIdHigh = span_traceIdHigh obj} then P.Nothing else P.Just $ default_Span{span_traceIdHigh = span_traceIdHigh obj}-    , if obj == default_Span{span_spanId = span_spanId obj} then P.Nothing else P.Just $ default_Span{span_spanId = span_spanId obj}-    , if obj == default_Span{span_parentSpanId = span_parentSpanId obj} then P.Nothing else P.Just $ default_Span{span_parentSpanId = span_parentSpanId obj}-    , if obj == default_Span{span_operationName = span_operationName obj} then P.Nothing else P.Just $ default_Span{span_operationName = span_operationName obj}-    , if obj == default_Span{span_references = span_references obj} then P.Nothing else P.Just $ default_Span{span_references = span_references obj}-    , if obj == default_Span{span_flags = span_flags obj} then P.Nothing else P.Just $ default_Span{span_flags = span_flags obj}-    , if obj == default_Span{span_startTime = span_startTime obj} then P.Nothing else P.Just $ default_Span{span_startTime = span_startTime obj}-    , if obj == default_Span{span_duration = span_duration obj} then P.Nothing else P.Just $ default_Span{span_duration = span_duration obj}-    , if obj == default_Span{span_tags = span_tags obj} then P.Nothing else P.Just $ default_Span{span_tags = span_tags obj}-    , if obj == default_Span{span_logs = span_logs obj} then P.Nothing else P.Just $ default_Span{span_logs = span_logs obj}-    , if obj == default_Span{span_incomplete = span_incomplete obj} then P.Nothing else P.Just $ default_Span{span_incomplete = span_incomplete obj}-    ]-from_Span :: Span -> T.ThriftVal-from_Span record = T.TStruct $ Map.fromList $ M.catMaybes-  [ (\_v34 -> P.Just (1, ("traceIdLow",T.TI64 _v34))) $ span_traceIdLow record-  , (\_v34 -> P.Just (2, ("traceIdHigh",T.TI64 _v34))) $ span_traceIdHigh record-  , (\_v34 -> P.Just (3, ("spanId",T.TI64 _v34))) $ span_spanId record-  , (\_v34 -> P.Just (4, ("parentSpanId",T.TI64 _v34))) $ span_parentSpanId record-  , (\_v34 -> P.Just (5, ("operationName",T.TString $ E.encodeUtf8 _v34))) $ span_operationName record-  , (\_v34 -> (6, ("references",T.TList (T.T_STRUCT typemap_SpanRef) $ P.map (\_v36 -> from_SpanRef _v36) $ Vector.toList _v34))) <$> span_references record-  , (\_v34 -> P.Just (7, ("flags",T.TI32 _v34))) $ span_flags record-  , (\_v34 -> P.Just (8, ("startTime",T.TI64 _v34))) $ span_startTime record-  , (\_v34 -> P.Just (9, ("duration",T.TI64 _v34))) $ span_duration record-  , (\_v34 -> (10, ("tags",T.TList (T.T_STRUCT typemap_Tag) $ P.map (\_v38 -> from_Tag _v38) $ Vector.toList _v34))) <$> span_tags record-  , (\_v34 -> (11, ("logs",T.TList (T.T_STRUCT typemap_Log) $ P.map (\_v40 -> from_Log _v40) $ Vector.toList _v34))) <$> span_logs record-  , (\_v34 -> (12, ("incomplete",T.TBool _v34))) <$> span_incomplete record-  ]-write_Span :: T.Protocol p => p -> Span -> P.IO ()-write_Span oprot record = T.writeVal oprot $ from_Span record-encode_Span :: T.StatelessProtocol p => p -> Span -> LBS.ByteString-encode_Span oprot record = T.serializeVal oprot $ from_Span record-to_Span :: T.ThriftVal -> Span-to_Span (T.TStruct fields) = Span{-  span_traceIdLow = P.maybe (P.error "Missing required field: traceIdLow") (\(_,_val42) -> (case _val42 of {T.TI64 _val43 -> _val43; _ -> P.error "wrong type"})) (Map.lookup (1) fields),-  span_traceIdHigh = P.maybe (P.error "Missing required field: traceIdHigh") (\(_,_val42) -> (case _val42 of {T.TI64 _val44 -> _val44; _ -> P.error "wrong type"})) (Map.lookup (2) fields),-  span_spanId = P.maybe (P.error "Missing required field: spanId") (\(_,_val42) -> (case _val42 of {T.TI64 _val45 -> _val45; _ -> P.error "wrong type"})) (Map.lookup (3) fields),-  span_parentSpanId = P.maybe (P.error "Missing required field: parentSpanId") (\(_,_val42) -> (case _val42 of {T.TI64 _val46 -> _val46; _ -> P.error "wrong type"})) (Map.lookup (4) fields),-  span_operationName = P.maybe (P.error "Missing required field: operationName") (\(_,_val42) -> (case _val42 of {T.TString _val47 -> E.decodeUtf8 _val47; _ -> P.error "wrong type"})) (Map.lookup (5) fields),-  span_references = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TList _ _val48 -> (Vector.fromList $ P.map (\_v49 -> (case _v49 of {T.TStruct _val50 -> (to_SpanRef (T.TStruct _val50)); _ -> P.error "wrong type"})) _val48); _ -> P.error "wrong type"})) (Map.lookup (6) fields),-  span_flags = P.maybe (P.error "Missing required field: flags") (\(_,_val42) -> (case _val42 of {T.TI32 _val51 -> _val51; _ -> P.error "wrong type"})) (Map.lookup (7) fields),-  span_startTime = P.maybe (P.error "Missing required field: startTime") (\(_,_val42) -> (case _val42 of {T.TI64 _val52 -> _val52; _ -> P.error "wrong type"})) (Map.lookup (8) fields),-  span_duration = P.maybe (P.error "Missing required field: duration") (\(_,_val42) -> (case _val42 of {T.TI64 _val53 -> _val53; _ -> P.error "wrong type"})) (Map.lookup (9) fields),-  span_tags = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TList _ _val54 -> (Vector.fromList $ P.map (\_v55 -> (case _v55 of {T.TStruct _val56 -> (to_Tag (T.TStruct _val56)); _ -> P.error "wrong type"})) _val54); _ -> P.error "wrong type"})) (Map.lookup (10) fields),-  span_logs = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TList _ _val57 -> (Vector.fromList $ P.map (\_v58 -> (case _v58 of {T.TStruct _val59 -> (to_Log (T.TStruct _val59)); _ -> P.error "wrong type"})) _val57); _ -> P.error "wrong type"})) (Map.lookup (11) fields),-  span_incomplete = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TBool _val60 -> _val60; _ -> P.error "wrong type"})) (Map.lookup (12) fields)-  }-to_Span _ = P.error "not a struct"-read_Span :: T.Protocol p => p -> P.IO Span-read_Span iprot = to_Span <$> T.readVal iprot (T.T_STRUCT typemap_Span)-decode_Span :: T.StatelessProtocol p => p -> LBS.ByteString -> Span-decode_Span iprot bs = to_Span $ T.deserializeVal iprot (T.T_STRUCT typemap_Span) bs-typemap_Span :: T.TypeMap-typemap_Span = Map.fromList [(1,("traceIdLow",T.T_I64)),(2,("traceIdHigh",T.T_I64)),(3,("spanId",T.T_I64)),(4,("parentSpanId",T.T_I64)),(5,("operationName",T.T_STRING)),(6,("references",(T.T_LIST (T.T_STRUCT typemap_SpanRef)))),(7,("flags",T.T_I32)),(8,("startTime",T.T_I64)),(9,("duration",T.T_I64)),(10,("tags",(T.T_LIST (T.T_STRUCT typemap_Tag)))),(11,("logs",(T.T_LIST (T.T_STRUCT typemap_Log)))),(12,("incomplete",T.T_BOOL))]-default_Span :: Span-default_Span = Span{-  span_traceIdLow = 0,-  span_traceIdHigh = 0,-  span_spanId = 0,-  span_parentSpanId = 0,-  span_operationName = "",-  span_references = P.Nothing,-  span_flags = 0,-  span_startTime = 0,-  span_duration = 0,-  span_tags = P.Nothing,-  span_logs = P.Nothing,-  span_incomplete = P.Nothing}-data Process = Process  { process_serviceName :: LT.Text-  , process_tags :: P.Maybe (Vector.Vector Tag)-  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable Process where-  hashWithSalt salt record = salt   `H.hashWithSalt` process_serviceName record   `H.hashWithSalt` process_tags record  -instance QC.Arbitrary Process where -  arbitrary = M.liftM Process (QC.arbitrary)-          `M.ap`(M.liftM P.Just QC.arbitrary)-  shrink obj | obj == default_Process = []-             | P.otherwise = M.catMaybes-    [ if obj == default_Process{process_serviceName = process_serviceName obj} then P.Nothing else P.Just $ default_Process{process_serviceName = process_serviceName obj}-    , if obj == default_Process{process_tags = process_tags obj} then P.Nothing else P.Just $ default_Process{process_tags = process_tags obj}-    ]-from_Process :: Process -> T.ThriftVal-from_Process record = T.TStruct $ Map.fromList $ M.catMaybes-  [ (\_v63 -> P.Just (1, ("serviceName",T.TString $ E.encodeUtf8 _v63))) $ process_serviceName record-  , (\_v63 -> (2, ("tags",T.TList (T.T_STRUCT typemap_Tag) $ P.map (\_v65 -> from_Tag _v65) $ Vector.toList _v63))) <$> process_tags record-  ]-write_Process :: T.Protocol p => p -> Process -> P.IO ()-write_Process oprot record = T.writeVal oprot $ from_Process record-encode_Process :: T.StatelessProtocol p => p -> Process -> LBS.ByteString-encode_Process oprot record = T.serializeVal oprot $ from_Process record-to_Process :: T.ThriftVal -> Process-to_Process (T.TStruct fields) = Process{-  process_serviceName = P.maybe (P.error "Missing required field: serviceName") (\(_,_val67) -> (case _val67 of {T.TString _val68 -> E.decodeUtf8 _val68; _ -> P.error "wrong type"})) (Map.lookup (1) fields),-  process_tags = P.maybe (P.Nothing) (\(_,_val67) -> P.Just (case _val67 of {T.TList _ _val69 -> (Vector.fromList $ P.map (\_v70 -> (case _v70 of {T.TStruct _val71 -> (to_Tag (T.TStruct _val71)); _ -> P.error "wrong type"})) _val69); _ -> P.error "wrong type"})) (Map.lookup (2) fields)-  }-to_Process _ = P.error "not a struct"-read_Process :: T.Protocol p => p -> P.IO Process-read_Process iprot = to_Process <$> T.readVal iprot (T.T_STRUCT typemap_Process)-decode_Process :: T.StatelessProtocol p => p -> LBS.ByteString -> Process-decode_Process iprot bs = to_Process $ T.deserializeVal iprot (T.T_STRUCT typemap_Process) bs-typemap_Process :: T.TypeMap-typemap_Process = Map.fromList [(1,("serviceName",T.T_STRING)),(2,("tags",(T.T_LIST (T.T_STRUCT typemap_Tag))))]-default_Process :: Process-default_Process = Process{-  process_serviceName = "",-  process_tags = P.Nothing}-data Batch = Batch  { batch_process :: Process-  , batch_spans :: (Vector.Vector Span)-  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable Batch where-  hashWithSalt salt record = salt   `H.hashWithSalt` batch_process record   `H.hashWithSalt` batch_spans record  -instance QC.Arbitrary Batch where -  arbitrary = M.liftM Batch (QC.arbitrary)-          `M.ap`(QC.arbitrary)-  shrink obj | obj == default_Batch = []-             | P.otherwise = M.catMaybes-    [ if obj == default_Batch{batch_process = batch_process obj} then P.Nothing else P.Just $ default_Batch{batch_process = batch_process obj}-    , if obj == default_Batch{batch_spans = batch_spans obj} then P.Nothing else P.Just $ default_Batch{batch_spans = batch_spans obj}-    ]-from_Batch :: Batch -> T.ThriftVal-from_Batch record = T.TStruct $ Map.fromList $ M.catMaybes-  [ (\_v74 -> P.Just (1, ("process",from_Process _v74))) $ batch_process record-  , (\_v74 -> P.Just (2, ("spans",T.TList (T.T_STRUCT typemap_Span) $ P.map (\_v76 -> from_Span _v76) $ Vector.toList _v74))) $ batch_spans record-  ]-write_Batch :: T.Protocol p => p -> Batch -> P.IO ()-write_Batch oprot record = T.writeVal oprot $ from_Batch record-encode_Batch :: T.StatelessProtocol p => p -> Batch -> LBS.ByteString-encode_Batch oprot record = T.serializeVal oprot $ from_Batch record-to_Batch :: T.ThriftVal -> Batch-to_Batch (T.TStruct fields) = Batch{-  batch_process = P.maybe (P.error "Missing required field: process") (\(_,_val78) -> (case _val78 of {T.TStruct _val79 -> (to_Process (T.TStruct _val79)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),-  batch_spans = P.maybe (P.error "Missing required field: spans") (\(_,_val78) -> (case _val78 of {T.TList _ _val80 -> (Vector.fromList $ P.map (\_v81 -> (case _v81 of {T.TStruct _val82 -> (to_Span (T.TStruct _val82)); _ -> P.error "wrong type"})) _val80); _ -> P.error "wrong type"})) (Map.lookup (2) fields)-  }-to_Batch _ = P.error "not a struct"-read_Batch :: T.Protocol p => p -> P.IO Batch-read_Batch iprot = to_Batch <$> T.readVal iprot (T.T_STRUCT typemap_Batch)-decode_Batch :: T.StatelessProtocol p => p -> LBS.ByteString -> Batch-decode_Batch iprot bs = to_Batch $ T.deserializeVal iprot (T.T_STRUCT typemap_Batch) bs-typemap_Batch :: T.TypeMap-typemap_Batch = Map.fromList [(1,("process",(T.T_STRUCT typemap_Process))),(2,("spans",(T.T_LIST (T.T_STRUCT typemap_Span))))]-default_Batch :: Batch-default_Batch = Batch{-  batch_process = default_Process,-  batch_spans = Vector.empty}-data BatchSubmitResponse = BatchSubmitResponse  { batchSubmitResponse_ok :: P.Bool-  } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)-instance H.Hashable BatchSubmitResponse where-  hashWithSalt salt record = salt   `H.hashWithSalt` batchSubmitResponse_ok record  -instance QC.Arbitrary BatchSubmitResponse where -  arbitrary = M.liftM BatchSubmitResponse (QC.arbitrary)-  shrink obj | obj == default_BatchSubmitResponse = []-             | P.otherwise = M.catMaybes-    [ if obj == default_BatchSubmitResponse{batchSubmitResponse_ok = batchSubmitResponse_ok obj} then P.Nothing else P.Just $ default_BatchSubmitResponse{batchSubmitResponse_ok = batchSubmitResponse_ok obj}-    ]-from_BatchSubmitResponse :: BatchSubmitResponse -> T.ThriftVal-from_BatchSubmitResponse record = T.TStruct $ Map.fromList $ M.catMaybes-  [ (\_v85 -> P.Just (1, ("ok",T.TBool _v85))) $ batchSubmitResponse_ok record-  ]-write_BatchSubmitResponse :: T.Protocol p => p -> BatchSubmitResponse -> P.IO ()-write_BatchSubmitResponse oprot record = T.writeVal oprot $ from_BatchSubmitResponse record-encode_BatchSubmitResponse :: T.StatelessProtocol p => p -> BatchSubmitResponse -> LBS.ByteString-encode_BatchSubmitResponse oprot record = T.serializeVal oprot $ from_BatchSubmitResponse record-to_BatchSubmitResponse :: T.ThriftVal -> BatchSubmitResponse-to_BatchSubmitResponse (T.TStruct fields) = BatchSubmitResponse{-  batchSubmitResponse_ok = P.maybe (P.error "Missing required field: ok") (\(_,_val87) -> (case _val87 of {T.TBool _val88 -> _val88; _ -> P.error "wrong type"})) (Map.lookup (1) fields)-  }-to_BatchSubmitResponse _ = P.error "not a struct"-read_BatchSubmitResponse :: T.Protocol p => p -> P.IO BatchSubmitResponse-read_BatchSubmitResponse iprot = to_BatchSubmitResponse <$> T.readVal iprot (T.T_STRUCT typemap_BatchSubmitResponse)-decode_BatchSubmitResponse :: T.StatelessProtocol p => p -> LBS.ByteString -> BatchSubmitResponse-decode_BatchSubmitResponse iprot bs = to_BatchSubmitResponse $ T.deserializeVal iprot (T.T_STRUCT typemap_BatchSubmitResponse) bs-typemap_BatchSubmitResponse :: T.TypeMap-typemap_BatchSubmitResponse = Map.fromList [(1,("ok",T.T_BOOL))]-default_BatchSubmitResponse :: BatchSubmitResponse-default_BatchSubmitResponse = BatchSubmitResponse{-  batchSubmitResponse_ok = P.False}

@@ -0,0 +1,30 @@+{-# LANGUAGE TypeFamilies, DeriveGeneric, TypeApplications, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-name-shadowing -fno-warn-unused-matches #-}++module Zipkincore.Server where++import  Zipkincore.Types+import qualified Pinch.Server+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 ZipkinCollector+  = ZipkinCollector { submitZipkinBatch :: (Pinch.Server.Context) -> ((Data.Vector.Vector Span)) -> (Prelude.IO (Data.Vector.Vector Response)) }+++zipkinCollector_mkServer :: (ZipkinCollector) -> Pinch.Server.ThriftServer+zipkinCollector_mkServer server = let functions =   Data.HashMap.Strict.fromList ([ ( "submitZipkinBatch"+                                                      , Pinch.Server.CallHandler ((\ctx (SubmitZipkinBatch_Args a) -> Pinch.Internal.RPC.wrap @(SubmitZipkinBatch_Result) (submitZipkinBatch (server) (ctx) (a)))) ) ]) in Pinch.Server.createServer ((\nm -> Data.HashMap.Strict.lookup (nm) (functions)))

@@ -0,0 +1,176 @@+{-# LANGUAGE TypeFamilies, DeriveGeneric, TypeApplications, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-name-shadowing -fno-warn-unused-matches #-}++module Zipkincore.Types where++import qualified Prelude+import qualified Control.Applicative+import qualified Control.Exception+import qualified Pinch+import qualified Pinch.Server+import qualified Pinch.Internal.RPC+import qualified Data.Text+import qualified Data.ByteString+import qualified Data.Int+import qualified Data.Vector+import qualified Data.HashMap.Strict+import qualified Data.HashSet+import qualified GHC.Generics+import qualified Data.Hashable+import  Data.Vector.Instances ()++data Endpoint+  = Endpoint { endpoint_ipv4 :: Data.Int.Int32, endpoint_port :: Data.Int.Int16, endpoint_service_name :: Data.Text.Text, endpoint_ipv6 :: (Prelude.Maybe Data.ByteString.ByteString) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable Endpoint where+  type (Tag Endpoint) = Pinch.TStruct++  pinch (Endpoint endpoint_ipv4 endpoint_port endpoint_service_name endpoint_ipv6) = Pinch.struct ([ (1 Pinch..= endpoint_ipv4), (2 Pinch..= endpoint_port), (3 Pinch..= endpoint_service_name), (4 Pinch.?= endpoint_ipv6) ])++  unpinch value = ((((Prelude.pure (Endpoint) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..: 2)) Prelude.<*> (value Pinch..: 3)) Prelude.<*> (value Pinch..:? 4))+++instance Data.Hashable.Hashable Endpoint where++data Annotation+  = Annotation { annotation_timestamp :: Data.Int.Int64, annotation_value :: Data.Text.Text, annotation_host :: (Prelude.Maybe Endpoint) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable Annotation where+  type (Tag Annotation) = Pinch.TStruct++  pinch (Annotation annotation_timestamp annotation_value annotation_host) = Pinch.struct ([ (1 Pinch..= annotation_timestamp), (2 Pinch..= annotation_value), (3 Pinch.?= annotation_host) ])++  unpinch value = (((Prelude.pure (Annotation) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..: 2)) Prelude.<*> (value Pinch..:? 3))+++instance Data.Hashable.Hashable Annotation where++data AnnotationType+  = BOOL+  | BYTES+  | I16+  | I32+  | I64+  | DOUBLE+  | STRING+  deriving (Prelude.Eq, Prelude.Ord, GHC.Generics.Generic, Prelude.Show, Prelude.Bounded)++instance Pinch.Pinchable AnnotationType where+  type (Tag AnnotationType) = Pinch.TEnum++  pinch BOOL = Pinch.pinch ((0 :: Data.Int.Int32))+  pinch BYTES = Pinch.pinch ((1 :: Data.Int.Int32))+  pinch I16 = Pinch.pinch ((2 :: Data.Int.Int32))+  pinch I32 = Pinch.pinch ((3 :: Data.Int.Int32))+  pinch I64 = Pinch.pinch ((4 :: Data.Int.Int32))+  pinch DOUBLE = Pinch.pinch ((5 :: Data.Int.Int32))+  pinch STRING = Pinch.pinch ((6 :: Data.Int.Int32))++  unpinch v = do+    val <- Pinch.unpinch (v)+    case (val :: Data.Int.Int32) of+      0 -> Prelude.pure (BOOL)+      1 -> Prelude.pure (BYTES)+      2 -> Prelude.pure (I16)+      3 -> Prelude.pure (I32)+      4 -> Prelude.pure (I64)+      5 -> Prelude.pure (DOUBLE)+      6 -> Prelude.pure (STRING)+      _ -> Prelude.fail (("Unknown value for type AnnotationType: " Prelude.<> Prelude.show (val)))+++instance Prelude.Enum AnnotationType where+  fromEnum BOOL = 0+  fromEnum BYTES = 1+  fromEnum I16 = 2+  fromEnum I32 = 3+  fromEnum I64 = 4+  fromEnum DOUBLE = 5+  fromEnum STRING = 6++  toEnum 0 = BOOL+  toEnum 1 = BYTES+  toEnum 2 = I16+  toEnum 3 = I32+  toEnum 4 = I64+  toEnum 5 = DOUBLE+  toEnum 6 = STRING+  toEnum _ = Prelude.error ("Unknown value for enum AnnotationType.")+++instance Data.Hashable.Hashable AnnotationType where++data BinaryAnnotation+  = BinaryAnnotation { binaryAnnotation_key :: Data.Text.Text, binaryAnnotation_value :: Data.ByteString.ByteString, binaryAnnotation_annotation_type :: AnnotationType, binaryAnnotation_host :: (Prelude.Maybe Endpoint) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable BinaryAnnotation where+  type (Tag BinaryAnnotation) = Pinch.TStruct++  pinch (BinaryAnnotation binaryAnnotation_key binaryAnnotation_value binaryAnnotation_annotation_type binaryAnnotation_host) = Pinch.struct ([ (1 Pinch..= binaryAnnotation_key), (2 Pinch..= binaryAnnotation_value), (3 Pinch..= binaryAnnotation_annotation_type), (4 Pinch.?= binaryAnnotation_host) ])++  unpinch value = ((((Prelude.pure (BinaryAnnotation) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..: 2)) Prelude.<*> (value Pinch..: 3)) Prelude.<*> (value Pinch..:? 4))+++instance Data.Hashable.Hashable BinaryAnnotation where++data Span+  = Span { span_trace_id :: Data.Int.Int64, span_name :: Data.Text.Text, span_id :: Data.Int.Int64, span_parent_id :: (Prelude.Maybe Data.Int.Int64), span_annotations :: (Data.Vector.Vector Annotation), span_binary_annotations :: (Data.Vector.Vector BinaryAnnotation), span_debug :: (Prelude.Maybe Prelude.Bool), span_timestamp :: (Prelude.Maybe Data.Int.Int64), span_duration :: (Prelude.Maybe Data.Int.Int64), span_trace_id_high :: (Prelude.Maybe Data.Int.Int64) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable Span where+  type (Tag Span) = Pinch.TStruct++  pinch (Span span_trace_id span_name span_id span_parent_id span_annotations span_binary_annotations span_debug span_timestamp span_duration span_trace_id_high) = Pinch.struct ([ (1 Pinch..= span_trace_id), (3 Pinch..= span_name), (4 Pinch..= span_id), (5 Pinch.?= span_parent_id), (6 Pinch..= span_annotations), (8 Pinch..= span_binary_annotations), (9 Pinch.?= span_debug), (10 Pinch.?= span_timestamp), (11 Pinch.?= span_duration), (12 Pinch.?= span_trace_id_high) ])++  unpinch value = ((((((((((Prelude.pure (Span) Prelude.<*> (value Pinch..: 1)) Prelude.<*> (value Pinch..: 3)) Prelude.<*> (value Pinch..: 4)) Prelude.<*> (value Pinch..:? 5)) Prelude.<*> (value Pinch..: 6)) Prelude.<*> (value Pinch..: 8)) Prelude.<*> (value Pinch..:? 9)) Prelude.<*> (value Pinch..:? 10)) Prelude.<*> (value Pinch..:? 11)) Prelude.<*> (value Pinch..:? 12))+++instance Data.Hashable.Hashable Span where++data Response+  = Response { response_ok :: Prelude.Bool }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable Response where+  type (Tag Response) = Pinch.TStruct++  pinch (Response response_ok) = Pinch.struct ([ (1 Pinch..= response_ok) ])++  unpinch value = (Prelude.pure (Response) Prelude.<*> (value Pinch..: 1))+++instance Data.Hashable.Hashable Response where++data SubmitZipkinBatch_Args+  = SubmitZipkinBatch_Args { submitZipkinBatch_Args_spans :: (Data.Vector.Vector Span) }+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable SubmitZipkinBatch_Args where+  type (Tag SubmitZipkinBatch_Args) = Pinch.TStruct++  pinch (SubmitZipkinBatch_Args submitZipkinBatch_Args_spans) = Pinch.struct ([ (1 Pinch..= submitZipkinBatch_Args_spans) ])++  unpinch value = (Prelude.pure (SubmitZipkinBatch_Args) Prelude.<*> (value Pinch..: 1))+++instance Pinch.Internal.RPC.ThriftResult SubmitZipkinBatch_Result where+  type (ResultType SubmitZipkinBatch_Result) = (Data.Vector.Vector Response)++  unwrap (SubmitZipkinBatch_Result_Success x) = Prelude.pure (x)++  wrap m = Control.Exception.catches ((SubmitZipkinBatch_Result_Success Prelude.<$> m)) ([  ])+++data SubmitZipkinBatch_Result+  = SubmitZipkinBatch_Result_Success (Data.Vector.Vector Response)+  deriving (Prelude.Eq, GHC.Generics.Generic, Prelude.Show)++instance Pinch.Pinchable SubmitZipkinBatch_Result where+  type (Tag SubmitZipkinBatch_Result) = Pinch.TUnion++  pinch (SubmitZipkinBatch_Result_Success x) = Pinch.union (0) (x)++  unpinch v = (Control.Applicative.empty Control.Applicative.<|> (SubmitZipkinBatch_Result_Success Prelude.<$> (v Pinch..: 0)))

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

@@ -1,7 +1,7 @@ cabal-version: 2.2  name:           opentracing-jaeger-version:        0.1.0.0+version:        0.2.0 synopsis:       Jaeger backend for OpenTracing homepage:       https://github.com/kim/opentracing bug-reports:    https://github.com/kim/opentracing/issues@@ -27,13 +27,14 @@       OpenTracing.Jaeger.Propagation       OpenTracing.Jaeger.Thrift   other-modules:-      Jaeger_Consts-      Jaeger_Types-      Agent-      Agent_Client-      Agent_Types-      Agent_Iface-      Zipkincore_Types+      Agent.Client+      Agent.Server+      Agent.Types+      Jaeger.Client+      Jaeger.Server+      Jaeger.Types+      Zipkincore.Types+      Zipkincore.Server   hs-source-dirs:       src       gen-src@@ -58,7 +59,8 @@     , opentracing >= 0.1     , safe-exceptions >= 0.1     , text >= 1.2-    , thrift == 0.13.0+    , pinch >= 0.4.0.0+    , vector-instances     , unordered-containers >= 0.2     , vector >= 0.12   default-language: Haskell2010

@@ -27,50 +27,39 @@     ) where -import qualified Agent_Client                   as Thrift+import qualified Agent.Client                   as Thrift import           Control.Exception.Safe import           Control.Lens                   (makeLenses, view) import           Control.Monad.IO.Class import           Data.ByteString.Builder-import           Data.Semigroup import           Data.Text                      (Text) import qualified Data.Vector                    as Vector-import qualified Jaeger_Types                   as Thrift+import qualified Jaeger.Types                   as Thrift import           Network.Socket-import qualified Network.Socket.ByteString.Lazy as Net import           OpenTracing.Jaeger.Propagation (jaegerPropagation) import           OpenTracing.Jaeger.Thrift import           OpenTracing.Reporting          (defaultErrorLog) import           OpenTracing.Span import           OpenTracing.Tags import           OpenTracing.Types-import qualified Thrift-import qualified Thrift.Protocol.Compact        as Thrift-import qualified Thrift.Transport.IOBuffer      as Thrift-+import qualified Pinch+import qualified Pinch.Client as Pinch+import qualified Pinch.Transport as Pinch  data JaegerAgent = JaegerAgent     { envLocalProcess :: Thrift.Process     , envErrorLog     :: Builder -> IO ()-    , envTransport    :: AgentTransport-    }--data AgentTransport = AgentTransport-    { transSock :: Socket-    , transBuf  :: Thrift.WriteBuffer+    , envClient       :: JaegerClient     } -instance Thrift.Transport AgentTransport where-    tIsOpen = const (pure True)-    tWrite  = Thrift.writeBuf . transBuf--    tFlush AgentTransport{..} =-        Thrift.flushBuf transBuf >>= Net.sendAll transSock+data JaegerClient = JaegerClient+  {+    jclClient :: Pinch.Client+  , jclSocket :: Socket+  } -    tClose   = error "tClose undefined"-    tRead    = error "tRead undefined"-    tPeek    = error "tPeek undefined"-    tReadAll = error "tReadAll undefined"+instance Pinch.ThriftClient JaegerClient where+  call JaegerClient{jclClient} = Pinch.call jclClient  data JaegerAgentOptions = JaegerAgentOptions     { _jaoServiceName :: Text@@ -97,9 +86,9 @@      in JaegerAgent tproc _jaoErrorLog <$> openAgentTransport _jaoAddr  closeJaegerAgent :: JaegerAgent -> IO ()-closeJaegerAgent JaegerAgent{envTransport} =-    handleAny (const (return ())) $-        Thrift.tFlush envTransport *> Thrift.tClose envTransport+closeJaegerAgent JaegerAgent{envClient=JaegerClient{jclSocket}} =+  handleAny (const (return ())) $+    close jclSocket  withJaegerAgent     :: ( MonadIO   m@@ -111,24 +100,24 @@ withJaegerAgent opts =     bracket (liftIO $ newJaegerAgent opts) (liftIO . closeJaegerAgent) -openAgentTransport :: Addr 'UDP -> IO AgentTransport+openAgentTransport :: Addr 'UDP -> IO JaegerClient openAgentTransport addr = do     AddrInfo{..} : _ <- getAddrInfo (Just defaultHints { addrSocketType = Datagram })                                     (Just . view addrHostName $ addr)                                     (Just . show . view addrPort $ addr)     sock <- socket addrFamily addrSocketType addrProtocol     connect sock addrAddress-    buf  <- Thrift.newWriteBuffer-    return AgentTransport-        { transSock = sock-        , transBuf  = buf-        }+    channel <- Pinch.createChannel sock Pinch.unframedTransport Pinch.compactProtocol+    return JaegerClient+      {+        jclClient = Pinch.client channel+      , jclSocket = sock+      }  jaegerAgentReporter :: MonadIO m => JaegerAgent -> FinishedSpan -> m () jaegerAgentReporter JaegerAgent{..} s = liftIO $ emit `catchAny` err   where-    proto = Thrift.CompactProtocol envTransport-    emit  = Thrift.emitBatch (undefined, proto) batch+    emit = Pinch.call envClient (Thrift.emitBatch batch)     batch = toThriftBatch envLocalProcess (Vector.singleton s)     err e = envErrorLog $ shortByteString "Jaeger Agent Thrift error: "                        <> string8 (show e)

@@ -33,11 +33,11 @@ import           Control.Monad                  (unless) import           Control.Monad.Catch import           Control.Monad.IO.Class+import           Data.ByteString.Lazy           (fromStrict) import           Data.ByteString.Builder-import           Data.Monoid import           Data.Text                      (Text) import           Data.Vector                    (fromList)-import qualified Jaeger_Types                   as Thrift+import qualified Jaeger.Types                   as Thrift import           Network.HTTP.Client import           Network.HTTP.Types.Status import           OpenTracing.Jaeger.Propagation (jaegerPropagation)@@ -46,9 +46,7 @@ import           OpenTracing.Span import           OpenTracing.Tags import           OpenTracing.Types-import           Thrift.Protocol.Binary-import           Thrift.Transport.Empty-+import qualified Pinch  newtype JaegerCollector = JaegerCollector { fromJaegerCollector :: BatchEnv } @@ -125,7 +123,7 @@               <> intDec (statusCode rs)               <> char8 '\n'   where-    body = RequestBodyLBS . serializeBatch $ toThriftBatch tproc spans+    body = RequestBodyLBS . fromStrict . serializeBatch $ toThriftBatch tproc spans      -- nb. collector accepts 'BinaryProtocol', but agent 'CompactProtocol'-    serializeBatch = Thrift.encode_Batch (BinaryProtocol EmptyTransport)+    serializeBatch = Pinch.encode Pinch.binaryProtocol

@@ -15,7 +15,6 @@ import           Control.Lens import           Data.Bits import qualified Data.HashMap.Strict     as HashMap-import           Data.Monoid import           Data.Text               (Text, isPrefixOf) import qualified Data.Text               as Text import qualified Data.Text.Read          as Text

@@ -8,6 +8,7 @@     ) where +import           Data.ByteString.Lazy       (toStrict) import           Control.Lens import           Data.Bool                  (bool) import           Data.Foldable@@ -20,7 +21,7 @@ import qualified Data.Vector                as Vector import           Data.Vector.Lens           (vector) import           GHC.Stack                  (prettyCallStack)-import           Jaeger_Types+import           Jaeger.Types     ( Batch (..)     , Log (..)     , Process (..)@@ -28,7 +29,7 @@     , SpanRef (..)     , Tag (..)     )-import qualified Jaeger_Types               as Thrift+import qualified Jaeger.Types               as Thrift import           OpenTracing.Log import           OpenTracing.Span import           OpenTracing.Tags@@ -43,7 +44,7 @@     , span_spanId        = view (spanContext . to ctxSpanID') s     , span_parentSpanId  = maybe 0 (ctxSpanID' . refCtx) . findParent                          $ view spanRefs s-    , span_operationName = view (spanOperation . lazy) s+    , span_operationName = view spanOperation s     , span_references    = view ( spanRefs                                 . to (map toThriftSpanRef . toList)                                 . vector@@ -63,7 +64,6 @@                          . Vector.fromList                          . foldr' (\r acc -> toThriftLog r : acc) []                          $ view spanLogs s-    , span_incomplete    = Just False     }  toThriftSpanRef :: Reference -> Thrift.SpanRef@@ -85,18 +85,41 @@ -- acc. to https://github.com/opentracing/specification/blob/8d634bc7e3e73050f6ac1006858cddac8d9e0abe/semantic_conventions.yaml -- "http.status_code" is supposed to be integer-valued. Jaeger, however, drops -- the value (nb. _not_ the tag key) unless it is a string.-toThriftTag HttpStatusCodeKey (IntT v) = Thrift.default_Tag-    { tag_key  = view lazy HttpStatusCodeKey-    , tag_vStr = Just . toLazyText . decimal $ v+toThriftTag HttpStatusCodeKey (IntT v) = Thrift.Tag+    { tag_key     = HttpStatusCodeKey+    , tag_vType   = Thrift.STRING+    , tag_vStr    = Just . view strict . toLazyText . decimal $ v+    , tag_vDouble = Nothing+    , tag_vBool   = Nothing+    , tag_vLong   = Nothing+    , tag_vBinary = Nothing     } toThriftTag k v =-    let t = Thrift.default_Tag { tag_key = view lazy k }-     in case v of-            BoolT   x -> t { tag_vBool   = Just x }-            StringT x -> t { tag_vStr    = Just (view lazy x) }-            IntT    x -> t { tag_vLong   = Just x }-            DoubleT x -> t { tag_vDouble = Just x }-            BinaryT x -> t { tag_vBinary = Just x }+  Thrift.Tag+  {+    tag_key = k+  , tag_vType = case v of+      BoolT   _ -> Thrift.BOOL+      StringT _ -> Thrift.STRING+      IntT    _ -> Thrift.LONG+      DoubleT _ -> Thrift.DOUBLE+      BinaryT _ -> Thrift.BINARY+  , tag_vStr = case v of+      StringT x -> Just x+      _ -> Nothing+  , tag_vDouble = case v of+      DoubleT x -> Just x+      _ -> Nothing+  , tag_vBool = case v of+      BoolT x -> Just x+      _ -> Nothing+  , tag_vLong = case v of+      IntT x -> Just x+      _ -> Nothing+  , tag_vBinary = case v of+      BinaryT x -> Just (toStrict x)+      _ -> Nothing+  }  toThriftLog :: LogRecord -> Thrift.Log toThriftLog r = Thrift.Log@@ -118,7 +141,7 @@  toThriftProcess :: Text -> Tags -> Thrift.Process toThriftProcess srv tags = Thrift.Process-    { process_serviceName = view lazy srv+    { process_serviceName = srv     , process_tags        = Just $ toThriftTags tags     } @@ -126,6 +149,8 @@ toThriftBatch tproc spans = Thrift.Batch     { batch_process = tproc     , batch_spans   = toThriftSpan <$> spans+    , batch_seqNo   = Nothing+    , batch_stats   = Nothing     }  traceIdLo' :: SpanContext -> Int64