{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric,
  FlexibleInstances, MultiParamTypeClasses #-}

module Network.Monitoring.Riemann.Proto.Event
  ( Event(..)
  ) where

import qualified Data.Data as Prelude'
import qualified GHC.Generics as Prelude'
import qualified Network.Monitoring.Riemann.Proto.Attribute as Proto (Attribute)
import Prelude ((+))
import qualified Prelude as Prelude'
import qualified Text.ProtocolBuffers.Header as P'

data Event = Event
  { Event -> Maybe Int64
time :: !(P'.Maybe P'.Int64)
  , Event -> Maybe Utf8
state :: !(P'.Maybe P'.Utf8)
  , Event -> Maybe Utf8
service :: !(P'.Maybe P'.Utf8)
  , Event -> Maybe Utf8
host :: !(P'.Maybe P'.Utf8)
  , Event -> Maybe Utf8
description :: !(P'.Maybe P'.Utf8)
  , Event -> Seq Utf8
tags :: !(P'.Seq P'.Utf8)
  , Event -> Maybe Float
ttl :: !(P'.Maybe P'.Float)
  , Event -> Seq Attribute
attributes :: !(P'.Seq Proto.Attribute)
  , Event -> Maybe Int64
metric_sint64 :: !(P'.Maybe P'.Int64)
  , Event -> Maybe Double
metric_d :: !(P'.Maybe P'.Double)
  , Event -> Maybe Float
metric_f :: !(P'.Maybe P'.Float)
  } deriving ( Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Prelude'.Show
             , Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Prelude'.Eq
             , Eq Event
Eq Event
-> (Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
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 :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c< :: Event -> Event -> Bool
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
$cp1Ord :: Eq Event
Prelude'.Ord
             , Prelude'.Typeable
             , Typeable Event
DataType
Constr
Typeable Event
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Event -> c Event)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Event)
-> (Event -> Constr)
-> (Event -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Event))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event))
-> ((forall b. Data b => b -> b) -> Event -> Event)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r)
-> (forall u. (forall d. Data d => d -> u) -> Event -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Event -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Event -> m Event)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Event -> m Event)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Event -> m Event)
-> Data Event
Event -> DataType
Event -> Constr
(forall b. Data b => b -> b) -> Event -> Event
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Event -> u
forall u. (forall d. Data d => d -> u) -> Event -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Event -> m Event
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Event)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
$cEvent :: Constr
$tEvent :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Event -> m Event
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapMp :: (forall d. Data d => d -> m d) -> Event -> m Event
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapM :: (forall d. Data d => d -> m d) -> Event -> m Event
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapQi :: Int -> (forall d. Data d => d -> u) -> Event -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Event -> u
gmapQ :: (forall d. Data d => d -> u) -> Event -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Event -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
gmapT :: (forall b. Data b => b -> b) -> Event -> Event
$cgmapT :: (forall b. Data b => b -> b) -> Event -> Event
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Event)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Event)
dataTypeOf :: Event -> DataType
$cdataTypeOf :: Event -> DataType
toConstr :: Event -> Constr
$ctoConstr :: Event -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
$cp1Data :: Typeable Event
Prelude'.Data
             , (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
Prelude'.Generic
             )

instance P'.Mergeable Event where
  mergeAppend :: Event -> Event -> Event
mergeAppend (Event Maybe Int64
x'1 Maybe Utf8
x'2 Maybe Utf8
x'3 Maybe Utf8
x'4 Maybe Utf8
x'5 Seq Utf8
x'6 Maybe Float
x'7 Seq Attribute
x'8 Maybe Int64
x'9 Maybe Double
x'10 Maybe Float
x'11) (Event Maybe Int64
y'1 Maybe Utf8
y'2 Maybe Utf8
y'3 Maybe Utf8
y'4 Maybe Utf8
y'5 Seq Utf8
y'6 Maybe Float
y'7 Seq Attribute
y'8 Maybe Int64
y'9 Maybe Double
y'10 Maybe Float
y'11) =
    Maybe Int64
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Seq Utf8
-> Maybe Float
-> Seq Attribute
-> Maybe Int64
-> Maybe Double
-> Maybe Float
-> Event
Event
      (Maybe Int64 -> Maybe Int64 -> Maybe Int64
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Int64
x'1 Maybe Int64
y'1)
      (Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'2 Maybe Utf8
y'2)
      (Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'3 Maybe Utf8
y'3)
      (Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'4 Maybe Utf8
y'4)
      (Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'5 Maybe Utf8
y'5)
      (Seq Utf8 -> Seq Utf8 -> Seq Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Utf8
x'6 Seq Utf8
y'6)
      (Maybe Float -> Maybe Float -> Maybe Float
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Float
x'7 Maybe Float
y'7)
      (Seq Attribute -> Seq Attribute -> Seq Attribute
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Attribute
x'8 Seq Attribute
y'8)
      (Maybe Int64 -> Maybe Int64 -> Maybe Int64
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Int64
x'9 Maybe Int64
y'9)
      (Maybe Double -> Maybe Double -> Maybe Double
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Double
x'10 Maybe Double
y'10)
      (Maybe Float -> Maybe Float -> Maybe Float
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Float
x'11 Maybe Float
y'11)

instance P'.Default Event where
  defaultValue :: Event
defaultValue =
    Maybe Int64
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Seq Utf8
-> Maybe Float
-> Seq Attribute
-> Maybe Int64
-> Maybe Double
-> Maybe Float
-> Event
Event
      Maybe Int64
forall a. Default a => a
P'.defaultValue
      Maybe Utf8
forall a. Default a => a
P'.defaultValue
      Maybe Utf8
forall a. Default a => a
P'.defaultValue
      Maybe Utf8
forall a. Default a => a
P'.defaultValue
      Maybe Utf8
forall a. Default a => a
P'.defaultValue
      Seq Utf8
forall a. Default a => a
P'.defaultValue
      Maybe Float
forall a. Default a => a
P'.defaultValue
      Seq Attribute
forall a. Default a => a
P'.defaultValue
      Maybe Int64
forall a. Default a => a
P'.defaultValue
      Maybe Double
forall a. Default a => a
P'.defaultValue
      Maybe Float
forall a. Default a => a
P'.defaultValue

instance P'.Wire Event where
  wireSize :: FieldType -> Event -> Int64
wireSize FieldType
ft' self' :: Event
self'@(Event Maybe Int64
x'1 Maybe Utf8
x'2 Maybe Utf8
x'3 Maybe Utf8
x'4 Maybe Utf8
x'5 Seq Utf8
x'6 Maybe Float
x'7 Seq Attribute
x'8 Maybe Int64
x'9 Maybe Double
x'10 Maybe Float
x'11) =
    case FieldType
ft' of
      FieldType
10 -> Int64
calc'Size
      FieldType
11 -> Int64 -> Int64
P'.prependMessageSize Int64
calc'Size
      FieldType
_ -> FieldType -> Event -> Int64
forall a. Typeable a => FieldType -> a -> Int64
P'.wireSizeErr FieldType
ft' Event
self'
    where
      calc'Size :: Int64
calc'Size =
        Int64 -> FieldType -> Maybe Int64 -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
3 Maybe Int64
x'1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> FieldType -> Maybe Utf8 -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
9 Maybe Utf8
x'2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> FieldType -> Maybe Utf8 -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
9 Maybe Utf8
x'3 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
        Int64 -> FieldType -> Maybe Utf8 -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
9 Maybe Utf8
x'4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
        Int64 -> FieldType -> Maybe Utf8 -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
9 Maybe Utf8
x'5 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
        Int64 -> FieldType -> Seq Utf8 -> Int64
forall v. Wire v => Int64 -> FieldType -> Seq v -> Int64
P'.wireSizeRep Int64
1 FieldType
9 Seq Utf8
x'6 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
        Int64 -> FieldType -> Maybe Float -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
2 Maybe Float
x'7 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
        Int64 -> FieldType -> Seq Attribute -> Int64
forall v. Wire v => Int64 -> FieldType -> Seq v -> Int64
P'.wireSizeRep Int64
1 FieldType
11 Seq Attribute
x'8 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
        Int64 -> FieldType -> Maybe Int64 -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
18 Maybe Int64
x'9 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
        Int64 -> FieldType -> Maybe Double -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
1 Maybe Double
x'10 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
        Int64 -> FieldType -> Maybe Float -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
2 Maybe Float
x'11
  wirePut :: FieldType -> Event -> Put
wirePut FieldType
ft' self' :: Event
self'@(Event Maybe Int64
x'1 Maybe Utf8
x'2 Maybe Utf8
x'3 Maybe Utf8
x'4 Maybe Utf8
x'5 Seq Utf8
x'6 Maybe Float
x'7 Seq Attribute
x'8 Maybe Int64
x'9 Maybe Double
x'10 Maybe Float
x'11) =
    case FieldType
ft' of
      FieldType
10 -> Put
put'Fields
      FieldType
11 -> do
        Int64 -> Put
P'.putSize (FieldType -> Event -> Int64
forall b. Wire b => FieldType -> b -> Int64
P'.wireSize FieldType
10 Event
self')
        Put
put'Fields
      FieldType
_ -> FieldType -> Event -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' Event
self'
    where
      put'Fields :: Put
put'Fields = do
        WireTag -> FieldType -> Maybe Int64 -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
8 FieldType
3 Maybe Int64
x'1
        WireTag -> FieldType -> Maybe Utf8 -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
18 FieldType
9 Maybe Utf8
x'2
        WireTag -> FieldType -> Maybe Utf8 -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
26 FieldType
9 Maybe Utf8
x'3
        WireTag -> FieldType -> Maybe Utf8 -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
34 FieldType
9 Maybe Utf8
x'4
        WireTag -> FieldType -> Maybe Utf8 -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
42 FieldType
9 Maybe Utf8
x'5
        WireTag -> FieldType -> Seq Utf8 -> Put
forall v. Wire v => WireTag -> FieldType -> Seq v -> Put
P'.wirePutRep WireTag
58 FieldType
9 Seq Utf8
x'6
        WireTag -> FieldType -> Maybe Float -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
69 FieldType
2 Maybe Float
x'7
        WireTag -> FieldType -> Seq Attribute -> Put
forall v. Wire v => WireTag -> FieldType -> Seq v -> Put
P'.wirePutRep WireTag
74 FieldType
11 Seq Attribute
x'8
        WireTag -> FieldType -> Maybe Int64 -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
104 FieldType
18 Maybe Int64
x'9
        WireTag -> FieldType -> Maybe Double -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
113 FieldType
1 Maybe Double
x'10
        WireTag -> FieldType -> Maybe Float -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
125 FieldType
2 Maybe Float
x'11
  wireGet :: FieldType -> Get Event
wireGet FieldType
ft' =
    case FieldType
ft' of
      FieldType
10 -> (WireTag -> Event -> Get Event) -> Get Event
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith WireTag -> Event -> Get Event
update'Self
      FieldType
11 -> (WireTag -> Event -> Get Event) -> Get Event
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith WireTag -> Event -> Get Event
update'Self
      FieldType
_ -> FieldType -> Get Event
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
      update'Self :: WireTag -> Event -> Get Event
update'Self WireTag
wire'Tag Event
old'Self =
        case WireTag
wire'Tag of
          WireTag
8 ->
            (Int64 -> Event) -> Get Int64 -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Int64
new'Field -> Event
old'Self {time :: Maybe Int64
time = Int64 -> Maybe Int64
forall a. a -> Maybe a
Prelude'.Just Int64
new'Field})
              (FieldType -> Get Int64
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
3)
          WireTag
18 ->
            (Utf8 -> Event) -> Get Utf8 -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> Event
old'Self {state :: Maybe Utf8
state = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field})
              (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
          WireTag
26 ->
            (Utf8 -> Event) -> Get Utf8 -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> Event
old'Self {service :: Maybe Utf8
service = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field})
              (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
          WireTag
34 ->
            (Utf8 -> Event) -> Get Utf8 -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> Event
old'Self {host :: Maybe Utf8
host = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field})
              (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
          WireTag
42 ->
            (Utf8 -> Event) -> Get Utf8 -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> Event
old'Self {description :: Maybe Utf8
description = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field})
              (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
          WireTag
58 ->
            (Utf8 -> Event) -> Get Utf8 -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field ->
                 Event
old'Self {tags :: Seq Utf8
tags = Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
P'.append (Event -> Seq Utf8
tags Event
old'Self) Utf8
new'Field})
              (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
          WireTag
69 ->
            (Float -> Event) -> Get Float -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Float
new'Field -> Event
old'Self {ttl :: Maybe Float
ttl = Float -> Maybe Float
forall a. a -> Maybe a
Prelude'.Just Float
new'Field})
              (FieldType -> Get Float
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
2)
          WireTag
74 ->
            (Attribute -> Event) -> Get Attribute -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Attribute
new'Field ->
                 Event
old'Self
                   {attributes :: Seq Attribute
attributes = Seq Attribute -> Attribute -> Seq Attribute
forall a. Seq a -> a -> Seq a
P'.append (Event -> Seq Attribute
attributes Event
old'Self) Attribute
new'Field})
              (FieldType -> Get Attribute
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
          WireTag
104 ->
            (Int64 -> Event) -> Get Int64 -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Int64
new'Field ->
                 Event
old'Self {metric_sint64 :: Maybe Int64
metric_sint64 = Int64 -> Maybe Int64
forall a. a -> Maybe a
Prelude'.Just Int64
new'Field})
              (FieldType -> Get Int64
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
18)
          WireTag
113 ->
            (Double -> Event) -> Get Double -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Double
new'Field -> Event
old'Self {metric_d :: Maybe Double
metric_d = Double -> Maybe Double
forall a. a -> Maybe a
Prelude'.Just Double
new'Field})
              (FieldType -> Get Double
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
1)
          WireTag
125 ->
            (Float -> Event) -> Get Float -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Float
new'Field -> Event
old'Self {metric_f :: Maybe Float
metric_f = Float -> Maybe Float
forall a. a -> Maybe a
Prelude'.Just Float
new'Field})
              (FieldType -> Get Float
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
2)
          WireTag
_ ->
            let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag
             in FieldId -> WireType -> Event -> Get Event
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type Event
old'Self

instance P'.MessageAPI msg' (msg' -> Event) Event where
  getVal :: msg' -> (msg' -> Event) -> Event
getVal msg'
m' msg' -> Event
f' = msg' -> Event
f' msg'
m'

instance P'.GPB Event

instance P'.ReflectDescriptor Event where
  getMessageInfo :: Event -> GetMessageInfo
getMessageInfo Event
_ =
    Set WireTag -> Set WireTag -> GetMessageInfo
P'.GetMessageInfo
      ([WireTag] -> Set WireTag
forall a. [a] -> Set a
P'.fromDistinctAscList [])
      ([WireTag] -> Set WireTag
forall a. [a] -> Set a
P'.fromDistinctAscList [WireTag
8, WireTag
18, WireTag
26, WireTag
34, WireTag
42, WireTag
58, WireTag
69, WireTag
74, WireTag
104, WireTag
113, WireTag
125])
  reflectDescriptorInfo :: Event -> DescriptorInfo
reflectDescriptorInfo Event
_ =
    String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".Proto.Event\", haskellPrefix = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule = [MName \"Proto\"], baseName = MName \"Event\"}, descFilePath = [\"Network\",\"Monitoring\",\"Riemann\",\"Proto\",\"Event.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.time\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"time\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.state\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"state\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.service\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"service\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.host\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"host\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.description\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"description\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.tags\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"tags\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 58}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.ttl\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"ttl\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 8}, wireTag = WireTag {getWireTag = 69}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.attributes\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"attributes\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 9}, wireTag = WireTag {getWireTag = 74}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Proto.Attribute\", haskellPrefix = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule = [MName \"Proto\"], baseName = MName \"Attribute\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.metric_sint64\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"metric_sint64\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 13}, wireTag = WireTag {getWireTag = 104}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.metric_d\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"metric_d\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 14}, wireTag = WireTag {getWireTag = 113}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Event.metric_f\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Event\"], baseName' = FName \"metric_f\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 15}, wireTag = WireTag {getWireTag = 125}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}"

instance P'.TextType Event where
  tellT :: String -> Event -> Output
tellT = String -> Event -> Output
forall a. TextMsg a => String -> a -> Output
P'.tellSubMessage
  getT :: String -> Parsec s () Event
getT = String -> Parsec s () Event
forall s a.
(Stream s Identity Char, TextMsg a) =>
String -> Parsec s () a
P'.getSubMessage

instance P'.TextMsg Event where
  textPut :: Event -> Output
textPut Event
msg = do
    String -> Maybe Int64 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"time" (Event -> Maybe Int64
time Event
msg)
    String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"state" (Event -> Maybe Utf8
state Event
msg)
    String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"service" (Event -> Maybe Utf8
service Event
msg)
    String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"host" (Event -> Maybe Utf8
host Event
msg)
    String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"description" (Event -> Maybe Utf8
description Event
msg)
    String -> Seq Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"tags" (Event -> Seq Utf8
tags Event
msg)
    String -> Maybe Float -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"ttl" (Event -> Maybe Float
ttl Event
msg)
    String -> Seq Attribute -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"attributes" (Event -> Seq Attribute
attributes Event
msg)
    String -> Maybe Int64 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"metric_sint64" (Event -> Maybe Int64
metric_sint64 Event
msg)
    String -> Maybe Double -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"metric_d" (Event -> Maybe Double
metric_d Event
msg)
    String -> Maybe Float -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"metric_f" (Event -> Maybe Float
metric_f Event
msg)
  textGet :: Parsec s () Event
textGet = do
    [Event -> Event]
mods <-
      ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity ()
-> ParsecT s () Identity [Event -> Event]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P'.sepEndBy
        ([ParsecT s () Identity (Event -> Event)]
-> ParsecT s () Identity (Event -> Event)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
P'.choice
           [ ParsecT s () Identity (Event -> Event)
parse'time
           , ParsecT s () Identity (Event -> Event)
parse'state
           , ParsecT s () Identity (Event -> Event)
parse'service
           , ParsecT s () Identity (Event -> Event)
parse'host
           , ParsecT s () Identity (Event -> Event)
parse'description
           , ParsecT s () Identity (Event -> Event)
parse'tags
           , ParsecT s () Identity (Event -> Event)
parse'ttl
           , ParsecT s () Identity (Event -> Event)
parse'attributes
           , ParsecT s () Identity (Event -> Event)
parse'metric_sint64
           , ParsecT s () Identity (Event -> Event)
parse'metric_d
           , ParsecT s () Identity (Event -> Event)
parse'metric_f
           ])
        ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
    Event -> Parsec s () Event
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((Event -> (Event -> Event) -> Event)
-> Event -> [Event -> Event] -> Event
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl (\Event
v Event -> Event
f -> Event -> Event
f Event
v) Event
forall a. Default a => a
P'.defaultValue [Event -> Event]
mods)
    where
      parse'time :: ParsecT s () Identity (Event -> Event)
parse'time =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Int64
v <- String -> Parsec s () (Maybe Int64)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"time"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Event
o -> Event
o {time :: Maybe Int64
time = Maybe Int64
v}))
      parse'state :: ParsecT s () Identity (Event -> Event)
parse'state =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Utf8
v <- String -> Parsec s () (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"state"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Event
o -> Event
o {state :: Maybe Utf8
state = Maybe Utf8
v}))
      parse'service :: ParsecT s () Identity (Event -> Event)
parse'service =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Utf8
v <- String -> Parsec s () (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"service"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Event
o -> Event
o {service :: Maybe Utf8
service = Maybe Utf8
v}))
      parse'host :: ParsecT s () Identity (Event -> Event)
parse'host =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Utf8
v <- String -> Parsec s () (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"host"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Event
o -> Event
o {host :: Maybe Utf8
host = Maybe Utf8
v}))
      parse'description :: ParsecT s () Identity (Event -> Event)
parse'description =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Utf8
v <- String -> Parsec s () (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"description"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Event
o -> Event
o {description :: Maybe Utf8
description = Maybe Utf8
v}))
      parse'tags :: ParsecT s () Identity (Event -> Event)
parse'tags =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Utf8
v <- String -> Parsec s () Utf8
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"tags"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Event
o -> Event
o {tags :: Seq Utf8
tags = Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
P'.append (Event -> Seq Utf8
tags Event
o) Utf8
v}))
      parse'ttl :: ParsecT s () Identity (Event -> Event)
parse'ttl =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Float
v <- String -> Parsec s () (Maybe Float)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"ttl"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Event
o -> Event
o {ttl :: Maybe Float
ttl = Maybe Float
v}))
      parse'attributes :: ParsecT s () Identity (Event -> Event)
parse'attributes =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Attribute
v <- String -> Parsec s () Attribute
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"attributes"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return
                (\Event
o -> Event
o {attributes :: Seq Attribute
attributes = Seq Attribute -> Attribute -> Seq Attribute
forall a. Seq a -> a -> Seq a
P'.append (Event -> Seq Attribute
attributes Event
o) Attribute
v}))
      parse'metric_sint64 :: ParsecT s () Identity (Event -> Event)
parse'metric_sint64 =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Int64
v <- String -> Parsec s () (Maybe Int64)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"metric_sint64"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Event
o -> Event
o {metric_sint64 :: Maybe Int64
metric_sint64 = Maybe Int64
v}))
      parse'metric_d :: ParsecT s () Identity (Event -> Event)
parse'metric_d =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Double
v <- String -> Parsec s () (Maybe Double)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"metric_d"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Event
o -> Event
o {metric_d :: Maybe Double
metric_d = Maybe Double
v}))
      parse'metric_f :: ParsecT s () Identity (Event -> Event)
parse'metric_f =
        ParsecT s () Identity (Event -> Event)
-> ParsecT s () Identity (Event -> Event)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Float
v <- String -> Parsec s () (Maybe Float)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"metric_f"
              (Event -> Event) -> ParsecT s () Identity (Event -> Event)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Event
o -> Event
o {metric_f :: Maybe Float
metric_f = Maybe Float
v}))