module Network.Bugsnag.BeforeNotify
    ( BeforeNotify
    , beforeNotify
    , runBeforeNotify

    -- * Modifying the underlying Exceptions
    , updateExceptions
    , filterExceptions
    , updateStackFrames
    , filterStackFrames
    , setStackFramesCode
    , setStackFramesInProject
    , setStackFramesInProjectByFile
    , setStackFramesInProjectBy

    -- * Modifying the Event
    , updateEvent
    , updateEventFromOriginalException
    , setGroupingHash
    , setGroupingHashBy
    , setDevice
    , setContext
    , setRequest
    , setWarningSeverity
    , setErrorSeverity
    , setInfoSeverity
    ) where

import Prelude

import qualified Control.Exception as Exception
import Data.Bugsnag
import Data.Maybe (isJust)
import Data.Text (Text, unpack)
import Network.Bugsnag.CodeIndex
import Network.Bugsnag.StackFrame

-- | A function from 'Event' to 'Event' that is applied before notifying
--
-- The wrapped function also accepts the original exception, for cases in which
-- that's useful -- but it's often not. Most 'BeforeNotify's use 'updateEvent',
-- which discards it.
--
-- 'BeforeNotify' implements 'Semigroup' and 'Monoid', which means the /do
-- nothing/ 'BeforeNotify' is 'mempty' and two 'BeforeNotify's @doThis@ then
-- @doThat@ can be implemented as @doThat <> doThis@.
--
newtype BeforeNotify = BeforeNotify
    { BeforeNotify -> forall e. Exception e => e -> Event -> Event
_unBeforeNotify :: forall e. Exception.Exception e => e -> Event -> Event
    }

instance Semigroup BeforeNotify where
    BeforeNotify forall e. Exception e => e -> Event -> Event
f <> :: BeforeNotify -> BeforeNotify -> BeforeNotify
<> BeforeNotify forall e. Exception e => e -> Event -> Event
g = (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
BeforeNotify ((forall e. Exception e => e -> Event -> Event) -> BeforeNotify)
-> (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \e
e -> e -> Event -> Event
forall e. Exception e => e -> Event -> Event
f e
e (Event -> Event) -> (Event -> Event) -> Event -> Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Event -> Event
forall e. Exception e => e -> Event -> Event
g e
e

instance Monoid BeforeNotify where
    mempty :: BeforeNotify
mempty = (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
BeforeNotify ((forall e. Exception e => e -> Event -> Event) -> BeforeNotify)
-> (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ (Event -> Event) -> e -> Event -> Event
forall a b. a -> b -> a
const Event -> Event
forall a. a -> a
id

beforeNotify
    :: (forall e . Exception.Exception e => e -> Event -> Event)
    -> BeforeNotify
beforeNotify :: (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
beforeNotify = (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
BeforeNotify

runBeforeNotify :: Exception.Exception e => BeforeNotify -> e -> Event -> Event
runBeforeNotify :: BeforeNotify -> e -> Event -> Event
runBeforeNotify (BeforeNotify forall e. Exception e => e -> Event -> Event
f) = e -> Event -> Event
forall e. Exception e => e -> Event -> Event
f

updateExceptions :: (Exception -> Exception) -> BeforeNotify
updateExceptions :: (Exception -> Exception) -> BeforeNotify
updateExceptions Exception -> Exception
f = (Event -> Event) -> BeforeNotify
updateEvent
    ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event { event_exceptions :: [Exception]
event_exceptions = (Exception -> Exception) -> [Exception] -> [Exception]
forall a b. (a -> b) -> [a] -> [b]
map Exception -> Exception
f ([Exception] -> [Exception]) -> [Exception] -> [Exception]
forall a b. (a -> b) -> a -> b
$ Event -> [Exception]
event_exceptions Event
event }

filterExceptions :: (Exception -> Bool) -> BeforeNotify
filterExceptions :: (Exception -> Bool) -> BeforeNotify
filterExceptions Exception -> Bool
p = (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event ->
    Event
event { event_exceptions :: [Exception]
event_exceptions = (Exception -> Bool) -> [Exception] -> [Exception]
forall a. (a -> Bool) -> [a] -> [a]
filter Exception -> Bool
p ([Exception] -> [Exception]) -> [Exception] -> [Exception]
forall a b. (a -> b) -> a -> b
$ Event -> [Exception]
event_exceptions Event
event }

updateStackFrames :: (StackFrame -> StackFrame) -> BeforeNotify
updateStackFrames :: (StackFrame -> StackFrame) -> BeforeNotify
updateStackFrames StackFrame -> StackFrame
f = (Exception -> Exception) -> BeforeNotify
updateExceptions
    ((Exception -> Exception) -> BeforeNotify)
-> (Exception -> Exception) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Exception
e -> Exception
e { exception_stacktrace :: [StackFrame]
exception_stacktrace = (StackFrame -> StackFrame) -> [StackFrame] -> [StackFrame]
forall a b. (a -> b) -> [a] -> [b]
map StackFrame -> StackFrame
f ([StackFrame] -> [StackFrame]) -> [StackFrame] -> [StackFrame]
forall a b. (a -> b) -> a -> b
$ Exception -> [StackFrame]
exception_stacktrace Exception
e }

filterStackFrames :: (StackFrame -> Bool) -> BeforeNotify
filterStackFrames :: (StackFrame -> Bool) -> BeforeNotify
filterStackFrames StackFrame -> Bool
p = (Exception -> Exception) -> BeforeNotify
updateExceptions
    ((Exception -> Exception) -> BeforeNotify)
-> (Exception -> Exception) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Exception
e -> Exception
e { exception_stacktrace :: [StackFrame]
exception_stacktrace = (StackFrame -> Bool) -> [StackFrame] -> [StackFrame]
forall a. (a -> Bool) -> [a] -> [a]
filter StackFrame -> Bool
p ([StackFrame] -> [StackFrame]) -> [StackFrame] -> [StackFrame]
forall a b. (a -> b) -> a -> b
$ Exception -> [StackFrame]
exception_stacktrace Exception
e }

setStackFramesCode :: CodeIndex -> BeforeNotify
setStackFramesCode :: CodeIndex -> BeforeNotify
setStackFramesCode =
    ((StackFrame -> Bool) -> BeforeNotify
setStackFramesInProjectBy (Maybe (HashMap Int Text) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (HashMap Int Text) -> Bool)
-> (StackFrame -> Maybe (HashMap Int Text)) -> StackFrame -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackFrame -> Maybe (HashMap Int Text)
stackFrame_code) BeforeNotify -> BeforeNotify -> BeforeNotify
forall a. Semigroup a => a -> a -> a
<>)
        (BeforeNotify -> BeforeNotify)
-> (CodeIndex -> BeforeNotify) -> CodeIndex -> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StackFrame -> StackFrame) -> BeforeNotify
updateStackFrames
        ((StackFrame -> StackFrame) -> BeforeNotify)
-> (CodeIndex -> StackFrame -> StackFrame)
-> CodeIndex
-> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeIndex -> StackFrame -> StackFrame
attachBugsnagCode

setStackFramesInProject :: Bool -> BeforeNotify
setStackFramesInProject :: Bool -> BeforeNotify
setStackFramesInProject = (StackFrame -> Bool) -> BeforeNotify
setStackFramesInProjectBy ((StackFrame -> Bool) -> BeforeNotify)
-> (Bool -> StackFrame -> Bool) -> Bool -> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> StackFrame -> Bool
forall a b. a -> b -> a
const

setStackFramesInProjectByFile :: (FilePath -> Bool) -> BeforeNotify
setStackFramesInProjectByFile :: (FilePath -> Bool) -> BeforeNotify
setStackFramesInProjectByFile FilePath -> Bool
f =
    (StackFrame -> Bool) -> BeforeNotify
setStackFramesInProjectBy ((StackFrame -> Bool) -> BeforeNotify)
-> (StackFrame -> Bool) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ FilePath -> Bool
f (FilePath -> Bool)
-> (StackFrame -> FilePath) -> StackFrame -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack (Text -> FilePath)
-> (StackFrame -> Text) -> StackFrame -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackFrame -> Text
stackFrame_file

setStackFramesInProjectBy :: (StackFrame -> Bool) -> BeforeNotify
setStackFramesInProjectBy :: (StackFrame -> Bool) -> BeforeNotify
setStackFramesInProjectBy StackFrame -> Bool
f =
    (StackFrame -> StackFrame) -> BeforeNotify
updateStackFrames ((StackFrame -> StackFrame) -> BeforeNotify)
-> (StackFrame -> StackFrame) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \StackFrame
sf -> StackFrame
sf { stackFrame_inProject :: Maybe Bool
stackFrame_inProject = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ StackFrame -> Bool
f StackFrame
sf }

updateEvent :: (Event -> Event) -> BeforeNotify
updateEvent :: (Event -> Event) -> BeforeNotify
updateEvent Event -> Event
f = (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
beforeNotify ((forall e. Exception e => e -> Event -> Event) -> BeforeNotify)
-> (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \e
_e Event
event -> Event -> Event
f Event
event

-- | Update the 'Event' based on the original exception
--
-- This allows updating the Event after casting to an exception type that this
-- library doesn't know about (e.g. @SqlError@). Because the result of your
-- function is itself a 'BeforeNotify', you can (and should) use other
-- helpers:
--
-- @
-- myBeforeNotify =
--     'defaultBeforeNotify'
--         <> 'updateEventFromOriginalException' asSqlError
--         <> 'updateEventFromOriginalException' asHttpError
--         <> -- ...
--
-- asSqlError :: SqlError -> BeforeNotify
-- asSqlError SqlError{..} =
--     'setGroupingHash' sqlErrorCode <> 'updateException' (\e -> e
--         { exception_errorClass = sqlErrorCode
--         , exception_message = Just sqlErrorMessage
--         })
-- @
--
-- If the cast fails, the event is unchanged.
--
updateEventFromOriginalException
    :: forall e . Exception.Exception e => (e -> BeforeNotify) -> BeforeNotify
updateEventFromOriginalException :: (e -> BeforeNotify) -> BeforeNotify
updateEventFromOriginalException e -> BeforeNotify
f = (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
beforeNotify ((forall e. Exception e => e -> Event -> Event) -> BeforeNotify)
-> (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \e
e Event
event ->
    let bn :: BeforeNotify
bn = BeforeNotify -> (e -> BeforeNotify) -> Maybe e -> BeforeNotify
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BeforeNotify
forall a. Monoid a => a
mempty e -> BeforeNotify
f (Maybe e -> BeforeNotify) -> Maybe e -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
Exception.fromException (SomeException -> Maybe e) -> SomeException -> Maybe e
forall a b. (a -> b) -> a -> b
$ e -> SomeException
forall e. Exception e => e -> SomeException
Exception.toException e
e
    in BeforeNotify -> e -> Event -> Event
forall e. Exception e => BeforeNotify -> e -> Event -> Event
runBeforeNotify BeforeNotify
bn e
e Event
event

setGroupingHash :: Text -> BeforeNotify
setGroupingHash :: Text -> BeforeNotify
setGroupingHash Text
hash = (Event -> Maybe Text) -> BeforeNotify
setGroupingHashBy ((Event -> Maybe Text) -> BeforeNotify)
-> (Event -> Maybe Text) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Event -> Maybe Text
forall a b. a -> b -> a
const (Maybe Text -> Event -> Maybe Text)
-> Maybe Text -> Event -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
hash

setGroupingHashBy :: (Event -> Maybe Text) -> BeforeNotify
setGroupingHashBy :: (Event -> Maybe Text) -> BeforeNotify
setGroupingHashBy Event -> Maybe Text
f =
    (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event { event_groupingHash :: Maybe Text
event_groupingHash = Event -> Maybe Text
f Event
event }

-- | Set the Event's Context
setContext :: Text -> BeforeNotify
setContext :: Text -> BeforeNotify
setContext Text
context =
    (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event { event_context :: Maybe Text
event_context = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
context }

-- | Set the Event's Request
--
-- See 'bugsnagRequestFromWaiRequest'
--
setRequest :: Request -> BeforeNotify
setRequest :: Request -> BeforeNotify
setRequest Request
request =
    (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event { event_request :: Maybe Request
event_request = Request -> Maybe Request
forall a. a -> Maybe a
Just Request
request }

-- | Set the Event's Device
--
-- See 'bugsnagDeviceFromWaiRequest'
--
setDevice :: Device -> BeforeNotify
setDevice :: Device -> BeforeNotify
setDevice Device
device = (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event { event_device :: Maybe Device
event_device = Device -> Maybe Device
forall a. a -> Maybe a
Just Device
device }

-- | Set to 'ErrorSeverity'
setErrorSeverity :: BeforeNotify
setErrorSeverity :: BeforeNotify
setErrorSeverity = Severity -> BeforeNotify
setSeverity Severity
errorSeverity

-- | Set to 'WarningSeverity'
setWarningSeverity :: BeforeNotify
setWarningSeverity :: BeforeNotify
setWarningSeverity = Severity -> BeforeNotify
setSeverity Severity
warningSeverity

-- | Set to 'InfoSeverity'
setInfoSeverity :: BeforeNotify
setInfoSeverity :: BeforeNotify
setInfoSeverity = Severity -> BeforeNotify
setSeverity Severity
infoSeverity

setSeverity :: Severity -> BeforeNotify
setSeverity :: Severity -> BeforeNotify
setSeverity Severity
severity =
    (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Event
event -> Event
event { event_severity :: Maybe Severity
event_severity = Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
severity }