module Data.Bugsnag.Settings
  ( Settings (..)
  , defaultSettings
  ) where

import Prelude

import Data.Bugsnag
import Data.Text (Text)
import Network.Bugsnag.BeforeNotify
import Network.Bugsnag.CodeIndex
import Network.HTTP.Client (HttpException)

data Settings = Settings
  { Settings -> ApiKey
settings_apiKey :: ApiKey
  -- ^ Your Integration API Key
  , Settings -> Maybe Text
settings_appVersion :: Maybe Text
  -- ^ The version of your application
  --
  -- Marking bugs as Fixed and having them auto-reopen in new versions
  -- requires you set this.
  , Settings -> Text
settings_releaseStage :: Text
  -- ^ The current release-stage, Production by default
  , Settings -> [Text]
settings_enabledReleaseStages :: [Text]
  -- ^ Which release-stages to notify in. Only Production by default
  , Settings -> BeforeNotify
settings_beforeNotify :: BeforeNotify
  -- ^ Modify any events before they are sent
  --
  -- For example to attach a user, or set the context.
  , Settings -> Exception -> Bool
settings_ignoreException :: Exception -> Bool
  -- ^ Exception filtering
  --
  -- Functions like 'notifyBugsnag' will do nothing with exceptions that pass
  -- this predicate. N.B. Something lower-level, like 'reportError' won't be
  -- aware of this.
  , Settings -> HttpException -> IO ()
settings_onNotifyException :: HttpException -> IO ()
  -- ^ How to handle an exception reporting error events
  --
  -- Default is to ignore.
  , Settings -> Maybe CodeIndex
settings_codeIndex :: Maybe CodeIndex
  -- ^ A 'CodeIndex' built at compile-time from project sources
  --
  -- If set, this will be used to update StackFrames to include lines of
  -- source code context as read out of this value. N.B. using this means
  -- loading and keeping the source code for the entire project in memory.
  }

defaultSettings :: Text -> Settings
defaultSettings :: Text -> Settings
defaultSettings Text
k =
  Settings
    { settings_apiKey :: ApiKey
settings_apiKey = Text -> ApiKey
apiKey Text
k
    , settings_appVersion :: Maybe Text
settings_appVersion = Maybe Text
forall a. Maybe a
Nothing
    , settings_releaseStage :: Text
settings_releaseStage = Text
"production"
    , settings_enabledReleaseStages :: [Text]
settings_enabledReleaseStages = [Text
"production"]
    , settings_beforeNotify :: BeforeNotify
settings_beforeNotify = BeforeNotify
forall a. Monoid a => a
mempty
    , settings_ignoreException :: Exception -> Bool
settings_ignoreException = Bool -> Exception -> Bool
forall a b. a -> b -> a
const Bool
False
    , settings_onNotifyException :: HttpException -> IO ()
settings_onNotifyException = IO () -> HttpException -> IO ()
forall a b. a -> b -> a
const (IO () -> HttpException -> IO ())
-> IO () -> HttpException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , settings_codeIndex :: Maybe CodeIndex
settings_codeIndex = Maybe CodeIndex
forall a. Maybe a
Nothing
    }