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

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

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

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

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

instance P'.Default Msg where
  defaultValue :: Msg
defaultValue =
    Maybe Bool
-> Maybe Utf8 -> Seq State -> Maybe Query -> Seq Event -> Msg
Msg
      Maybe Bool
forall a. Default a => a
P'.defaultValue
      Maybe Utf8
forall a. Default a => a
P'.defaultValue
      Seq State
forall a. Default a => a
P'.defaultValue
      Maybe Query
forall a. Default a => a
P'.defaultValue
      Seq Event
forall a. Default a => a
P'.defaultValue

instance P'.Wire Msg where
  wireSize :: FieldType -> Msg -> WireSize
wireSize FieldType
ft' self' :: Msg
self'@(Msg Maybe Bool
x'1 Maybe Utf8
x'2 Seq State
x'3 Maybe Query
x'4 Seq Event
x'5) =
    case FieldType
ft' of
      FieldType
10 -> WireSize
calc'Size
      FieldType
11 -> WireSize -> WireSize
P'.prependMessageSize WireSize
calc'Size
      FieldType
_ -> FieldType -> Msg -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' Msg
self'
    where
      calc'Size :: WireSize
calc'Size =
        WireSize -> FieldType -> Maybe Bool -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
8 Maybe Bool
x'1 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'2 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+
        WireSize -> FieldType -> Seq State -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq State
x'3 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+
        WireSize -> FieldType -> Maybe Query -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
11 Maybe Query
x'4 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+
        WireSize -> FieldType -> Seq Event -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq Event
x'5
  wirePut :: FieldType -> Msg -> Put
wirePut FieldType
ft' self' :: Msg
self'@(Msg Maybe Bool
x'1 Maybe Utf8
x'2 Seq State
x'3 Maybe Query
x'4 Seq Event
x'5) =
    case FieldType
ft' of
      FieldType
10 -> Put
put'Fields
      FieldType
11 -> do
        WireSize -> Put
P'.putSize (FieldType -> Msg -> WireSize
forall b. Wire b => FieldType -> b -> WireSize
P'.wireSize FieldType
10 Msg
self')
        Put
put'Fields
      FieldType
_ -> FieldType -> Msg -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' Msg
self'
    where
      put'Fields :: Put
put'Fields = do
        WireTag -> FieldType -> Maybe Bool -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
16 FieldType
8 Maybe Bool
x'1
        WireTag -> FieldType -> Maybe Utf8 -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
26 FieldType
9 Maybe Utf8
x'2
        WireTag -> FieldType -> Seq State -> Put
forall v. Wire v => WireTag -> FieldType -> Seq v -> Put
P'.wirePutRep WireTag
34 FieldType
11 Seq State
x'3
        WireTag -> FieldType -> Maybe Query -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
P'.wirePutOpt WireTag
42 FieldType
11 Maybe Query
x'4
        WireTag -> FieldType -> Seq Event -> Put
forall v. Wire v => WireTag -> FieldType -> Seq v -> Put
P'.wirePutRep WireTag
50 FieldType
11 Seq Event
x'5
  wireGet :: FieldType -> Get Msg
wireGet FieldType
ft' =
    case FieldType
ft' of
      FieldType
10 -> (WireTag -> Msg -> Get Msg) -> Get Msg
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith WireTag -> Msg -> Get Msg
update'Self
      FieldType
11 -> (WireTag -> Msg -> Get Msg) -> Get Msg
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith WireTag -> Msg -> Get Msg
update'Self
      FieldType
_ -> FieldType -> Get Msg
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
      update'Self :: WireTag -> Msg -> Get Msg
update'Self WireTag
wire'Tag Msg
old'Self =
        case WireTag
wire'Tag of
          WireTag
16 ->
            (Bool -> Msg) -> Get Bool -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Bool
new'Field -> Msg
old'Self {ok :: Maybe Bool
ok = 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
26 ->
            (Utf8 -> Msg) -> Get Utf8 -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> Msg
old'Self {error :: Maybe Utf8
error = 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 ->
            (State -> Msg) -> Get State -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !State
new'Field ->
                 Msg
old'Self {states :: Seq State
states = Seq State -> State -> Seq State
forall a. Seq a -> a -> Seq a
P'.append (Msg -> Seq State
states Msg
old'Self) State
new'Field})
              (FieldType -> Get State
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
          WireTag
42 ->
            (Query -> Msg) -> Get Query -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Query
new'Field ->
                 Msg
old'Self
                   { query :: Maybe Query
query =
                       Maybe Query -> Maybe Query -> Maybe Query
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (Msg -> Maybe Query
query Msg
old'Self) (Query -> Maybe Query
forall a. a -> Maybe a
Prelude'.Just Query
new'Field)
                   })
              (FieldType -> Get Query
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
          WireTag
50 ->
            (Event -> Msg) -> Get Event -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Event
new'Field ->
                 Msg
old'Self {events :: Seq Event
events = Seq Event -> Event -> Seq Event
forall a. Seq a -> a -> Seq a
P'.append (Msg -> Seq Event
events Msg
old'Self) Event
new'Field})
              (FieldType -> Get Event
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
          WireTag
_ ->
            let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag
             in FieldId -> WireType -> Msg -> Get Msg
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type Msg
old'Self

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

instance P'.GPB Msg

instance P'.ReflectDescriptor Msg where
  getMessageInfo :: Msg -> GetMessageInfo
getMessageInfo Msg
_ =
    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
16, WireTag
26, WireTag
34, WireTag
42, WireTag
50])
  reflectDescriptorInfo :: Msg -> DescriptorInfo
reflectDescriptorInfo Msg
_ =
    String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".Proto.Msg\", haskellPrefix = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule = [MName \"Proto\"], baseName = MName \"Msg\"}, descFilePath = [\"Network\",\"Monitoring\",\"Riemann\",\"Proto\",\"Msg.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Msg.ok\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Msg\"], baseName' = FName \"ok\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, 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.Msg.error\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Msg\"], baseName' = FName \"error\", 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.Msg.states\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Msg\"], baseName' = FName \"states\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Proto.State\", haskellPrefix = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule = [MName \"Proto\"], baseName = MName \"State\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Msg.query\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Msg\"], baseName' = FName \"query\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Proto.Query\", haskellPrefix = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule = [MName \"Proto\"], baseName = MName \"Query\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Msg.events\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Msg\"], baseName' = FName \"events\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Proto.Event\", haskellPrefix = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule = [MName \"Proto\"], baseName = MName \"Event\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}"

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

instance P'.TextMsg Msg where
  textPut :: Msg -> Output
textPut Msg
msg = do
    String -> Maybe Bool -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"ok" (Msg -> Maybe Bool
ok Msg
msg)
    String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"error" (Msg -> Maybe Utf8
error Msg
msg)
    String -> Seq State -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"states" (Msg -> Seq State
states Msg
msg)
    String -> Maybe Query -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"query" (Msg -> Maybe Query
query Msg
msg)
    String -> Seq Event -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"events" (Msg -> Seq Event
events Msg
msg)
  textGet :: Parsec s () Msg
textGet = do
    [Msg -> Msg]
mods <-
      ParsecT s () Identity (Msg -> Msg)
-> ParsecT s () Identity () -> ParsecT s () Identity [Msg -> Msg]
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 (Msg -> Msg)]
-> ParsecT s () Identity (Msg -> Msg)
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 (Msg -> Msg)
parse'ok, ParsecT s () Identity (Msg -> Msg)
parse'error, ParsecT s () Identity (Msg -> Msg)
parse'states, ParsecT s () Identity (Msg -> Msg)
parse'query, ParsecT s () Identity (Msg -> Msg)
parse'events])
        ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
    Msg -> Parsec s () Msg
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((Msg -> (Msg -> Msg) -> Msg) -> Msg -> [Msg -> Msg] -> Msg
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl (\Msg
v Msg -> Msg
f -> Msg -> Msg
f Msg
v) Msg
forall a. Default a => a
P'.defaultValue [Msg -> Msg]
mods)
    where
      parse'ok :: ParsecT s () Identity (Msg -> Msg)
parse'ok =
        ParsecT s () Identity (Msg -> Msg)
-> ParsecT s () Identity (Msg -> Msg)
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
"ok"
              (Msg -> Msg) -> ParsecT s () Identity (Msg -> Msg)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Msg
o -> Msg
o {ok :: Maybe Bool
ok = Maybe Bool
v}))
      parse'error :: ParsecT s () Identity (Msg -> Msg)
parse'error =
        ParsecT s () Identity (Msg -> Msg)
-> ParsecT s () Identity (Msg -> Msg)
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
"error"
              (Msg -> Msg) -> ParsecT s () Identity (Msg -> Msg)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Msg
o -> Msg
o {error :: Maybe Utf8
error = Maybe Utf8
v}))
      parse'states :: ParsecT s () Identity (Msg -> Msg)
parse'states =
        ParsecT s () Identity (Msg -> Msg)
-> ParsecT s () Identity (Msg -> Msg)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do State
v <- String -> Parsec s () State
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"states"
              (Msg -> Msg) -> ParsecT s () Identity (Msg -> Msg)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Msg
o -> Msg
o {states :: Seq State
states = Seq State -> State -> Seq State
forall a. Seq a -> a -> Seq a
P'.append (Msg -> Seq State
states Msg
o) State
v}))
      parse'query :: ParsecT s () Identity (Msg -> Msg)
parse'query =
        ParsecT s () Identity (Msg -> Msg)
-> ParsecT s () Identity (Msg -> Msg)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Maybe Query
v <- String -> Parsec s () (Maybe Query)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"query"
              (Msg -> Msg) -> ParsecT s () Identity (Msg -> Msg)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Msg
o -> Msg
o {query :: Maybe Query
query = Maybe Query
v}))
      parse'events :: ParsecT s () Identity (Msg -> Msg)
parse'events =
        ParsecT s () Identity (Msg -> Msg)
-> ParsecT s () Identity (Msg -> Msg)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
          (do Event
v <- String -> Parsec s () Event
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"events"
              (Msg -> Msg) -> ParsecT s () Identity (Msg -> Msg)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Msg
o -> Msg
o {events :: Seq Event
events = Seq Event -> Event -> Seq Event
forall a. Seq a -> a -> Seq a
P'.append (Msg -> Seq Event
events Msg
o) Event
v}))