{- This file was auto-generated from opentelemetry/proto/common/v1/common.proto by the proto-lens-protoc program. -}
{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, UndecidableInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternSynonyms, MagicHash, NoImplicitPrelude, DataKinds, BangPatterns, TypeApplications, OverloadedStrings, DerivingStrategies#-}
{-# OPTIONS_GHC -Wno-unused-imports#-}
{-# OPTIONS_GHC -Wno-duplicate-exports#-}
{-# OPTIONS_GHC -Wno-dodgy-exports#-}
module Proto.Opentelemetry.Proto.Common.V1.Common (
        AnyValue(), AnyValue'Value(..), _AnyValue'StringValue,
        _AnyValue'BoolValue, _AnyValue'IntValue, _AnyValue'DoubleValue,
        _AnyValue'ArrayValue, _AnyValue'KvlistValue, _AnyValue'BytesValue,
        ArrayValue(), InstrumentationLibrary(), KeyValue(), KeyValueList(),
        StringKeyValue()
    ) where
import qualified Data.ProtoLens.Runtime.Control.DeepSeq as Control.DeepSeq
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Prism as Data.ProtoLens.Prism
import qualified Data.ProtoLens.Runtime.Prelude as Prelude
import qualified Data.ProtoLens.Runtime.Data.Int as Data.Int
import qualified Data.ProtoLens.Runtime.Data.Monoid as Data.Monoid
import qualified Data.ProtoLens.Runtime.Data.Word as Data.Word
import qualified Data.ProtoLens.Runtime.Data.ProtoLens as Data.ProtoLens
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Bytes as Data.ProtoLens.Encoding.Bytes
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Growing as Data.ProtoLens.Encoding.Growing
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Parser.Unsafe as Data.ProtoLens.Encoding.Parser.Unsafe
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Wire as Data.ProtoLens.Encoding.Wire
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Field as Data.ProtoLens.Field
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Message.Enum as Data.ProtoLens.Message.Enum
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Service.Types as Data.ProtoLens.Service.Types
import qualified Data.ProtoLens.Runtime.Lens.Family2 as Lens.Family2
import qualified Data.ProtoLens.Runtime.Lens.Family2.Unchecked as Lens.Family2.Unchecked
import qualified Data.ProtoLens.Runtime.Data.Text as Data.Text
import qualified Data.ProtoLens.Runtime.Data.Map as Data.Map
import qualified Data.ProtoLens.Runtime.Data.ByteString as Data.ByteString
import qualified Data.ProtoLens.Runtime.Data.ByteString.Char8 as Data.ByteString.Char8
import qualified Data.ProtoLens.Runtime.Data.Text.Encoding as Data.Text.Encoding
import qualified Data.ProtoLens.Runtime.Data.Vector as Data.Vector
import qualified Data.ProtoLens.Runtime.Data.Vector.Generic as Data.Vector.Generic
import qualified Data.ProtoLens.Runtime.Data.Vector.Unboxed as Data.Vector.Unboxed
import qualified Data.ProtoLens.Runtime.Text.Read as Text.Read
{- | Fields :
     
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.maybe'value' @:: Lens' AnyValue (Prelude.Maybe AnyValue'Value)@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.maybe'stringValue' @:: Lens' AnyValue (Prelude.Maybe Data.Text.Text)@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.stringValue' @:: Lens' AnyValue Data.Text.Text@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.maybe'boolValue' @:: Lens' AnyValue (Prelude.Maybe Prelude.Bool)@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.boolValue' @:: Lens' AnyValue Prelude.Bool@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.maybe'intValue' @:: Lens' AnyValue (Prelude.Maybe Data.Int.Int64)@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.intValue' @:: Lens' AnyValue Data.Int.Int64@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.maybe'doubleValue' @:: Lens' AnyValue (Prelude.Maybe Prelude.Double)@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.doubleValue' @:: Lens' AnyValue Prelude.Double@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.maybe'arrayValue' @:: Lens' AnyValue (Prelude.Maybe ArrayValue)@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.arrayValue' @:: Lens' AnyValue ArrayValue@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.maybe'kvlistValue' @:: Lens' AnyValue (Prelude.Maybe KeyValueList)@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.kvlistValue' @:: Lens' AnyValue KeyValueList@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.maybe'bytesValue' @:: Lens' AnyValue (Prelude.Maybe Data.ByteString.ByteString)@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.bytesValue' @:: Lens' AnyValue Data.ByteString.ByteString@ -}
data AnyValue
  = AnyValue'_constructor {AnyValue -> Maybe AnyValue'Value
_AnyValue'value :: !(Prelude.Maybe AnyValue'Value),
                           AnyValue -> FieldSet
_AnyValue'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (AnyValue -> AnyValue -> Bool
(AnyValue -> AnyValue -> Bool)
-> (AnyValue -> AnyValue -> Bool) -> Eq AnyValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyValue -> AnyValue -> Bool
$c/= :: AnyValue -> AnyValue -> Bool
== :: AnyValue -> AnyValue -> Bool
$c== :: AnyValue -> AnyValue -> Bool
Prelude.Eq, Eq AnyValue
Eq AnyValue
-> (AnyValue -> AnyValue -> Ordering)
-> (AnyValue -> AnyValue -> Bool)
-> (AnyValue -> AnyValue -> Bool)
-> (AnyValue -> AnyValue -> Bool)
-> (AnyValue -> AnyValue -> Bool)
-> (AnyValue -> AnyValue -> AnyValue)
-> (AnyValue -> AnyValue -> AnyValue)
-> Ord AnyValue
AnyValue -> AnyValue -> Bool
AnyValue -> AnyValue -> Ordering
AnyValue -> AnyValue -> AnyValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AnyValue -> AnyValue -> AnyValue
$cmin :: AnyValue -> AnyValue -> AnyValue
max :: AnyValue -> AnyValue -> AnyValue
$cmax :: AnyValue -> AnyValue -> AnyValue
>= :: AnyValue -> AnyValue -> Bool
$c>= :: AnyValue -> AnyValue -> Bool
> :: AnyValue -> AnyValue -> Bool
$c> :: AnyValue -> AnyValue -> Bool
<= :: AnyValue -> AnyValue -> Bool
$c<= :: AnyValue -> AnyValue -> Bool
< :: AnyValue -> AnyValue -> Bool
$c< :: AnyValue -> AnyValue -> Bool
compare :: AnyValue -> AnyValue -> Ordering
$ccompare :: AnyValue -> AnyValue -> Ordering
$cp1Ord :: Eq AnyValue
Prelude.Ord)
instance Prelude.Show AnyValue where
  showsPrec :: Int -> AnyValue -> ShowS
showsPrec Int
_ AnyValue
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (AnyValue -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort AnyValue
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
data AnyValue'Value
  = AnyValue'StringValue !Data.Text.Text |
    AnyValue'BoolValue !Prelude.Bool |
    AnyValue'IntValue !Data.Int.Int64 |
    AnyValue'DoubleValue !Prelude.Double |
    AnyValue'ArrayValue !ArrayValue |
    AnyValue'KvlistValue !KeyValueList |
    AnyValue'BytesValue !Data.ByteString.ByteString
  deriving stock (Int -> AnyValue'Value -> ShowS
[AnyValue'Value] -> ShowS
AnyValue'Value -> String
(Int -> AnyValue'Value -> ShowS)
-> (AnyValue'Value -> String)
-> ([AnyValue'Value] -> ShowS)
-> Show AnyValue'Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnyValue'Value] -> ShowS
$cshowList :: [AnyValue'Value] -> ShowS
show :: AnyValue'Value -> String
$cshow :: AnyValue'Value -> String
showsPrec :: Int -> AnyValue'Value -> ShowS
$cshowsPrec :: Int -> AnyValue'Value -> ShowS
Prelude.Show, AnyValue'Value -> AnyValue'Value -> Bool
(AnyValue'Value -> AnyValue'Value -> Bool)
-> (AnyValue'Value -> AnyValue'Value -> Bool) -> Eq AnyValue'Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyValue'Value -> AnyValue'Value -> Bool
$c/= :: AnyValue'Value -> AnyValue'Value -> Bool
== :: AnyValue'Value -> AnyValue'Value -> Bool
$c== :: AnyValue'Value -> AnyValue'Value -> Bool
Prelude.Eq, Eq AnyValue'Value
Eq AnyValue'Value
-> (AnyValue'Value -> AnyValue'Value -> Ordering)
-> (AnyValue'Value -> AnyValue'Value -> Bool)
-> (AnyValue'Value -> AnyValue'Value -> Bool)
-> (AnyValue'Value -> AnyValue'Value -> Bool)
-> (AnyValue'Value -> AnyValue'Value -> Bool)
-> (AnyValue'Value -> AnyValue'Value -> AnyValue'Value)
-> (AnyValue'Value -> AnyValue'Value -> AnyValue'Value)
-> Ord AnyValue'Value
AnyValue'Value -> AnyValue'Value -> Bool
AnyValue'Value -> AnyValue'Value -> Ordering
AnyValue'Value -> AnyValue'Value -> AnyValue'Value
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AnyValue'Value -> AnyValue'Value -> AnyValue'Value
$cmin :: AnyValue'Value -> AnyValue'Value -> AnyValue'Value
max :: AnyValue'Value -> AnyValue'Value -> AnyValue'Value
$cmax :: AnyValue'Value -> AnyValue'Value -> AnyValue'Value
>= :: AnyValue'Value -> AnyValue'Value -> Bool
$c>= :: AnyValue'Value -> AnyValue'Value -> Bool
> :: AnyValue'Value -> AnyValue'Value -> Bool
$c> :: AnyValue'Value -> AnyValue'Value -> Bool
<= :: AnyValue'Value -> AnyValue'Value -> Bool
$c<= :: AnyValue'Value -> AnyValue'Value -> Bool
< :: AnyValue'Value -> AnyValue'Value -> Bool
$c< :: AnyValue'Value -> AnyValue'Value -> Bool
compare :: AnyValue'Value -> AnyValue'Value -> Ordering
$ccompare :: AnyValue'Value -> AnyValue'Value -> Ordering
$cp1Ord :: Eq AnyValue'Value
Prelude.Ord)
instance Data.ProtoLens.Field.HasField AnyValue "maybe'value" (Prelude.Maybe AnyValue'Value) where
  fieldOf :: Proxy# "maybe'value"
-> (Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> AnyValue
-> f AnyValue
fieldOf Proxy# "maybe'value"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        (Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> Maybe AnyValue'Value -> f (Maybe AnyValue'Value)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField AnyValue "maybe'stringValue" (Prelude.Maybe Data.Text.Text) where
  fieldOf :: Proxy# "maybe'stringValue"
-> (Maybe Text -> f (Maybe Text)) -> AnyValue -> f AnyValue
fieldOf Proxy# "maybe'stringValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Maybe Text -> f (Maybe Text))
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Maybe Text -> f (Maybe Text))
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        ((Maybe AnyValue'Value -> Maybe Text)
-> (Maybe AnyValue'Value -> Maybe Text -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe Text)
     (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           (\ Maybe AnyValue'Value
x__
              -> case Maybe AnyValue'Value
x__ of
                   (Prelude.Just (AnyValue'StringValue Text
x__val)) -> Text -> Maybe Text
forall a. a -> Maybe a
Prelude.Just Text
x__val
                   Maybe AnyValue'Value
_otherwise -> Maybe Text
forall a. Maybe a
Prelude.Nothing)
           (\ Maybe AnyValue'Value
_ Maybe Text
y__ -> (Text -> AnyValue'Value) -> Maybe Text -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Text -> AnyValue'Value
AnyValue'StringValue Maybe Text
y__))
instance Data.ProtoLens.Field.HasField AnyValue "stringValue" Data.Text.Text where
  fieldOf :: Proxy# "stringValue" -> (Text -> f Text) -> AnyValue -> f AnyValue
fieldOf Proxy# "stringValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Text -> f Text)
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Text -> f Text)
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        (((Maybe Text -> f (Maybe Text))
 -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> ((Text -> f Text) -> Maybe Text -> f (Maybe Text))
-> (Text -> f Text)
-> Maybe AnyValue'Value
-> f (Maybe AnyValue'Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
           ((Maybe AnyValue'Value -> Maybe Text)
-> (Maybe AnyValue'Value -> Maybe Text -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe Text)
     (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
              (\ Maybe AnyValue'Value
x__
                 -> case Maybe AnyValue'Value
x__ of
                      (Prelude.Just (AnyValue'StringValue Text
x__val)) -> Text -> Maybe Text
forall a. a -> Maybe a
Prelude.Just Text
x__val
                      Maybe AnyValue'Value
_otherwise -> Maybe Text
forall a. Maybe a
Prelude.Nothing)
              (\ Maybe AnyValue'Value
_ Maybe Text
y__ -> (Text -> AnyValue'Value) -> Maybe Text -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Text -> AnyValue'Value
AnyValue'StringValue Maybe Text
y__))
           (Text -> Lens' (Maybe Text) Text
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault))
instance Data.ProtoLens.Field.HasField AnyValue "maybe'boolValue" (Prelude.Maybe Prelude.Bool) where
  fieldOf :: Proxy# "maybe'boolValue"
-> (Maybe Bool -> f (Maybe Bool)) -> AnyValue -> f AnyValue
fieldOf Proxy# "maybe'boolValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Maybe Bool -> f (Maybe Bool))
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Maybe Bool -> f (Maybe Bool))
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        ((Maybe AnyValue'Value -> Maybe Bool)
-> (Maybe AnyValue'Value -> Maybe Bool -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe Bool)
     (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           (\ Maybe AnyValue'Value
x__
              -> case Maybe AnyValue'Value
x__ of
                   (Prelude.Just (AnyValue'BoolValue Bool
x__val)) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude.Just Bool
x__val
                   Maybe AnyValue'Value
_otherwise -> Maybe Bool
forall a. Maybe a
Prelude.Nothing)
           (\ Maybe AnyValue'Value
_ Maybe Bool
y__ -> (Bool -> AnyValue'Value) -> Maybe Bool -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Bool -> AnyValue'Value
AnyValue'BoolValue Maybe Bool
y__))
instance Data.ProtoLens.Field.HasField AnyValue "boolValue" Prelude.Bool where
  fieldOf :: Proxy# "boolValue" -> (Bool -> f Bool) -> AnyValue -> f AnyValue
fieldOf Proxy# "boolValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Bool -> f Bool)
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Bool -> f Bool)
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        (((Maybe Bool -> f (Maybe Bool))
 -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> ((Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool))
-> (Bool -> f Bool)
-> Maybe AnyValue'Value
-> f (Maybe AnyValue'Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
           ((Maybe AnyValue'Value -> Maybe Bool)
-> (Maybe AnyValue'Value -> Maybe Bool -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe Bool)
     (Maybe Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
              (\ Maybe AnyValue'Value
x__
                 -> case Maybe AnyValue'Value
x__ of
                      (Prelude.Just (AnyValue'BoolValue Bool
x__val)) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude.Just Bool
x__val
                      Maybe AnyValue'Value
_otherwise -> Maybe Bool
forall a. Maybe a
Prelude.Nothing)
              (\ Maybe AnyValue'Value
_ Maybe Bool
y__ -> (Bool -> AnyValue'Value) -> Maybe Bool -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Bool -> AnyValue'Value
AnyValue'BoolValue Maybe Bool
y__))
           (Bool -> Lens' (Maybe Bool) Bool
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Bool
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault))
instance Data.ProtoLens.Field.HasField AnyValue "maybe'intValue" (Prelude.Maybe Data.Int.Int64) where
  fieldOf :: Proxy# "maybe'intValue"
-> (Maybe Int64 -> f (Maybe Int64)) -> AnyValue -> f AnyValue
fieldOf Proxy# "maybe'intValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Maybe Int64 -> f (Maybe Int64))
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Maybe Int64 -> f (Maybe Int64))
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        ((Maybe AnyValue'Value -> Maybe Int64)
-> (Maybe AnyValue'Value -> Maybe Int64 -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe Int64)
     (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           (\ Maybe AnyValue'Value
x__
              -> case Maybe AnyValue'Value
x__ of
                   (Prelude.Just (AnyValue'IntValue Int64
x__val)) -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Prelude.Just Int64
x__val
                   Maybe AnyValue'Value
_otherwise -> Maybe Int64
forall a. Maybe a
Prelude.Nothing)
           (\ Maybe AnyValue'Value
_ Maybe Int64
y__ -> (Int64 -> AnyValue'Value) -> Maybe Int64 -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Int64 -> AnyValue'Value
AnyValue'IntValue Maybe Int64
y__))
instance Data.ProtoLens.Field.HasField AnyValue "intValue" Data.Int.Int64 where
  fieldOf :: Proxy# "intValue" -> (Int64 -> f Int64) -> AnyValue -> f AnyValue
fieldOf Proxy# "intValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Int64 -> f Int64)
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Int64 -> f Int64)
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        (((Maybe Int64 -> f (Maybe Int64))
 -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> ((Int64 -> f Int64) -> Maybe Int64 -> f (Maybe Int64))
-> (Int64 -> f Int64)
-> Maybe AnyValue'Value
-> f (Maybe AnyValue'Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
           ((Maybe AnyValue'Value -> Maybe Int64)
-> (Maybe AnyValue'Value -> Maybe Int64 -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe Int64)
     (Maybe Int64)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
              (\ Maybe AnyValue'Value
x__
                 -> case Maybe AnyValue'Value
x__ of
                      (Prelude.Just (AnyValue'IntValue Int64
x__val)) -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Prelude.Just Int64
x__val
                      Maybe AnyValue'Value
_otherwise -> Maybe Int64
forall a. Maybe a
Prelude.Nothing)
              (\ Maybe AnyValue'Value
_ Maybe Int64
y__ -> (Int64 -> AnyValue'Value) -> Maybe Int64 -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Int64 -> AnyValue'Value
AnyValue'IntValue Maybe Int64
y__))
           (Int64 -> Lens' (Maybe Int64) Int64
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Int64
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault))
instance Data.ProtoLens.Field.HasField AnyValue "maybe'doubleValue" (Prelude.Maybe Prelude.Double) where
  fieldOf :: Proxy# "maybe'doubleValue"
-> (Maybe Double -> f (Maybe Double)) -> AnyValue -> f AnyValue
fieldOf Proxy# "maybe'doubleValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Maybe Double -> f (Maybe Double))
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Maybe Double -> f (Maybe Double))
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        ((Maybe AnyValue'Value -> Maybe Double)
-> (Maybe AnyValue'Value -> Maybe Double -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe Double)
     (Maybe Double)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           (\ Maybe AnyValue'Value
x__
              -> case Maybe AnyValue'Value
x__ of
                   (Prelude.Just (AnyValue'DoubleValue Double
x__val)) -> Double -> Maybe Double
forall a. a -> Maybe a
Prelude.Just Double
x__val
                   Maybe AnyValue'Value
_otherwise -> Maybe Double
forall a. Maybe a
Prelude.Nothing)
           (\ Maybe AnyValue'Value
_ Maybe Double
y__ -> (Double -> AnyValue'Value) -> Maybe Double -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Double -> AnyValue'Value
AnyValue'DoubleValue Maybe Double
y__))
instance Data.ProtoLens.Field.HasField AnyValue "doubleValue" Prelude.Double where
  fieldOf :: Proxy# "doubleValue"
-> (Double -> f Double) -> AnyValue -> f AnyValue
fieldOf Proxy# "doubleValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Double -> f Double)
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Double -> f Double)
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        (((Maybe Double -> f (Maybe Double))
 -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> ((Double -> f Double) -> Maybe Double -> f (Maybe Double))
-> (Double -> f Double)
-> Maybe AnyValue'Value
-> f (Maybe AnyValue'Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
           ((Maybe AnyValue'Value -> Maybe Double)
-> (Maybe AnyValue'Value -> Maybe Double -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe Double)
     (Maybe Double)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
              (\ Maybe AnyValue'Value
x__
                 -> case Maybe AnyValue'Value
x__ of
                      (Prelude.Just (AnyValue'DoubleValue Double
x__val)) -> Double -> Maybe Double
forall a. a -> Maybe a
Prelude.Just Double
x__val
                      Maybe AnyValue'Value
_otherwise -> Maybe Double
forall a. Maybe a
Prelude.Nothing)
              (\ Maybe AnyValue'Value
_ Maybe Double
y__ -> (Double -> AnyValue'Value) -> Maybe Double -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap Double -> AnyValue'Value
AnyValue'DoubleValue Maybe Double
y__))
           (Double -> Lens' (Maybe Double) Double
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens Double
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault))
instance Data.ProtoLens.Field.HasField AnyValue "maybe'arrayValue" (Prelude.Maybe ArrayValue) where
  fieldOf :: Proxy# "maybe'arrayValue"
-> (Maybe ArrayValue -> f (Maybe ArrayValue))
-> AnyValue
-> f AnyValue
fieldOf Proxy# "maybe'arrayValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Maybe ArrayValue -> f (Maybe ArrayValue))
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Maybe ArrayValue -> f (Maybe ArrayValue))
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        ((Maybe AnyValue'Value -> Maybe ArrayValue)
-> (Maybe AnyValue'Value
    -> Maybe ArrayValue -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe ArrayValue)
     (Maybe ArrayValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           (\ Maybe AnyValue'Value
x__
              -> case Maybe AnyValue'Value
x__ of
                   (Prelude.Just (AnyValue'ArrayValue ArrayValue
x__val)) -> ArrayValue -> Maybe ArrayValue
forall a. a -> Maybe a
Prelude.Just ArrayValue
x__val
                   Maybe AnyValue'Value
_otherwise -> Maybe ArrayValue
forall a. Maybe a
Prelude.Nothing)
           (\ Maybe AnyValue'Value
_ Maybe ArrayValue
y__ -> (ArrayValue -> AnyValue'Value)
-> Maybe ArrayValue -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap ArrayValue -> AnyValue'Value
AnyValue'ArrayValue Maybe ArrayValue
y__))
instance Data.ProtoLens.Field.HasField AnyValue "arrayValue" ArrayValue where
  fieldOf :: Proxy# "arrayValue"
-> (ArrayValue -> f ArrayValue) -> AnyValue -> f AnyValue
fieldOf Proxy# "arrayValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((ArrayValue -> f ArrayValue)
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (ArrayValue -> f ArrayValue)
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        (((Maybe ArrayValue -> f (Maybe ArrayValue))
 -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> ((ArrayValue -> f ArrayValue)
    -> Maybe ArrayValue -> f (Maybe ArrayValue))
-> (ArrayValue -> f ArrayValue)
-> Maybe AnyValue'Value
-> f (Maybe AnyValue'Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
           ((Maybe AnyValue'Value -> Maybe ArrayValue)
-> (Maybe AnyValue'Value
    -> Maybe ArrayValue -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe ArrayValue)
     (Maybe ArrayValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
              (\ Maybe AnyValue'Value
x__
                 -> case Maybe AnyValue'Value
x__ of
                      (Prelude.Just (AnyValue'ArrayValue ArrayValue
x__val)) -> ArrayValue -> Maybe ArrayValue
forall a. a -> Maybe a
Prelude.Just ArrayValue
x__val
                      Maybe AnyValue'Value
_otherwise -> Maybe ArrayValue
forall a. Maybe a
Prelude.Nothing)
              (\ Maybe AnyValue'Value
_ Maybe ArrayValue
y__ -> (ArrayValue -> AnyValue'Value)
-> Maybe ArrayValue -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap ArrayValue -> AnyValue'Value
AnyValue'ArrayValue Maybe ArrayValue
y__))
           (ArrayValue -> Lens' (Maybe ArrayValue) ArrayValue
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ArrayValue
forall msg. Message msg => msg
Data.ProtoLens.defMessage))
instance Data.ProtoLens.Field.HasField AnyValue "maybe'kvlistValue" (Prelude.Maybe KeyValueList) where
  fieldOf :: Proxy# "maybe'kvlistValue"
-> (Maybe KeyValueList -> f (Maybe KeyValueList))
-> AnyValue
-> f AnyValue
fieldOf Proxy# "maybe'kvlistValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Maybe KeyValueList -> f (Maybe KeyValueList))
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Maybe KeyValueList -> f (Maybe KeyValueList))
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        ((Maybe AnyValue'Value -> Maybe KeyValueList)
-> (Maybe AnyValue'Value
    -> Maybe KeyValueList -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe KeyValueList)
     (Maybe KeyValueList)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           (\ Maybe AnyValue'Value
x__
              -> case Maybe AnyValue'Value
x__ of
                   (Prelude.Just (AnyValue'KvlistValue KeyValueList
x__val)) -> KeyValueList -> Maybe KeyValueList
forall a. a -> Maybe a
Prelude.Just KeyValueList
x__val
                   Maybe AnyValue'Value
_otherwise -> Maybe KeyValueList
forall a. Maybe a
Prelude.Nothing)
           (\ Maybe AnyValue'Value
_ Maybe KeyValueList
y__ -> (KeyValueList -> AnyValue'Value)
-> Maybe KeyValueList -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap KeyValueList -> AnyValue'Value
AnyValue'KvlistValue Maybe KeyValueList
y__))
instance Data.ProtoLens.Field.HasField AnyValue "kvlistValue" KeyValueList where
  fieldOf :: Proxy# "kvlistValue"
-> (KeyValueList -> f KeyValueList) -> AnyValue -> f AnyValue
fieldOf Proxy# "kvlistValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((KeyValueList -> f KeyValueList)
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (KeyValueList -> f KeyValueList)
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        (((Maybe KeyValueList -> f (Maybe KeyValueList))
 -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> ((KeyValueList -> f KeyValueList)
    -> Maybe KeyValueList -> f (Maybe KeyValueList))
-> (KeyValueList -> f KeyValueList)
-> Maybe AnyValue'Value
-> f (Maybe AnyValue'Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
           ((Maybe AnyValue'Value -> Maybe KeyValueList)
-> (Maybe AnyValue'Value
    -> Maybe KeyValueList -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe KeyValueList)
     (Maybe KeyValueList)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
              (\ Maybe AnyValue'Value
x__
                 -> case Maybe AnyValue'Value
x__ of
                      (Prelude.Just (AnyValue'KvlistValue KeyValueList
x__val)) -> KeyValueList -> Maybe KeyValueList
forall a. a -> Maybe a
Prelude.Just KeyValueList
x__val
                      Maybe AnyValue'Value
_otherwise -> Maybe KeyValueList
forall a. Maybe a
Prelude.Nothing)
              (\ Maybe AnyValue'Value
_ Maybe KeyValueList
y__ -> (KeyValueList -> AnyValue'Value)
-> Maybe KeyValueList -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap KeyValueList -> AnyValue'Value
AnyValue'KvlistValue Maybe KeyValueList
y__))
           (KeyValueList -> Lens' (Maybe KeyValueList) KeyValueList
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens KeyValueList
forall msg. Message msg => msg
Data.ProtoLens.defMessage))
instance Data.ProtoLens.Field.HasField AnyValue "maybe'bytesValue" (Prelude.Maybe Data.ByteString.ByteString) where
  fieldOf :: Proxy# "maybe'bytesValue"
-> (Maybe ByteString -> f (Maybe ByteString))
-> AnyValue
-> f AnyValue
fieldOf Proxy# "maybe'bytesValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((Maybe ByteString -> f (Maybe ByteString))
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (Maybe ByteString -> f (Maybe ByteString))
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        ((Maybe AnyValue'Value -> Maybe ByteString)
-> (Maybe AnyValue'Value
    -> Maybe ByteString -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           (\ Maybe AnyValue'Value
x__
              -> case Maybe AnyValue'Value
x__ of
                   (Prelude.Just (AnyValue'BytesValue ByteString
x__val)) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Prelude.Just ByteString
x__val
                   Maybe AnyValue'Value
_otherwise -> Maybe ByteString
forall a. Maybe a
Prelude.Nothing)
           (\ Maybe AnyValue'Value
_ Maybe ByteString
y__ -> (ByteString -> AnyValue'Value)
-> Maybe ByteString -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap ByteString -> AnyValue'Value
AnyValue'BytesValue Maybe ByteString
y__))
instance Data.ProtoLens.Field.HasField AnyValue "bytesValue" Data.ByteString.ByteString where
  fieldOf :: Proxy# "bytesValue"
-> (ByteString -> f ByteString) -> AnyValue -> f AnyValue
fieldOf Proxy# "bytesValue"
_
    = ((Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
 -> AnyValue -> f AnyValue)
-> ((ByteString -> f ByteString)
    -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> (ByteString -> f ByteString)
-> AnyValue
-> f AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((AnyValue -> Maybe AnyValue'Value)
-> (AnyValue -> Maybe AnyValue'Value -> AnyValue)
-> Lens
     AnyValue AnyValue (Maybe AnyValue'Value) (Maybe AnyValue'Value)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           AnyValue -> Maybe AnyValue'Value
_AnyValue'value (\ AnyValue
x__ Maybe AnyValue'Value
y__ -> AnyValue
x__ {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
y__}))
        (((Maybe ByteString -> f (Maybe ByteString))
 -> Maybe AnyValue'Value -> f (Maybe AnyValue'Value))
-> ((ByteString -> f ByteString)
    -> Maybe ByteString -> f (Maybe ByteString))
-> (ByteString -> f ByteString)
-> Maybe AnyValue'Value
-> f (Maybe AnyValue'Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
           ((Maybe AnyValue'Value -> Maybe ByteString)
-> (Maybe AnyValue'Value
    -> Maybe ByteString -> Maybe AnyValue'Value)
-> Lens
     (Maybe AnyValue'Value)
     (Maybe AnyValue'Value)
     (Maybe ByteString)
     (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
              (\ Maybe AnyValue'Value
x__
                 -> case Maybe AnyValue'Value
x__ of
                      (Prelude.Just (AnyValue'BytesValue ByteString
x__val)) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Prelude.Just ByteString
x__val
                      Maybe AnyValue'Value
_otherwise -> Maybe ByteString
forall a. Maybe a
Prelude.Nothing)
              (\ Maybe AnyValue'Value
_ Maybe ByteString
y__ -> (ByteString -> AnyValue'Value)
-> Maybe ByteString -> Maybe AnyValue'Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap ByteString -> AnyValue'Value
AnyValue'BytesValue Maybe ByteString
y__))
           (ByteString -> Lens' (Maybe ByteString) ByteString
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens ByteString
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault))
instance Data.ProtoLens.Message AnyValue where
  messageName :: Proxy AnyValue -> Text
messageName Proxy AnyValue
_
    = String -> Text
Data.Text.pack String
"opentelemetry.proto.common.v1.AnyValue"
  packedMessageDescriptor :: Proxy AnyValue -> ByteString
packedMessageDescriptor Proxy AnyValue
_
    = ByteString
"\n\
      \\bAnyValue\DC2#\n\
      \\fstring_value\CAN\SOH \SOH(\tH\NULR\vstringValue\DC2\US\n\
      \\n\
      \bool_value\CAN\STX \SOH(\bH\NULR\tboolValue\DC2\GS\n\
      \\tint_value\CAN\ETX \SOH(\ETXH\NULR\bintValue\DC2#\n\
      \\fdouble_value\CAN\EOT \SOH(\SOHH\NULR\vdoubleValue\DC2L\n\
      \\varray_value\CAN\ENQ \SOH(\v2).opentelemetry.proto.common.v1.ArrayValueH\NULR\n\
      \arrayValue\DC2P\n\
      \\fkvlist_value\CAN\ACK \SOH(\v2+.opentelemetry.proto.common.v1.KeyValueListH\NULR\vkvlistValue\DC2!\n\
      \\vbytes_value\CAN\a \SOH(\fH\NULR\n\
      \bytesValueB\a\n\
      \\ENQvalue"
  packedFileDescriptor :: Proxy AnyValue -> ByteString
packedFileDescriptor Proxy AnyValue
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor AnyValue)
fieldsByTag
    = let
        stringValue__field_descriptor :: FieldDescriptor AnyValue
stringValue__field_descriptor
          = String
-> FieldTypeDescriptor Text
-> FieldAccessor AnyValue Text
-> FieldDescriptor AnyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"string_value"
              (ScalarField Text -> FieldTypeDescriptor Text
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Text
Data.ProtoLens.StringField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)
              (Lens' AnyValue (Maybe Text) -> FieldAccessor AnyValue Text
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'stringValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'stringValue")) ::
              Data.ProtoLens.FieldDescriptor AnyValue
        boolValue__field_descriptor :: FieldDescriptor AnyValue
boolValue__field_descriptor
          = String
-> FieldTypeDescriptor Bool
-> FieldAccessor AnyValue Bool
-> FieldDescriptor AnyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bool_value"
              (ScalarField Bool -> FieldTypeDescriptor Bool
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Bool
Data.ProtoLens.BoolField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)
              (Lens' AnyValue (Maybe Bool) -> FieldAccessor AnyValue Bool
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'boolValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'boolValue")) ::
              Data.ProtoLens.FieldDescriptor AnyValue
        intValue__field_descriptor :: FieldDescriptor AnyValue
intValue__field_descriptor
          = String
-> FieldTypeDescriptor Int64
-> FieldAccessor AnyValue Int64
-> FieldDescriptor AnyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"int_value"
              (ScalarField Int64 -> FieldTypeDescriptor Int64
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Int64
Data.ProtoLens.Int64Field ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)
              (Lens' AnyValue (Maybe Int64) -> FieldAccessor AnyValue Int64
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'intValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'intValue")) ::
              Data.ProtoLens.FieldDescriptor AnyValue
        doubleValue__field_descriptor :: FieldDescriptor AnyValue
doubleValue__field_descriptor
          = String
-> FieldTypeDescriptor Double
-> FieldAccessor AnyValue Double
-> FieldDescriptor AnyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"double_value"
              (ScalarField Double -> FieldTypeDescriptor Double
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Double
Data.ProtoLens.DoubleField ::
                 Data.ProtoLens.FieldTypeDescriptor Prelude.Double)
              (Lens' AnyValue (Maybe Double) -> FieldAccessor AnyValue Double
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'doubleValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'doubleValue")) ::
              Data.ProtoLens.FieldDescriptor AnyValue
        arrayValue__field_descriptor :: FieldDescriptor AnyValue
arrayValue__field_descriptor
          = String
-> FieldTypeDescriptor ArrayValue
-> FieldAccessor AnyValue ArrayValue
-> FieldDescriptor AnyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"array_value"
              (MessageOrGroup -> FieldTypeDescriptor ArrayValue
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor ArrayValue)
              (Lens' AnyValue (Maybe ArrayValue)
-> FieldAccessor AnyValue ArrayValue
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'arrayValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'arrayValue")) ::
              Data.ProtoLens.FieldDescriptor AnyValue
        kvlistValue__field_descriptor :: FieldDescriptor AnyValue
kvlistValue__field_descriptor
          = String
-> FieldTypeDescriptor KeyValueList
-> FieldAccessor AnyValue KeyValueList
-> FieldDescriptor AnyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"kvlist_value"
              (MessageOrGroup -> FieldTypeDescriptor KeyValueList
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor KeyValueList)
              (Lens' AnyValue (Maybe KeyValueList)
-> FieldAccessor AnyValue KeyValueList
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'kvlistValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'kvlistValue")) ::
              Data.ProtoLens.FieldDescriptor AnyValue
        bytesValue__field_descriptor :: FieldDescriptor AnyValue
bytesValue__field_descriptor
          = String
-> FieldTypeDescriptor ByteString
-> FieldAccessor AnyValue ByteString
-> FieldDescriptor AnyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"bytes_value"
              (ScalarField ByteString -> FieldTypeDescriptor ByteString
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField ByteString
Data.ProtoLens.BytesField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)
              (Lens' AnyValue (Maybe ByteString)
-> FieldAccessor AnyValue ByteString
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'bytesValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'bytesValue")) ::
              Data.ProtoLens.FieldDescriptor AnyValue
      in
        [(Tag, FieldDescriptor AnyValue)]
-> Map Tag (FieldDescriptor AnyValue)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor AnyValue
stringValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor AnyValue
boolValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
3, FieldDescriptor AnyValue
intValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
4, FieldDescriptor AnyValue
doubleValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
5, FieldDescriptor AnyValue
arrayValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
6, FieldDescriptor AnyValue
kvlistValue__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
7, FieldDescriptor AnyValue
bytesValue__field_descriptor)]
  unknownFields :: LensLike' f AnyValue FieldSet
unknownFields
    = (AnyValue -> FieldSet)
-> (AnyValue -> FieldSet -> AnyValue) -> Lens' AnyValue FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        AnyValue -> FieldSet
_AnyValue'_unknownFields
        (\ AnyValue
x__ FieldSet
y__ -> AnyValue
x__ {_AnyValue'_unknownFields :: FieldSet
_AnyValue'_unknownFields = FieldSet
y__})
  defMessage :: AnyValue
defMessage
    = AnyValue'_constructor :: Maybe AnyValue'Value -> FieldSet -> AnyValue
AnyValue'_constructor
        {_AnyValue'value :: Maybe AnyValue'Value
_AnyValue'value = Maybe AnyValue'Value
forall a. Maybe a
Prelude.Nothing, _AnyValue'_unknownFields :: FieldSet
_AnyValue'_unknownFields = []}
  parseMessage :: Parser AnyValue
parseMessage
    = let
        loop :: AnyValue -> Data.ProtoLens.Encoding.Bytes.Parser AnyValue
        loop :: AnyValue -> Parser AnyValue
loop AnyValue
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      AnyValue -> Parser AnyValue
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter AnyValue AnyValue FieldSet FieldSet
-> (FieldSet -> FieldSet) -> AnyValue -> AnyValue
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter AnyValue AnyValue FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) AnyValue
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Text
y <- Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do ByteString
value <- do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                                       Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                                         (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                           Either String Text -> Parser Text
forall a. Either String a -> Parser a
Data.ProtoLens.Encoding.Bytes.runEither
                                             (case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
value of
                                                (Prelude.Left UnicodeException
err)
                                                  -> String -> Either String Text
forall a b. a -> Either a b
Prelude.Left (UnicodeException -> String
forall a. Show a => a -> String
Prelude.show UnicodeException
err)
                                                (Prelude.Right Text
r) -> Text -> Either String Text
forall a b. b -> Either a b
Prelude.Right Text
r))
                                       String
"string_value"
                                AnyValue -> Parser AnyValue
loop
                                  (Setter AnyValue AnyValue Text Text -> Text -> AnyValue -> AnyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "stringValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"stringValue") Text
y AnyValue
x)
                        Word64
16
                          -> do Bool
y <- Parser Bool -> String -> Parser Bool
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Bool) -> Parser Word64 -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          (Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude./=) Word64
0) Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt)
                                       String
"bool_value"
                                AnyValue -> Parser AnyValue
loop
                                  (Setter AnyValue AnyValue Bool Bool -> Bool -> AnyValue -> AnyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "boolValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"boolValue") Bool
y AnyValue
x)
                        Word64
24
                          -> do Int64
y <- Parser Int64 -> String -> Parser Int64
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Int64) -> Parser Word64 -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                                          Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt)
                                       String
"int_value"
                                AnyValue -> Parser AnyValue
loop
                                  (Setter AnyValue AnyValue Int64 Int64
-> Int64 -> AnyValue -> AnyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "intValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"intValue") Int64
y AnyValue
x)
                        Word64
33
                          -> do Double
y <- Parser Double -> String -> Parser Double
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       ((Word64 -> Double) -> Parser Word64 -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
                                          Word64 -> Double
Data.ProtoLens.Encoding.Bytes.wordToDouble
                                          Parser Word64
Data.ProtoLens.Encoding.Bytes.getFixed64)
                                       String
"double_value"
                                AnyValue -> Parser AnyValue
loop
                                  (Setter AnyValue AnyValue Double Double
-> Double -> AnyValue -> AnyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "doubleValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"doubleValue") Double
y AnyValue
x)
                        Word64
42
                          -> do ArrayValue
y <- Parser ArrayValue -> String -> Parser ArrayValue
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser ArrayValue -> Parser ArrayValue
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser ArrayValue
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"array_value"
                                AnyValue -> Parser AnyValue
loop
                                  (Setter AnyValue AnyValue ArrayValue ArrayValue
-> ArrayValue -> AnyValue -> AnyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "arrayValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"arrayValue") ArrayValue
y AnyValue
x)
                        Word64
50
                          -> do KeyValueList
y <- Parser KeyValueList -> String -> Parser KeyValueList
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser KeyValueList -> Parser KeyValueList
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser KeyValueList
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"kvlist_value"
                                AnyValue -> Parser AnyValue
loop
                                  (Setter AnyValue AnyValue KeyValueList KeyValueList
-> KeyValueList -> AnyValue -> AnyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "kvlistValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"kvlistValue") KeyValueList
y AnyValue
x)
                        Word64
58
                          -> do ByteString
y <- Parser ByteString -> String -> Parser ByteString
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len))
                                       String
"bytes_value"
                                AnyValue -> Parser AnyValue
loop
                                  (Setter AnyValue AnyValue ByteString ByteString
-> ByteString -> AnyValue -> AnyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "bytesValue" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"bytesValue") ByteString
y AnyValue
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                AnyValue -> Parser AnyValue
loop
                                  (Setter AnyValue AnyValue FieldSet FieldSet
-> (FieldSet -> FieldSet) -> AnyValue -> AnyValue
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter AnyValue AnyValue FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) AnyValue
x)
      in
        Parser AnyValue -> String -> Parser AnyValue
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do AnyValue -> Parser AnyValue
loop AnyValue
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"AnyValue"
  buildMessage :: AnyValue -> Builder
buildMessage
    = \ AnyValue
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (case
                  FoldLike
  (Maybe AnyValue'Value)
  AnyValue
  AnyValue
  (Maybe AnyValue'Value)
  (Maybe AnyValue'Value)
-> AnyValue -> Maybe AnyValue'Value
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value") AnyValue
_x
              of
                Maybe AnyValue'Value
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                (Prelude.Just (AnyValue'StringValue Text
v))
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                       ((ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
v)
                (Prelude.Just (AnyValue'BoolValue Bool
v))
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
16)
                       ((Word64 -> Builder) -> (Bool -> Word64) -> Bool -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt (\ Bool
b -> if Bool
b then Word64
1 else Word64
0)
                          Bool
v)
                (Prelude.Just (AnyValue'IntValue Int64
v))
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
24)
                       ((Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int64
v)
                (Prelude.Just (AnyValue'DoubleValue Double
v))
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
33)
                       ((Word64 -> Builder) -> (Double -> Word64) -> Double -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putFixed64
                          Double -> Word64
Data.ProtoLens.Encoding.Bytes.doubleToWord Double
v)
                (Prelude.Just (AnyValue'ArrayValue ArrayValue
v))
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
42)
                       ((ByteString -> Builder)
-> (ArrayValue -> ByteString) -> ArrayValue -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          ArrayValue -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage ArrayValue
v)
                (Prelude.Just (AnyValue'KvlistValue KeyValueList
v))
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
50)
                       ((ByteString -> Builder)
-> (KeyValueList -> ByteString) -> KeyValueList -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                          (\ ByteString
bs
                             -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                  (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                     (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                  (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          KeyValueList -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage KeyValueList
v)
                (Prelude.Just (AnyValue'BytesValue ByteString
v))
                  -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                       (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
58)
                       ((\ ByteString
bs
                           -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                   (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                          ByteString
v))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet AnyValue AnyValue FieldSet FieldSet
-> AnyValue -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet AnyValue AnyValue FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields AnyValue
_x))
instance Control.DeepSeq.NFData AnyValue where
  rnf :: AnyValue -> ()
rnf
    = \ AnyValue
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (AnyValue -> FieldSet
_AnyValue'_unknownFields AnyValue
x__)
             (Maybe AnyValue'Value -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (AnyValue -> Maybe AnyValue'Value
_AnyValue'value AnyValue
x__) ())
instance Control.DeepSeq.NFData AnyValue'Value where
  rnf :: AnyValue'Value -> ()
rnf (AnyValue'StringValue Text
x__) = Text -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf Text
x__
  rnf (AnyValue'BoolValue Bool
x__) = Bool -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf Bool
x__
  rnf (AnyValue'IntValue Int64
x__) = Int64 -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf Int64
x__
  rnf (AnyValue'DoubleValue Double
x__) = Double -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf Double
x__
  rnf (AnyValue'ArrayValue ArrayValue
x__) = ArrayValue -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf ArrayValue
x__
  rnf (AnyValue'KvlistValue KeyValueList
x__) = KeyValueList -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf KeyValueList
x__
  rnf (AnyValue'BytesValue ByteString
x__) = ByteString -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf ByteString
x__
_AnyValue'StringValue ::
  Data.ProtoLens.Prism.Prism' AnyValue'Value Data.Text.Text
_AnyValue'StringValue :: p Text (f Text) -> p AnyValue'Value (f AnyValue'Value)
_AnyValue'StringValue
  = (Text -> AnyValue'Value)
-> (AnyValue'Value -> Maybe Text)
-> Prism AnyValue'Value AnyValue'Value Text Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Data.ProtoLens.Prism.prism'
      Text -> AnyValue'Value
AnyValue'StringValue
      (\ AnyValue'Value
p__
         -> case AnyValue'Value
p__ of
              (AnyValue'StringValue Text
p__val) -> Text -> Maybe Text
forall a. a -> Maybe a
Prelude.Just Text
p__val
              AnyValue'Value
_otherwise -> Maybe Text
forall a. Maybe a
Prelude.Nothing)
_AnyValue'BoolValue ::
  Data.ProtoLens.Prism.Prism' AnyValue'Value Prelude.Bool
_AnyValue'BoolValue :: p Bool (f Bool) -> p AnyValue'Value (f AnyValue'Value)
_AnyValue'BoolValue
  = (Bool -> AnyValue'Value)
-> (AnyValue'Value -> Maybe Bool)
-> Prism AnyValue'Value AnyValue'Value Bool Bool
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Data.ProtoLens.Prism.prism'
      Bool -> AnyValue'Value
AnyValue'BoolValue
      (\ AnyValue'Value
p__
         -> case AnyValue'Value
p__ of
              (AnyValue'BoolValue Bool
p__val) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude.Just Bool
p__val
              AnyValue'Value
_otherwise -> Maybe Bool
forall a. Maybe a
Prelude.Nothing)
_AnyValue'IntValue ::
  Data.ProtoLens.Prism.Prism' AnyValue'Value Data.Int.Int64
_AnyValue'IntValue :: p Int64 (f Int64) -> p AnyValue'Value (f AnyValue'Value)
_AnyValue'IntValue
  = (Int64 -> AnyValue'Value)
-> (AnyValue'Value -> Maybe Int64)
-> Prism AnyValue'Value AnyValue'Value Int64 Int64
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Data.ProtoLens.Prism.prism'
      Int64 -> AnyValue'Value
AnyValue'IntValue
      (\ AnyValue'Value
p__
         -> case AnyValue'Value
p__ of
              (AnyValue'IntValue Int64
p__val) -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Prelude.Just Int64
p__val
              AnyValue'Value
_otherwise -> Maybe Int64
forall a. Maybe a
Prelude.Nothing)
_AnyValue'DoubleValue ::
  Data.ProtoLens.Prism.Prism' AnyValue'Value Prelude.Double
_AnyValue'DoubleValue :: p Double (f Double) -> p AnyValue'Value (f AnyValue'Value)
_AnyValue'DoubleValue
  = (Double -> AnyValue'Value)
-> (AnyValue'Value -> Maybe Double)
-> Prism AnyValue'Value AnyValue'Value Double Double
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Data.ProtoLens.Prism.prism'
      Double -> AnyValue'Value
AnyValue'DoubleValue
      (\ AnyValue'Value
p__
         -> case AnyValue'Value
p__ of
              (AnyValue'DoubleValue Double
p__val) -> Double -> Maybe Double
forall a. a -> Maybe a
Prelude.Just Double
p__val
              AnyValue'Value
_otherwise -> Maybe Double
forall a. Maybe a
Prelude.Nothing)
_AnyValue'ArrayValue ::
  Data.ProtoLens.Prism.Prism' AnyValue'Value ArrayValue
_AnyValue'ArrayValue :: p ArrayValue (f ArrayValue) -> p AnyValue'Value (f AnyValue'Value)
_AnyValue'ArrayValue
  = (ArrayValue -> AnyValue'Value)
-> (AnyValue'Value -> Maybe ArrayValue)
-> Prism AnyValue'Value AnyValue'Value ArrayValue ArrayValue
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Data.ProtoLens.Prism.prism'
      ArrayValue -> AnyValue'Value
AnyValue'ArrayValue
      (\ AnyValue'Value
p__
         -> case AnyValue'Value
p__ of
              (AnyValue'ArrayValue ArrayValue
p__val) -> ArrayValue -> Maybe ArrayValue
forall a. a -> Maybe a
Prelude.Just ArrayValue
p__val
              AnyValue'Value
_otherwise -> Maybe ArrayValue
forall a. Maybe a
Prelude.Nothing)
_AnyValue'KvlistValue ::
  Data.ProtoLens.Prism.Prism' AnyValue'Value KeyValueList
_AnyValue'KvlistValue :: p KeyValueList (f KeyValueList)
-> p AnyValue'Value (f AnyValue'Value)
_AnyValue'KvlistValue
  = (KeyValueList -> AnyValue'Value)
-> (AnyValue'Value -> Maybe KeyValueList)
-> Prism AnyValue'Value AnyValue'Value KeyValueList KeyValueList
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Data.ProtoLens.Prism.prism'
      KeyValueList -> AnyValue'Value
AnyValue'KvlistValue
      (\ AnyValue'Value
p__
         -> case AnyValue'Value
p__ of
              (AnyValue'KvlistValue KeyValueList
p__val) -> KeyValueList -> Maybe KeyValueList
forall a. a -> Maybe a
Prelude.Just KeyValueList
p__val
              AnyValue'Value
_otherwise -> Maybe KeyValueList
forall a. Maybe a
Prelude.Nothing)
_AnyValue'BytesValue ::
  Data.ProtoLens.Prism.Prism' AnyValue'Value Data.ByteString.ByteString
_AnyValue'BytesValue :: p ByteString (f ByteString) -> p AnyValue'Value (f AnyValue'Value)
_AnyValue'BytesValue
  = (ByteString -> AnyValue'Value)
-> (AnyValue'Value -> Maybe ByteString)
-> Prism AnyValue'Value AnyValue'Value ByteString ByteString
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
Data.ProtoLens.Prism.prism'
      ByteString -> AnyValue'Value
AnyValue'BytesValue
      (\ AnyValue'Value
p__
         -> case AnyValue'Value
p__ of
              (AnyValue'BytesValue ByteString
p__val) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Prelude.Just ByteString
p__val
              AnyValue'Value
_otherwise -> Maybe ByteString
forall a. Maybe a
Prelude.Nothing)
{- | Fields :
     
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.values' @:: Lens' ArrayValue [AnyValue]@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.vec'values' @:: Lens' ArrayValue (Data.Vector.Vector AnyValue)@ -}
data ArrayValue
  = ArrayValue'_constructor {ArrayValue -> Vector AnyValue
_ArrayValue'values :: !(Data.Vector.Vector AnyValue),
                             ArrayValue -> FieldSet
_ArrayValue'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (ArrayValue -> ArrayValue -> Bool
(ArrayValue -> ArrayValue -> Bool)
-> (ArrayValue -> ArrayValue -> Bool) -> Eq ArrayValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrayValue -> ArrayValue -> Bool
$c/= :: ArrayValue -> ArrayValue -> Bool
== :: ArrayValue -> ArrayValue -> Bool
$c== :: ArrayValue -> ArrayValue -> Bool
Prelude.Eq, Eq ArrayValue
Eq ArrayValue
-> (ArrayValue -> ArrayValue -> Ordering)
-> (ArrayValue -> ArrayValue -> Bool)
-> (ArrayValue -> ArrayValue -> Bool)
-> (ArrayValue -> ArrayValue -> Bool)
-> (ArrayValue -> ArrayValue -> Bool)
-> (ArrayValue -> ArrayValue -> ArrayValue)
-> (ArrayValue -> ArrayValue -> ArrayValue)
-> Ord ArrayValue
ArrayValue -> ArrayValue -> Bool
ArrayValue -> ArrayValue -> Ordering
ArrayValue -> ArrayValue -> ArrayValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArrayValue -> ArrayValue -> ArrayValue
$cmin :: ArrayValue -> ArrayValue -> ArrayValue
max :: ArrayValue -> ArrayValue -> ArrayValue
$cmax :: ArrayValue -> ArrayValue -> ArrayValue
>= :: ArrayValue -> ArrayValue -> Bool
$c>= :: ArrayValue -> ArrayValue -> Bool
> :: ArrayValue -> ArrayValue -> Bool
$c> :: ArrayValue -> ArrayValue -> Bool
<= :: ArrayValue -> ArrayValue -> Bool
$c<= :: ArrayValue -> ArrayValue -> Bool
< :: ArrayValue -> ArrayValue -> Bool
$c< :: ArrayValue -> ArrayValue -> Bool
compare :: ArrayValue -> ArrayValue -> Ordering
$ccompare :: ArrayValue -> ArrayValue -> Ordering
$cp1Ord :: Eq ArrayValue
Prelude.Ord)
instance Prelude.Show ArrayValue where
  showsPrec :: Int -> ArrayValue -> ShowS
showsPrec Int
_ ArrayValue
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (ArrayValue -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort ArrayValue
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField ArrayValue "values" [AnyValue] where
  fieldOf :: Proxy# "values"
-> ([AnyValue] -> f [AnyValue]) -> ArrayValue -> f ArrayValue
fieldOf Proxy# "values"
_
    = ((Vector AnyValue -> f (Vector AnyValue))
 -> ArrayValue -> f ArrayValue)
-> (([AnyValue] -> f [AnyValue])
    -> Vector AnyValue -> f (Vector AnyValue))
-> ([AnyValue] -> f [AnyValue])
-> ArrayValue
-> f ArrayValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((ArrayValue -> Vector AnyValue)
-> (ArrayValue -> Vector AnyValue -> ArrayValue)
-> Lens ArrayValue ArrayValue (Vector AnyValue) (Vector AnyValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           ArrayValue -> Vector AnyValue
_ArrayValue'values (\ ArrayValue
x__ Vector AnyValue
y__ -> ArrayValue
x__ {_ArrayValue'values :: Vector AnyValue
_ArrayValue'values = Vector AnyValue
y__}))
        ((Vector AnyValue -> [AnyValue])
-> (Vector AnyValue -> [AnyValue] -> Vector AnyValue)
-> Lens (Vector AnyValue) (Vector AnyValue) [AnyValue] [AnyValue]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector AnyValue -> [AnyValue]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector AnyValue
_ [AnyValue]
y__ -> [AnyValue] -> Vector AnyValue
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [AnyValue]
y__))
instance Data.ProtoLens.Field.HasField ArrayValue "vec'values" (Data.Vector.Vector AnyValue) where
  fieldOf :: Proxy# "vec'values"
-> (Vector AnyValue -> f (Vector AnyValue))
-> ArrayValue
-> f ArrayValue
fieldOf Proxy# "vec'values"
_
    = ((Vector AnyValue -> f (Vector AnyValue))
 -> ArrayValue -> f ArrayValue)
-> ((Vector AnyValue -> f (Vector AnyValue))
    -> Vector AnyValue -> f (Vector AnyValue))
-> (Vector AnyValue -> f (Vector AnyValue))
-> ArrayValue
-> f ArrayValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((ArrayValue -> Vector AnyValue)
-> (ArrayValue -> Vector AnyValue -> ArrayValue)
-> Lens ArrayValue ArrayValue (Vector AnyValue) (Vector AnyValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           ArrayValue -> Vector AnyValue
_ArrayValue'values (\ ArrayValue
x__ Vector AnyValue
y__ -> ArrayValue
x__ {_ArrayValue'values :: Vector AnyValue
_ArrayValue'values = Vector AnyValue
y__}))
        (Vector AnyValue -> f (Vector AnyValue))
-> Vector AnyValue -> f (Vector AnyValue)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message ArrayValue where
  messageName :: Proxy ArrayValue -> Text
messageName Proxy ArrayValue
_
    = String -> Text
Data.Text.pack String
"opentelemetry.proto.common.v1.ArrayValue"
  packedMessageDescriptor :: Proxy ArrayValue -> ByteString
packedMessageDescriptor Proxy ArrayValue
_
    = ByteString
"\n\
      \\n\
      \ArrayValue\DC2?\n\
      \\ACKvalues\CAN\SOH \ETX(\v2'.opentelemetry.proto.common.v1.AnyValueR\ACKvalues"
  packedFileDescriptor :: Proxy ArrayValue -> ByteString
packedFileDescriptor Proxy ArrayValue
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor ArrayValue)
fieldsByTag
    = let
        values__field_descriptor :: FieldDescriptor ArrayValue
values__field_descriptor
          = String
-> FieldTypeDescriptor AnyValue
-> FieldAccessor ArrayValue AnyValue
-> FieldDescriptor ArrayValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"values"
              (MessageOrGroup -> FieldTypeDescriptor AnyValue
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor AnyValue)
              (Packing
-> Lens' ArrayValue [AnyValue] -> FieldAccessor ArrayValue AnyValue
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "values" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"values")) ::
              Data.ProtoLens.FieldDescriptor ArrayValue
      in
        [(Tag, FieldDescriptor ArrayValue)]
-> Map Tag (FieldDescriptor ArrayValue)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor ArrayValue
values__field_descriptor)]
  unknownFields :: LensLike' f ArrayValue FieldSet
unknownFields
    = (ArrayValue -> FieldSet)
-> (ArrayValue -> FieldSet -> ArrayValue)
-> Lens' ArrayValue FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        ArrayValue -> FieldSet
_ArrayValue'_unknownFields
        (\ ArrayValue
x__ FieldSet
y__ -> ArrayValue
x__ {_ArrayValue'_unknownFields :: FieldSet
_ArrayValue'_unknownFields = FieldSet
y__})
  defMessage :: ArrayValue
defMessage
    = ArrayValue'_constructor :: Vector AnyValue -> FieldSet -> ArrayValue
ArrayValue'_constructor
        {_ArrayValue'values :: Vector AnyValue
_ArrayValue'values = Vector AnyValue
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _ArrayValue'_unknownFields :: FieldSet
_ArrayValue'_unknownFields = []}
  parseMessage :: Parser ArrayValue
parseMessage
    = let
        loop ::
          ArrayValue
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld AnyValue
             -> Data.ProtoLens.Encoding.Bytes.Parser ArrayValue
        loop :: ArrayValue
-> Growing Vector RealWorld AnyValue -> Parser ArrayValue
loop ArrayValue
x Growing Vector RealWorld AnyValue
mutable'values
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector AnyValue
frozen'values <- IO (Vector AnyValue) -> Parser (Vector AnyValue)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                         (Growing Vector (PrimState IO) AnyValue -> IO (Vector AnyValue)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Growing v (PrimState m) a -> m (v a)
Data.ProtoLens.Encoding.Growing.unsafeFreeze
                                            Growing Vector RealWorld AnyValue
Growing Vector (PrimState IO) AnyValue
mutable'values)
                      (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      ArrayValue -> Parser ArrayValue
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter ArrayValue ArrayValue FieldSet FieldSet
-> (FieldSet -> FieldSet) -> ArrayValue -> ArrayValue
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter ArrayValue ArrayValue FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter ArrayValue ArrayValue (Vector AnyValue) (Vector AnyValue)
-> Vector AnyValue -> ArrayValue -> ArrayValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'values" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'values") Vector AnyValue
frozen'values ArrayValue
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !AnyValue
y <- Parser AnyValue -> String -> Parser AnyValue
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser AnyValue -> Parser AnyValue
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                              (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                              Parser AnyValue
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"values"
                                Growing Vector RealWorld AnyValue
v <- IO (Growing Vector RealWorld AnyValue)
-> Parser (Growing Vector RealWorld AnyValue)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) AnyValue
-> AnyValue -> IO (Growing Vector (PrimState IO) AnyValue)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Growing v (PrimState m) a -> a -> m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.append Growing Vector RealWorld AnyValue
Growing Vector (PrimState IO) AnyValue
mutable'values AnyValue
y)
                                ArrayValue
-> Growing Vector RealWorld AnyValue -> Parser ArrayValue
loop ArrayValue
x Growing Vector RealWorld AnyValue
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                ArrayValue
-> Growing Vector RealWorld AnyValue -> Parser ArrayValue
loop
                                  (Setter ArrayValue ArrayValue FieldSet FieldSet
-> (FieldSet -> FieldSet) -> ArrayValue -> ArrayValue
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter ArrayValue ArrayValue FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) ArrayValue
x)
                                  Growing Vector RealWorld AnyValue
mutable'values
      in
        Parser ArrayValue -> String -> Parser ArrayValue
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld AnyValue
mutable'values <- IO (Growing Vector RealWorld AnyValue)
-> Parser (Growing Vector RealWorld AnyValue)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                  IO (Growing Vector RealWorld AnyValue)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              ArrayValue
-> Growing Vector RealWorld AnyValue -> Parser ArrayValue
loop ArrayValue
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld AnyValue
mutable'values)
          String
"ArrayValue"
  buildMessage :: ArrayValue -> Builder
buildMessage
    = \ ArrayValue
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((AnyValue -> Builder) -> Vector AnyValue -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ AnyValue
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (AnyValue -> ByteString) -> AnyValue -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                           (\ ByteString
bs
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                      (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                   (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                           AnyValue -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage AnyValue
_v))
                (FoldLike
  (Vector AnyValue)
  ArrayValue
  ArrayValue
  (Vector AnyValue)
  (Vector AnyValue)
-> ArrayValue -> Vector AnyValue
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'values" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'values") ArrayValue
_x))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet ArrayValue ArrayValue FieldSet FieldSet
-> ArrayValue -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet ArrayValue ArrayValue FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields ArrayValue
_x))
instance Control.DeepSeq.NFData ArrayValue where
  rnf :: ArrayValue -> ()
rnf
    = \ ArrayValue
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (ArrayValue -> FieldSet
_ArrayValue'_unknownFields ArrayValue
x__)
             (Vector AnyValue -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (ArrayValue -> Vector AnyValue
_ArrayValue'values ArrayValue
x__) ())
{- | Fields :
     
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.name' @:: Lens' InstrumentationLibrary Data.Text.Text@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.version' @:: Lens' InstrumentationLibrary Data.Text.Text@ -}
data InstrumentationLibrary
  = InstrumentationLibrary'_constructor {InstrumentationLibrary -> Text
_InstrumentationLibrary'name :: !Data.Text.Text,
                                         InstrumentationLibrary -> Text
_InstrumentationLibrary'version :: !Data.Text.Text,
                                         InstrumentationLibrary -> FieldSet
_InstrumentationLibrary'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (InstrumentationLibrary -> InstrumentationLibrary -> Bool
(InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> (InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> Eq InstrumentationLibrary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$c/= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
== :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$c== :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
Prelude.Eq, Eq InstrumentationLibrary
Eq InstrumentationLibrary
-> (InstrumentationLibrary -> InstrumentationLibrary -> Ordering)
-> (InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> (InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> (InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> (InstrumentationLibrary -> InstrumentationLibrary -> Bool)
-> (InstrumentationLibrary
    -> InstrumentationLibrary -> InstrumentationLibrary)
-> (InstrumentationLibrary
    -> InstrumentationLibrary -> InstrumentationLibrary)
-> Ord InstrumentationLibrary
InstrumentationLibrary -> InstrumentationLibrary -> Bool
InstrumentationLibrary -> InstrumentationLibrary -> Ordering
InstrumentationLibrary
-> InstrumentationLibrary -> InstrumentationLibrary
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InstrumentationLibrary
-> InstrumentationLibrary -> InstrumentationLibrary
$cmin :: InstrumentationLibrary
-> InstrumentationLibrary -> InstrumentationLibrary
max :: InstrumentationLibrary
-> InstrumentationLibrary -> InstrumentationLibrary
$cmax :: InstrumentationLibrary
-> InstrumentationLibrary -> InstrumentationLibrary
>= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$c>= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
> :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$c> :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
<= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$c<= :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
< :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
$c< :: InstrumentationLibrary -> InstrumentationLibrary -> Bool
compare :: InstrumentationLibrary -> InstrumentationLibrary -> Ordering
$ccompare :: InstrumentationLibrary -> InstrumentationLibrary -> Ordering
$cp1Ord :: Eq InstrumentationLibrary
Prelude.Ord)
instance Prelude.Show InstrumentationLibrary where
  showsPrec :: Int -> InstrumentationLibrary -> ShowS
showsPrec Int
_ InstrumentationLibrary
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (InstrumentationLibrary -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort InstrumentationLibrary
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField InstrumentationLibrary "name" Data.Text.Text where
  fieldOf :: Proxy# "name"
-> (Text -> f Text)
-> InstrumentationLibrary
-> f InstrumentationLibrary
fieldOf Proxy# "name"
_
    = ((Text -> f Text)
 -> InstrumentationLibrary -> f InstrumentationLibrary)
-> ((Text -> f Text) -> Text -> f Text)
-> (Text -> f Text)
-> InstrumentationLibrary
-> f InstrumentationLibrary
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InstrumentationLibrary -> Text)
-> (InstrumentationLibrary -> Text -> InstrumentationLibrary)
-> Lens InstrumentationLibrary InstrumentationLibrary Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InstrumentationLibrary -> Text
_InstrumentationLibrary'name
           (\ InstrumentationLibrary
x__ Text
y__ -> InstrumentationLibrary
x__ {_InstrumentationLibrary'name :: Text
_InstrumentationLibrary'name = Text
y__}))
        (Text -> f Text) -> Text -> f Text
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField InstrumentationLibrary "version" Data.Text.Text where
  fieldOf :: Proxy# "version"
-> (Text -> f Text)
-> InstrumentationLibrary
-> f InstrumentationLibrary
fieldOf Proxy# "version"
_
    = ((Text -> f Text)
 -> InstrumentationLibrary -> f InstrumentationLibrary)
-> ((Text -> f Text) -> Text -> f Text)
-> (Text -> f Text)
-> InstrumentationLibrary
-> f InstrumentationLibrary
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((InstrumentationLibrary -> Text)
-> (InstrumentationLibrary -> Text -> InstrumentationLibrary)
-> Lens InstrumentationLibrary InstrumentationLibrary Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           InstrumentationLibrary -> Text
_InstrumentationLibrary'version
           (\ InstrumentationLibrary
x__ Text
y__ -> InstrumentationLibrary
x__ {_InstrumentationLibrary'version :: Text
_InstrumentationLibrary'version = Text
y__}))
        (Text -> f Text) -> Text -> f Text
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message InstrumentationLibrary where
  messageName :: Proxy InstrumentationLibrary -> Text
messageName Proxy InstrumentationLibrary
_
    = String -> Text
Data.Text.pack
        String
"opentelemetry.proto.common.v1.InstrumentationLibrary"
  packedMessageDescriptor :: Proxy InstrumentationLibrary -> ByteString
packedMessageDescriptor Proxy InstrumentationLibrary
_
    = ByteString
"\n\
      \\SYNInstrumentationLibrary\DC2\DC2\n\
      \\EOTname\CAN\SOH \SOH(\tR\EOTname\DC2\CAN\n\
      \\aversion\CAN\STX \SOH(\tR\aversion"
  packedFileDescriptor :: Proxy InstrumentationLibrary -> ByteString
packedFileDescriptor Proxy InstrumentationLibrary
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor InstrumentationLibrary)
fieldsByTag
    = let
        name__field_descriptor :: FieldDescriptor InstrumentationLibrary
name__field_descriptor
          = String
-> FieldTypeDescriptor Text
-> FieldAccessor InstrumentationLibrary Text
-> FieldDescriptor InstrumentationLibrary
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"name"
              (ScalarField Text -> FieldTypeDescriptor Text
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Text
Data.ProtoLens.StringField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)
              (WireDefault Text
-> Lens InstrumentationLibrary InstrumentationLibrary Text Text
-> FieldAccessor InstrumentationLibrary Text
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Text
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name")) ::
              Data.ProtoLens.FieldDescriptor InstrumentationLibrary
        version__field_descriptor :: FieldDescriptor InstrumentationLibrary
version__field_descriptor
          = String
-> FieldTypeDescriptor Text
-> FieldAccessor InstrumentationLibrary Text
-> FieldDescriptor InstrumentationLibrary
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"version"
              (ScalarField Text -> FieldTypeDescriptor Text
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Text
Data.ProtoLens.StringField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)
              (WireDefault Text
-> Lens InstrumentationLibrary InstrumentationLibrary Text Text
-> FieldAccessor InstrumentationLibrary Text
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Text
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall s a (f :: * -> *).
(HasField s "version" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"version")) ::
              Data.ProtoLens.FieldDescriptor InstrumentationLibrary
      in
        [(Tag, FieldDescriptor InstrumentationLibrary)]
-> Map Tag (FieldDescriptor InstrumentationLibrary)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor InstrumentationLibrary
name__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor InstrumentationLibrary
version__field_descriptor)]
  unknownFields :: LensLike' f InstrumentationLibrary FieldSet
unknownFields
    = (InstrumentationLibrary -> FieldSet)
-> (InstrumentationLibrary -> FieldSet -> InstrumentationLibrary)
-> Lens' InstrumentationLibrary FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        InstrumentationLibrary -> FieldSet
_InstrumentationLibrary'_unknownFields
        (\ InstrumentationLibrary
x__ FieldSet
y__ -> InstrumentationLibrary
x__ {_InstrumentationLibrary'_unknownFields :: FieldSet
_InstrumentationLibrary'_unknownFields = FieldSet
y__})
  defMessage :: InstrumentationLibrary
defMessage
    = InstrumentationLibrary'_constructor :: Text -> Text -> FieldSet -> InstrumentationLibrary
InstrumentationLibrary'_constructor
        {_InstrumentationLibrary'name :: Text
_InstrumentationLibrary'name = Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _InstrumentationLibrary'version :: Text
_InstrumentationLibrary'version = Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _InstrumentationLibrary'_unknownFields :: FieldSet
_InstrumentationLibrary'_unknownFields = []}
  parseMessage :: Parser InstrumentationLibrary
parseMessage
    = let
        loop ::
          InstrumentationLibrary
          -> Data.ProtoLens.Encoding.Bytes.Parser InstrumentationLibrary
        loop :: InstrumentationLibrary -> Parser InstrumentationLibrary
loop InstrumentationLibrary
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      InstrumentationLibrary -> Parser InstrumentationLibrary
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter
  InstrumentationLibrary InstrumentationLibrary FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> InstrumentationLibrary
-> InstrumentationLibrary
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter
  InstrumentationLibrary InstrumentationLibrary FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) InstrumentationLibrary
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Text
y <- Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do ByteString
value <- do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                                       Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                                         (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                           Either String Text -> Parser Text
forall a. Either String a -> Parser a
Data.ProtoLens.Encoding.Bytes.runEither
                                             (case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
value of
                                                (Prelude.Left UnicodeException
err)
                                                  -> String -> Either String Text
forall a b. a -> Either a b
Prelude.Left (UnicodeException -> String
forall a. Show a => a -> String
Prelude.show UnicodeException
err)
                                                (Prelude.Right Text
r) -> Text -> Either String Text
forall a b. b -> Either a b
Prelude.Right Text
r))
                                       String
"name"
                                InstrumentationLibrary -> Parser InstrumentationLibrary
loop (Setter InstrumentationLibrary InstrumentationLibrary Text Text
-> Text -> InstrumentationLibrary -> InstrumentationLibrary
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") Text
y InstrumentationLibrary
x)
                        Word64
18
                          -> do Text
y <- Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do ByteString
value <- do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                                       Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                                         (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                           Either String Text -> Parser Text
forall a. Either String a -> Parser a
Data.ProtoLens.Encoding.Bytes.runEither
                                             (case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
value of
                                                (Prelude.Left UnicodeException
err)
                                                  -> String -> Either String Text
forall a b. a -> Either a b
Prelude.Left (UnicodeException -> String
forall a. Show a => a -> String
Prelude.show UnicodeException
err)
                                                (Prelude.Right Text
r) -> Text -> Either String Text
forall a b. b -> Either a b
Prelude.Right Text
r))
                                       String
"version"
                                InstrumentationLibrary -> Parser InstrumentationLibrary
loop (Setter InstrumentationLibrary InstrumentationLibrary Text Text
-> Text -> InstrumentationLibrary -> InstrumentationLibrary
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "version" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"version") Text
y InstrumentationLibrary
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                InstrumentationLibrary -> Parser InstrumentationLibrary
loop
                                  (Setter
  InstrumentationLibrary InstrumentationLibrary FieldSet FieldSet
-> (FieldSet -> FieldSet)
-> InstrumentationLibrary
-> InstrumentationLibrary
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter
  InstrumentationLibrary InstrumentationLibrary FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) InstrumentationLibrary
x)
      in
        Parser InstrumentationLibrary
-> String -> Parser InstrumentationLibrary
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do InstrumentationLibrary -> Parser InstrumentationLibrary
loop InstrumentationLibrary
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"InstrumentationLibrary"
  buildMessage :: InstrumentationLibrary -> Builder
buildMessage
    = \ InstrumentationLibrary
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (let _v :: Text
_v = FoldLike
  Text InstrumentationLibrary InstrumentationLibrary Text Text
-> InstrumentationLibrary -> Text
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "name" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"name") InstrumentationLibrary
_x
              in
                if Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) Text
_v Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                    Builder
forall a. Monoid a => a
Data.Monoid.mempty
                else
                    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                      ((ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                         (\ ByteString
bs
                            -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                 (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                    (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                 (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                         Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
_v))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (let
                   _v :: Text
_v = FoldLike
  Text InstrumentationLibrary InstrumentationLibrary Text Text
-> InstrumentationLibrary -> Text
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "version" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"version") InstrumentationLibrary
_x
                 in
                   if Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) Text
_v Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                       Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   else
                       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                         ((ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                            (\ ByteString
bs
                               -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                    (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                       (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                    (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                            Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
_v))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike
  FieldSet
  InstrumentationLibrary
  InstrumentationLibrary
  FieldSet
  FieldSet
-> InstrumentationLibrary -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike
  FieldSet
  InstrumentationLibrary
  InstrumentationLibrary
  FieldSet
  FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields InstrumentationLibrary
_x)))
instance Control.DeepSeq.NFData InstrumentationLibrary where
  rnf :: InstrumentationLibrary -> ()
rnf
    = \ InstrumentationLibrary
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (InstrumentationLibrary -> FieldSet
_InstrumentationLibrary'_unknownFields InstrumentationLibrary
x__)
             (Text -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (InstrumentationLibrary -> Text
_InstrumentationLibrary'name InstrumentationLibrary
x__)
                (Text -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (InstrumentationLibrary -> Text
_InstrumentationLibrary'version InstrumentationLibrary
x__) ()))
{- | Fields :
     
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.key' @:: Lens' KeyValue Data.Text.Text@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.value' @:: Lens' KeyValue AnyValue@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.maybe'value' @:: Lens' KeyValue (Prelude.Maybe AnyValue)@ -}
data KeyValue
  = KeyValue'_constructor {KeyValue -> Text
_KeyValue'key :: !Data.Text.Text,
                           KeyValue -> Maybe AnyValue
_KeyValue'value :: !(Prelude.Maybe AnyValue),
                           KeyValue -> FieldSet
_KeyValue'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (KeyValue -> KeyValue -> Bool
(KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> Bool) -> Eq KeyValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyValue -> KeyValue -> Bool
$c/= :: KeyValue -> KeyValue -> Bool
== :: KeyValue -> KeyValue -> Bool
$c== :: KeyValue -> KeyValue -> Bool
Prelude.Eq, Eq KeyValue
Eq KeyValue
-> (KeyValue -> KeyValue -> Ordering)
-> (KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> KeyValue)
-> (KeyValue -> KeyValue -> KeyValue)
-> Ord KeyValue
KeyValue -> KeyValue -> Bool
KeyValue -> KeyValue -> Ordering
KeyValue -> KeyValue -> KeyValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeyValue -> KeyValue -> KeyValue
$cmin :: KeyValue -> KeyValue -> KeyValue
max :: KeyValue -> KeyValue -> KeyValue
$cmax :: KeyValue -> KeyValue -> KeyValue
>= :: KeyValue -> KeyValue -> Bool
$c>= :: KeyValue -> KeyValue -> Bool
> :: KeyValue -> KeyValue -> Bool
$c> :: KeyValue -> KeyValue -> Bool
<= :: KeyValue -> KeyValue -> Bool
$c<= :: KeyValue -> KeyValue -> Bool
< :: KeyValue -> KeyValue -> Bool
$c< :: KeyValue -> KeyValue -> Bool
compare :: KeyValue -> KeyValue -> Ordering
$ccompare :: KeyValue -> KeyValue -> Ordering
$cp1Ord :: Eq KeyValue
Prelude.Ord)
instance Prelude.Show KeyValue where
  showsPrec :: Int -> KeyValue -> ShowS
showsPrec Int
_ KeyValue
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (KeyValue -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort KeyValue
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField KeyValue "key" Data.Text.Text where
  fieldOf :: Proxy# "key" -> (Text -> f Text) -> KeyValue -> f KeyValue
fieldOf Proxy# "key"
_
    = ((Text -> f Text) -> KeyValue -> f KeyValue)
-> ((Text -> f Text) -> Text -> f Text)
-> (Text -> f Text)
-> KeyValue
-> f KeyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((KeyValue -> Text)
-> (KeyValue -> Text -> KeyValue)
-> Lens KeyValue KeyValue Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           KeyValue -> Text
_KeyValue'key (\ KeyValue
x__ Text
y__ -> KeyValue
x__ {_KeyValue'key :: Text
_KeyValue'key = Text
y__}))
        (Text -> f Text) -> Text -> f Text
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField KeyValue "value" AnyValue where
  fieldOf :: Proxy# "value"
-> (AnyValue -> f AnyValue) -> KeyValue -> f KeyValue
fieldOf Proxy# "value"
_
    = ((Maybe AnyValue -> f (Maybe AnyValue)) -> KeyValue -> f KeyValue)
-> ((AnyValue -> f AnyValue)
    -> Maybe AnyValue -> f (Maybe AnyValue))
-> (AnyValue -> f AnyValue)
-> KeyValue
-> f KeyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((KeyValue -> Maybe AnyValue)
-> (KeyValue -> Maybe AnyValue -> KeyValue)
-> Lens KeyValue KeyValue (Maybe AnyValue) (Maybe AnyValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           KeyValue -> Maybe AnyValue
_KeyValue'value (\ KeyValue
x__ Maybe AnyValue
y__ -> KeyValue
x__ {_KeyValue'value :: Maybe AnyValue
_KeyValue'value = Maybe AnyValue
y__}))
        (AnyValue -> Lens' (Maybe AnyValue) AnyValue
forall b. b -> Lens' (Maybe b) b
Data.ProtoLens.maybeLens AnyValue
forall msg. Message msg => msg
Data.ProtoLens.defMessage)
instance Data.ProtoLens.Field.HasField KeyValue "maybe'value" (Prelude.Maybe AnyValue) where
  fieldOf :: Proxy# "maybe'value"
-> (Maybe AnyValue -> f (Maybe AnyValue)) -> KeyValue -> f KeyValue
fieldOf Proxy# "maybe'value"
_
    = ((Maybe AnyValue -> f (Maybe AnyValue)) -> KeyValue -> f KeyValue)
-> ((Maybe AnyValue -> f (Maybe AnyValue))
    -> Maybe AnyValue -> f (Maybe AnyValue))
-> (Maybe AnyValue -> f (Maybe AnyValue))
-> KeyValue
-> f KeyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((KeyValue -> Maybe AnyValue)
-> (KeyValue -> Maybe AnyValue -> KeyValue)
-> Lens KeyValue KeyValue (Maybe AnyValue) (Maybe AnyValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           KeyValue -> Maybe AnyValue
_KeyValue'value (\ KeyValue
x__ Maybe AnyValue
y__ -> KeyValue
x__ {_KeyValue'value :: Maybe AnyValue
_KeyValue'value = Maybe AnyValue
y__}))
        (Maybe AnyValue -> f (Maybe AnyValue))
-> Maybe AnyValue -> f (Maybe AnyValue)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message KeyValue where
  messageName :: Proxy KeyValue -> Text
messageName Proxy KeyValue
_
    = String -> Text
Data.Text.pack String
"opentelemetry.proto.common.v1.KeyValue"
  packedMessageDescriptor :: Proxy KeyValue -> ByteString
packedMessageDescriptor Proxy KeyValue
_
    = ByteString
"\n\
      \\bKeyValue\DC2\DLE\n\
      \\ETXkey\CAN\SOH \SOH(\tR\ETXkey\DC2=\n\
      \\ENQvalue\CAN\STX \SOH(\v2'.opentelemetry.proto.common.v1.AnyValueR\ENQvalue"
  packedFileDescriptor :: Proxy KeyValue -> ByteString
packedFileDescriptor Proxy KeyValue
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor KeyValue)
fieldsByTag
    = let
        key__field_descriptor :: FieldDescriptor KeyValue
key__field_descriptor
          = String
-> FieldTypeDescriptor Text
-> FieldAccessor KeyValue Text
-> FieldDescriptor KeyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (ScalarField Text -> FieldTypeDescriptor Text
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Text
Data.ProtoLens.StringField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)
              (WireDefault Text
-> Lens KeyValue KeyValue Text Text -> FieldAccessor KeyValue Text
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Text
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor KeyValue
        value__field_descriptor :: FieldDescriptor KeyValue
value__field_descriptor
          = String
-> FieldTypeDescriptor AnyValue
-> FieldAccessor KeyValue AnyValue
-> FieldDescriptor KeyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"value"
              (MessageOrGroup -> FieldTypeDescriptor AnyValue
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor AnyValue)
              (Lens KeyValue KeyValue (Maybe AnyValue) (Maybe AnyValue)
-> FieldAccessor KeyValue AnyValue
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
Data.ProtoLens.OptionalField
                 (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value")) ::
              Data.ProtoLens.FieldDescriptor KeyValue
      in
        [(Tag, FieldDescriptor KeyValue)]
-> Map Tag (FieldDescriptor KeyValue)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor KeyValue
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor KeyValue
value__field_descriptor)]
  unknownFields :: LensLike' f KeyValue FieldSet
unknownFields
    = (KeyValue -> FieldSet)
-> (KeyValue -> FieldSet -> KeyValue) -> Lens' KeyValue FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        KeyValue -> FieldSet
_KeyValue'_unknownFields
        (\ KeyValue
x__ FieldSet
y__ -> KeyValue
x__ {_KeyValue'_unknownFields :: FieldSet
_KeyValue'_unknownFields = FieldSet
y__})
  defMessage :: KeyValue
defMessage
    = KeyValue'_constructor :: Text -> Maybe AnyValue -> FieldSet -> KeyValue
KeyValue'_constructor
        {_KeyValue'key :: Text
_KeyValue'key = Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _KeyValue'value :: Maybe AnyValue
_KeyValue'value = Maybe AnyValue
forall a. Maybe a
Prelude.Nothing, _KeyValue'_unknownFields :: FieldSet
_KeyValue'_unknownFields = []}
  parseMessage :: Parser KeyValue
parseMessage
    = let
        loop :: KeyValue -> Data.ProtoLens.Encoding.Bytes.Parser KeyValue
        loop :: KeyValue -> Parser KeyValue
loop KeyValue
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      KeyValue -> Parser KeyValue
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter KeyValue KeyValue FieldSet FieldSet
-> (FieldSet -> FieldSet) -> KeyValue -> KeyValue
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter KeyValue KeyValue FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) KeyValue
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Text
y <- Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do ByteString
value <- do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                                       Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                                         (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                           Either String Text -> Parser Text
forall a. Either String a -> Parser a
Data.ProtoLens.Encoding.Bytes.runEither
                                             (case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
value of
                                                (Prelude.Left UnicodeException
err)
                                                  -> String -> Either String Text
forall a b. a -> Either a b
Prelude.Left (UnicodeException -> String
forall a. Show a => a -> String
Prelude.show UnicodeException
err)
                                                (Prelude.Right Text
r) -> Text -> Either String Text
forall a b. b -> Either a b
Prelude.Right Text
r))
                                       String
"key"
                                KeyValue -> Parser KeyValue
loop (Setter KeyValue KeyValue Text Text -> Text -> KeyValue -> KeyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") Text
y KeyValue
x)
                        Word64
18
                          -> do AnyValue
y <- Parser AnyValue -> String -> Parser AnyValue
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                           Int -> Parser AnyValue -> Parser AnyValue
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                             (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len) Parser AnyValue
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                       String
"value"
                                KeyValue -> Parser KeyValue
loop (Setter KeyValue KeyValue AnyValue AnyValue
-> AnyValue -> KeyValue -> KeyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value") AnyValue
y KeyValue
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                KeyValue -> Parser KeyValue
loop
                                  (Setter KeyValue KeyValue FieldSet FieldSet
-> (FieldSet -> FieldSet) -> KeyValue -> KeyValue
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter KeyValue KeyValue FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) KeyValue
x)
      in
        Parser KeyValue -> String -> Parser KeyValue
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do KeyValue -> Parser KeyValue
loop KeyValue
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"KeyValue"
  buildMessage :: KeyValue -> Builder
buildMessage
    = \ KeyValue
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (let _v :: Text
_v = FoldLike Text KeyValue KeyValue Text Text -> KeyValue -> Text
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") KeyValue
_x
              in
                if Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) Text
_v Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                    Builder
forall a. Monoid a => a
Data.Monoid.mempty
                else
                    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                      ((ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                         (\ ByteString
bs
                            -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                 (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                    (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                 (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                         Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
_v))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (case
                     FoldLike
  (Maybe AnyValue)
  KeyValue
  KeyValue
  (Maybe AnyValue)
  (Maybe AnyValue)
-> KeyValue -> Maybe AnyValue
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "maybe'value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"maybe'value") KeyValue
_x
                 of
                   Maybe AnyValue
Prelude.Nothing -> Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   (Prelude.Just AnyValue
_v)
                     -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                          (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                          ((ByteString -> Builder)
-> (AnyValue -> ByteString) -> AnyValue -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                             (\ ByteString
bs
                                -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                     (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                        (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                     (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                             AnyValue -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage AnyValue
_v))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet KeyValue KeyValue FieldSet FieldSet
-> KeyValue -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet KeyValue KeyValue FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields KeyValue
_x)))
instance Control.DeepSeq.NFData KeyValue where
  rnf :: KeyValue -> ()
rnf
    = \ KeyValue
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (KeyValue -> FieldSet
_KeyValue'_unknownFields KeyValue
x__)
             (Text -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (KeyValue -> Text
_KeyValue'key KeyValue
x__)
                (Maybe AnyValue -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (KeyValue -> Maybe AnyValue
_KeyValue'value KeyValue
x__) ()))
{- | Fields :
     
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.values' @:: Lens' KeyValueList [KeyValue]@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.vec'values' @:: Lens' KeyValueList (Data.Vector.Vector KeyValue)@ -}
data KeyValueList
  = KeyValueList'_constructor {KeyValueList -> Vector KeyValue
_KeyValueList'values :: !(Data.Vector.Vector KeyValue),
                               KeyValueList -> FieldSet
_KeyValueList'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (KeyValueList -> KeyValueList -> Bool
(KeyValueList -> KeyValueList -> Bool)
-> (KeyValueList -> KeyValueList -> Bool) -> Eq KeyValueList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyValueList -> KeyValueList -> Bool
$c/= :: KeyValueList -> KeyValueList -> Bool
== :: KeyValueList -> KeyValueList -> Bool
$c== :: KeyValueList -> KeyValueList -> Bool
Prelude.Eq, Eq KeyValueList
Eq KeyValueList
-> (KeyValueList -> KeyValueList -> Ordering)
-> (KeyValueList -> KeyValueList -> Bool)
-> (KeyValueList -> KeyValueList -> Bool)
-> (KeyValueList -> KeyValueList -> Bool)
-> (KeyValueList -> KeyValueList -> Bool)
-> (KeyValueList -> KeyValueList -> KeyValueList)
-> (KeyValueList -> KeyValueList -> KeyValueList)
-> Ord KeyValueList
KeyValueList -> KeyValueList -> Bool
KeyValueList -> KeyValueList -> Ordering
KeyValueList -> KeyValueList -> KeyValueList
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeyValueList -> KeyValueList -> KeyValueList
$cmin :: KeyValueList -> KeyValueList -> KeyValueList
max :: KeyValueList -> KeyValueList -> KeyValueList
$cmax :: KeyValueList -> KeyValueList -> KeyValueList
>= :: KeyValueList -> KeyValueList -> Bool
$c>= :: KeyValueList -> KeyValueList -> Bool
> :: KeyValueList -> KeyValueList -> Bool
$c> :: KeyValueList -> KeyValueList -> Bool
<= :: KeyValueList -> KeyValueList -> Bool
$c<= :: KeyValueList -> KeyValueList -> Bool
< :: KeyValueList -> KeyValueList -> Bool
$c< :: KeyValueList -> KeyValueList -> Bool
compare :: KeyValueList -> KeyValueList -> Ordering
$ccompare :: KeyValueList -> KeyValueList -> Ordering
$cp1Ord :: Eq KeyValueList
Prelude.Ord)
instance Prelude.Show KeyValueList where
  showsPrec :: Int -> KeyValueList -> ShowS
showsPrec Int
_ KeyValueList
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (KeyValueList -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort KeyValueList
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField KeyValueList "values" [KeyValue] where
  fieldOf :: Proxy# "values"
-> ([KeyValue] -> f [KeyValue]) -> KeyValueList -> f KeyValueList
fieldOf Proxy# "values"
_
    = ((Vector KeyValue -> f (Vector KeyValue))
 -> KeyValueList -> f KeyValueList)
-> (([KeyValue] -> f [KeyValue])
    -> Vector KeyValue -> f (Vector KeyValue))
-> ([KeyValue] -> f [KeyValue])
-> KeyValueList
-> f KeyValueList
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((KeyValueList -> Vector KeyValue)
-> (KeyValueList -> Vector KeyValue -> KeyValueList)
-> Lens
     KeyValueList KeyValueList (Vector KeyValue) (Vector KeyValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           KeyValueList -> Vector KeyValue
_KeyValueList'values
           (\ KeyValueList
x__ Vector KeyValue
y__ -> KeyValueList
x__ {_KeyValueList'values :: Vector KeyValue
_KeyValueList'values = Vector KeyValue
y__}))
        ((Vector KeyValue -> [KeyValue])
-> (Vector KeyValue -> [KeyValue] -> Vector KeyValue)
-> Lens (Vector KeyValue) (Vector KeyValue) [KeyValue] [KeyValue]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           Vector KeyValue -> [KeyValue]
forall (v :: * -> *) a. Vector v a => v a -> [a]
Data.Vector.Generic.toList
           (\ Vector KeyValue
_ [KeyValue]
y__ -> [KeyValue] -> Vector KeyValue
forall (v :: * -> *) a. Vector v a => [a] -> v a
Data.Vector.Generic.fromList [KeyValue]
y__))
instance Data.ProtoLens.Field.HasField KeyValueList "vec'values" (Data.Vector.Vector KeyValue) where
  fieldOf :: Proxy# "vec'values"
-> (Vector KeyValue -> f (Vector KeyValue))
-> KeyValueList
-> f KeyValueList
fieldOf Proxy# "vec'values"
_
    = ((Vector KeyValue -> f (Vector KeyValue))
 -> KeyValueList -> f KeyValueList)
-> ((Vector KeyValue -> f (Vector KeyValue))
    -> Vector KeyValue -> f (Vector KeyValue))
-> (Vector KeyValue -> f (Vector KeyValue))
-> KeyValueList
-> f KeyValueList
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((KeyValueList -> Vector KeyValue)
-> (KeyValueList -> Vector KeyValue -> KeyValueList)
-> Lens
     KeyValueList KeyValueList (Vector KeyValue) (Vector KeyValue)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           KeyValueList -> Vector KeyValue
_KeyValueList'values
           (\ KeyValueList
x__ Vector KeyValue
y__ -> KeyValueList
x__ {_KeyValueList'values :: Vector KeyValue
_KeyValueList'values = Vector KeyValue
y__}))
        (Vector KeyValue -> f (Vector KeyValue))
-> Vector KeyValue -> f (Vector KeyValue)
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message KeyValueList where
  messageName :: Proxy KeyValueList -> Text
messageName Proxy KeyValueList
_
    = String -> Text
Data.Text.pack String
"opentelemetry.proto.common.v1.KeyValueList"
  packedMessageDescriptor :: Proxy KeyValueList -> ByteString
packedMessageDescriptor Proxy KeyValueList
_
    = ByteString
"\n\
      \\fKeyValueList\DC2?\n\
      \\ACKvalues\CAN\SOH \ETX(\v2'.opentelemetry.proto.common.v1.KeyValueR\ACKvalues"
  packedFileDescriptor :: Proxy KeyValueList -> ByteString
packedFileDescriptor Proxy KeyValueList
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor KeyValueList)
fieldsByTag
    = let
        values__field_descriptor :: FieldDescriptor KeyValueList
values__field_descriptor
          = String
-> FieldTypeDescriptor KeyValue
-> FieldAccessor KeyValueList KeyValue
-> FieldDescriptor KeyValueList
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"values"
              (MessageOrGroup -> FieldTypeDescriptor KeyValue
forall value.
Message value =>
MessageOrGroup -> FieldTypeDescriptor value
Data.ProtoLens.MessageField MessageOrGroup
Data.ProtoLens.MessageType ::
                 Data.ProtoLens.FieldTypeDescriptor KeyValue)
              (Packing
-> Lens' KeyValueList [KeyValue]
-> FieldAccessor KeyValueList KeyValue
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
Data.ProtoLens.RepeatedField
                 Packing
Data.ProtoLens.Unpacked (forall s a (f :: * -> *).
(HasField s "values" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"values")) ::
              Data.ProtoLens.FieldDescriptor KeyValueList
      in
        [(Tag, FieldDescriptor KeyValueList)]
-> Map Tag (FieldDescriptor KeyValueList)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor KeyValueList
values__field_descriptor)]
  unknownFields :: LensLike' f KeyValueList FieldSet
unknownFields
    = (KeyValueList -> FieldSet)
-> (KeyValueList -> FieldSet -> KeyValueList)
-> Lens' KeyValueList FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        KeyValueList -> FieldSet
_KeyValueList'_unknownFields
        (\ KeyValueList
x__ FieldSet
y__ -> KeyValueList
x__ {_KeyValueList'_unknownFields :: FieldSet
_KeyValueList'_unknownFields = FieldSet
y__})
  defMessage :: KeyValueList
defMessage
    = KeyValueList'_constructor :: Vector KeyValue -> FieldSet -> KeyValueList
KeyValueList'_constructor
        {_KeyValueList'values :: Vector KeyValue
_KeyValueList'values = Vector KeyValue
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty,
         _KeyValueList'_unknownFields :: FieldSet
_KeyValueList'_unknownFields = []}
  parseMessage :: Parser KeyValueList
parseMessage
    = let
        loop ::
          KeyValueList
          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld KeyValue
             -> Data.ProtoLens.Encoding.Bytes.Parser KeyValueList
        loop :: KeyValueList
-> Growing Vector RealWorld KeyValue -> Parser KeyValueList
loop KeyValueList
x Growing Vector RealWorld KeyValue
mutable'values
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do Vector KeyValue
frozen'values <- IO (Vector KeyValue) -> Parser (Vector KeyValue)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                         (Growing Vector (PrimState IO) KeyValue -> IO (Vector KeyValue)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Growing v (PrimState m) a -> m (v a)
Data.ProtoLens.Encoding.Growing.unsafeFreeze
                                            Growing Vector RealWorld KeyValue
Growing Vector (PrimState IO) KeyValue
mutable'values)
                      (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      KeyValueList -> Parser KeyValueList
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter KeyValueList KeyValueList FieldSet FieldSet
-> (FieldSet -> FieldSet) -> KeyValueList -> KeyValueList
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter KeyValueList KeyValueList FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t)
                           (Setter
  KeyValueList KeyValueList (Vector KeyValue) (Vector KeyValue)
-> Vector KeyValue -> KeyValueList -> KeyValueList
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set
                              (forall s a (f :: * -> *).
(HasField s "vec'values" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'values") Vector KeyValue
frozen'values KeyValueList
x))
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do !KeyValue
y <- Parser KeyValue -> String -> Parser KeyValue
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                        (do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                            Int -> Parser KeyValue -> Parser KeyValue
forall a. Int -> Parser a -> Parser a
Data.ProtoLens.Encoding.Bytes.isolate
                                              (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                              Parser KeyValue
forall msg. Message msg => Parser msg
Data.ProtoLens.parseMessage)
                                        String
"values"
                                Growing Vector RealWorld KeyValue
v <- IO (Growing Vector RealWorld KeyValue)
-> Parser (Growing Vector RealWorld KeyValue)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                       (Growing Vector (PrimState IO) KeyValue
-> KeyValue -> IO (Growing Vector (PrimState IO) KeyValue)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Growing v (PrimState m) a -> a -> m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.append Growing Vector RealWorld KeyValue
Growing Vector (PrimState IO) KeyValue
mutable'values KeyValue
y)
                                KeyValueList
-> Growing Vector RealWorld KeyValue -> Parser KeyValueList
loop KeyValueList
x Growing Vector RealWorld KeyValue
v
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                KeyValueList
-> Growing Vector RealWorld KeyValue -> Parser KeyValueList
loop
                                  (Setter KeyValueList KeyValueList FieldSet FieldSet
-> (FieldSet -> FieldSet) -> KeyValueList -> KeyValueList
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter KeyValueList KeyValueList FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) KeyValueList
x)
                                  Growing Vector RealWorld KeyValue
mutable'values
      in
        Parser KeyValueList -> String -> Parser KeyValueList
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do Growing Vector RealWorld KeyValue
mutable'values <- IO (Growing Vector RealWorld KeyValue)
-> Parser (Growing Vector RealWorld KeyValue)
forall a. IO a -> Parser a
Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO
                                  IO (Growing Vector RealWorld KeyValue)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
m (Growing v (PrimState m) a)
Data.ProtoLens.Encoding.Growing.new
              KeyValueList
-> Growing Vector RealWorld KeyValue -> Parser KeyValueList
loop KeyValueList
forall msg. Message msg => msg
Data.ProtoLens.defMessage Growing Vector RealWorld KeyValue
mutable'values)
          String
"KeyValueList"
  buildMessage :: KeyValueList -> Builder
buildMessage
    = \ KeyValueList
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             ((KeyValue -> Builder) -> Vector KeyValue -> Builder
forall (v :: * -> *) a.
Vector v a =>
(a -> Builder) -> v a -> Builder
Data.ProtoLens.Encoding.Bytes.foldMapBuilder
                (\ KeyValue
_v
                   -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                        (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                        ((ByteString -> Builder)
-> (KeyValue -> ByteString) -> KeyValue -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                           (\ ByteString
bs
                              -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                   (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                      (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                   (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                           KeyValue -> ByteString
forall msg. Message msg => msg -> ByteString
Data.ProtoLens.encodeMessage KeyValue
_v))
                (FoldLike
  (Vector KeyValue)
  KeyValueList
  KeyValueList
  (Vector KeyValue)
  (Vector KeyValue)
-> KeyValueList -> Vector KeyValue
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "vec'values" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"vec'values") KeyValueList
_x))
             (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                (FoldLike FieldSet KeyValueList KeyValueList FieldSet FieldSet
-> KeyValueList -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet KeyValueList KeyValueList FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields KeyValueList
_x))
instance Control.DeepSeq.NFData KeyValueList where
  rnf :: KeyValueList -> ()
rnf
    = \ KeyValueList
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (KeyValueList -> FieldSet
_KeyValueList'_unknownFields KeyValueList
x__)
             (Vector KeyValue -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (KeyValueList -> Vector KeyValue
_KeyValueList'values KeyValueList
x__) ())
{- | Fields :
     
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.key' @:: Lens' StringKeyValue Data.Text.Text@
         * 'Proto.Opentelemetry.Proto.Common.V1.Common_Fields.value' @:: Lens' StringKeyValue Data.Text.Text@ -}
data StringKeyValue
  = StringKeyValue'_constructor {StringKeyValue -> Text
_StringKeyValue'key :: !Data.Text.Text,
                                 StringKeyValue -> Text
_StringKeyValue'value :: !Data.Text.Text,
                                 StringKeyValue -> FieldSet
_StringKeyValue'_unknownFields :: !Data.ProtoLens.FieldSet}
  deriving stock (StringKeyValue -> StringKeyValue -> Bool
(StringKeyValue -> StringKeyValue -> Bool)
-> (StringKeyValue -> StringKeyValue -> Bool) -> Eq StringKeyValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringKeyValue -> StringKeyValue -> Bool
$c/= :: StringKeyValue -> StringKeyValue -> Bool
== :: StringKeyValue -> StringKeyValue -> Bool
$c== :: StringKeyValue -> StringKeyValue -> Bool
Prelude.Eq, Eq StringKeyValue
Eq StringKeyValue
-> (StringKeyValue -> StringKeyValue -> Ordering)
-> (StringKeyValue -> StringKeyValue -> Bool)
-> (StringKeyValue -> StringKeyValue -> Bool)
-> (StringKeyValue -> StringKeyValue -> Bool)
-> (StringKeyValue -> StringKeyValue -> Bool)
-> (StringKeyValue -> StringKeyValue -> StringKeyValue)
-> (StringKeyValue -> StringKeyValue -> StringKeyValue)
-> Ord StringKeyValue
StringKeyValue -> StringKeyValue -> Bool
StringKeyValue -> StringKeyValue -> Ordering
StringKeyValue -> StringKeyValue -> StringKeyValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StringKeyValue -> StringKeyValue -> StringKeyValue
$cmin :: StringKeyValue -> StringKeyValue -> StringKeyValue
max :: StringKeyValue -> StringKeyValue -> StringKeyValue
$cmax :: StringKeyValue -> StringKeyValue -> StringKeyValue
>= :: StringKeyValue -> StringKeyValue -> Bool
$c>= :: StringKeyValue -> StringKeyValue -> Bool
> :: StringKeyValue -> StringKeyValue -> Bool
$c> :: StringKeyValue -> StringKeyValue -> Bool
<= :: StringKeyValue -> StringKeyValue -> Bool
$c<= :: StringKeyValue -> StringKeyValue -> Bool
< :: StringKeyValue -> StringKeyValue -> Bool
$c< :: StringKeyValue -> StringKeyValue -> Bool
compare :: StringKeyValue -> StringKeyValue -> Ordering
$ccompare :: StringKeyValue -> StringKeyValue -> Ordering
$cp1Ord :: Eq StringKeyValue
Prelude.Ord)
instance Prelude.Show StringKeyValue where
  showsPrec :: Int -> StringKeyValue -> ShowS
showsPrec Int
_ StringKeyValue
__x String
__s
    = Char -> ShowS
Prelude.showChar
        Char
'{'
        (String -> ShowS
Prelude.showString
           (StringKeyValue -> String
forall msg. Message msg => msg -> String
Data.ProtoLens.showMessageShort StringKeyValue
__x) (Char -> ShowS
Prelude.showChar Char
'}' String
__s))
instance Data.ProtoLens.Field.HasField StringKeyValue "key" Data.Text.Text where
  fieldOf :: Proxy# "key"
-> (Text -> f Text) -> StringKeyValue -> f StringKeyValue
fieldOf Proxy# "key"
_
    = ((Text -> f Text) -> StringKeyValue -> f StringKeyValue)
-> ((Text -> f Text) -> Text -> f Text)
-> (Text -> f Text)
-> StringKeyValue
-> f StringKeyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((StringKeyValue -> Text)
-> (StringKeyValue -> Text -> StringKeyValue)
-> Lens StringKeyValue StringKeyValue Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           StringKeyValue -> Text
_StringKeyValue'key (\ StringKeyValue
x__ Text
y__ -> StringKeyValue
x__ {_StringKeyValue'key :: Text
_StringKeyValue'key = Text
y__}))
        (Text -> f Text) -> Text -> f Text
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Field.HasField StringKeyValue "value" Data.Text.Text where
  fieldOf :: Proxy# "value"
-> (Text -> f Text) -> StringKeyValue -> f StringKeyValue
fieldOf Proxy# "value"
_
    = ((Text -> f Text) -> StringKeyValue -> f StringKeyValue)
-> ((Text -> f Text) -> Text -> f Text)
-> (Text -> f Text)
-> StringKeyValue
-> f StringKeyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
        ((StringKeyValue -> Text)
-> (StringKeyValue -> Text -> StringKeyValue)
-> Lens StringKeyValue StringKeyValue Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
           StringKeyValue -> Text
_StringKeyValue'value
           (\ StringKeyValue
x__ Text
y__ -> StringKeyValue
x__ {_StringKeyValue'value :: Text
_StringKeyValue'value = Text
y__}))
        (Text -> f Text) -> Text -> f Text
forall a. a -> a
Prelude.id
instance Data.ProtoLens.Message StringKeyValue where
  messageName :: Proxy StringKeyValue -> Text
messageName Proxy StringKeyValue
_
    = String -> Text
Data.Text.pack String
"opentelemetry.proto.common.v1.StringKeyValue"
  packedMessageDescriptor :: Proxy StringKeyValue -> ByteString
packedMessageDescriptor Proxy StringKeyValue
_
    = ByteString
"\n\
      \\SOStringKeyValue\DC2\DLE\n\
      \\ETXkey\CAN\SOH \SOH(\tR\ETXkey\DC2\DC4\n\
      \\ENQvalue\CAN\STX \SOH(\tR\ENQvalue:\STX\CAN\SOH"
  packedFileDescriptor :: Proxy StringKeyValue -> ByteString
packedFileDescriptor Proxy StringKeyValue
_ = ByteString
packedFileDescriptor
  fieldsByTag :: Map Tag (FieldDescriptor StringKeyValue)
fieldsByTag
    = let
        key__field_descriptor :: FieldDescriptor StringKeyValue
key__field_descriptor
          = String
-> FieldTypeDescriptor Text
-> FieldAccessor StringKeyValue Text
-> FieldDescriptor StringKeyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"key"
              (ScalarField Text -> FieldTypeDescriptor Text
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Text
Data.ProtoLens.StringField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)
              (WireDefault Text
-> Lens StringKeyValue StringKeyValue Text Text
-> FieldAccessor StringKeyValue Text
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Text
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key")) ::
              Data.ProtoLens.FieldDescriptor StringKeyValue
        value__field_descriptor :: FieldDescriptor StringKeyValue
value__field_descriptor
          = String
-> FieldTypeDescriptor Text
-> FieldAccessor StringKeyValue Text
-> FieldDescriptor StringKeyValue
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
Data.ProtoLens.FieldDescriptor
              String
"value"
              (ScalarField Text -> FieldTypeDescriptor Text
forall value. ScalarField value -> FieldTypeDescriptor value
Data.ProtoLens.ScalarField ScalarField Text
Data.ProtoLens.StringField ::
                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)
              (WireDefault Text
-> Lens StringKeyValue StringKeyValue Text Text
-> FieldAccessor StringKeyValue Text
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
Data.ProtoLens.PlainField
                 WireDefault Text
forall value. (FieldDefault value, Eq value) => WireDefault value
Data.ProtoLens.Optional (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value")) ::
              Data.ProtoLens.FieldDescriptor StringKeyValue
      in
        [(Tag, FieldDescriptor StringKeyValue)]
-> Map Tag (FieldDescriptor StringKeyValue)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [(Int -> Tag
Data.ProtoLens.Tag Int
1, FieldDescriptor StringKeyValue
key__field_descriptor),
           (Int -> Tag
Data.ProtoLens.Tag Int
2, FieldDescriptor StringKeyValue
value__field_descriptor)]
  unknownFields :: LensLike' f StringKeyValue FieldSet
unknownFields
    = (StringKeyValue -> FieldSet)
-> (StringKeyValue -> FieldSet -> StringKeyValue)
-> Lens' StringKeyValue FieldSet
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.Family2.Unchecked.lens
        StringKeyValue -> FieldSet
_StringKeyValue'_unknownFields
        (\ StringKeyValue
x__ FieldSet
y__ -> StringKeyValue
x__ {_StringKeyValue'_unknownFields :: FieldSet
_StringKeyValue'_unknownFields = FieldSet
y__})
  defMessage :: StringKeyValue
defMessage
    = StringKeyValue'_constructor :: Text -> Text -> FieldSet -> StringKeyValue
StringKeyValue'_constructor
        {_StringKeyValue'key :: Text
_StringKeyValue'key = Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _StringKeyValue'value :: Text
_StringKeyValue'value = Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault,
         _StringKeyValue'_unknownFields :: FieldSet
_StringKeyValue'_unknownFields = []}
  parseMessage :: Parser StringKeyValue
parseMessage
    = let
        loop ::
          StringKeyValue
          -> Data.ProtoLens.Encoding.Bytes.Parser StringKeyValue
        loop :: StringKeyValue -> Parser StringKeyValue
loop StringKeyValue
x
          = do Bool
end <- Parser Bool
Data.ProtoLens.Encoding.Bytes.atEnd
               if Bool
end then
                   do (let missing :: [a]
missing = []
                       in
                         if [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Any]
forall a. [a]
missing then
                             () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
                         else
                             String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
                               (String -> ShowS
forall a. [a] -> [a] -> [a]
(Prelude.++)
                                  String
"Missing required fields: "
                                  ([String] -> String
forall a. Show a => a -> String
Prelude.show ([String]
forall a. [a]
missing :: [Prelude.String]))))
                      StringKeyValue -> Parser StringKeyValue
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
                        (Setter StringKeyValue StringKeyValue FieldSet FieldSet
-> (FieldSet -> FieldSet) -> StringKeyValue -> StringKeyValue
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                           forall msg. Message msg => Lens' msg FieldSet
Setter StringKeyValue StringKeyValue FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> FieldSet -> FieldSet
forall a. [a] -> [a]
Prelude.reverse FieldSet
t) StringKeyValue
x)
               else
                   do Word64
tag <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                      case Word64
tag of
                        Word64
10
                          -> do Text
y <- Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do ByteString
value <- do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                                       Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                                         (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                           Either String Text -> Parser Text
forall a. Either String a -> Parser a
Data.ProtoLens.Encoding.Bytes.runEither
                                             (case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
value of
                                                (Prelude.Left UnicodeException
err)
                                                  -> String -> Either String Text
forall a b. a -> Either a b
Prelude.Left (UnicodeException -> String
forall a. Show a => a -> String
Prelude.show UnicodeException
err)
                                                (Prelude.Right Text
r) -> Text -> Either String Text
forall a b. b -> Either a b
Prelude.Right Text
r))
                                       String
"key"
                                StringKeyValue -> Parser StringKeyValue
loop (Setter StringKeyValue StringKeyValue Text Text
-> Text -> StringKeyValue -> StringKeyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") Text
y StringKeyValue
x)
                        Word64
18
                          -> do Text
y <- Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
                                       (do ByteString
value <- do Word64
len <- Parser Word64
Data.ProtoLens.Encoding.Bytes.getVarInt
                                                       Int -> Parser ByteString
Data.ProtoLens.Encoding.Bytes.getBytes
                                                         (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
len)
                                           Either String Text -> Parser Text
forall a. Either String a -> Parser a
Data.ProtoLens.Encoding.Bytes.runEither
                                             (case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
value of
                                                (Prelude.Left UnicodeException
err)
                                                  -> String -> Either String Text
forall a b. a -> Either a b
Prelude.Left (UnicodeException -> String
forall a. Show a => a -> String
Prelude.show UnicodeException
err)
                                                (Prelude.Right Text
r) -> Text -> Either String Text
forall a b. b -> Either a b
Prelude.Right Text
r))
                                       String
"value"
                                StringKeyValue -> Parser StringKeyValue
loop (Setter StringKeyValue StringKeyValue Text Text
-> Text -> StringKeyValue -> StringKeyValue
forall s t a b. Setter s t a b -> b -> s -> t
Lens.Family2.set (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value") Text
y StringKeyValue
x)
                        Word64
wire
                          -> do !TaggedValue
y <- Word64 -> Parser TaggedValue
Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                        Word64
wire
                                StringKeyValue -> Parser StringKeyValue
loop
                                  (Setter StringKeyValue StringKeyValue FieldSet FieldSet
-> (FieldSet -> FieldSet) -> StringKeyValue -> StringKeyValue
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
Lens.Family2.over
                                     forall msg. Message msg => Lens' msg FieldSet
Setter StringKeyValue StringKeyValue FieldSet FieldSet
Data.ProtoLens.unknownFields (\ !FieldSet
t -> (:) TaggedValue
y FieldSet
t) StringKeyValue
x)
      in
        Parser StringKeyValue -> String -> Parser StringKeyValue
forall a. Parser a -> String -> Parser a
(Data.ProtoLens.Encoding.Bytes.<?>)
          (do StringKeyValue -> Parser StringKeyValue
loop StringKeyValue
forall msg. Message msg => msg
Data.ProtoLens.defMessage) String
"StringKeyValue"
  buildMessage :: StringKeyValue -> Builder
buildMessage
    = \ StringKeyValue
_x
        -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
             (let _v :: Text
_v = FoldLike Text StringKeyValue StringKeyValue Text Text
-> StringKeyValue -> Text
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "key" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"key") StringKeyValue
_x
              in
                if Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) Text
_v Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                    Builder
forall a. Monoid a => a
Data.Monoid.mempty
                else
                    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                      (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
10)
                      ((ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                         (\ ByteString
bs
                            -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                 (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                    (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                 (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                         Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
_v))
             (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                (let
                   _v :: Text
_v = FoldLike Text StringKeyValue StringKeyValue Text Text
-> StringKeyValue -> Text
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view (forall s a (f :: * -> *).
(HasField s "value" a, Functor f) =>
(a -> f a) -> s -> f s
forall (x :: Symbol) s a (f :: * -> *).
(HasField s x a, Functor f) =>
(a -> f a) -> s -> f s
Data.ProtoLens.Field.field @"value") StringKeyValue
_x
                 in
                   if Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) Text
_v Text
forall value. FieldDefault value => value
Data.ProtoLens.fieldDefault then
                       Builder
forall a. Monoid a => a
Data.Monoid.mempty
                   else
                       Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                         (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt Word64
18)
                         ((ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Prelude..)
                            (\ ByteString
bs
                               -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Data.Monoid.<>)
                                    (Word64 -> Builder
Data.ProtoLens.Encoding.Bytes.putVarInt
                                       (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (ByteString -> Int
Data.ByteString.length ByteString
bs)))
                                    (ByteString -> Builder
Data.ProtoLens.Encoding.Bytes.putBytes ByteString
bs))
                            Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
_v))
                (FieldSet -> Builder
Data.ProtoLens.Encoding.Wire.buildFieldSet
                   (FoldLike FieldSet StringKeyValue StringKeyValue FieldSet FieldSet
-> StringKeyValue -> FieldSet
forall a s t b. FoldLike a s t a b -> s -> a
Lens.Family2.view FoldLike FieldSet StringKeyValue StringKeyValue FieldSet FieldSet
forall msg. Message msg => Lens' msg FieldSet
Data.ProtoLens.unknownFields StringKeyValue
_x)))
instance Control.DeepSeq.NFData StringKeyValue where
  rnf :: StringKeyValue -> ()
rnf
    = \ StringKeyValue
x__
        -> FieldSet -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
             (StringKeyValue -> FieldSet
_StringKeyValue'_unknownFields StringKeyValue
x__)
             (Text -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq
                (StringKeyValue -> Text
_StringKeyValue'key StringKeyValue
x__)
                (Text -> () -> ()
forall a b. NFData a => a -> b -> b
Control.DeepSeq.deepseq (StringKeyValue -> Text
_StringKeyValue'value StringKeyValue
x__) ()))
packedFileDescriptor :: Data.ByteString.ByteString
packedFileDescriptor :: ByteString
packedFileDescriptor
  = ByteString
"\n\
    \*opentelemetry/proto/common/v1/common.proto\DC2\GSopentelemetry.proto.common.v1\"\224\STX\n\
    \\bAnyValue\DC2#\n\
    \\fstring_value\CAN\SOH \SOH(\tH\NULR\vstringValue\DC2\US\n\
    \\n\
    \bool_value\CAN\STX \SOH(\bH\NULR\tboolValue\DC2\GS\n\
    \\tint_value\CAN\ETX \SOH(\ETXH\NULR\bintValue\DC2#\n\
    \\fdouble_value\CAN\EOT \SOH(\SOHH\NULR\vdoubleValue\DC2L\n\
    \\varray_value\CAN\ENQ \SOH(\v2).opentelemetry.proto.common.v1.ArrayValueH\NULR\n\
    \arrayValue\DC2P\n\
    \\fkvlist_value\CAN\ACK \SOH(\v2+.opentelemetry.proto.common.v1.KeyValueListH\NULR\vkvlistValue\DC2!\n\
    \\vbytes_value\CAN\a \SOH(\fH\NULR\n\
    \bytesValueB\a\n\
    \\ENQvalue\"M\n\
    \\n\
    \ArrayValue\DC2?\n\
    \\ACKvalues\CAN\SOH \ETX(\v2'.opentelemetry.proto.common.v1.AnyValueR\ACKvalues\"O\n\
    \\fKeyValueList\DC2?\n\
    \\ACKvalues\CAN\SOH \ETX(\v2'.opentelemetry.proto.common.v1.KeyValueR\ACKvalues\"[\n\
    \\bKeyValue\DC2\DLE\n\
    \\ETXkey\CAN\SOH \SOH(\tR\ETXkey\DC2=\n\
    \\ENQvalue\CAN\STX \SOH(\v2'.opentelemetry.proto.common.v1.AnyValueR\ENQvalue\"<\n\
    \\SOStringKeyValue\DC2\DLE\n\
    \\ETXkey\CAN\SOH \SOH(\tR\ETXkey\DC2\DC4\n\
    \\ENQvalue\CAN\STX \SOH(\tR\ENQvalue:\STX\CAN\SOH\"F\n\
    \\SYNInstrumentationLibrary\DC2\DC2\n\
    \\EOTname\CAN\SOH \SOH(\tR\EOTname\DC2\CAN\n\
    \\aversion\CAN\STX \SOH(\tR\aversionBq\n\
    \ io.opentelemetry.proto.common.v1B\vCommonProtoP\SOHZ>github.com/open-telemetry/opentelemetry-proto/gen/go/common/v1J\164\EM\n\
    \\ACK\DC2\EOT\SO\NULP\SOH\n\
    \\200\EOT\n\
    \\SOH\f\DC2\ETX\SO\NUL\DC22\189\EOT Copyright 2019, OpenTelemetry Authors\n\
    \\n\
    \ Licensed under the Apache License, Version 2.0 (the \"License\");\n\
    \ you may not use this file except in compliance with the License.\n\
    \ You may obtain a copy of the License at\n\
    \\n\
    \     http://www.apache.org/licenses/LICENSE-2.0\n\
    \\n\
    \ Unless required by applicable law or agreed to in writing, software\n\
    \ distributed under the License is distributed on an \"AS IS\" BASIS,\n\
    \ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.\n\
    \ See the License for the specific language governing permissions and\n\
    \ limitations under the License.\n\
    \\n\
    \\b\n\
    \\SOH\STX\DC2\ETX\DLE\NUL&\n\
    \\b\n\
    \\SOH\b\DC2\ETX\DC2\NUL\"\n\
    \\t\n\
    \\STX\b\n\
    \\DC2\ETX\DC2\NUL\"\n\
    \\b\n\
    \\SOH\b\DC2\ETX\DC3\NUL9\n\
    \\t\n\
    \\STX\b\SOH\DC2\ETX\DC3\NUL9\n\
    \\b\n\
    \\SOH\b\DC2\ETX\DC4\NUL,\n\
    \\t\n\
    \\STX\b\b\DC2\ETX\DC4\NUL,\n\
    \\b\n\
    \\SOH\b\DC2\ETX\NAK\NULU\n\
    \\t\n\
    \\STX\b\v\DC2\ETX\NAK\NULU\n\
    \\238\SOH\n\
    \\STX\EOT\NUL\DC2\EOT\SUB\NUL&\SOH\SUB\225\SOH AnyValue is used to represent any type of attribute value. AnyValue may contain a\n\
    \ primitive value such as a string or integer or it may contain an arbitrary nested\n\
    \ object containing arrays, key-value lists and primitives.\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\NUL\SOH\DC2\ETX\SUB\b\DLE\n\
    \\158\SOH\n\
    \\EOT\EOT\NUL\b\NUL\DC2\EOT\GS\STX%\ETX\SUB\143\SOH The value is one of the listed fields. It is valid for all values to be unspecified\n\
    \ in which case this AnyValue is considered to be \"empty\".\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\NUL\b\NUL\SOH\DC2\ETX\GS\b\r\n\
    \\v\n\
    \\EOT\EOT\NUL\STX\NUL\DC2\ETX\RS\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\NUL\ENQ\DC2\ETX\RS\EOT\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\NUL\SOH\DC2\ETX\RS\v\ETB\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\NUL\ETX\DC2\ETX\RS\SUB\ESC\n\
    \\v\n\
    \\EOT\EOT\NUL\STX\SOH\DC2\ETX\US\EOT\CAN\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\SOH\ENQ\DC2\ETX\US\EOT\b\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\SOH\SOH\DC2\ETX\US\t\DC3\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\SOH\ETX\DC2\ETX\US\SYN\ETB\n\
    \\v\n\
    \\EOT\EOT\NUL\STX\STX\DC2\ETX \EOT\CAN\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\STX\ENQ\DC2\ETX \EOT\t\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\STX\SOH\DC2\ETX \n\
    \\DC3\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\STX\ETX\DC2\ETX \SYN\ETB\n\
    \\v\n\
    \\EOT\EOT\NUL\STX\ETX\DC2\ETX!\EOT\FS\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\ETX\ENQ\DC2\ETX!\EOT\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\ETX\SOH\DC2\ETX!\v\ETB\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\ETX\ETX\DC2\ETX!\SUB\ESC\n\
    \\v\n\
    \\EOT\EOT\NUL\STX\EOT\DC2\ETX\"\EOT\US\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\EOT\ACK\DC2\ETX\"\EOT\SO\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\EOT\SOH\DC2\ETX\"\SI\SUB\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\EOT\ETX\DC2\ETX\"\GS\RS\n\
    \\v\n\
    \\EOT\EOT\NUL\STX\ENQ\DC2\ETX#\EOT\"\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\ENQ\ACK\DC2\ETX#\EOT\DLE\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\ENQ\SOH\DC2\ETX#\DC1\GS\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\ENQ\ETX\DC2\ETX# !\n\
    \\v\n\
    \\EOT\EOT\NUL\STX\ACK\DC2\ETX$\EOT\SUB\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\ACK\ENQ\DC2\ETX$\EOT\t\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\ACK\SOH\DC2\ETX$\n\
    \\NAK\n\
    \\f\n\
    \\ENQ\EOT\NUL\STX\ACK\ETX\DC2\ETX$\CAN\EM\n\
    \\146\SOH\n\
    \\STX\EOT\SOH\DC2\EOT*\NUL-\SOH\SUB\133\SOH ArrayValue is a list of AnyValue messages. We need ArrayValue as a message\n\
    \ since oneof in AnyValue does not allow repeated fields.\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\SOH\SOH\DC2\ETX*\b\DC2\n\
    \L\n\
    \\EOT\EOT\SOH\STX\NUL\DC2\ETX,\STX\US\SUB? Array of values. The array may be empty (contain 0 elements).\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\EOT\DC2\ETX,\STX\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\ACK\DC2\ETX,\v\DC3\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\SOH\DC2\ETX,\DC4\SUB\n\
    \\f\n\
    \\ENQ\EOT\SOH\STX\NUL\ETX\DC2\ETX,\GS\RS\n\
    \\251\STX\n\
    \\STX\EOT\STX\DC2\EOT4\NUL8\SOH\SUB\238\STX KeyValueList is a list of KeyValue messages. We need KeyValueList as a message\n\
    \ since `oneof` in AnyValue does not allow repeated fields. Everywhere else where we need\n\
    \ a list of KeyValue messages (e.g. in Span) we use `repeated KeyValue` directly to\n\
    \ avoid unnecessary extra wrapping (which slows down the protocol). The 2 approaches\n\
    \ are semantically equivalent.\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\STX\SOH\DC2\ETX4\b\DC4\n\
    \s\n\
    \\EOT\EOT\STX\STX\NUL\DC2\ETX7\STX\US\SUBf A collection of key/value pairs of key-value pairs. The list may be empty (may\n\
    \ contain 0 elements).\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\EOT\DC2\ETX7\STX\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\ACK\DC2\ETX7\v\DC3\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\SOH\DC2\ETX7\DC4\SUB\n\
    \\f\n\
    \\ENQ\EOT\STX\STX\NUL\ETX\DC2\ETX7\GS\RS\n\
    \h\n\
    \\STX\EOT\ETX\DC2\EOT<\NUL?\SOH\SUB\\ KeyValue is a key-value pair that is used to store Span attributes, Link\n\
    \ attributes, etc.\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\ETX\SOH\DC2\ETX<\b\DLE\n\
    \\v\n\
    \\EOT\EOT\ETX\STX\NUL\DC2\ETX=\STX\DC1\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\NUL\ENQ\DC2\ETX=\STX\b\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\NUL\SOH\DC2\ETX=\t\f\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\NUL\ETX\DC2\ETX=\SI\DLE\n\
    \\v\n\
    \\EOT\EOT\ETX\STX\SOH\DC2\ETX>\STX\NAK\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\SOH\ACK\DC2\ETX>\STX\n\
    \\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\SOH\SOH\DC2\ETX>\v\DLE\n\
    \\f\n\
    \\ENQ\EOT\ETX\STX\SOH\ETX\DC2\ETX>\DC3\DC4\n\
    \\149\SOH\n\
    \\STX\EOT\EOT\DC2\EOTC\NULH\SOH\SUB\136\SOH StringKeyValue is a pair of key/value strings. This is the simpler (and faster) version\n\
    \ of KeyValue that only supports string values.\n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\EOT\SOH\DC2\ETXC\b\SYN\n\
    \\n\
    \\n\
    \\ETX\EOT\EOT\a\DC2\ETXD\STX\ESC\n\
    \\v\n\
    \\EOT\EOT\EOT\a\ETX\DC2\ETXD\STX\ESC\n\
    \\v\n\
    \\EOT\EOT\EOT\STX\NUL\DC2\ETXF\STX\DC1\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\NUL\ENQ\DC2\ETXF\STX\b\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\NUL\SOH\DC2\ETXF\t\f\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\NUL\ETX\DC2\ETXF\SI\DLE\n\
    \\v\n\
    \\EOT\EOT\EOT\STX\SOH\DC2\ETXG\STX\DC3\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\SOH\ENQ\DC2\ETXG\STX\b\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\SOH\SOH\DC2\ETXG\t\SO\n\
    \\f\n\
    \\ENQ\EOT\EOT\STX\SOH\ETX\DC2\ETXG\DC1\DC2\n\
    \\151\SOH\n\
    \\STX\EOT\ENQ\DC2\EOTL\NULP\SOH\SUB\138\SOH InstrumentationLibrary is a message representing the instrumentation library information\n\
    \ such as the fully qualified name and version. \n\
    \\n\
    \\n\
    \\n\
    \\ETX\EOT\ENQ\SOH\DC2\ETXL\b\RS\n\
    \P\n\
    \\EOT\EOT\ENQ\STX\NUL\DC2\ETXN\STX\DC2\SUBC An empty instrumentation library name means the name is unknown. \n\
    \\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\NUL\ENQ\DC2\ETXN\STX\b\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\NUL\SOH\DC2\ETXN\t\r\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\NUL\ETX\DC2\ETXN\DLE\DC1\n\
    \\v\n\
    \\EOT\EOT\ENQ\STX\SOH\DC2\ETXO\STX\NAK\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\SOH\ENQ\DC2\ETXO\STX\b\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\SOH\SOH\DC2\ETXO\t\DLE\n\
    \\f\n\
    \\ENQ\EOT\ENQ\STX\SOH\ETX\DC2\ETXO\DC3\DC4b\ACKproto3"