hriemann 0.3.1.0 → 0.3.2.0

raw patch · 18 files changed

+1043/−752 lines, 18 filesdep +HUnitdep +QuickCheckdep +hspecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: HUnit, QuickCheck, hspec, hspec-core, mtl

API changes (from Hackage documentation)

Files

• app/Main.hs +17/−16
• hriemann.cabal +12/−3
• src/Data/Sequence/Extra.hs +13/−0
• src/Network/Monitoring/Riemann/BatchClient.hs +106/−94
• src/Network/Monitoring/Riemann/Client.hs +5/−3
• src/Network/Monitoring/Riemann/Event.hs +37/−40
• src/Network/Monitoring/Riemann/Event/Monoid.hs +12/−12
• src/Network/Monitoring/Riemann/Json.hs +41/−34
• src/Network/Monitoring/Riemann/LoggingClient.hs +10/−5
• src/Network/Monitoring/Riemann/Proto/Attribute.hs +76/−58
• src/Network/Monitoring/Riemann/Proto/Event.hs +218/−150
• src/Network/Monitoring/Riemann/Proto/Msg.hs +135/−89
• src/Network/Monitoring/Riemann/Proto/Query.hs +58/−49
• src/Network/Monitoring/Riemann/Proto/State.hs +174/−119
• src/Network/Monitoring/Riemann/TCP.hs +87/−67
• src/Network/Monitoring/Riemann/TCPClient.hs +17/−11
• test/Network/Monitoring/Riemann/BatchClientSpec.hs +24/−0
• test/Spec.hs +1/−2

@@ -1,21 +1,22 @@ module Main where -import           Control.Monad                            (forM_)-import           Data.Function-import           Network.Monitoring.Riemann.BatchClient-import           Network.Monitoring.Riemann.Client-import qualified Network.Monitoring.Riemann.Event         as Event+import Control.Monad (forM_)+import Data.Function+import Network.Monitoring.Riemann.BatchClient+import Network.Monitoring.Riemann.Client+import qualified Network.Monitoring.Riemann.Event as Event  main :: IO () main = do-    client <- batchClient "localhost" 5555 100 100 print-    putStrLn "doing some IO work"-    event <- pure $-                 Event.warn "my service"-                     & Event.description "my description"-                     & Event.metric (length [ "some data" ])-                     & Event.ttl 20-                     & Event.tags [ "tag1", "tag2" ]-    forM_ [1 .. 1000000] $ \i -> sendEvent client $ event & Event.metric (i :: Int)-    close client-    putStrLn "finished"+  client <- batchClient "localhost" 5555 100 100 print+  putStrLn "doing some IO work"+  event <-+    pure $+    Event.warn "my service" & Event.description "my description" &+    Event.metric (length ["some data"]) &+    Event.ttl 20 &+    Event.tags ["tag1", "tag2"]+  forM_ [1 .. 1000000] $ \i ->+    sendEvent client $ event & Event.metric (i :: Int)+  close client+  putStrLn "finished"

@@ -1,6 +1,6 @@ name:                hriemann-version:             0.3.1.0-synopsis:            Initial project template from stack+version:             0.3.2.0+synopsis:            A Riemann Client for Haskell description:         A Riemann Client for Haskell homepage:            https://github.com/shmish111/hriemann license:             MIT@@ -15,7 +15,7 @@  library   hs-source-dirs:      src-  ghc-options:         -Wall+  ghc-options:         -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-import-lists   exposed-modules:     Network.Monitoring.Riemann.Client                        Network.Monitoring.Riemann.Event                        Network.Monitoring.Riemann.Event.Monoid@@ -29,6 +29,7 @@                        Network.Monitoring.Riemann.Proto.Msg                        Network.Monitoring.Riemann.Proto.Query                        Network.Monitoring.Riemann.Proto.State+                       Data.Sequence.Extra   build-depends:       base >= 4.7 && < 5                      , aeson                      , protocol-buffers@@ -40,6 +41,7 @@                      , containers                      , binary                      , time+                     , mtl                      , hostname                      , unagi-chan                      , kazura-queue@@ -58,8 +60,15 @@   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Spec.hs+  other-modules:       Network.Monitoring.Riemann.BatchClientSpec   build-depends:       base                      , hriemann+                     , containers+                     , HUnit+                     , hspec+                     , hspec-core+                     , QuickCheck+                     , kazura-queue   ghc-options:         -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010 

@@ -0,0 +1,13 @@+module Data.Sequence.Extra+  ( separate+  ) where++import Data.Sequence (Seq, (|>), empty)++separate :: (a -> Either b c) -> Seq a -> (Seq b, Seq c)+separate f = foldl g (empty, empty)+  where+    g (bs, cs) a =+      case f a of+        Left b -> (bs |> b, cs)+        Right c -> (bs, cs |> c)

@@ -1,20 +1,38 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE LambdaCase #-}+ module Network.Monitoring.Riemann.BatchClient where -import           Control.Concurrent-import           Control.Concurrent.Chan.Unagi          as Unagi-import           Control.Concurrent.KazuraQueue-import           Data.Sequence                          as Seq-import           Network.Monitoring.Riemann.Client+import Control.Concurrent (MVar, forkIO, newEmptyMVar, putMVar, takeMVar)+import qualified Control.Concurrent.Chan.Unagi as Unagi+import Control.Concurrent.KazuraQueue+  ( Queue+  , lengthQueue+  , newQueue+  , readQueue+  , tryReadQueue+  , writeQueue+  )+import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Data.Sequence as Seq+import Data.Sequence (Seq, (|>))+import qualified Data.Sequence.Extra as Seq+import Network.Monitoring.Riemann.Client (Client, close, sendEvent) import qualified Network.Monitoring.Riemann.Proto.Event as PE-import           Network.Monitoring.Riemann.TCP         as TCP-import           Network.Socket+import qualified Network.Monitoring.Riemann.TCP as TCP+import Network.Socket (HostName)+import System.IO (hPutStrLn, stderr) -data BatchClient = BatchClient (Unagi.InChan LogCommand)+newtype BatchClient =+  BatchClient (Unagi.InChan LogCommand) -data BatchClientNoBuffer = BatchClientNoBuffer (Queue LogCommand)+newtype BatchClientNoBuffer =+  BatchClientNoBuffer (Queue LogCommand) -data LogCommand = Event PE.Event-                | Stop (MVar ())+data LogCommand+  = Event PE.Event+  | Stop (MVar ())  {-|     A new BatchClient@@ -33,100 +51,94 @@      '''Note''': We never use IPv6 address resolved for given hostname. -}-batchClient :: HostName-            -> Port-            -> Int-            -> Int-            -> (PE.Event -> IO ())-            -> IO BatchClient+batchClient ::+     HostName -> TCP.Port -> Int -> Int -> (PE.Event -> IO ()) -> IO BatchClient batchClient hostname port bufferSize batchSize overflow-    | batchSize <= 0 = error "Batch Size must be positive"-    | otherwise = do-          connection <- TCP.tcpConnection hostname port-          (inChan, outChan) <- Unagi.newChan-          q <- newQueue-          _ <- forkIO $ overflowConsumer outChan q bufferSize overflow-          _ <- forkIO $ riemannConsumer batchSize q connection-          return $ BatchClient inChan+  | batchSize <= 0 = error "Batch Size must be positive"+  | otherwise = do+    connection <- TCP.tcpConnection hostname port+    (inChan, outChan) <- Unagi.newChan+    queue <- newQueue+    _ <- forkIO $ overflowConsumer outChan queue bufferSize overflow+    _ <- forkIO $ riemannConsumer batchSize queue connection+    pure $ BatchClient inChan -bufferlessBatchClient :: HostName -> Port -> Int -> IO BatchClientNoBuffer+bufferlessBatchClient :: HostName -> TCP.Port -> Int -> IO BatchClientNoBuffer bufferlessBatchClient hostname port batchSize-    | batchSize <= 0 = error "Batch Size must be positive"-    | otherwise = do-          connection <- TCP.tcpConnection hostname port-          q <- newQueue-          _ <- forkIO $ riemannConsumer batchSize q connection-          return $ BatchClientNoBuffer q+  | batchSize <= 0 = error "Batch Size must be positive"+  | otherwise = do+    connection <- TCP.tcpConnection hostname port+    queue <- newQueue+    _ <- forkIO $ riemannConsumer batchSize queue connection+    pure $ BatchClientNoBuffer queue -overflowConsumer :: Unagi.OutChan LogCommand-                 -> Queue LogCommand-                 -> Int-                 -> (PE.Event -> IO ())-                 -> IO ()-overflowConsumer outChan q bufferSize f =-    loop+overflowConsumer ::+     Unagi.OutChan LogCommand+  -> Queue LogCommand+  -> Int+  -> (PE.Event -> IO ())+  -> IO ()+overflowConsumer outChan queue bufferSize f = loop   where     loop = do-        cmd <- Unagi.readChan outChan-        case cmd of-            Event event -> do-                qSize <- lengthQueue q-                if qSize >= bufferSize-                    then do-                        f event-                        loop-                    else do-                        writeQueue q cmd-                        loop-            Stop _ -> do-                putStrLn "stopping log consumer"-                writeQueue q cmd+      cmd <- Unagi.readChan outChan+      case cmd of+        Event event -> do+          qSize <- lengthQueue queue+          if qSize >= bufferSize+            then do+              f event+              loop+            else do+              writeQueue queue cmd+              loop+        Stop _ -> do+          hPutStrLn stderr "stopping log consumer"+          writeQueue queue cmd  drainAll :: Queue a -> Int -> IO (Seq a)-drainAll q n = do-    msg <- readQueue q-    loop $ singleton msg+drainAll queue limit = do+  msg <- readQueue queue+  loop (pure msg) (limit - 1)   where-    loop msgs = if Seq.length msgs >= n-                then return msgs-                else do-                    msg <- tryReadQueue q-                    case msg of-                        Just m  -> loop $ msgs |> m-                        Nothing -> return msgs+    loop msgs 0 = pure msgs+    loop msgs n =+      tryReadQueue queue >>= \case+        Nothing -> pure msgs+        Just msg -> loop (msgs |> msg) (n - 1) -riemannConsumer :: Int -> Queue LogCommand -> TCPConnection -> IO ()-riemannConsumer batchSize q connection =-    loop+riemannConsumer :: Int -> Queue LogCommand -> TCP.TCPConnection -> IO ()+riemannConsumer batchSize queue connection = loop   where     loop = do-        cmds <- drainAll q batchSize-        let (events', stops') = Seq.partition (\cmd -> case cmd of-                                                   Event _ -> True-                                                   Stop _  -> False)-                                              cmds-            events = fmap (\(Event e) -> e) events'-            stops = fmap (\(Stop s) -> s) stops'-        TCP.sendEvents connection events-        if Seq.null stops-            then loop-            else let s = Seq.index stops 0-                 in do-                     putStrLn "stopping riemann consumer"-                     putMVar s ()+      cmds <- drainAll queue batchSize+      let (events, stops) =+            Seq.separate+              (\case+                 Event e -> Left e+                 Stop s -> Right s)+              cmds+      TCP.sendEvents connection events+      if Seq.null stops+        then loop+        else let s = Seq.index stops 0+              in do hPutStrLn stderr "stopping riemann consumer"+                    putMVar s () -instance Client BatchClient where-    sendEvent (BatchClient inChan) event =-        Unagi.writeChan inChan $ Event event-    close (BatchClient inChan) = do-        s <- newEmptyMVar-        Unagi.writeChan inChan (Stop s)-        takeMVar s+instance MonadIO m => Client m BatchClient where+  sendEvent (BatchClient inChan) event =+    liftIO . Unagi.writeChan inChan $ Event event+  close (BatchClient inChan) =+    liftIO $ do+      s <- newEmptyMVar+      Unagi.writeChan inChan (Stop s)+      takeMVar s -instance Client BatchClientNoBuffer where-    sendEvent (BatchClientNoBuffer q) event =-        writeQueue q $ Event event-    close (BatchClientNoBuffer q) = do-        s <- newEmptyMVar-        writeQueue q (Stop s)-        takeMVar s+instance MonadIO m => Client m BatchClientNoBuffer where+  sendEvent (BatchClientNoBuffer queue) event =+    liftIO . writeQueue queue $ Event event+  close (BatchClientNoBuffer queue) =+    liftIO $ do+      s <- newEmptyMVar+      writeQueue queue (Stop s)+      takeMVar s

@@ -1,3 +1,5 @@+{-# LANGUAGE MultiParamTypeClasses #-}+ module Network.Monitoring.Riemann.Client where  import qualified Network.Monitoring.Riemann.Proto.Event as Event@@ -5,6 +7,6 @@ {-|     A Client is able to send 'Network.Monitoring.Riemann.Proto.Event.Event's to Riemann -}-class Client a where-    sendEvent :: a -> Event.Event -> IO ()-    close :: a -> IO ()+class Client m a where+  sendEvent :: a -> Event.Event -> m ()+  close :: a -> m ()

@@ -22,17 +22,17 @@ -} module Network.Monitoring.Riemann.Event where -import qualified Data.ByteString.Lazy.Char8                 as BC-import           Data.Maybe-import           Data.Monoid                                ((<>))-import           Data.Sequence-import           Data.Time.Clock.POSIX-import           Network.HostName-import           Network.Monitoring.Riemann.Json            ()+import qualified Data.ByteString.Lazy.Char8 as BC+import Data.Maybe (isJust)+import Data.Monoid ((<>))+import Data.Sequence (Seq, fromList)+import Data.Time.Clock.POSIX (getPOSIXTime)+import Network.HostName (getHostName)+import Network.Monitoring.Riemann.Json () import qualified Network.Monitoring.Riemann.Proto.Attribute as Attribute-import qualified Network.Monitoring.Riemann.Proto.Event     as E-import           Text.ProtocolBuffers.Basic                 as Basic-import qualified Text.ProtocolBuffers.Header                as P'+import qualified Network.Monitoring.Riemann.Proto.Event as E+import qualified Text.ProtocolBuffers.Basic as Basic+import qualified Text.ProtocolBuffers.Header as P'  type Service = String @@ -47,10 +47,10 @@ toField string = Just $ Basic.Utf8 $ BC.pack string  info :: Service -> Event-info service = P'.defaultValue { E.service = toField service }+info service = P'.defaultValue {E.service = toField service}  state :: State -> Event -> Event-state s e = e { E.state = toField s }+state s e = e {E.state = toField s}  ok :: Service -> Event ok service = state "ok" $ info service@@ -62,25 +62,25 @@ failure service = state "failure" $ info service  description :: String -> Event -> Event-description d e = e { E.description = toField d }+description d e = e {E.description = toField d}  class Metric a where-    setMetric :: a -> Event -> Event+  setMetric :: a -> Event -> Event  instance Metric Int where-    setMetric m e = e { E.metric_sint64 = Just $ fromIntegral m }+  setMetric m e = e {E.metric_sint64 = Just $ fromIntegral m}  instance Metric Integer where-    setMetric m e = e { E.metric_sint64 = Just $ fromIntegral m }+  setMetric m e = e {E.metric_sint64 = Just $ fromIntegral m} -instance Metric Int64 where-    setMetric m e = e { E.metric_sint64 = Just m }+instance Metric P'.Int64 where+  setMetric m e = e {E.metric_sint64 = Just m}  instance Metric Double where-    setMetric m e = e { E.metric_d = Just m }+  setMetric m e = e {E.metric_d = Just m}  instance Metric Float where-    setMetric m e = e { E.metric_f = Just m }+  setMetric m e = e {E.metric_f = Just m}  {-|     Note that since Riemann's protocol has separate types for integers, floats and doubles, you need to specify which@@ -100,23 +100,21 @@ metric = setMetric  ttl :: Float -> Event -> Event-ttl t e = e { E.ttl = Just t }+ttl t e = e {E.ttl = Just t}  tags :: [String] -> Event -> Event-tags ts e = let tags' = fromList $ fmap (Basic.Utf8 . BC.pack) ts-            in-                e { E.tags = tags' <> E.tags e }+tags ts e =+  let tags' = fromList $ fmap (Basic.Utf8 . BC.pack) ts+   in e {E.tags = tags' <> E.tags e}  attributes :: [Attribute.Attribute] -> Event -> Event-attributes as e = e { E.attributes = fromList as <> E.attributes e }+attributes as e = e {E.attributes = fromList as <> E.attributes e}  attribute :: String -> Maybe String -> Attribute.Attribute-attribute k mv = let k' = (Basic.Utf8 . BC.pack) k-                     mv' = fmap (Basic.Utf8 . BC.pack) mv-                 in-                     P'.defaultValue { Attribute.key = k'-                                     , Attribute.value = mv'-                                     }+attribute k mv =+  let k' = (Basic.Utf8 . BC.pack) k+      mv' = fmap (Basic.Utf8 . BC.pack) mv+   in P'.defaultValue {Attribute.key = k', Attribute.value = mv'}  {-|     Add local hostname and current time to an Event@@ -125,14 +123,13 @@ -} withDefaults :: Seq Event -> IO (Seq Event) withDefaults e = do-    now <- fmap round getPOSIXTime-    hostname <- getHostName-    return $ fmap (addTimeAndHost now hostname) e+  now <- fmap round getPOSIXTime+  hostname <- getHostName+  pure $ addTimeAndHost now hostname <$> e -addTimeAndHost :: Int64 -> String -> Event -> Event+addTimeAndHost :: P'.Int64 -> String -> Event -> Event addTimeAndHost now hostname e-    | isJust (E.time e) && isJust (E.host e) =-          e-    | isJust (E.time e) = e { E.host = toField hostname }-    | isJust (E.host e) = e { E.time = Just now }-    | otherwise = e { E.time = Just now, E.host = toField hostname }+  | isJust (E.time e) && isJust (E.host e) = e+  | isJust (E.time e) = e {E.host = toField hostname}+  | isJust (E.host e) = e {E.time = Just now}+  | otherwise = e {E.time = Just now, E.host = toField hostname}

@@ -1,13 +1,13 @@ module Network.Monitoring.Riemann.Event.Monoid where -import           Data.Monoid                                (Endo (..), appEndo)-import           Data.Time.Clock.POSIX                      (getPOSIXTime)-import           Network.HostName                           (getHostName)-import           Network.Monitoring.Riemann.Event           (Service)-import qualified Network.Monitoring.Riemann.Event           as E-import           Network.Monitoring.Riemann.Proto.Attribute (Attribute)-import qualified Network.Monitoring.Riemann.Proto.Event     as PE-import           Text.ProtocolBuffers.Basic                 (Int64)+import Data.Monoid (Endo(Endo), appEndo)+import Data.Time.Clock.POSIX (getPOSIXTime)+import Network.HostName (getHostName)+import Network.Monitoring.Riemann.Event (Service)+import qualified Network.Monitoring.Riemann.Event as E+import Network.Monitoring.Riemann.Proto.Attribute (Attribute)+import qualified Network.Monitoring.Riemann.Proto.Event as PE+import Text.ProtocolBuffers.Basic (Int64)  type Event = PE.Event @@ -33,7 +33,7 @@ metric = Endo . E.metric  timestamp :: Int64 -> Endo Event-timestamp t = Endo $ \e -> e { PE.time = Just t }+timestamp t = Endo $ \e -> e {PE.time = Just t}  attributes :: [Attribute] -> Endo Event attributes = Endo . E.attributes@@ -43,9 +43,9 @@  timeAndHost :: IO (Endo Event) timeAndHost = do-    now <- fmap round getPOSIXTime-    hostname <- getHostName-    return $ Endo $ E.addTimeAndHost now hostname+  now <- round <$> getPOSIXTime+  hostname <- getHostName+  pure . Endo $ E.addTimeAndHost now hostname  attribute :: String -> Maybe String -> Attribute attribute = E.attribute

@@ -1,23 +1,27 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE OverloadedLists   #-}+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC  -fno-warn-orphans #-}+ module Network.Monitoring.Riemann.Json where -import           Control.Applicative                        ((<|>))-import           Data.Aeson                                 (FromJSON, ToJSON,-                                                             Value (String),-                                                             parseJSON, toJSON,-                                                             withObject,-                                                             withText, (.!=),-                                                             (.:?))-import           Data.Scientific                            (toBoundedInteger,-                                                             toBoundedRealFloat)-import qualified Data.Text                                  as Text-import           Network.Monitoring.Riemann.Proto.Attribute as PA-import           Network.Monitoring.Riemann.Proto.Event     as PE-import qualified Text.ProtocolBuffers.Header                as P'+import Control.Applicative ((<|>))+import Data.Aeson+  ( FromJSON+  , ToJSON+  , Value(String)+  , (.!=)+  , (.:?)+  , parseJSON+  , toJSON+  , withObject+  , withText+  )+import Data.Scientific (toBoundedInteger, toBoundedRealFloat)+import qualified Data.Text as Text+import qualified Network.Monitoring.Riemann.Proto.Attribute as PA+import qualified Network.Monitoring.Riemann.Proto.Event as PE+import qualified Text.ProtocolBuffers.Header as P'  instance ToJSON P'.Utf8 where   toJSON v = String (Text.pack (P'.uToString v))@@ -32,24 +36,27 @@ instance ToJSON PE.Event  instance FromJSON PE.Event where-  parseJSON = withObject "Event" $ \v -> do-    time <- v .:? "time"-    state <- v .:? "state"-    service <- v .:? "service"-    host <- v .:? "host"-    description <- v .:? "description"-    tags <- v .:? "tags" .!= []-    ttl <- v .:? "ttl"-    attributes <- v .:? "attributes" .!= []-    mMetric_sint64 <- v .:? "metric_sint64"-    mMetric_d <- v .:? "metric_d"-    mMetric_f <- v .:? "metric_f"-    mMetric <- v .:? "metric"-    let metric_sint64 = mMetric_sint64 <|> (toBoundedInteger =<< mMetric)-        metric_d = mMetric_d <|> (rightToJust . toBoundedRealFloat =<< mMetric)-        metric_f = mMetric_f <|> (rightToJust . toBoundedRealFloat =<< mMetric)-    pure Event { .. }+  parseJSON =+    withObject "Event" $ \v -> do+      time <- v .:? "time"+      state <- v .:? "state"+      service <- v .:? "service"+      host <- v .:? "host"+      description <- v .:? "description"+      tags <- v .:? "tags" .!= []+      ttl <- v .:? "ttl"+      attributes <- v .:? "attributes" .!= []+      mMetric_sint64 <- v .:? "metric_sint64"+      mMetric_d <- v .:? "metric_d"+      mMetric_f <- v .:? "metric_f"+      mMetric <- v .:? "metric"+      let metric_sint64 = mMetric_sint64 <|> (toBoundedInteger =<< mMetric)+          metric_d =+            mMetric_d <|> (rightToJust . toBoundedRealFloat =<< mMetric)+          metric_f =+            mMetric_f <|> (rightToJust . toBoundedRealFloat =<< mMetric)+      pure PE.Event {..}  rightToJust :: Either l r -> Maybe r-rightToJust (Left _)  = Nothing+rightToJust (Left _) = Nothing rightToJust (Right v) = Just v

@@ -1,8 +1,13 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+ module Network.Monitoring.Riemann.LoggingClient where -import           Network.Monitoring.Riemann.Client+import Control.Monad.IO.Class (MonadIO, liftIO)+import Network.Monitoring.Riemann.Client (Client, close, sendEvent) -data LoggingClient = LoggingClient+data LoggingClient =+  LoggingClient  {-|     A new LoggingClient@@ -12,6 +17,6 @@ loggingClient :: LoggingClient loggingClient = LoggingClient -instance Client LoggingClient where-    sendEvent _ = print-    close _ = print "close"+instance MonadIO m => Client m LoggingClient where+  sendEvent _ = liftIO . print+  close _ = liftIO $ print "close"

@@ -1,53 +1,72 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}-{-# OPTIONS_GHC  -fno-warn-unused-imports #-}-module Network.Monitoring.Riemann.Proto.Attribute (Attribute(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified GHC.Generics as Prelude'+{-# 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{key :: !(P'.Utf8), value :: !(P'.Maybe P'.Utf8)}-               deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)+data Attribute = Attribute+  { key :: !P'.Utf8+  , value :: !(P'.Maybe P'.Utf8)+  } deriving ( Prelude'.Show+             , Prelude'.Eq+             , Prelude'.Ord+             , Prelude'.Typeable+             , Prelude'.Data+             , Prelude'.Generic+             )  instance P'.Mergeable Attribute where-  mergeAppend (Attribute x'1 x'2) (Attribute y'1 y'2) = Attribute (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+  mergeAppend (Attribute x'1 x'2) (Attribute y'1 y'2) =+    Attribute (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)  instance P'.Default Attribute where   defaultValue = Attribute P'.defaultValue P'.defaultValue  instance P'.Wire Attribute where-  wireSize ft' self'@(Attribute x'1 x'2)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size = (P'.wireSizeReq 1 9 x'1 + P'.wireSizeOpt 1 9 x'2)-  wirePut ft' self'@(Attribute x'1 x'2)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'+  wireSize ft' self'@(Attribute x'1 x'2) =+    case ft' of+      10 -> calc'Size+      11 -> P'.prependMessageSize calc'Size+      _ -> P'.wireSizeErr ft' self'     where+      calc'Size = P'.wireSizeReq 1 9 x'1 + P'.wireSizeOpt 1 9 x'2+  wirePut ft' self'@(Attribute x'1 x'2) =+    case ft' of+      10 -> put'Fields+      11 -> do+        P'.putSize (P'.wireSize 10 self')         put'Fields-         = do-             P'.wirePutReq 10 9 x'1-             P'.wirePutOpt 18 9 x'2-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'+      _ -> P'.wirePutErr ft' self'     where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             10 -> Prelude'.fmap (\ !new'Field -> old'Self{key = new'Field}) (P'.wireGet 9)-             18 -> Prelude'.fmap (\ !new'Field -> old'Self{value = Prelude'.Just new'Field}) (P'.wireGet 9)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+      put'Fields = do+        P'.wirePutReq 10 9 x'1+        P'.wirePutOpt 18 9 x'2+  wireGet ft' =+    case ft' of+      10 -> P'.getBareMessageWith update'Self+      11 -> P'.getMessageWith update'Self+      _ -> P'.wireGetErr ft'+    where+      update'Self wire'Tag old'Self =+        case wire'Tag of+          10 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {key = new'Field})+              (P'.wireGet 9)+          18 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {value = Prelude'.Just new'Field})+              (P'.wireGet 9)+          _ ->+            let (field'Number, wire'Type) = P'.splitWireTag wire'Tag+             in P'.unknown field'Number wire'Type old'Self  instance P'.MessageAPI msg' (msg' -> Attribute) Attribute where   getVal m' f' = f' m'@@ -55,9 +74,12 @@ instance P'.GPB Attribute  instance P'.ReflectDescriptor Attribute where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10, 18])-  reflectDescriptorInfo _-   = Prelude'.read+  getMessageInfo _ =+    P'.GetMessageInfo+      (P'.fromDistinctAscList [10])+      (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _ =+    Prelude'.read       "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@@ -65,22 +87,18 @@   getT = P'.getSubMessage  instance P'.TextMsg Attribute where-  textPut msg-   = do-       P'.tellT "key" (key msg)-       P'.tellT "value" (value msg)-  textGet-   = do-       mods <- P'.sepEndBy (P'.choice [parse'key, parse'value]) P'.spaces-       Prelude'.return (Prelude'.foldl (\ v f -> f v) P'.defaultValue mods)+  textPut msg = do+    P'.tellT "key" (key msg)+    P'.tellT "value" (value msg)+  textGet = do+    mods <- P'.sepEndBy (P'.choice [parse'key, parse'value]) P'.spaces+    Prelude'.return (Prelude'.foldl (\v f -> f v) P'.defaultValue mods)     where-        parse'key-         = P'.try-            (do-               v <- P'.getT "key"-               Prelude'.return (\ o -> o{key = v}))-        parse'value-         = P'.try-            (do-               v <- P'.getT "value"-               Prelude'.return (\ o -> o{value = v}))+      parse'key =+        P'.try+          (do v <- P'.getT "key"+              Prelude'.return (\o -> o {key = v}))+      parse'value =+        P'.try+          (do v <- P'.getT "value"+              Prelude'.return (\o -> o {value = v}))

@@ -1,23 +1,44 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}-{-# OPTIONS_GHC  -fno-warn-unused-imports #-}-module Network.Monitoring.Riemann.Proto.Event (Event(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified GHC.Generics as Prelude'+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric,+  FlexibleInstances, MultiParamTypeClasses #-}++module Network.Monitoring.Riemann.Proto.Event+  ( Event(..)+  ) where+ import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'+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{time :: !(P'.Maybe P'.Int64), state :: !(P'.Maybe P'.Utf8), service :: !(P'.Maybe P'.Utf8),-                   host :: !(P'.Maybe P'.Utf8), description :: !(P'.Maybe P'.Utf8), tags :: !(P'.Seq P'.Utf8),-                   ttl :: !(P'.Maybe P'.Float), attributes :: !(P'.Seq Proto.Attribute), metric_sint64 :: !(P'.Maybe P'.Int64),-                   metric_d :: !(P'.Maybe P'.Double), metric_f :: !(P'.Maybe P'.Float)}-           deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)+data Event = Event+  { time :: !(P'.Maybe P'.Int64)+  , state :: !(P'.Maybe P'.Utf8)+  , service :: !(P'.Maybe P'.Utf8)+  , host :: !(P'.Maybe P'.Utf8)+  , description :: !(P'.Maybe P'.Utf8)+  , tags :: !(P'.Seq P'.Utf8)+  , ttl :: !(P'.Maybe P'.Float)+  , attributes :: !(P'.Seq Proto.Attribute)+  , metric_sint64 :: !(P'.Maybe P'.Int64)+  , metric_d :: !(P'.Maybe P'.Double)+  , metric_f :: !(P'.Maybe P'.Float)+  } deriving ( Prelude'.Show+             , Prelude'.Eq+             , Prelude'.Ord+             , Prelude'.Typeable+             , Prelude'.Data+             , Prelude'.Generic+             )  instance P'.Mergeable Event where-  mergeAppend (Event x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11) (Event y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8 y'9 y'10 y'11)-   = Event (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+  mergeAppend (Event x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11) (Event y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8 y'9 y'10 y'11) =+    Event+      (P'.mergeAppend x'1 y'1)+      (P'.mergeAppend x'2 y'2)+      (P'.mergeAppend x'3 y'3)+      (P'.mergeAppend x'4 y'4)       (P'.mergeAppend x'5 y'5)       (P'.mergeAppend x'6 y'6)       (P'.mergeAppend x'7 y'7)@@ -27,70 +48,116 @@       (P'.mergeAppend x'11 y'11)  instance P'.Default Event where-  defaultValue-   = Event P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+  defaultValue =+    Event       P'.defaultValue       P'.defaultValue       P'.defaultValue       P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue  instance P'.Wire Event where-  wireSize ft' self'@(Event x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size-         = (P'.wireSizeOpt 1 3 x'1 + P'.wireSizeOpt 1 9 x'2 + P'.wireSizeOpt 1 9 x'3 + P'.wireSizeOpt 1 9 x'4 +-             P'.wireSizeOpt 1 9 x'5-             + P'.wireSizeRep 1 9 x'6-             + P'.wireSizeOpt 1 2 x'7-             + P'.wireSizeRep 1 11 x'8-             + P'.wireSizeOpt 1 18 x'9-             + P'.wireSizeOpt 1 1 x'10-             + P'.wireSizeOpt 1 2 x'11)-  wirePut ft' self'@(Event x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'+  wireSize ft' self'@(Event x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11) =+    case ft' of+      10 -> calc'Size+      11 -> P'.prependMessageSize calc'Size+      _ -> P'.wireSizeErr ft' self'     where+      calc'Size =+        P'.wireSizeOpt 1 3 x'1 + P'.wireSizeOpt 1 9 x'2 + P'.wireSizeOpt 1 9 x'3 ++        P'.wireSizeOpt 1 9 x'4 ++        P'.wireSizeOpt 1 9 x'5 ++        P'.wireSizeRep 1 9 x'6 ++        P'.wireSizeOpt 1 2 x'7 ++        P'.wireSizeRep 1 11 x'8 ++        P'.wireSizeOpt 1 18 x'9 ++        P'.wireSizeOpt 1 1 x'10 ++        P'.wireSizeOpt 1 2 x'11+  wirePut ft' self'@(Event x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11) =+    case ft' of+      10 -> put'Fields+      11 -> do+        P'.putSize (P'.wireSize 10 self')         put'Fields-         = do-             P'.wirePutOpt 8 3 x'1-             P'.wirePutOpt 18 9 x'2-             P'.wirePutOpt 26 9 x'3-             P'.wirePutOpt 34 9 x'4-             P'.wirePutOpt 42 9 x'5-             P'.wirePutRep 58 9 x'6-             P'.wirePutOpt 69 2 x'7-             P'.wirePutRep 74 11 x'8-             P'.wirePutOpt 104 18 x'9-             P'.wirePutOpt 113 1 x'10-             P'.wirePutOpt 125 2 x'11-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'+      _ -> P'.wirePutErr ft' self'     where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             8 -> Prelude'.fmap (\ !new'Field -> old'Self{time = Prelude'.Just new'Field}) (P'.wireGet 3)-             18 -> Prelude'.fmap (\ !new'Field -> old'Self{state = Prelude'.Just new'Field}) (P'.wireGet 9)-             26 -> Prelude'.fmap (\ !new'Field -> old'Self{service = Prelude'.Just new'Field}) (P'.wireGet 9)-             34 -> Prelude'.fmap (\ !new'Field -> old'Self{host = Prelude'.Just new'Field}) (P'.wireGet 9)-             42 -> Prelude'.fmap (\ !new'Field -> old'Self{description = Prelude'.Just new'Field}) (P'.wireGet 9)-             58 -> Prelude'.fmap (\ !new'Field -> old'Self{tags = P'.append (tags old'Self) new'Field}) (P'.wireGet 9)-             69 -> Prelude'.fmap (\ !new'Field -> old'Self{ttl = Prelude'.Just new'Field}) (P'.wireGet 2)-             74 -> Prelude'.fmap (\ !new'Field -> old'Self{attributes = P'.append (attributes old'Self) new'Field}) (P'.wireGet 11)-             104 -> Prelude'.fmap (\ !new'Field -> old'Self{metric_sint64 = Prelude'.Just new'Field}) (P'.wireGet 18)-             113 -> Prelude'.fmap (\ !new'Field -> old'Self{metric_d = Prelude'.Just new'Field}) (P'.wireGet 1)-             125 -> Prelude'.fmap (\ !new'Field -> old'Self{metric_f = Prelude'.Just new'Field}) (P'.wireGet 2)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+      put'Fields = do+        P'.wirePutOpt 8 3 x'1+        P'.wirePutOpt 18 9 x'2+        P'.wirePutOpt 26 9 x'3+        P'.wirePutOpt 34 9 x'4+        P'.wirePutOpt 42 9 x'5+        P'.wirePutRep 58 9 x'6+        P'.wirePutOpt 69 2 x'7+        P'.wirePutRep 74 11 x'8+        P'.wirePutOpt 104 18 x'9+        P'.wirePutOpt 113 1 x'10+        P'.wirePutOpt 125 2 x'11+  wireGet ft' =+    case ft' of+      10 -> P'.getBareMessageWith update'Self+      11 -> P'.getMessageWith update'Self+      _ -> P'.wireGetErr ft'+    where+      update'Self wire'Tag old'Self =+        case wire'Tag of+          8 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {time = Prelude'.Just new'Field})+              (P'.wireGet 3)+          18 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {state = Prelude'.Just new'Field})+              (P'.wireGet 9)+          26 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {service = Prelude'.Just new'Field})+              (P'.wireGet 9)+          34 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {host = Prelude'.Just new'Field})+              (P'.wireGet 9)+          42 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {description = Prelude'.Just new'Field})+              (P'.wireGet 9)+          58 ->+            Prelude'.fmap+              (\ !new'Field ->+                 old'Self {tags = P'.append (tags old'Self) new'Field})+              (P'.wireGet 9)+          69 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {ttl = Prelude'.Just new'Field})+              (P'.wireGet 2)+          74 ->+            Prelude'.fmap+              (\ !new'Field ->+                 old'Self+                   {attributes = P'.append (attributes old'Self) new'Field})+              (P'.wireGet 11)+          104 ->+            Prelude'.fmap+              (\ !new'Field ->+                 old'Self {metric_sint64 = Prelude'.Just new'Field})+              (P'.wireGet 18)+          113 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {metric_d = Prelude'.Just new'Field})+              (P'.wireGet 1)+          125 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {metric_f = Prelude'.Just new'Field})+              (P'.wireGet 2)+          _ ->+            let (field'Number, wire'Type) = P'.splitWireTag wire'Tag+             in P'.unknown field'Number wire'Type old'Self  instance P'.MessageAPI msg' (msg' -> Event) Event where   getVal m' f' = f' m'@@ -98,10 +165,12 @@ instance P'.GPB Event  instance P'.ReflectDescriptor Event where-  getMessageInfo _-   = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 18, 26, 34, 42, 58, 69, 74, 104, 113, 125])-  reflectDescriptorInfo _-   = Prelude'.read+  getMessageInfo _ =+    P'.GetMessageInfo+      (P'.fromDistinctAscList [])+      (P'.fromDistinctAscList [8, 18, 26, 34, 42, 58, 69, 74, 104, 113, 125])+  reflectDescriptorInfo _ =+    Prelude'.read       "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@@ -109,80 +178,79 @@   getT = P'.getSubMessage  instance P'.TextMsg Event where-  textPut msg-   = do-       P'.tellT "time" (time msg)-       P'.tellT "state" (state msg)-       P'.tellT "service" (service msg)-       P'.tellT "host" (host msg)-       P'.tellT "description" (description msg)-       P'.tellT "tags" (tags msg)-       P'.tellT "ttl" (ttl msg)-       P'.tellT "attributes" (attributes msg)-       P'.tellT "metric_sint64" (metric_sint64 msg)-       P'.tellT "metric_d" (metric_d msg)-       P'.tellT "metric_f" (metric_f msg)-  textGet-   = do-       mods <- P'.sepEndBy-                (P'.choice-                  [parse'time, parse'state, parse'service, parse'host, parse'description, parse'tags, parse'ttl, parse'attributes,-                   parse'metric_sint64, parse'metric_d, parse'metric_f])-                P'.spaces-       Prelude'.return (Prelude'.foldl (\ v f -> f v) P'.defaultValue mods)+  textPut msg = do+    P'.tellT "time" (time msg)+    P'.tellT "state" (state msg)+    P'.tellT "service" (service msg)+    P'.tellT "host" (host msg)+    P'.tellT "description" (description msg)+    P'.tellT "tags" (tags msg)+    P'.tellT "ttl" (ttl msg)+    P'.tellT "attributes" (attributes msg)+    P'.tellT "metric_sint64" (metric_sint64 msg)+    P'.tellT "metric_d" (metric_d msg)+    P'.tellT "metric_f" (metric_f msg)+  textGet = do+    mods <-+      P'.sepEndBy+        (P'.choice+           [ parse'time+           , parse'state+           , parse'service+           , parse'host+           , parse'description+           , parse'tags+           , parse'ttl+           , parse'attributes+           , parse'metric_sint64+           , parse'metric_d+           , parse'metric_f+           ])+        P'.spaces+    Prelude'.return (Prelude'.foldl (\v f -> f v) P'.defaultValue mods)     where-        parse'time-         = P'.try-            (do-               v <- P'.getT "time"-               Prelude'.return (\ o -> o{time = v}))-        parse'state-         = P'.try-            (do-               v <- P'.getT "state"-               Prelude'.return (\ o -> o{state = v}))-        parse'service-         = P'.try-            (do-               v <- P'.getT "service"-               Prelude'.return (\ o -> o{service = v}))-        parse'host-         = P'.try-            (do-               v <- P'.getT "host"-               Prelude'.return (\ o -> o{host = v}))-        parse'description-         = P'.try-            (do-               v <- P'.getT "description"-               Prelude'.return (\ o -> o{description = v}))-        parse'tags-         = P'.try-            (do-               v <- P'.getT "tags"-               Prelude'.return (\ o -> o{tags = P'.append (tags o) v}))-        parse'ttl-         = P'.try-            (do-               v <- P'.getT "ttl"-               Prelude'.return (\ o -> o{ttl = v}))-        parse'attributes-         = P'.try-            (do-               v <- P'.getT "attributes"-               Prelude'.return (\ o -> o{attributes = P'.append (attributes o) v}))-        parse'metric_sint64-         = P'.try-            (do-               v <- P'.getT "metric_sint64"-               Prelude'.return (\ o -> o{metric_sint64 = v}))-        parse'metric_d-         = P'.try-            (do-               v <- P'.getT "metric_d"-               Prelude'.return (\ o -> o{metric_d = v}))-        parse'metric_f-         = P'.try-            (do-               v <- P'.getT "metric_f"-               Prelude'.return (\ o -> o{metric_f = v}))+      parse'time =+        P'.try+          (do v <- P'.getT "time"+              Prelude'.return (\o -> o {time = v}))+      parse'state =+        P'.try+          (do v <- P'.getT "state"+              Prelude'.return (\o -> o {state = v}))+      parse'service =+        P'.try+          (do v <- P'.getT "service"+              Prelude'.return (\o -> o {service = v}))+      parse'host =+        P'.try+          (do v <- P'.getT "host"+              Prelude'.return (\o -> o {host = v}))+      parse'description =+        P'.try+          (do v <- P'.getT "description"+              Prelude'.return (\o -> o {description = v}))+      parse'tags =+        P'.try+          (do v <- P'.getT "tags"+              Prelude'.return (\o -> o {tags = P'.append (tags o) v}))+      parse'ttl =+        P'.try+          (do v <- P'.getT "ttl"+              Prelude'.return (\o -> o {ttl = v}))+      parse'attributes =+        P'.try+          (do v <- P'.getT "attributes"+              Prelude'.return+                (\o -> o {attributes = P'.append (attributes o) v}))+      parse'metric_sint64 =+        P'.try+          (do v <- P'.getT "metric_sint64"+              Prelude'.return (\o -> o {metric_sint64 = v}))+      parse'metric_d =+        P'.try+          (do v <- P'.getT "metric_d"+              Prelude'.return (\o -> o {metric_d = v}))+      parse'metric_f =+        P'.try+          (do v <- P'.getT "metric_f"+              Prelude'.return (\o -> o {metric_f = v}))

@@ -1,68 +1,114 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}-{-# OPTIONS_GHC  -fno-warn-unused-imports #-}-module Network.Monitoring.Riemann.Proto.Msg (Msg(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified GHC.Generics as Prelude'+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric,+  FlexibleInstances, MultiParamTypeClasses #-}++module Network.Monitoring.Riemann.Proto.Msg+  ( Msg(..)+  ) where+ import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'+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{ok :: !(P'.Maybe P'.Bool), error :: !(P'.Maybe P'.Utf8), states :: !(P'.Seq Proto.State),-               query :: !(P'.Maybe Proto.Query), events :: !(P'.Seq Proto.Event)}-         deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)+data Msg = Msg+  { ok :: !(P'.Maybe P'.Bool)+  , error :: !(P'.Maybe P'.Utf8)+  , states :: !(P'.Seq Proto.State)+  , query :: !(P'.Maybe Proto.Query)+  , events :: !(P'.Seq Proto.Event)+  } deriving ( Prelude'.Show+             , Prelude'.Eq+             , Prelude'.Ord+             , Prelude'.Typeable+             , Prelude'.Data+             , Prelude'.Generic+             )  instance P'.Mergeable Msg where-  mergeAppend (Msg x'1 x'2 x'3 x'4 x'5) (Msg y'1 y'2 y'3 y'4 y'5)-   = Msg (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+  mergeAppend (Msg x'1 x'2 x'3 x'4 x'5) (Msg y'1 y'2 y'3 y'4 y'5) =+    Msg+      (P'.mergeAppend x'1 y'1)+      (P'.mergeAppend x'2 y'2)+      (P'.mergeAppend x'3 y'3)+      (P'.mergeAppend x'4 y'4)       (P'.mergeAppend x'5 y'5)  instance P'.Default Msg where-  defaultValue = Msg P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+  defaultValue =+    Msg+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue  instance P'.Wire Msg where-  wireSize ft' self'@(Msg x'1 x'2 x'3 x'4 x'5)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size-         = (P'.wireSizeOpt 1 8 x'1 + P'.wireSizeOpt 1 9 x'2 + P'.wireSizeRep 1 11 x'3 + P'.wireSizeOpt 1 11 x'4 +-             P'.wireSizeRep 1 11 x'5)-  wirePut ft' self'@(Msg x'1 x'2 x'3 x'4 x'5)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'+  wireSize ft' self'@(Msg x'1 x'2 x'3 x'4 x'5) =+    case ft' of+      10 -> calc'Size+      11 -> P'.prependMessageSize calc'Size+      _ -> P'.wireSizeErr ft' self'     where+      calc'Size =+        P'.wireSizeOpt 1 8 x'1 + P'.wireSizeOpt 1 9 x'2 ++        P'.wireSizeRep 1 11 x'3 ++        P'.wireSizeOpt 1 11 x'4 ++        P'.wireSizeRep 1 11 x'5+  wirePut ft' self'@(Msg x'1 x'2 x'3 x'4 x'5) =+    case ft' of+      10 -> put'Fields+      11 -> do+        P'.putSize (P'.wireSize 10 self')         put'Fields-         = do-             P'.wirePutOpt 16 8 x'1-             P'.wirePutOpt 26 9 x'2-             P'.wirePutRep 34 11 x'3-             P'.wirePutOpt 42 11 x'4-             P'.wirePutRep 50 11 x'5-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'+      _ -> P'.wirePutErr ft' self'     where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             16 -> Prelude'.fmap (\ !new'Field -> old'Self{ok = Prelude'.Just new'Field}) (P'.wireGet 8)-             26 -> Prelude'.fmap (\ !new'Field -> old'Self{error = Prelude'.Just new'Field}) (P'.wireGet 9)-             34 -> Prelude'.fmap (\ !new'Field -> old'Self{states = P'.append (states old'Self) new'Field}) (P'.wireGet 11)-             42 -> Prelude'.fmap (\ !new'Field -> old'Self{query = P'.mergeAppend (query old'Self) (Prelude'.Just new'Field)})-                    (P'.wireGet 11)-             50 -> Prelude'.fmap (\ !new'Field -> old'Self{events = P'.append (events old'Self) new'Field}) (P'.wireGet 11)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+      put'Fields = do+        P'.wirePutOpt 16 8 x'1+        P'.wirePutOpt 26 9 x'2+        P'.wirePutRep 34 11 x'3+        P'.wirePutOpt 42 11 x'4+        P'.wirePutRep 50 11 x'5+  wireGet ft' =+    case ft' of+      10 -> P'.getBareMessageWith update'Self+      11 -> P'.getMessageWith update'Self+      _ -> P'.wireGetErr ft'+    where+      update'Self wire'Tag old'Self =+        case wire'Tag of+          16 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {ok = Prelude'.Just new'Field})+              (P'.wireGet 8)+          26 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {error = Prelude'.Just new'Field})+              (P'.wireGet 9)+          34 ->+            Prelude'.fmap+              (\ !new'Field ->+                 old'Self {states = P'.append (states old'Self) new'Field})+              (P'.wireGet 11)+          42 ->+            Prelude'.fmap+              (\ !new'Field ->+                 old'Self+                   { query =+                       P'.mergeAppend (query old'Self) (Prelude'.Just new'Field)+                   })+              (P'.wireGet 11)+          50 ->+            Prelude'.fmap+              (\ !new'Field ->+                 old'Self {events = P'.append (events old'Self) new'Field})+              (P'.wireGet 11)+          _ ->+            let (field'Number, wire'Type) = P'.splitWireTag wire'Tag+             in P'.unknown field'Number wire'Type old'Self  instance P'.MessageAPI msg' (msg' -> Msg) Msg where   getVal m' f' = f' m'@@ -70,9 +116,12 @@ instance P'.GPB Msg  instance P'.ReflectDescriptor Msg where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [16, 26, 34, 42, 50])-  reflectDescriptorInfo _-   = Prelude'.read+  getMessageInfo _ =+    P'.GetMessageInfo+      (P'.fromDistinctAscList [])+      (P'.fromDistinctAscList [16, 26, 34, 42, 50])+  reflectDescriptorInfo _ =+    Prelude'.read       "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@@ -80,40 +129,37 @@   getT = P'.getSubMessage  instance P'.TextMsg Msg where-  textPut msg-   = do-       P'.tellT "ok" (ok msg)-       P'.tellT "error" (error msg)-       P'.tellT "states" (states msg)-       P'.tellT "query" (query msg)-       P'.tellT "events" (events msg)-  textGet-   = do-       mods <- P'.sepEndBy (P'.choice [parse'ok, parse'error, parse'states, parse'query, parse'events]) P'.spaces-       Prelude'.return (Prelude'.foldl (\ v f -> f v) P'.defaultValue mods)+  textPut msg = do+    P'.tellT "ok" (ok msg)+    P'.tellT "error" (error msg)+    P'.tellT "states" (states msg)+    P'.tellT "query" (query msg)+    P'.tellT "events" (events msg)+  textGet = do+    mods <-+      P'.sepEndBy+        (P'.choice+           [parse'ok, parse'error, parse'states, parse'query, parse'events])+        P'.spaces+    Prelude'.return (Prelude'.foldl (\v f -> f v) P'.defaultValue mods)     where-        parse'ok-         = P'.try-            (do-               v <- P'.getT "ok"-               Prelude'.return (\ o -> o{ok = v}))-        parse'error-         = P'.try-            (do-               v <- P'.getT "error"-               Prelude'.return (\ o -> o{error = v}))-        parse'states-         = P'.try-            (do-               v <- P'.getT "states"-               Prelude'.return (\ o -> o{states = P'.append (states o) v}))-        parse'query-         = P'.try-            (do-               v <- P'.getT "query"-               Prelude'.return (\ o -> o{query = v}))-        parse'events-         = P'.try-            (do-               v <- P'.getT "events"-               Prelude'.return (\ o -> o{events = P'.append (events o) v}))+      parse'ok =+        P'.try+          (do v <- P'.getT "ok"+              Prelude'.return (\o -> o {ok = v}))+      parse'error =+        P'.try+          (do v <- P'.getT "error"+              Prelude'.return (\o -> o {error = v}))+      parse'states =+        P'.try+          (do v <- P'.getT "states"+              Prelude'.return (\o -> o {states = P'.append (states o) v}))+      parse'query =+        P'.try+          (do v <- P'.getT "query"+              Prelude'.return (\o -> o {query = v}))+      parse'events =+        P'.try+          (do v <- P'.getT "events"+              Prelude'.return (\o -> o {events = P'.append (events o) v}))

@@ -1,15 +1,24 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}-{-# OPTIONS_GHC  -fno-warn-unused-imports #-}-module Network.Monitoring.Riemann.Proto.Query (Query(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified GHC.Generics as Prelude'+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric,+  FlexibleInstances, MultiParamTypeClasses #-}++module Network.Monitoring.Riemann.Proto.Query+  ( Query(..)+  ) where+ import qualified Data.Data as Prelude'+import qualified GHC.Generics as Prelude'+import qualified Prelude as Prelude' import qualified Text.ProtocolBuffers.Header as P' -data Query = Query{string :: !(P'.Maybe P'.Utf8)}-           deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)+newtype Query = Query+  { string :: P'.Maybe P'.Utf8+  } deriving ( Prelude'.Show+             , Prelude'.Eq+             , Prelude'.Ord+             , Prelude'.Typeable+             , Prelude'.Data+             , Prelude'.Generic+             )  instance P'.Mergeable Query where   mergeAppend (Query x'1) (Query y'1) = Query (P'.mergeAppend x'1 y'1)@@ -18,34 +27,37 @@   defaultValue = Query P'.defaultValue  instance P'.Wire Query where-  wireSize ft' self'@(Query x'1)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size = (P'.wireSizeOpt 1 9 x'1)-  wirePut ft' self'@(Query x'1)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'+  wireSize ft' self'@(Query x'1) =+    case ft' of+      10 -> calc'Size+      11 -> P'.prependMessageSize calc'Size+      _ -> P'.wireSizeErr ft' self'     where+      calc'Size = P'.wireSizeOpt 1 9 x'1+  wirePut ft' self'@(Query x'1) =+    case ft' of+      10 -> put'Fields+      11 -> do+        P'.putSize (P'.wireSize 10 self')         put'Fields-         = do-             P'.wirePutOpt 10 9 x'1-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'+      _ -> P'.wirePutErr ft' self'     where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             10 -> Prelude'.fmap (\ !new'Field -> old'Self{string = Prelude'.Just new'Field}) (P'.wireGet 9)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+      put'Fields = P'.wirePutOpt 10 9 x'1+  wireGet ft' =+    case ft' of+      10 -> P'.getBareMessageWith update'Self+      11 -> P'.getMessageWith update'Self+      _ -> P'.wireGetErr ft'+    where+      update'Self wire'Tag old'Self =+        case wire'Tag of+          10 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {string = Prelude'.Just new'Field})+              (P'.wireGet 9)+          _ ->+            let (field'Number, wire'Type) = P'.splitWireTag wire'Tag+             in P'.unknown field'Number wire'Type old'Self  instance P'.MessageAPI msg' (msg' -> Query) Query where   getVal m' f' = f' m'@@ -53,9 +65,10 @@ instance P'.GPB Query  instance P'.ReflectDescriptor Query where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10])-  reflectDescriptorInfo _-   = Prelude'.read+  getMessageInfo _ =+    P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _ =+    Prelude'.read       "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Proto.Query\", haskellPrefix = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule = [MName \"Proto\"], baseName = MName \"Query\"}, descFilePath = [\"Network\",\"Monitoring\",\"Riemann\",\"Proto\",\"Query.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Proto.Query.string\", haskellPrefix' = [MName \"Network\",MName \"Monitoring\",MName \"Riemann\"], parentModule' = [MName \"Proto\",MName \"Query\"], baseName' = FName \"string\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, 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 Query where@@ -63,16 +76,12 @@   getT = P'.getSubMessage  instance P'.TextMsg Query where-  textPut msg-   = do-       P'.tellT "string" (string msg)-  textGet-   = do-       mods <- P'.sepEndBy (P'.choice [parse'string]) P'.spaces-       Prelude'.return (Prelude'.foldl (\ v f -> f v) P'.defaultValue mods)+  textPut msg = P'.tellT "string" (string msg)+  textGet = do+    mods <- P'.sepEndBy (P'.choice [parse'string]) P'.spaces+    Prelude'.return (Prelude'.foldl (\v f -> f v) P'.defaultValue mods)     where-        parse'string-         = P'.try-            (do-               v <- P'.getT "string"-               Prelude'.return (\ o -> o{string = v}))+      parse'string =+        P'.try+          (do v <- P'.getT "string"+              Prelude'.return (\o -> o {string = v}))

@@ -1,79 +1,132 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}-{-# OPTIONS_GHC  -fno-warn-unused-imports #-}-module Network.Monitoring.Riemann.Proto.State (State(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified GHC.Generics as Prelude'+{-# 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{time :: !(P'.Maybe P'.Int64), state :: !(P'.Maybe P'.Utf8), service :: !(P'.Maybe P'.Utf8),-                   host :: !(P'.Maybe P'.Utf8), description :: !(P'.Maybe P'.Utf8), once :: !(P'.Maybe P'.Bool),-                   tags :: !(P'.Seq P'.Utf8), ttl :: !(P'.Maybe P'.Float)}-           deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)+data State = State+  { time :: !(P'.Maybe P'.Int64)+  , state :: !(P'.Maybe P'.Utf8)+  , service :: !(P'.Maybe P'.Utf8)+  , host :: !(P'.Maybe P'.Utf8)+  , description :: !(P'.Maybe P'.Utf8)+  , once :: !(P'.Maybe P'.Bool)+  , tags :: !(P'.Seq P'.Utf8)+  , ttl :: !(P'.Maybe P'.Float)+  } deriving ( Prelude'.Show+             , Prelude'.Eq+             , Prelude'.Ord+             , Prelude'.Typeable+             , Prelude'.Data+             , Prelude'.Generic+             )  instance P'.Mergeable State where-  mergeAppend (State x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8) (State y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8)-   = State (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+  mergeAppend (State x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8) (State y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8) =+    State+      (P'.mergeAppend x'1 y'1)+      (P'.mergeAppend x'2 y'2)+      (P'.mergeAppend x'3 y'3)+      (P'.mergeAppend x'4 y'4)       (P'.mergeAppend x'5 y'5)       (P'.mergeAppend x'6 y'6)       (P'.mergeAppend x'7 y'7)       (P'.mergeAppend x'8 y'8)  instance P'.Default State where-  defaultValue-   = State P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+  defaultValue =+    State       P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue+      P'.defaultValue  instance P'.Wire State where-  wireSize ft' self'@(State x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size-         = (P'.wireSizeOpt 1 3 x'1 + P'.wireSizeOpt 1 9 x'2 + P'.wireSizeOpt 1 9 x'3 + P'.wireSizeOpt 1 9 x'4 +-             P'.wireSizeOpt 1 9 x'5-             + P'.wireSizeOpt 1 8 x'6-             + P'.wireSizeRep 1 9 x'7-             + P'.wireSizeOpt 1 2 x'8)-  wirePut ft' self'@(State x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'+  wireSize ft' self'@(State x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8) =+    case ft' of+      10 -> calc'Size+      11 -> P'.prependMessageSize calc'Size+      _ -> P'.wireSizeErr ft' self'     where+      calc'Size =+        P'.wireSizeOpt 1 3 x'1 + P'.wireSizeOpt 1 9 x'2 + P'.wireSizeOpt 1 9 x'3 ++        P'.wireSizeOpt 1 9 x'4 ++        P'.wireSizeOpt 1 9 x'5 ++        P'.wireSizeOpt 1 8 x'6 ++        P'.wireSizeRep 1 9 x'7 ++        P'.wireSizeOpt 1 2 x'8+  wirePut ft' self'@(State x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8) =+    case ft' of+      10 -> put'Fields+      11 -> do+        P'.putSize (P'.wireSize 10 self')         put'Fields-         = do-             P'.wirePutOpt 8 3 x'1-             P'.wirePutOpt 18 9 x'2-             P'.wirePutOpt 26 9 x'3-             P'.wirePutOpt 34 9 x'4-             P'.wirePutOpt 42 9 x'5-             P'.wirePutOpt 48 8 x'6-             P'.wirePutRep 58 9 x'7-             P'.wirePutOpt 69 2 x'8-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'+      _ -> P'.wirePutErr ft' self'     where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             8 -> Prelude'.fmap (\ !new'Field -> old'Self{time = Prelude'.Just new'Field}) (P'.wireGet 3)-             18 -> Prelude'.fmap (\ !new'Field -> old'Self{state = Prelude'.Just new'Field}) (P'.wireGet 9)-             26 -> Prelude'.fmap (\ !new'Field -> old'Self{service = Prelude'.Just new'Field}) (P'.wireGet 9)-             34 -> Prelude'.fmap (\ !new'Field -> old'Self{host = Prelude'.Just new'Field}) (P'.wireGet 9)-             42 -> Prelude'.fmap (\ !new'Field -> old'Self{description = Prelude'.Just new'Field}) (P'.wireGet 9)-             48 -> Prelude'.fmap (\ !new'Field -> old'Self{once = Prelude'.Just new'Field}) (P'.wireGet 8)-             58 -> Prelude'.fmap (\ !new'Field -> old'Self{tags = P'.append (tags old'Self) new'Field}) (P'.wireGet 9)-             69 -> Prelude'.fmap (\ !new'Field -> old'Self{ttl = Prelude'.Just new'Field}) (P'.wireGet 2)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+      put'Fields = do+        P'.wirePutOpt 8 3 x'1+        P'.wirePutOpt 18 9 x'2+        P'.wirePutOpt 26 9 x'3+        P'.wirePutOpt 34 9 x'4+        P'.wirePutOpt 42 9 x'5+        P'.wirePutOpt 48 8 x'6+        P'.wirePutRep 58 9 x'7+        P'.wirePutOpt 69 2 x'8+  wireGet ft' =+    case ft' of+      10 -> P'.getBareMessageWith update'Self+      11 -> P'.getMessageWith update'Self+      _ -> P'.wireGetErr ft'+    where+      update'Self wire'Tag old'Self =+        case wire'Tag of+          8 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {time = Prelude'.Just new'Field})+              (P'.wireGet 3)+          18 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {state = Prelude'.Just new'Field})+              (P'.wireGet 9)+          26 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {service = Prelude'.Just new'Field})+              (P'.wireGet 9)+          34 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {host = Prelude'.Just new'Field})+              (P'.wireGet 9)+          42 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {description = Prelude'.Just new'Field})+              (P'.wireGet 9)+          48 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {once = Prelude'.Just new'Field})+              (P'.wireGet 8)+          58 ->+            Prelude'.fmap+              (\ !new'Field ->+                 old'Self {tags = P'.append (tags old'Self) new'Field})+              (P'.wireGet 9)+          69 ->+            Prelude'.fmap+              (\ !new'Field -> old'Self {ttl = Prelude'.Just new'Field})+              (P'.wireGet 2)+          _ ->+            let (field'Number, wire'Type) = P'.splitWireTag wire'Tag+             in P'.unknown field'Number wire'Type old'Self  instance P'.MessageAPI msg' (msg' -> State) State where   getVal m' f' = f' m'@@ -81,9 +134,12 @@ instance P'.GPB State  instance P'.ReflectDescriptor State where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 18, 26, 34, 42, 48, 58, 69])-  reflectDescriptorInfo _-   = Prelude'.read+  getMessageInfo _ =+    P'.GetMessageInfo+      (P'.fromDistinctAscList [])+      (P'.fromDistinctAscList [8, 18, 26, 34, 42, 48, 58, 69])+  reflectDescriptorInfo _ =+    Prelude'.read       "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@@ -91,61 +147,60 @@   getT = P'.getSubMessage  instance P'.TextMsg State where-  textPut msg-   = do-       P'.tellT "time" (time msg)-       P'.tellT "state" (state msg)-       P'.tellT "service" (service msg)-       P'.tellT "host" (host msg)-       P'.tellT "description" (description msg)-       P'.tellT "once" (once msg)-       P'.tellT "tags" (tags msg)-       P'.tellT "ttl" (ttl msg)-  textGet-   = do-       mods <- P'.sepEndBy-                (P'.choice-                  [parse'time, parse'state, parse'service, parse'host, parse'description, parse'once, parse'tags, parse'ttl])-                P'.spaces-       Prelude'.return (Prelude'.foldl (\ v f -> f v) P'.defaultValue mods)+  textPut msg = do+    P'.tellT "time" (time msg)+    P'.tellT "state" (state msg)+    P'.tellT "service" (service msg)+    P'.tellT "host" (host msg)+    P'.tellT "description" (description msg)+    P'.tellT "once" (once msg)+    P'.tellT "tags" (tags msg)+    P'.tellT "ttl" (ttl msg)+  textGet = do+    mods <-+      P'.sepEndBy+        (P'.choice+           [ parse'time+           , parse'state+           , parse'service+           , parse'host+           , parse'description+           , parse'once+           , parse'tags+           , parse'ttl+           ])+        P'.spaces+    Prelude'.return (Prelude'.foldl (\v f -> f v) P'.defaultValue mods)     where-        parse'time-         = P'.try-            (do-               v <- P'.getT "time"-               Prelude'.return (\ o -> o{time = v}))-        parse'state-         = P'.try-            (do-               v <- P'.getT "state"-               Prelude'.return (\ o -> o{state = v}))-        parse'service-         = P'.try-            (do-               v <- P'.getT "service"-               Prelude'.return (\ o -> o{service = v}))-        parse'host-         = P'.try-            (do-               v <- P'.getT "host"-               Prelude'.return (\ o -> o{host = v}))-        parse'description-         = P'.try-            (do-               v <- P'.getT "description"-               Prelude'.return (\ o -> o{description = v}))-        parse'once-         = P'.try-            (do-               v <- P'.getT "once"-               Prelude'.return (\ o -> o{once = v}))-        parse'tags-         = P'.try-            (do-               v <- P'.getT "tags"-               Prelude'.return (\ o -> o{tags = P'.append (tags o) v}))-        parse'ttl-         = P'.try-            (do-               v <- P'.getT "ttl"-               Prelude'.return (\ o -> o{ttl = v}))+      parse'time =+        P'.try+          (do v <- P'.getT "time"+              Prelude'.return (\o -> o {time = v}))+      parse'state =+        P'.try+          (do v <- P'.getT "state"+              Prelude'.return (\o -> o {state = v}))+      parse'service =+        P'.try+          (do v <- P'.getT "service"+              Prelude'.return (\o -> o {service = v}))+      parse'host =+        P'.try+          (do v <- P'.getT "host"+              Prelude'.return (\o -> o {host = v}))+      parse'description =+        P'.try+          (do v <- P'.getT "description"+              Prelude'.return (\o -> o {description = v}))+      parse'once =+        P'.try+          (do v <- P'.getT "once"+              Prelude'.return (\o -> o {once = v}))+      parse'tags =+        P'.try+          (do v <- P'.getT "tags"+              Prelude'.return (\o -> o {tags = P'.append (tags o) v}))+      parse'ttl =+        P'.try+          (do v <- P'.getT "ttl"+              Prelude'.return (\o -> o {ttl = v}))

@@ -1,102 +1,122 @@-{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-}  module Network.Monitoring.Riemann.TCP-    ( tcpConnection-    , sendEvents-    , sendMsg-    , TCPConnection-    , Port-    ) where+  ( tcpConnection+  , sendEvents+  , sendMsg+  , TCPConnection+  , Port+  ) where -import           Control.Concurrent-import           Data.Binary.Put                        as Put-import qualified Data.ByteString.Lazy                   as BS-import qualified Data.ByteString.Lazy.Char8             as BC-import qualified Data.Maybe                             as Maybe-import qualified Data.Sequence                          as Seq-import qualified Network.Monitoring.Riemann.Event       as Event+import Control.Concurrent (MVar, newMVar, putMVar, takeMVar)+import qualified Data.Binary.Put as Put+import qualified Data.ByteString.Lazy as BS+import qualified Data.ByteString.Lazy.Char8 as BC+import qualified Data.Maybe as Maybe+import Data.Sequence (Seq)+import qualified Network.Monitoring.Riemann.Event as Event import qualified Network.Monitoring.Riemann.Proto.Event as PE-import qualified Network.Monitoring.Riemann.Proto.Msg   as Msg-import           Network.Socket-import           Network.Socket.ByteString.Lazy         as NSB-import qualified Text.ProtocolBuffers.Header            as P'-import           Text.ProtocolBuffers.WireMessage       as WM+import qualified Network.Monitoring.Riemann.Proto.Msg as Msg+import Network.Socket+  ( AddrInfo+  , AddrInfoFlag(AI_NUMERICSERV)+  , Family(AF_INET, AF_INET6)+  , HostName+  , Socket+  , SocketType(Stream)+  , addrAddress+  , addrFlags+  , connect+  , defaultHints+  , defaultProtocol+  , getAddrInfo+  , isSupportedFamily+  , socket+  )+import qualified Network.Socket.ByteString.Lazy as NSB+import System.IO (hPutStrLn, stderr)+import qualified Text.ProtocolBuffers.Header as P'+import qualified Text.ProtocolBuffers.WireMessage as WM  type ClientInfo = (HostName, Port, TCPStatus)  type TCPConnection = MVar ClientInfo -data TCPStatus = CnxClosed-               | CnxOpen (Socket, AddrInfo)-    deriving (Show)+data TCPStatus+  = CnxClosed+  | CnxOpen (Socket, AddrInfo)+  deriving (Show)  type Port = Int  tcpConnection :: HostName -> Port -> IO TCPConnection tcpConnection h p = do-    connection <- doConnect h p-    newMVar (h, p, CnxOpen connection)+  connection <- doConnect h p+  newMVar (h, p, CnxOpen connection)  getConnection :: ClientInfo -> IO (Socket, AddrInfo)-getConnection (_, _, CnxOpen (s, a)) =-    return (s, a)-getConnection (h, p, CnxClosed) =-    doConnect h p+getConnection (_, _, CnxOpen (s, a)) = pure (s, a)+getConnection (h, p, CnxClosed) = doConnect h p  doConnect :: HostName -> Port -> IO (Socket, AddrInfo) doConnect hn po = do-    addrs <- getAddrInfo (Just $-                              defaultHints { addrFlags = [ AI_NUMERICSERV ] })-                         (Just hn)-                         (Just $ show po)-    case addrs of-        [] -> fail ("No accessible addresses in " ++ show addrs)-        (addy : _) -> do-            s <- socket AF_INET Stream defaultProtocol-            connect s (addrAddress addy)-            return (s, addy)+  addrs <-+    getAddrInfo+      (Just $ defaultHints {addrFlags = [AI_NUMERICSERV]})+      (Just hn)+      (Just $ show po)+  let family =+        if isSupportedFamily AF_INET6+          then AF_INET6+          else AF_INET+  case addrs of+    [] -> fail ("No accessible addresses in " ++ show addrs)+    (addy:_) -> do+      s <- socket family Stream defaultProtocol+      connect s (addrAddress addy)+      pure (s, addy)  msgToByteString :: Msg.Msg -> BC.ByteString-msgToByteString msg = Put.runPut $ do+msgToByteString msg =+  Put.runPut $ do     Put.putWord32be $ fromIntegral $ WM.messageSize msg-    messagePutM msg+    WM.messagePutM msg  decodeMsg :: BC.ByteString -> Either String Msg.Msg-decodeMsg bs = let result = messageGet (BS.drop 4 bs)-               in-                   case result of-                       Left e -> Left e-                       Right (m, _) -> if Maybe.isNothing (Msg.ok m)-                                       then Left "error"-                                       else Right m+decodeMsg bs =+  let result = WM.messageGet (BS.drop 4 bs)+   in case result of+        Left e -> Left e+        Right (m, _) ->+          if Maybe.isNothing (Msg.ok m)+            then Left "error"+            else Right m  sendMsg :: TCPConnection -> Msg.Msg -> IO (Either Msg.Msg Msg.Msg) sendMsg client msg = do-    clientInfo@(h, p, _) <- takeMVar client-    (s, _) <- getConnection clientInfo-    sendAll s $ msgToByteString msg-    bs <- NSB.recv s 4096-    result <- pure $ decodeMsg bs-    case result of-        Right m -> do-            putMVar client clientInfo-            return $ Right m-        Left _ -> do-            putMVar client (h, p, CnxClosed)-            return $ Left msg+  clientInfo@(h, p, _) <- takeMVar client+  (s, _) <- getConnection clientInfo+  NSB.sendAll s $ msgToByteString msg+  bs <- NSB.recv s 4096+  case decodeMsg bs of+    Right m -> do+      putMVar client clientInfo+      pure $ Right m+    Left _ -> do+      putMVar client (h, p, CnxClosed)+      pure $ Left msg  {-|     Send a list of Riemann events      Host and Time will be added if they do not exist on the Event -}-sendEvents :: TCPConnection -> Seq.Seq PE.Event -> IO ()+sendEvents :: TCPConnection -> Seq PE.Event -> IO () sendEvents connection events = do-    eventsWithDefaults <- Event.withDefaults events-    --     print $ "sending " ++ show (Seq.length events) ++ " events"-    result <- sendMsg connection $-                  P'.defaultValue { Msg.events = eventsWithDefaults }-    case result of-        Left msg -> print $ "failed to send" ++ show msg-        Right _ -> return ()+  eventsWithDefaults <- Event.withDefaults events+  result <-+    sendMsg connection $ P'.defaultValue {Msg.events = eventsWithDefaults}+  case result of+    Left msg -> hPutStrLn stderr $ "failed to send" ++ show msg+    Right _ -> pure ()

@@ -1,11 +1,17 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+ module Network.Monitoring.Riemann.TCPClient where -import           Network.Monitoring.Riemann.Client-import           Network.Monitoring.Riemann.TCP    as TCP-import           Network.Socket-import Data.Sequence as Seq+import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Data.Sequence as Seq+import Network.Monitoring.Riemann.Client (Client, close, sendEvent)+import qualified Network.Monitoring.Riemann.TCP as TCP+import Network.Monitoring.Riemann.TCP (Port, TCPConnection)+import Network.Socket (HostName) -data TCPClient = TCPClient TCPConnection+newtype TCPClient =+  TCPClient TCPConnection  {-|     A new TCPClient@@ -18,10 +24,10 @@ -} tcpClient :: HostName -> Port -> IO TCPClient tcpClient h p = do-    c <- TCP.tcpConnection h p-    return $ TCPClient c+  c <- TCP.tcpConnection h p+  pure $ TCPClient c -instance Client TCPClient where-    sendEvent (TCPClient connection) event =-        TCP.sendEvents connection $ Seq.singleton event-    close _ = print "close"+instance MonadIO m => Client m TCPClient where+  sendEvent (TCPClient connection) event =+    liftIO $ TCP.sendEvents connection $ Seq.singleton event+  close _ = liftIO $ print "close"

@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Monitoring.Riemann.BatchClientSpec where++import Control.Concurrent.KazuraQueue (newQueue, writeQueue)+import Data.Foldable (for_)+import qualified Data.Sequence as Seq+import Network.Monitoring.Riemann.BatchClient (drainAll)+import Test.Hspec (Spec, describe, it, shouldBe)+import Test.QuickCheck (getPositive, property)++spec :: Spec+spec = drainAllSpec++drainAllSpec :: Spec+drainAllSpec =+  describe "drainAll" $+  it "Should drain no more than the give batch size." $+  property $ \available toDrain -> do+    queue <- newQueue+    for_ [1 .. getPositive available] (writeQueue queue)+    xs <- drainAll queue $ getPositive toDrain+    Seq.length xs `shouldBe` getPositive (min available toDrain)+    Seq.lookup 0 xs `shouldBe` Just 1

@@ -1,2 +1,1 @@-main :: IO ()-main = putStrLn "Test suite not yet implemented"+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}