{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}

-- |
--
-- <https://docs.bugsnag.com/api/error-reporting/#per-session-settings>
--
module Network.Bugsnag.Session
    ( BugsnagSession(..)
    , bugsnagSession
    ) where

import Prelude

import Data.Aeson
import Data.Aeson.Ext
import Data.Text (Text)
import GHC.Generics
import Network.Bugsnag.User

data BugsnagSession = BugsnagSession
    { BugsnagSession -> Maybe BugsnagUser
bsUser :: Maybe BugsnagUser
    , BugsnagSession -> Maybe Text
bsContext :: Maybe Text
    , BugsnagSession -> Maybe Value
bsMetaData :: Maybe Value
    }
    deriving stock (forall x. BugsnagSession -> Rep BugsnagSession x)
-> (forall x. Rep BugsnagSession x -> BugsnagSession)
-> Generic BugsnagSession
forall x. Rep BugsnagSession x -> BugsnagSession
forall x. BugsnagSession -> Rep BugsnagSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagSession x -> BugsnagSession
$cfrom :: forall x. BugsnagSession -> Rep BugsnagSession x
Generic

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

bugsnagSession :: BugsnagSession
bugsnagSession :: BugsnagSession
bugsnagSession = BugsnagSession :: Maybe BugsnagUser -> Maybe Text -> Maybe Value -> BugsnagSession
BugsnagSession
    { bsUser :: Maybe BugsnagUser
bsUser = Maybe BugsnagUser
forall a. Maybe a
Nothing
    , bsContext :: Maybe Text
bsContext = Maybe Text
forall a. Maybe a
Nothing
    , bsMetaData :: Maybe Value
bsMetaData = Maybe Value
forall a. Maybe a
Nothing
    }