module Network.Bugsnag.Breadcrumb
    ( BugsnagBreadcrumbType(..)
    , BugsnagBreadcrumb(..)
    , bugsnagBreadcrumb
    )
where

import Prelude

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

data BugsnagBreadcrumbType
    = NavigationBreadcrumb
    | RequestBreadcrumb
    | ProcessBreadcrumb
    | LogBreadcrumb
    | UserBreadcrumb
    | StateBreadcrumb
    | ErrorBreadcrumb
    | ManualBreadcrumb
    deriving stock (forall x. BugsnagBreadcrumbType -> Rep BugsnagBreadcrumbType x)
-> (forall x. Rep BugsnagBreadcrumbType x -> BugsnagBreadcrumbType)
-> Generic BugsnagBreadcrumbType
forall x. Rep BugsnagBreadcrumbType x -> BugsnagBreadcrumbType
forall x. BugsnagBreadcrumbType -> Rep BugsnagBreadcrumbType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagBreadcrumbType x -> BugsnagBreadcrumbType
$cfrom :: forall x. BugsnagBreadcrumbType -> Rep BugsnagBreadcrumbType x
Generic

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

data BugsnagBreadcrumb = BugsnagBreadcrumb
    { BugsnagBreadcrumb -> UTCTime
bbTimestamp :: UTCTime
    , BugsnagBreadcrumb -> Text
bbName :: Text
    , BugsnagBreadcrumb -> BugsnagBreadcrumbType
bbType :: BugsnagBreadcrumbType
    , BugsnagBreadcrumb -> Maybe Value
bbMetaData :: Maybe Value
    }
    deriving stock (forall x. BugsnagBreadcrumb -> Rep BugsnagBreadcrumb x)
-> (forall x. Rep BugsnagBreadcrumb x -> BugsnagBreadcrumb)
-> Generic BugsnagBreadcrumb
forall x. Rep BugsnagBreadcrumb x -> BugsnagBreadcrumb
forall x. BugsnagBreadcrumb -> Rep BugsnagBreadcrumb x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagBreadcrumb x -> BugsnagBreadcrumb
$cfrom :: forall x. BugsnagBreadcrumb -> Rep BugsnagBreadcrumb x
Generic

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

bugsnagBreadcrumb
    :: UTCTime -> Text -> BugsnagBreadcrumbType -> BugsnagBreadcrumb
bugsnagBreadcrumb :: UTCTime -> Text -> BugsnagBreadcrumbType -> BugsnagBreadcrumb
bugsnagBreadcrumb UTCTime
timestamp Text
name BugsnagBreadcrumbType
typ = BugsnagBreadcrumb :: UTCTime
-> Text
-> BugsnagBreadcrumbType
-> Maybe Value
-> BugsnagBreadcrumb
BugsnagBreadcrumb
    { bbTimestamp :: UTCTime
bbTimestamp = UTCTime
timestamp
    , bbName :: Text
bbName = Text
name
    , bbType :: BugsnagBreadcrumbType
bbType = BugsnagBreadcrumbType
typ
    , bbMetaData :: Maybe Value
bbMetaData = Maybe Value
forall a. Maybe a
Nothing
    }