module Network.Bugsnag.App
    ( BugsnagApp(..)
    , bugsnagApp
    )
where

import Prelude

import Data.Aeson
import Data.Aeson.Ext
import Data.Text (Text)
import GHC.Generics
import Network.Bugsnag.ReleaseStage
import Numeric.Natural

data BugsnagApp = BugsnagApp
    { BugsnagApp -> Maybe Text
baId :: Maybe Text
    , BugsnagApp -> Maybe Text
baVersion :: Maybe Text
    , BugsnagApp -> Maybe Text
baBuildUUID :: Maybe Text
    , BugsnagApp -> Maybe BugsnagReleaseStage
baReleaseStage :: Maybe BugsnagReleaseStage
    , BugsnagApp -> Maybe Text
baType :: Maybe Text
    , BugsnagApp -> Maybe [Text]
baDsymUUIDs :: Maybe [Text]
    , BugsnagApp -> Maybe Natural
baDuration :: Maybe Natural
    , BugsnagApp -> Maybe Natural
baDurationInForeground :: Maybe Natural
    , BugsnagApp -> Maybe Bool
baInForeground :: Maybe Bool
    }
    deriving stock (forall x. BugsnagApp -> Rep BugsnagApp x)
-> (forall x. Rep BugsnagApp x -> BugsnagApp) -> Generic BugsnagApp
forall x. Rep BugsnagApp x -> BugsnagApp
forall x. BugsnagApp -> Rep BugsnagApp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagApp x -> BugsnagApp
$cfrom :: forall x. BugsnagApp -> Rep BugsnagApp x
Generic

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

bugsnagApp :: BugsnagApp
bugsnagApp :: BugsnagApp
bugsnagApp = BugsnagApp :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe BugsnagReleaseStage
-> Maybe Text
-> Maybe [Text]
-> Maybe Natural
-> Maybe Natural
-> Maybe Bool
-> BugsnagApp
BugsnagApp
    { baId :: Maybe Text
baId = Maybe Text
forall a. Maybe a
Nothing
    , baVersion :: Maybe Text
baVersion = Maybe Text
forall a. Maybe a
Nothing
    , baBuildUUID :: Maybe Text
baBuildUUID = Maybe Text
forall a. Maybe a
Nothing
    , baReleaseStage :: Maybe BugsnagReleaseStage
baReleaseStage = Maybe BugsnagReleaseStage
forall a. Maybe a
Nothing
    , baType :: Maybe Text
baType = Maybe Text
forall a. Maybe a
Nothing
    , baDsymUUIDs :: Maybe [Text]
baDsymUUIDs = Maybe [Text]
forall a. Maybe a
Nothing
    , baDuration :: Maybe Natural
baDuration = Maybe Natural
forall a. Maybe a
Nothing
    , baDurationInForeground :: Maybe Natural
baDurationInForeground = Maybe Natural
forall a. Maybe a
Nothing
    , baInForeground :: Maybe Bool
baInForeground = Maybe Bool
forall a. Maybe a
Nothing
    }