{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Network.Monitoring.Riemann.Json where

import Control.Applicative ((<|>))
import Data.Aeson
  ( FromJSON,
    ToJSON,
    parseJSON,
    withObject,
    (.!=),
    (.:),
    (.:?),
  )
import Data.Scientific (toBoundedInteger, toBoundedRealFloat)
import Network.Monitoring.Riemann.Proto.Attribute (Attribute)
import Network.Monitoring.Riemann.Proto.Event (Event (..))
import Network.Monitoring.Riemann.Proto.Msg (Msg (..))
import Network.Monitoring.Riemann.Proto.Query (Query (..))
import Network.Monitoring.Riemann.Proto.State (State (..))
import Prelude hiding (error)

instance ToJSON Attribute

instance FromJSON Attribute

instance ToJSON Event

instance FromJSON Event where
  parseJSON :: Value -> Parser Event
parseJSON =
    String -> (Object -> Parser Event) -> Value -> Parser Event
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Event" ((Object -> Parser Event) -> Value -> Parser Event)
-> (Object -> Parser Event) -> Value -> Parser Event
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe Int64
time <- Object
v Object -> Text -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"time"
      Maybe Utf8
state <- Object
v Object -> Text -> Parser (Maybe Utf8)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"state"
      Maybe Utf8
service <- Object
v Object -> Text -> Parser (Maybe Utf8)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"service"
      Maybe Utf8
host <- Object
v Object -> Text -> Parser (Maybe Utf8)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"host"
      Maybe Utf8
description <- Object
v Object -> Text -> Parser (Maybe Utf8)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description"
      Seq Utf8
tags <- Object
v Object -> Text -> Parser (Maybe (Seq Utf8))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"tags" Parser (Maybe (Seq Utf8)) -> Seq Utf8 -> Parser (Seq Utf8)
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Maybe Float
ttl <- Object
v Object -> Text -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ttl"
      Seq Attribute
attributes <- Object
v Object -> Text -> Parser (Maybe (Seq Attribute))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"attributes" Parser (Maybe (Seq Attribute))
-> Seq Attribute -> Parser (Seq Attribute)
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Maybe Int64
mMetric_sint64 <- Object
v Object -> Text -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"metric_sint64"
      Maybe Double
mMetric_d <- Object
v Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"metric_d"
      Maybe Float
mMetric_f <- Object
v Object -> Text -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"metric_f"
      Maybe Scientific
mMetric <- Object
v Object -> Text -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"metric"
      let metric_sint64 :: Maybe Int64
metric_sint64 = Maybe Int64
mMetric_sint64 Maybe Int64 -> Maybe Int64 -> Maybe Int64
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Scientific -> Maybe Int64
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger (Scientific -> Maybe Int64) -> Maybe Scientific -> Maybe Int64
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Scientific
mMetric)
          metric_d :: Maybe Double
metric_d =
            Maybe Double
mMetric_d Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Either Double Double -> Maybe Double
forall l r. Either l r -> Maybe r
rightToJust (Either Double Double -> Maybe Double)
-> (Scientific -> Either Double Double)
-> Scientific
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Either Double Double
forall a. RealFloat a => Scientific -> Either a a
toBoundedRealFloat (Scientific -> Maybe Double) -> Maybe Scientific -> Maybe Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Scientific
mMetric)
          metric_f :: Maybe Float
metric_f =
            Maybe Float
mMetric_f Maybe Float -> Maybe Float -> Maybe Float
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Either Float Float -> Maybe Float
forall l r. Either l r -> Maybe r
rightToJust (Either Float Float -> Maybe Float)
-> (Scientific -> Either Float Float) -> Scientific -> Maybe Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Either Float Float
forall a. RealFloat a => Scientific -> Either a a
toBoundedRealFloat (Scientific -> Maybe Float) -> Maybe Scientific -> Maybe Float
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Scientific
mMetric)
      Event -> Parser Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event :: Maybe Int64
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Seq Utf8
-> Maybe Float
-> Seq Attribute
-> Maybe Int64
-> Maybe Double
-> Maybe Float
-> Event
Event {Maybe Double
Maybe Float
Maybe Int64
Maybe Utf8
Seq Utf8
Seq Attribute
metric_f :: Maybe Float
metric_d :: Maybe Double
metric_sint64 :: Maybe Int64
attributes :: Seq Attribute
ttl :: Maybe Float
tags :: Seq Utf8
description :: Maybe Utf8
host :: Maybe Utf8
service :: Maybe Utf8
state :: Maybe Utf8
time :: Maybe Int64
metric_f :: Maybe Float
metric_d :: Maybe Double
metric_sint64 :: Maybe Int64
attributes :: Seq Attribute
ttl :: Maybe Float
tags :: Seq Utf8
description :: Maybe Utf8
host :: Maybe Utf8
service :: Maybe Utf8
state :: Maybe Utf8
time :: Maybe Int64
..}

instance ToJSON Query

instance FromJSON Query where
  parseJSON :: Value -> Parser Query
parseJSON =
    String -> (Object -> Parser Query) -> Value -> Parser Query
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Query" ((Object -> Parser Query) -> Value -> Parser Query)
-> (Object -> Parser Query) -> Value -> Parser Query
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe Utf8
string <- Object
v Object -> Text -> Parser (Maybe Utf8)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"string"
      Query -> Parser Query
forall (f :: * -> *) a. Applicative f => a -> f a
pure Query :: Maybe Utf8 -> Query
Query {Maybe Utf8
string :: Maybe Utf8
string :: Maybe Utf8
..}

instance ToJSON State

instance FromJSON State where
  parseJSON :: Value -> Parser State
parseJSON =
    String -> (Object -> Parser State) -> Value -> Parser State
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"State" ((Object -> Parser State) -> Value -> Parser State)
-> (Object -> Parser State) -> Value -> Parser State
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe Int64
time <- Object
v Object -> Text -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"time"
      Maybe Utf8
state <- Object
v Object -> Text -> Parser (Maybe Utf8)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"state"
      Maybe Utf8
service <- Object
v Object -> Text -> Parser (Maybe Utf8)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"service"
      Maybe Utf8
host <- Object
v Object -> Text -> Parser (Maybe Utf8)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"host"
      Maybe Utf8
description <- Object
v Object -> Text -> Parser (Maybe Utf8)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description"
      Maybe Bool
once <- Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"once"
      Seq Utf8
tags <- Object
v Object -> Text -> Parser (Maybe (Seq Utf8))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"tags" Parser (Maybe (Seq Utf8)) -> Seq Utf8 -> Parser (Seq Utf8)
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Maybe Float
ttl <- Object
v Object -> Text -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ttl"
      State -> Parser State
forall (f :: * -> *) a. Applicative f => a -> f a
pure State :: Maybe Int64
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Utf8
-> Maybe Bool
-> Seq Utf8
-> Maybe Float
-> State
State {Maybe Bool
Maybe Float
Maybe Int64
Maybe Utf8
Seq Utf8
ttl :: Maybe Float
tags :: Seq Utf8
once :: Maybe Bool
description :: Maybe Utf8
host :: Maybe Utf8
service :: Maybe Utf8
state :: Maybe Utf8
time :: Maybe Int64
ttl :: Maybe Float
tags :: Seq Utf8
once :: Maybe Bool
description :: Maybe Utf8
host :: Maybe Utf8
service :: Maybe Utf8
state :: Maybe Utf8
time :: Maybe Int64
..}

instance ToJSON Msg

instance FromJSON Msg where
  parseJSON :: Value -> Parser Msg
parseJSON =
    String -> (Object -> Parser Msg) -> Value -> Parser Msg
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Msg" ((Object -> Parser Msg) -> Value -> Parser Msg)
-> (Object -> Parser Msg) -> Value -> Parser Msg
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe Bool
ok <- Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ok"
      Maybe Utf8
error <- Object
v Object -> Text -> Parser (Maybe Utf8)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"error"
      Seq State
states <- Object
v Object -> Text -> Parser (Maybe (Seq State))
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"states" Parser (Maybe (Seq State)) -> Seq State -> Parser (Seq State)
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Maybe Query
query <- Object
v Object -> Text -> Parser (Maybe Query)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"query"
      Seq Event
events <- Object
v Object -> Text -> Parser (Maybe (Seq Event))
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"events" Parser (Maybe (Seq Event)) -> Seq Event -> Parser (Seq Event)
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Msg -> Parser Msg
forall (f :: * -> *) a. Applicative f => a -> f a
pure Msg :: Maybe Bool
-> Maybe Utf8 -> Seq State -> Maybe Query -> Seq Event -> Msg
Msg {Maybe Bool
Maybe Utf8
Maybe Query
Seq Event
Seq State
events :: Seq Event
query :: Maybe Query
states :: Seq State
error :: Maybe Utf8
ok :: Maybe Bool
events :: Seq Event
query :: Maybe Query
states :: Seq State
error :: Maybe Utf8
ok :: Maybe Bool
..}

rightToJust :: Either l r -> Maybe r
rightToJust :: Either l r -> Maybe r
rightToJust (Left l
_) = Maybe r
forall a. Maybe a
Nothing
rightToJust (Right r
v) = r -> Maybe r
forall a. a -> Maybe a
Just r
v