module Network.Bugsnag.Severity
    ( BugsnagSeverity(..)
    , BugsnagSeverityReason(..)
    , BugsnagSeverityReasonAttributes(..)
    , bugsnagSeverityReasonAttributes
    , BugsnagSeverityReasonType(..)
    ) where

import Prelude

import Data.Aeson
import Data.Aeson.Ext
import Data.Text (Text)
import GHC.Generics

data BugsnagSeverity
    = ErrorSeverity
    | WarningSeverity
    | InfoSeverity
    deriving stock (forall x. BugsnagSeverity -> Rep BugsnagSeverity x)
-> (forall x. Rep BugsnagSeverity x -> BugsnagSeverity)
-> Generic BugsnagSeverity
forall x. Rep BugsnagSeverity x -> BugsnagSeverity
forall x. BugsnagSeverity -> Rep BugsnagSeverity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagSeverity x -> BugsnagSeverity
$cfrom :: forall x. BugsnagSeverity -> Rep BugsnagSeverity x
Generic

instance ToJSON BugsnagSeverity where
    toJSON :: BugsnagSeverity -> Value
toJSON = Options -> BugsnagSeverity -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> BugsnagSeverity -> Value)
-> Options -> BugsnagSeverity -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"Severity"
    toEncoding :: BugsnagSeverity -> Encoding
toEncoding = Options -> BugsnagSeverity -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> BugsnagSeverity -> Encoding)
-> Options -> BugsnagSeverity -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"Severity"

data BugsnagSeverityReasonType
    = UnhandledExceptionReasonType
    | UnhandledErrorReasonType
    | LogReasonType
    | SignalReasonType
    | StrictModeReasonType
    | UnhandledPromiseRejectionReasonType
    | CallbackErrorInterceptReasonType
    | ErrorClassReasonType
    | UnhandledPanicReasonType
    | UserCallbackSetSeverityReasonType
    | UserSpecifiedSeverityReasonType
    | HandledExceptionReasonType
    | HandledErrorReasonType
    | HandledPanicReasonType
    | UserContextSetSeverityReasonType
    deriving stock (forall x.
 BugsnagSeverityReasonType -> Rep BugsnagSeverityReasonType x)
-> (forall x.
    Rep BugsnagSeverityReasonType x -> BugsnagSeverityReasonType)
-> Generic BugsnagSeverityReasonType
forall x.
Rep BugsnagSeverityReasonType x -> BugsnagSeverityReasonType
forall x.
BugsnagSeverityReasonType -> Rep BugsnagSeverityReasonType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BugsnagSeverityReasonType x -> BugsnagSeverityReasonType
$cfrom :: forall x.
BugsnagSeverityReasonType -> Rep BugsnagSeverityReasonType x
Generic

instance ToJSON BugsnagSeverityReasonType where
    toJSON :: BugsnagSeverityReasonType -> Value
toJSON = Options -> BugsnagSeverityReasonType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> BugsnagSeverityReasonType -> Value)
-> Options -> BugsnagSeverityReasonType -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"ReasonType"
    toEncoding :: BugsnagSeverityReasonType -> Encoding
toEncoding = Options -> BugsnagSeverityReasonType -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> BugsnagSeverityReasonType -> Encoding)
-> Options -> BugsnagSeverityReasonType -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"ReasonType"

data BugsnagSeverityReasonAttributes = BugsnagSeverityReasonAttributes
    { BugsnagSeverityReasonAttributes -> Maybe Text
bsraErrorType :: Maybe Text
    , BugsnagSeverityReasonAttributes -> Maybe Text
bsraLevel :: Maybe Text
    , BugsnagSeverityReasonAttributes -> Maybe Text
bsraSignalType :: Maybe Text
    , BugsnagSeverityReasonAttributes -> Maybe Text
bsraViolationType :: Maybe Text
    , BugsnagSeverityReasonAttributes -> Maybe Text
bsraErrorClass :: Maybe Text
    }
    deriving stock (forall x.
 BugsnagSeverityReasonAttributes
 -> Rep BugsnagSeverityReasonAttributes x)
-> (forall x.
    Rep BugsnagSeverityReasonAttributes x
    -> BugsnagSeverityReasonAttributes)
-> Generic BugsnagSeverityReasonAttributes
forall x.
Rep BugsnagSeverityReasonAttributes x
-> BugsnagSeverityReasonAttributes
forall x.
BugsnagSeverityReasonAttributes
-> Rep BugsnagSeverityReasonAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BugsnagSeverityReasonAttributes x
-> BugsnagSeverityReasonAttributes
$cfrom :: forall x.
BugsnagSeverityReasonAttributes
-> Rep BugsnagSeverityReasonAttributes x
Generic

instance ToJSON BugsnagSeverityReasonAttributes where
    toJSON :: BugsnagSeverityReasonAttributes -> Value
toJSON = Options -> BugsnagSeverityReasonAttributes -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> BugsnagSeverityReasonAttributes -> Value)
-> Options -> BugsnagSeverityReasonAttributes -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"bsra"
    toEncoding :: BugsnagSeverityReasonAttributes -> Encoding
toEncoding = Options -> BugsnagSeverityReasonAttributes -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> BugsnagSeverityReasonAttributes -> Encoding)
-> Options -> BugsnagSeverityReasonAttributes -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"bsra"

data BugsnagSeverityReason = BugsnagSeverityReason
    { BugsnagSeverityReason -> BugsnagSeverityReasonType
bsrType :: BugsnagSeverityReasonType
    , BugsnagSeverityReason -> BugsnagSeverityReasonAttributes
bsrAttributes :: BugsnagSeverityReasonAttributes
    }
    deriving stock (forall x. BugsnagSeverityReason -> Rep BugsnagSeverityReason x)
-> (forall x. Rep BugsnagSeverityReason x -> BugsnagSeverityReason)
-> Generic BugsnagSeverityReason
forall x. Rep BugsnagSeverityReason x -> BugsnagSeverityReason
forall x. BugsnagSeverityReason -> Rep BugsnagSeverityReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagSeverityReason x -> BugsnagSeverityReason
$cfrom :: forall x. BugsnagSeverityReason -> Rep BugsnagSeverityReason x
Generic

instance ToJSON BugsnagSeverityReason where
    toJSON :: BugsnagSeverityReason -> Value
toJSON = Options -> BugsnagSeverityReason -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> BugsnagSeverityReason -> Value)
-> Options -> BugsnagSeverityReason -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"bsr"
    toEncoding :: BugsnagSeverityReason -> Encoding
toEncoding = Options -> BugsnagSeverityReason -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> BugsnagSeverityReason -> Encoding)
-> Options -> BugsnagSeverityReason -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
bsAesonOptions String
"bsr"

bugsnagSeverityReasonAttributes :: BugsnagSeverityReasonAttributes
bugsnagSeverityReasonAttributes :: BugsnagSeverityReasonAttributes
bugsnagSeverityReasonAttributes = BugsnagSeverityReasonAttributes :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> BugsnagSeverityReasonAttributes
BugsnagSeverityReasonAttributes
    { bsraErrorType :: Maybe Text
bsraErrorType = Maybe Text
forall a. Maybe a
Nothing
    , bsraLevel :: Maybe Text
bsraLevel = Maybe Text
forall a. Maybe a
Nothing
    , bsraSignalType :: Maybe Text
bsraSignalType = Maybe Text
forall a. Maybe a
Nothing
    , bsraViolationType :: Maybe Text
bsraViolationType = Maybe Text
forall a. Maybe a
Nothing
    , bsraErrorClass :: Maybe Text
bsraErrorClass = Maybe Text
forall a. Maybe a
Nothing
    }