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

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

import qualified Data.Data as Prelude'
import qualified GHC.Generics as Prelude'
import Prelude ((+))
import qualified Prelude as Prelude'
import qualified Text.ProtocolBuffers.Header as P'

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

instance P'.Mergeable State where
  mergeAppend :: State -> State -> State
mergeAppend (State Maybe Int64
x'1 Maybe Utf8
x'2 Maybe Utf8
x'3 Maybe Utf8
x'4 Maybe Utf8
x'5 Maybe Bool
x'6 Seq Utf8
x'7 Maybe Float
x'8) (State Maybe Int64
y'1 Maybe Utf8
y'2 Maybe Utf8
y'3 Maybe Utf8
y'4 Maybe Utf8
y'5 Maybe Bool
y'6 Seq Utf8
y'7 Maybe Float
y'8) =
    Maybe Int64
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Bool
-> Seq Utf8
-> Maybe Float
-> State
State
      (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)
      (Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Bool
x'6 Maybe Bool
y'6)
      (Seq Utf8 -> Seq Utf8 -> Seq Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Utf8
x'7 Seq Utf8
y'7)
      (Maybe Float -> Maybe Float -> Maybe Float
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Float
x'8 Maybe Float
y'8)

instance P'.Default State where
  defaultValue :: State
defaultValue =
    Maybe Int64
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Bool
-> Seq Utf8
-> Maybe Float
-> State
State
      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
      Maybe Bool
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

instance P'.Wire State where
  wireSize :: FieldType -> State -> Int64
wireSize FieldType
ft' self' :: State
self'@(State Maybe Int64
x'1 Maybe Utf8
x'2 Maybe Utf8
x'3 Maybe Utf8
x'4 Maybe Utf8
x'5 Maybe Bool
x'6 Seq Utf8
x'7 Maybe Float
x'8) =
    case FieldType
ft' of
      FieldType
10 -> Int64
calc'Size
      FieldType
11 -> Int64 -> Int64
P'.prependMessageSize Int64
calc'Size
      FieldType
_ -> FieldType -> State -> Int64
forall a. Typeable a => FieldType -> a -> Int64
P'.wireSizeErr FieldType
ft' State
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 -> Maybe Bool -> Int64
forall v. Wire v => Int64 -> FieldType -> Maybe v -> Int64
P'.wireSizeOpt Int64
1 FieldType
8 Maybe Bool
x'6 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'7 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'8
  wirePut :: FieldType -> State -> Put
wirePut FieldType
ft' self' :: State
self'@(State Maybe Int64
x'1 Maybe Utf8
x'2 Maybe Utf8
x'3 Maybe Utf8
x'4 Maybe Utf8
x'5 Maybe Bool
x'6 Seq Utf8
x'7 Maybe Float
x'8) =
    case FieldType
ft' of
      FieldType
10 -> Put
put'Fields
      FieldType
11 -> do
        Int64 -> Put
P'.putSize (FieldType -> State -> Int64
forall b. Wire b => FieldType -> b -> Int64
P'.wireSize FieldType
10 State
self')
        Put
put'Fields
      FieldType
_ -> FieldType -> State -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' State
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 -> Maybe Bool -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
48 FieldType
8 Maybe Bool
x'6
        WireTag -> FieldType -> Seq Utf8 -> Put
forall v. Wire v => WireTag -> FieldType -> Seq v -> Put
P'.wirePutRep WireTag
58 FieldType
9 Seq Utf8
x'7
        WireTag -> FieldType -> Maybe Float -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
69 FieldType
2 Maybe Float
x'8
  wireGet :: FieldType -> Get State
wireGet FieldType
ft' =
    case FieldType
ft' of
      FieldType
10 -> (WireTag -> State -> Get State) -> Get State
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith WireTag -> State -> Get State
update'Self
      FieldType
11 -> (WireTag -> State -> Get State) -> Get State
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith WireTag -> State -> Get State
update'Self
      FieldType
_ -> FieldType -> Get State
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
      update'Self :: WireTag -> State -> Get State
update'Self WireTag
wire'Tag State
old'Self =
        case WireTag
wire'Tag of
          WireTag
8 ->
            (Int64 -> State) -> Get Int64 -> Get State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Int64
new'Field -> State
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 -> State) -> Get Utf8 -> Get State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> State
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 -> State) -> Get Utf8 -> Get State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> State
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 -> State) -> Get Utf8 -> Get State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> State
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 -> State) -> Get Utf8 -> Get State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> State
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
48 ->
            (Bool -> State) -> Get Bool -> Get State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Bool
new'Field -> State
old'Self {once :: Maybe Bool
once = Bool -> Maybe Bool
forall a. a -> Maybe a
Prelude'.Just Bool
new'Field})
              (FieldType -> Get Bool
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
8)
          WireTag
58 ->
            (Utf8 -> State) -> Get Utf8 -> Get State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field ->
                 State
old'Self {tags :: Seq Utf8
tags = Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
P'.append (State -> Seq Utf8
tags State
old'Self) Utf8
new'Field})
              (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
          WireTag
69 ->
            (Float -> State) -> Get Float -> Get State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Float
new'Field -> State
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
_ ->
            let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag
             in FieldId -> WireType -> State -> Get State
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type State
old'Self

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

instance P'.GPB State

instance P'.ReflectDescriptor State where
  getMessageInfo :: State -> GetMessageInfo
getMessageInfo State
_ =
    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
48, WireTag
58, WireTag
69])
  reflectDescriptorInfo :: State -> DescriptorInfo
reflectDescriptorInfo State
_ =
    String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".Proto.State\", haskellPrefix = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule = [MName \"Proto\"], baseName = MName \"State\"}, descFilePath = [\"Network\",\"Monitoring\",\"Riemann\",\"Proto\",\"State.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.State.time\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"State\"], 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.State.state\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"State\"], 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.State.service\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"State\"], 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.State.host\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"State\"], 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.State.description\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"State\"], 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.State.once\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"State\"], baseName' = FName \"once\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 48}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.State.tags\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"State\"], 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.State.ttl\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"State\"], 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}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}"

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

instance P'.TextMsg State where
  textPut :: State -> Output
textPut State
msg = do
    String -> Maybe Int64 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"time" (State -> Maybe Int64
time State
msg)
    String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"state" (State -> Maybe Utf8
state State
msg)
    String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"service" (State -> Maybe Utf8
service State
msg)
    String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"host" (State -> Maybe Utf8
host State
msg)
    String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"description" (State -> Maybe Utf8
description State
msg)
    String -> Maybe Bool -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"once" (State -> Maybe Bool
once State
msg)
    String -> Seq Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"tags" (State -> Seq Utf8
tags State
msg)
    String -> Maybe Float -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"ttl" (State -> Maybe Float
ttl State
msg)
  textGet :: Parsec s () State
textGet = do
    [State -> State]
mods <-
      ParsecT s () Identity (State -> State)
-> ParsecT s () Identity ()
-> ParsecT s () Identity [State -> State]
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 (State -> State)]
-> ParsecT s () Identity (State -> State)
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 (State -> State)
parse'time
           , ParsecT s () Identity (State -> State)
parse'state
           , ParsecT s () Identity (State -> State)
parse'service
           , ParsecT s () Identity (State -> State)
parse'host
           , ParsecT s () Identity (State -> State)
parse'description
           , ParsecT s () Identity (State -> State)
parse'once
           , ParsecT s () Identity (State -> State)
parse'tags
           , ParsecT s () Identity (State -> State)
parse'ttl
           ])
        ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
    State -> Parsec s () State
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((State -> (State -> State) -> State)
-> State -> [State -> State] -> State
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl (\State
v State -> State
f -> State -> State
f State
v) State
forall a. Default a => a
P'.defaultValue [State -> State]
mods)
    where
      parse'time :: ParsecT s () Identity (State -> State)
parse'time =
        ParsecT s () Identity (State -> State)
-> ParsecT s () Identity (State -> State)
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"
              (State -> State) -> ParsecT s () Identity (State -> State)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\State
o -> State
o {time :: Maybe Int64
time = Maybe Int64
v}))
      parse'state :: ParsecT s () Identity (State -> State)
parse'state =
        ParsecT s () Identity (State -> State)
-> ParsecT s () Identity (State -> State)
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"
              (State -> State) -> ParsecT s () Identity (State -> State)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\State
o -> State
o {state :: Maybe Utf8
state = Maybe Utf8
v}))
      parse'service :: ParsecT s () Identity (State -> State)
parse'service =
        ParsecT s () Identity (State -> State)
-> ParsecT s () Identity (State -> State)
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"
              (State -> State) -> ParsecT s () Identity (State -> State)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\State
o -> State
o {service :: Maybe Utf8
service = Maybe Utf8
v}))
      parse'host :: ParsecT s () Identity (State -> State)
parse'host =
        ParsecT s () Identity (State -> State)
-> ParsecT s () Identity (State -> State)
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"
              (State -> State) -> ParsecT s () Identity (State -> State)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\State
o -> State
o {host :: Maybe Utf8
host = Maybe Utf8
v}))
      parse'description :: ParsecT s () Identity (State -> State)
parse'description =
        ParsecT s () Identity (State -> State)
-> ParsecT s () Identity (State -> State)
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"
              (State -> State) -> ParsecT s () Identity (State -> State)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\State
o -> State
o {description :: Maybe Utf8
description = Maybe Utf8
v}))
      parse'once :: ParsecT s () Identity (State -> State)
parse'once =
        ParsecT s () Identity (State -> State)
-> ParsecT s () Identity (State -> State)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Bool
v <- String -> Parsec s () (Maybe Bool)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"once"
              (State -> State) -> ParsecT s () Identity (State -> State)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\State
o -> State
o {once :: Maybe Bool
once = Maybe Bool
v}))
      parse'tags :: ParsecT s () Identity (State -> State)
parse'tags =
        ParsecT s () Identity (State -> State)
-> ParsecT s () Identity (State -> State)
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"
              (State -> State) -> ParsecT s () Identity (State -> State)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\State
o -> State
o {tags :: Seq Utf8
tags = Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
P'.append (State -> Seq Utf8
tags State
o) Utf8
v}))
      parse'ttl :: ParsecT s () Identity (State -> State)
parse'ttl =
        ParsecT s () Identity (State -> State)
-> ParsecT s () Identity (State -> State)
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"
              (State -> State) -> ParsecT s () Identity (State -> State)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\State
o -> State
o {ttl :: Maybe Float
ttl = Maybe Float
v}))