hriemann 0.2.2.0 → 0.2.2.1

raw patch · 2 files changed

+70/−1 lines, 2 filesdep +aesondep +scientificPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: aeson, scientific

API changes (from Hackage documentation)

Files

• hriemann.cabal +4/−1
• src/Network/Monitoring/Riemann/Json.hs +66/−0

@@ -1,5 +1,5 @@ name:                hriemann-version:             0.2.2.0+version:             0.2.2.1 synopsis:            Initial project template from stack description:         A Riemann Client for Haskell homepage:            https://github.com/shmish111/hriemann@@ -19,6 +19,7 @@   exposed-modules:     Network.Monitoring.Riemann.Client                        Network.Monitoring.Riemann.Event                        Network.Monitoring.Riemann.Event.Monoid+                       Network.Monitoring.Riemann.Json                        Network.Monitoring.Riemann.TCP                        Network.Monitoring.Riemann.LoggingClient                        Network.Monitoring.Riemann.TCPClient@@ -29,10 +30,12 @@                        Network.Monitoring.Riemann.Proto.Query                        Network.Monitoring.Riemann.Proto.State   build-depends:       base >= 4.7 && < 5+                     , aeson                      , protocol-buffers                      , protocol-buffers-descriptor                      , bytestring                      , network+                     , scientific                      , text                      , containers                      , binary

@@ -0,0 +1,66 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE OverloadedLists   #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# OPTIONS_GHC  -fno-warn-orphans #-}+module Network.Monitoring.Riemann.Json where++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'++instance ToJSON P'.Utf8 where+  toJSON v = String (Text.pack (P'.uToString v))++instance FromJSON P'.Utf8 where+  parseJSON = withText "Utf8 String" $ pure . P'.uFromString . Text.unpack++instance ToJSON PA.Attribute++instance FromJSON PA.Attribute++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 = case mMetric_sint64 of+          Nothing -> do+            s <- mMetric+            toBoundedInteger s+          i -> i+    let metric_d = case mMetric_d of+          Nothing -> do+            s <- mMetric+            rightToJust $ toBoundedRealFloat s+          d -> d+    let metric_f = case mMetric_f of+          Nothing -> do+            s <- mMetric+            rightToJust $ toBoundedRealFloat s+          d -> d+    pure Event { .. }++rightToJust :: Either l r -> Maybe r+rightToJust (Left _)  = Nothing+rightToJust (Right v) = Just v