module Network.Bugsnag.Report
    ( BugsnagReport(..)
    , bugsnagReport
    ) where

import Prelude

import Data.Aeson
import Data.Aeson.Ext
import GHC.Generics
import Network.Bugsnag.Event
import Network.Bugsnag.Notifier

data BugsnagReport = BugsnagReport
    { BugsnagReport -> BugsnagNotifier
brNotifier :: BugsnagNotifier
    , BugsnagReport -> [BugsnagEvent]
brEvents :: [BugsnagEvent]
    }
    deriving stock (forall x. BugsnagReport -> Rep BugsnagReport x)
-> (forall x. Rep BugsnagReport x -> BugsnagReport)
-> Generic BugsnagReport
forall x. Rep BugsnagReport x -> BugsnagReport
forall x. BugsnagReport -> Rep BugsnagReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagReport x -> BugsnagReport
$cfrom :: forall x. BugsnagReport -> Rep BugsnagReport x
Generic

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

bugsnagReport :: [BugsnagEvent] -> BugsnagReport
bugsnagReport :: [BugsnagEvent] -> BugsnagReport
bugsnagReport [BugsnagEvent]
events =
    BugsnagReport :: BugsnagNotifier -> [BugsnagEvent] -> BugsnagReport
BugsnagReport { brNotifier :: BugsnagNotifier
brNotifier = BugsnagNotifier
bugsnagNotifier, brEvents :: [BugsnagEvent]
brEvents = [BugsnagEvent]
events }