{-# LANGUAGE ExistentialQuantification #-}

module Network.Bugsnag.Exception
    ( AsException(..)
    , bugsnagExceptionFromSomeException
    ) where

import Prelude

import Control.Exception hiding (Exception)
import qualified Control.Exception as Exception
import Data.Bugsnag
import Data.Foldable (asum)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy(..))
import Data.Text (Text, pack)
import Data.Typeable (typeRep)
import Instances.TH.Lift ()
import Network.Bugsnag.Exception.Parse

-- | Newtype over 'Exception', so it can be thrown and caught
newtype AsException = AsException
    { AsException -> Exception
unAsException :: Exception
    }
    deriving newtype Int -> AsException -> ShowS
[AsException] -> ShowS
AsException -> String
(Int -> AsException -> ShowS)
-> (AsException -> String)
-> ([AsException] -> ShowS)
-> Show AsException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsException] -> ShowS
$cshowList :: [AsException] -> ShowS
show :: AsException -> String
$cshow :: AsException -> String
showsPrec :: Int -> AsException -> ShowS
$cshowsPrec :: Int -> AsException -> ShowS
Show
    deriving anyclass Show AsException
Typeable AsException
Typeable AsException
-> Show AsException
-> (AsException -> SomeException)
-> (SomeException -> Maybe AsException)
-> (AsException -> String)
-> Exception AsException
SomeException -> Maybe AsException
AsException -> String
AsException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: AsException -> String
$cdisplayException :: AsException -> String
fromException :: SomeException -> Maybe AsException
$cfromException :: SomeException -> Maybe AsException
toException :: AsException -> SomeException
$ctoException :: AsException -> SomeException
$cp2Exception :: Show AsException
$cp1Exception :: Typeable AsException
Exception.Exception

-- | Construct a 'Exception' from a 'SomeException'
bugsnagExceptionFromSomeException :: SomeException -> Exception
bugsnagExceptionFromSomeException :: SomeException -> Exception
bugsnagExceptionFromSomeException SomeException
ex = Exception -> Maybe Exception -> Exception
forall a. a -> Maybe a -> a
fromMaybe Exception
fallback (Maybe Exception -> Exception) -> Maybe Exception -> Exception
forall a b. (a -> b) -> a -> b
$ [Maybe Exception] -> Maybe Exception
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ AsException -> Exception
unAsException (AsException -> Exception) -> Maybe AsException -> Maybe Exception
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe AsException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex
    , (ErrorCall -> Either String MessageWithStackFrames)
-> ErrorCall -> Exception
forall e.
Exception e =>
(e -> Either String MessageWithStackFrames) -> e -> Exception
bugsnagExceptionWithParser ErrorCall -> Either String MessageWithStackFrames
parseErrorCall (ErrorCall -> Exception) -> Maybe ErrorCall -> Maybe Exception
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe ErrorCall
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex
    ]
  where
    fallback :: Exception
fallback = ((SomeException -> Either String MessageWithStackFrames)
-> SomeException -> Exception
forall e.
Exception e =>
(e -> Either String MessageWithStackFrames) -> e -> Exception
bugsnagExceptionWithParser SomeException -> Either String MessageWithStackFrames
parseStringException SomeException
ex)
        { exception_errorClass :: Text
exception_errorClass = (\(SomeException e
e) -> e -> Text
forall e. Exception e => e -> Text
exErrorClass e
e) SomeException
ex
        }

bugsnagExceptionWithParser
    :: Exception.Exception e
    => (e -> Either String MessageWithStackFrames)
    -> e
    -> Exception
bugsnagExceptionWithParser :: (e -> Either String MessageWithStackFrames) -> e -> Exception
bugsnagExceptionWithParser e -> Either String MessageWithStackFrames
p e
ex = case e -> Either String MessageWithStackFrames
p e
ex of
    Left String
_ -> e -> Exception
forall e. Exception e => e -> Exception
bugsnagExceptionFromException e
ex
    Right (MessageWithStackFrames Text
message [StackFrame]
stacktrace) -> Exception
defaultException
        { exception_errorClass :: Text
exception_errorClass = e -> Text
forall e. Exception e => e -> Text
exErrorClass e
ex
        , exception_message :: Maybe Text
exception_message = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
message
        , exception_stacktrace :: [StackFrame]
exception_stacktrace = [StackFrame]
stacktrace
        }

bugsnagExceptionFromException :: Exception.Exception e => e -> Exception
bugsnagExceptionFromException :: e -> Exception
bugsnagExceptionFromException e
ex = Exception
defaultException
    { exception_errorClass :: Text
exception_errorClass = e -> Text
forall e. Exception e => e -> Text
exErrorClass e
ex
    , exception_message :: Maybe Text
exception_message = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
displayException e
ex
    , exception_stacktrace :: [StackFrame]
exception_stacktrace = []
    }

-- | Show an exception's "error class"
exErrorClass :: forall e . Exception.Exception e => e -> Text
exErrorClass :: e -> Text
exErrorClass e
_ = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy e -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy e -> TypeRep) -> Proxy e -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy e
forall k (t :: k). Proxy t
Proxy @e