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

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

instance P'.Mergeable Attribute where
  mergeAppend :: Attribute -> Attribute -> Attribute
mergeAppend (Attribute Utf8
x'1 Maybe Utf8
x'2) (Attribute Utf8
y'1 Maybe Utf8
y'2) =
    Utf8 -> Maybe Utf8 -> Attribute
Attribute (Utf8 -> Utf8 -> Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Utf8
x'1 Utf8
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)

instance P'.Default Attribute where
  defaultValue :: Attribute
defaultValue = Utf8 -> Maybe Utf8 -> Attribute
Attribute Utf8
forall a. Default a => a
P'.defaultValue Maybe Utf8
forall a. Default a => a
P'.defaultValue

instance P'.Wire Attribute where
  wireSize :: FieldType -> Attribute -> WireSize
wireSize FieldType
ft' self' :: Attribute
self'@(Attribute Utf8
x'1 Maybe Utf8
x'2) =
    case FieldType
ft' of
      FieldType
10 -> WireSize
calc'Size
      FieldType
11 -> WireSize -> WireSize
P'.prependMessageSize WireSize
calc'Size
      FieldType
_ -> FieldType -> Attribute -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' Attribute
self'
    where
      calc'Size :: WireSize
calc'Size = WireSize -> FieldType -> Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> v -> WireSize
P'.wireSizeReq WireSize
1 FieldType
9 Utf8
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
  wirePut :: FieldType -> Attribute -> Put
wirePut FieldType
ft' self' :: Attribute
self'@(Attribute Utf8
x'1 Maybe Utf8
x'2) =
    case FieldType
ft' of
      FieldType
10 -> Put
put'Fields
      FieldType
11 -> do
        WireSize -> Put
P'.putSize (FieldType -> Attribute -> WireSize
forall b. Wire b => FieldType -> b -> WireSize
P'.wireSize FieldType
10 Attribute
self')
        Put
put'Fields
      FieldType
_ -> FieldType -> Attribute -> Put
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' Attribute
self'
    where
      put'Fields :: Put
put'Fields = do
        WireTag -> FieldType -> Utf8 -> Put
forall v. Wire v => WireTag -> FieldType -> v -> Put
P'.wirePutReq WireTag
10 FieldType
9 Utf8
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
  wireGet :: FieldType -> Get Attribute
wireGet FieldType
ft' =
    case FieldType
ft' of
      FieldType
10 -> (WireTag -> Attribute -> Get Attribute) -> Get Attribute
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith WireTag -> Attribute -> Get Attribute
update'Self
      FieldType
11 -> (WireTag -> Attribute -> Get Attribute) -> Get Attribute
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith WireTag -> Attribute -> Get Attribute
update'Self
      FieldType
_ -> FieldType -> Get Attribute
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
      update'Self :: WireTag -> Attribute -> Get Attribute
update'Self WireTag
wire'Tag Attribute
old'Self =
        case WireTag
wire'Tag of
          WireTag
10 ->
            (Utf8 -> Attribute) -> Get Utf8 -> Get Attribute
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> Attribute
old'Self {key :: Utf8
key = Utf8
new'Field})
              (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
          WireTag
18 ->
            (Utf8 -> Attribute) -> Get Utf8 -> Get Attribute
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
              (\ !Utf8
new'Field -> Attribute
old'Self {value :: Maybe Utf8
value = 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
_ ->
            let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag
             in FieldId -> WireType -> Attribute -> Get Attribute
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type Attribute
old'Self

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

instance P'.GPB Attribute

instance P'.ReflectDescriptor Attribute where
  getMessageInfo :: Attribute -> GetMessageInfo
getMessageInfo Attribute
_ =
    Set WireTag -> Set WireTag -> GetMessageInfo
P'.GetMessageInfo
      ([WireTag] -> Set WireTag
forall a. [a] -> Set a
P'.fromDistinctAscList [WireTag
10])
      ([WireTag] -> Set WireTag
forall a. [a] -> Set a
P'.fromDistinctAscList [WireTag
10, WireTag
18])
  reflectDescriptorInfo :: Attribute -> DescriptorInfo
reflectDescriptorInfo Attribute
_ =
    String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".Proto.Attribute\", haskellPrefix = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule = [MName \"Proto\"], baseName = MName \"Attribute\"}, descFilePath = [\"Network\",\"Monitoring\",\"Riemann\",\"Proto\",\"Attribute.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Attribute.key\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Attribute\"], baseName' = FName \"key\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Attribute.value\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Attribute\"], baseName' = FName \"value\", 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}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}"

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

instance P'.TextMsg Attribute where
  textPut :: Attribute -> Output
textPut Attribute
msg = do
    String -> Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"key" (Attribute -> Utf8
key Attribute
msg)
    String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"value" (Attribute -> Maybe Utf8
value Attribute
msg)
  textGet :: Parsec s () Attribute
textGet = do
    [Attribute -> Attribute]
mods <- ParsecT s () Identity (Attribute -> Attribute)
-> ParsecT s () Identity ()
-> ParsecT s () Identity [Attribute -> Attribute]
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 (Attribute -> Attribute)]
-> ParsecT s () Identity (Attribute -> Attribute)
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 (Attribute -> Attribute)
parse'key, ParsecT s () Identity (Attribute -> Attribute)
parse'value]) ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
    Attribute -> Parsec s () Attribute
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((Attribute -> (Attribute -> Attribute) -> Attribute)
-> Attribute -> [Attribute -> Attribute] -> Attribute
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl (\Attribute
v Attribute -> Attribute
f -> Attribute -> Attribute
f Attribute
v) Attribute
forall a. Default a => a
P'.defaultValue [Attribute -> Attribute]
mods)
    where
      parse'key :: ParsecT s () Identity (Attribute -> Attribute)
parse'key =
        ParsecT s () Identity (Attribute -> Attribute)
-> ParsecT s () Identity (Attribute -> Attribute)
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
"key"
              (Attribute -> Attribute)
-> ParsecT s () Identity (Attribute -> Attribute)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Attribute
o -> Attribute
o {key :: Utf8
key = Utf8
v}))
      parse'value :: ParsecT s () Identity (Attribute -> Attribute)
parse'value =
        ParsecT s () Identity (Attribute -> Attribute)
-> ParsecT s () Identity (Attribute -> Attribute)
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
"value"
              (Attribute -> Attribute)
-> ParsecT s () Identity (Attribute -> Attribute)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\Attribute
o -> Attribute
o {value :: Maybe Utf8
value = Maybe Utf8
v}))