From 02283d8464b1b848cdf35d69c12f11105f6a19a4 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Mon, 11 Dec 2023 12:41:33 -0700 Subject: [PATCH] Support annotated-exception (#82) --- bugsnag/CHANGELOG.md | 19 ++- bugsnag/bugsnag.cabal | 11 +- bugsnag/package.yaml | 8 +- bugsnag/src/Data/Aeson/Compat.hs | 46 ++++++ bugsnag/src/Network/Bugsnag/BeforeNotify.hs | 8 +- bugsnag/src/Network/Bugsnag/Exception.hs | 142 ++++++++++++---- bugsnag/src/Network/Bugsnag/MetaData.hs | 95 +++++++++++ bugsnag/src/Network/Bugsnag/Notify.hs | 22 ++- bugsnag/test/Examples.hs | 4 + bugsnag/test/Network/Bugsnag/ExceptionSpec.hs | 151 ++++++++++-------- 10 files changed, 398 insertions(+), 108 deletions(-) create mode 100644 bugsnag/src/Data/Aeson/Compat.hs create mode 100644 bugsnag/src/Network/Bugsnag/MetaData.hs diff --git a/bugsnag/CHANGELOG.md b/bugsnag/CHANGELOG.md index 50c1f7c..caad489 100644 --- a/bugsnag/CHANGELOG.md +++ b/bugsnag/CHANGELOG.md @@ -1,7 +1,24 @@ -## [_Unreleased_](https://github.com/pbrisbin/bugsnag-haskell/compare/bugsnag-v1.0.0.1...main) +## [_Unreleased_](https://github.com/pbrisbin/bugsnag-haskell/compare/bugsnag-v1.1.0.0...main) - None +## [v1.0.1.0](https://github.com/pbrisbin/bugsnag-haskell/compare/bugsnag-v1.0.0.0...bugsnag-v1.1.0.0) + +- New module: `Network.Bugsnag.MetaData` + +- Adds some support for the `annotated-exception` package. + `updateEventFromOriginalException` now catches either `e` or `AnnotatedException e`. + + - `bugsnagExceptionFromSomeException` now has special cases to handle + `AnnotatedException` well. + - Annotations of type `CallStack` and `MetaData` are included in the bugsnag + report; other annotations are ignored. + +- Adds explicit support for `StringException` from the `unliftio` package. + + - `bugsnagExceptionFromSomeException` now has special cases to handle + `StringException` well. + ## [v1.0.0.1](https://github.com/pbrisbin/bugsnag-haskell/compare/bugsnag-v1.0.0.0...bugsnag-v1.0.0.1) - Support GHCs 9.0 and 9.2 diff --git a/bugsnag/bugsnag.cabal b/bugsnag/bugsnag.cabal index de07bc6..21e4145 100644 --- a/bugsnag/bugsnag.cabal +++ b/bugsnag/bugsnag.cabal @@ -5,7 +5,7 @@ cabal-version: 1.18 -- see: https://github.com/sol/hpack name: bugsnag -version: 1.0.0.1 +version: 1.1.0.0 synopsis: Bugsnag error reporter for Haskell description: Please see README.md category: Web @@ -36,10 +36,11 @@ library Network.Bugsnag.Device Network.Bugsnag.Exception Network.Bugsnag.Exception.Parse + Network.Bugsnag.MetaData Network.Bugsnag.Notify Network.Bugsnag.StackFrame other-modules: - Paths_bugsnag + Data.Aeson.Compat hs-source-dirs: src default-extensions: @@ -69,6 +70,8 @@ library TypeFamilies build-depends: Glob >=0.9.0 + , aeson + , annotated-exception , base >=4.11.0 && <5 , bugsnag-hs , bytestring @@ -80,6 +83,7 @@ library , text , th-lift-instances , ua-parser + , unliftio , unordered-containers default-language: Haskell2010 @@ -197,7 +201,8 @@ test-suite spec TypeApplications TypeFamilies build-depends: - base >=4.11.0 && <5 + annotated-exception + , base >=4.11.0 && <5 , bugsnag , hspec , unliftio diff --git a/bugsnag/package.yaml b/bugsnag/package.yaml index 8b5f8f1..ea27c6f 100644 --- a/bugsnag/package.yaml +++ b/bugsnag/package.yaml @@ -1,5 +1,5 @@ name: bugsnag -version: 1.0.0.1 +version: 1.1.0.0 synopsis: Bugsnag error reporter for Haskell description: Please see README.md homepage: https://github.com/pbrisbin/bugsnag-haskell#readme @@ -46,8 +46,12 @@ default-extensions: library: source-dirs: src + other-modules: + - Data.Aeson.Compat dependencies: - Glob >= 0.9.0 + - aeson + - annotated-exception - bugsnag-hs - bytestring - containers @@ -58,6 +62,7 @@ library: - text - th-lift-instances - ua-parser + - unliftio - unordered-containers executables: @@ -84,6 +89,7 @@ tests: main: Spec.hs source-dirs: test dependencies: + - annotated-exception - hspec - bugsnag - unliftio diff --git a/bugsnag/src/Data/Aeson/Compat.hs b/bugsnag/src/Data/Aeson/Compat.hs new file mode 100644 index 0000000..9f46cbe --- /dev/null +++ b/bugsnag/src/Data/Aeson/Compat.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE CPP #-} + +module Data.Aeson.Compat + ( -- * Key + Key + , fromText + , toText + + -- * KeyMap + , KeyMap + , empty + , null + , singleton + , fromList + , toList + , unionWith + + -- * Etc. + , Pair + , Value (Object) + , Object + , object + , (.=) + ) where + +import Data.Aeson.Types (Object, Pair, Value (Object), object, (.=)) +#if MIN_VERSION_aeson(2, 0, 0) +import Data.Aeson.Key (Key, fromText, toText) +import Data.Aeson.KeyMap (KeyMap, empty, fromList, null, singleton, toList, unionWith) +-- Avoid unused-packages (unordered-containers) warning for this path +import Data.HashMap.Strict () +#else +import Prelude (id) + +import Data.HashMap.Strict (HashMap, empty, fromList, null, singleton, toList, unionWith) +import Data.Text (Text) + +type Key = Text +type KeyMap = HashMap Text + +fromText :: Text -> Key +fromText = id + +toText :: Key -> Text +toText = id +#endif diff --git a/bugsnag/src/Network/Bugsnag/BeforeNotify.hs b/bugsnag/src/Network/Bugsnag/BeforeNotify.hs index ef0286a..c272789 100644 --- a/bugsnag/src/Network/Bugsnag/BeforeNotify.hs +++ b/bugsnag/src/Network/Bugsnag/BeforeNotify.hs @@ -29,6 +29,7 @@ module Network.Bugsnag.BeforeNotify import Prelude import qualified Control.Exception as Exception +import qualified Control.Exception.Annotated as Annotated import Data.Bugsnag import Data.Maybe (isJust) import Data.Text (Text, unpack) @@ -121,10 +122,15 @@ updateEvent f = beforeNotify $ \_e event -> f event -- @ -- -- If the cast fails, the event is unchanged. +-- +-- The cast will match either @e@ or @'AnnotatedException' e@. updateEventFromOriginalException :: forall e. Exception.Exception e => (e -> BeforeNotify) -> BeforeNotify updateEventFromOriginalException f = beforeNotify $ \e event -> - let bn = maybe mempty f $ Exception.fromException $ Exception.toException e + let bn = + maybe mempty (f . Annotated.exception) $ + Exception.fromException $ + Exception.toException e in runBeforeNotify bn e event setGroupingHash :: Text -> BeforeNotify diff --git a/bugsnag/src/Network/Bugsnag/Exception.hs b/bugsnag/src/Network/Bugsnag/Exception.hs index ae2b2be..43dfd57 100644 --- a/bugsnag/src/Network/Bugsnag/Exception.hs +++ b/bugsnag/src/Network/Bugsnag/Exception.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ExistentialQuantification #-} module Network.Bugsnag.Exception @@ -7,16 +8,26 @@ module Network.Bugsnag.Exception import Prelude -import Control.Exception hiding (Exception) +import Control.Exception + ( SomeException (SomeException) + , displayException + , fromException + ) import qualified Control.Exception as Exception +import Control.Exception.Annotated + ( AnnotatedException (AnnotatedException) + , annotatedExceptionCallStack + ) +import qualified Control.Exception.Annotated as Annotated 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 Data.Text (Text) +import qualified Data.Text as T +import Data.Typeable (Proxy (..), Typeable, typeRep) +import GHC.Stack (CallStack, SrcLoc (..), getCallStack) import Network.Bugsnag.Exception.Parse +import UnliftIO.Exception (StringException (StringException)) -- | Newtype over 'Exception', so it can be thrown and caught newtype AsException = AsException @@ -28,39 +39,102 @@ newtype AsException = AsException -- | Construct a 'Exception' from a 'SomeException' bugsnagExceptionFromSomeException :: SomeException -> Exception bugsnagExceptionFromSomeException ex = - fromMaybe fallback $ + fromMaybe defaultException $ asum - [ unAsException <$> fromException ex - , bugsnagExceptionWithParser parseErrorCall <$> fromException ex + [ bugsnagExceptionFromAnnotatedAsException <$> fromException ex + , bugsnagExceptionFromStringException <$> fromException ex + , bugsnagExceptionFromAnnotatedStringException <$> fromException ex + , bugsnagExceptionFromAnnotatedException <$> fromException ex ] - where - fallback = - (bugsnagExceptionWithParser parseStringException ex) - { exception_errorClass = (\(SomeException e) -> exErrorClass e) ex - } -bugsnagExceptionWithParser - :: Exception.Exception e - => (e -> Either String MessageWithStackFrames) - -> e - -> Exception -bugsnagExceptionWithParser p ex = case p ex of - Left _ -> bugsnagExceptionFromException ex - Right (MessageWithStackFrames message stacktrace) -> - defaultException - { exception_errorClass = exErrorClass ex - , exception_message = Just message - , exception_stacktrace = stacktrace - } +-- | Respect 'AsException' as-is without modifications. +-- If it's wrapped in 'AnnotatedException', ignore the annotations. +bugsnagExceptionFromAnnotatedAsException + :: AnnotatedException AsException -> Exception +bugsnagExceptionFromAnnotatedAsException = unAsException . Annotated.exception -bugsnagExceptionFromException :: Exception.Exception e => e -> Exception -bugsnagExceptionFromException ex = +-- | When a 'StringException' is thrown, we use its message and trace. +bugsnagExceptionFromStringException :: StringException -> Exception +bugsnagExceptionFromStringException (StringException message stack) = defaultException - { exception_errorClass = exErrorClass ex - , exception_message = Just $ pack $ displayException ex - , exception_stacktrace = [] + { exception_errorClass = typeName @StringException + , exception_message = Just $ T.pack message + , exception_stacktrace = callStackToStackFrames stack } --- | Show an exception's "error class" -exErrorClass :: forall e. Exception.Exception e => e -> Text -exErrorClass _ = pack $ show $ typeRep $ Proxy @e +-- | When 'StringException' is wrapped in 'AnnotatedException', +-- there are two possible sources of a 'CallStack'. +-- Prefer the one from 'AnnotatedException', falling back to the +-- 'StringException' trace if no 'CallStack' annotation is present. +bugsnagExceptionFromAnnotatedStringException + :: AnnotatedException StringException -> Exception +bugsnagExceptionFromAnnotatedStringException ae@AnnotatedException {exception = StringException message stringExceptionStack} = + defaultException + { exception_errorClass = typeName @StringException + , exception_message = Just $ T.pack message + , exception_stacktrace = + maybe + (callStackToStackFrames stringExceptionStack) + callStackToStackFrames + $ annotatedExceptionCallStack ae + } + +-- | For an 'AnnotatedException' exception, derive the error class and message +-- from the wrapped exception. +-- If a 'CallStack' annotation is present, use that as the stacetrace. +-- Otherwise, attempt to parse a trace from the underlying exception. +bugsnagExceptionFromAnnotatedException + :: AnnotatedException SomeException -> Exception +bugsnagExceptionFromAnnotatedException ae = + case annotatedExceptionCallStack ae of + Just stack -> + defaultException + { exception_errorClass = exErrorClass $ Annotated.exception ae + , exception_message = + Just $ T.pack $ displayException $ Annotated.exception ae + , exception_stacktrace = callStackToStackFrames stack + } + Nothing -> + let parseResult = + asum + [ fromException (Annotated.exception ae) + >>= (either (const Nothing) Just . parseErrorCall) + , either (const Nothing) Just $ + parseStringException (Annotated.exception ae) + ] + in defaultException + { exception_errorClass = + exErrorClass $ + Annotated.exception ae + , exception_message = + asum + [ mwsfMessage <$> parseResult + , Just $ + T.pack $ + displayException $ + Annotated.exception + ae + ] + , exception_stacktrace = foldMap mwsfStackFrames parseResult + } + +-- | Unwrap the 'SomeException' newtype to get the actual underlying type name +exErrorClass :: SomeException -> Text +exErrorClass (SomeException (_ :: e)) = typeName @e + +typeName :: forall a. Typeable a => Text +typeName = T.pack $ show $ typeRep $ Proxy @a + +-- | Converts a GHC call stack to a list of stack frames suitable +-- for use as the stacktrace in a Bugsnag exception +callStackToStackFrames :: CallStack -> [StackFrame] +callStackToStackFrames = fmap callSiteToStackFrame . getCallStack + +callSiteToStackFrame :: (String, SrcLoc) -> StackFrame +callSiteToStackFrame (str, loc) = + defaultStackFrame + { stackFrame_method = T.pack str + , stackFrame_file = T.pack $ srcLocFile loc + , stackFrame_lineNumber = srcLocStartLine loc + , stackFrame_columnNumber = Just $ srcLocStartCol loc + } diff --git a/bugsnag/src/Network/Bugsnag/MetaData.hs b/bugsnag/src/Network/Bugsnag/MetaData.hs new file mode 100644 index 0000000..4f691fd --- /dev/null +++ b/bugsnag/src/Network/Bugsnag/MetaData.hs @@ -0,0 +1,95 @@ +-- | Working with Bugsnag's 'event_metaData' field +module Network.Bugsnag.MetaData + ( MetaData (..) + , metaData + ) where + +import Prelude + +import Data.Aeson.Compat (Object, Value (Object), object, (.=)) +import qualified Data.Aeson.Compat as Aeson + +newtype MetaData = MetaData + { unMetaData :: Object + } + deriving stock (Eq, Show) + +instance Semigroup MetaData where + -- \| /Right/-biased, recursive union + -- + -- The chosen bias ensures that adding metadata in smaller scopes (later) + -- overrides values from larger scopes. + MetaData x <> MetaData y = MetaData $ unionObjects y x + where + unionObjects :: Object -> Object -> Object + unionObjects = Aeson.unionWith unionValues + + unionValues (Object a) (Object b) = Object $ unionObjects a b + unionValues a _ = a + +instance Monoid MetaData where + mempty = MetaData mempty + +-- | Construct 'MetaData' from 'Pair's +metaData + :: Aeson.Key + -- ^ The Tab within which the values will display + -> [Aeson.Pair] + -- ^ The Key-Values themselves + -> MetaData +metaData key = MetaData . Aeson.fromList . pure . (key .=) . object + +-- $details +-- +-- From +-- +-- @events[].metaData@ +-- +-- > An object containing any further data you wish to attach to this error +-- > event. This should contain one or more objects, with each object being +-- > displayed in its own tab on the event details on Bugsnag. +-- > +-- > { +-- > // Custom user data to be displayed in the User tab along with standard +-- > // user fields on the Bugsnag website. +-- > "user": { +-- > ... +-- > }, +-- > +-- > // Custom app data to be displayed in the App tab along with standard +-- > // app fields on the Bugsnag website. +-- > "app": { +-- > ... +-- > }, +-- > +-- > // Custom device data to be displayed in the Device tab along with +-- > //standard device fields on the Bugsnag website. +-- > "device": { +-- > ... +-- > }, +-- > +-- > Custom request data to be displayed in the Request tab along with +-- > standard request fields on the Bugsnag website. +-- > "request": { +-- > ... +-- > }, +-- > +-- > // This will be displayed as an extra tab on the Bugsnag website. +-- > "Some data": { +-- > +-- > // A key value pair that will be displayed in the first tab. +-- > "key": "value", +-- > +-- > // Key value pairs can be contained in nested objects which helps +-- > // to organise the information presented in the tab. +-- > "setOfKeys": { +-- > "key": "value", +-- > "key2": "value" +-- > } +-- > }, +-- > +-- > // This would be the second extra tab on the Bugsnag website. +-- > "Some more data": { +-- > ... +-- > } +-- > } diff --git a/bugsnag/src/Network/Bugsnag/Notify.hs b/bugsnag/src/Network/Bugsnag/Notify.hs index f7992f6..c466061 100644 --- a/bugsnag/src/Network/Bugsnag/Notify.hs +++ b/bugsnag/src/Network/Bugsnag/Notify.hs @@ -5,12 +5,19 @@ module Network.Bugsnag.Notify import Prelude +import Control.Exception (SomeException, fromException, toException) import qualified Control.Exception as Exception -import Control.Monad (unless) +import Control.Exception.Annotated (AnnotatedException) +import qualified Control.Exception.Annotated as Annotated +import Control.Monad (unless, (<=<)) +import Data.Annotation (tryAnnotations) import Data.Bugsnag import Data.Bugsnag.Settings +import Data.Foldable (fold) +import Data.List.NonEmpty (nonEmpty) import Network.Bugsnag.BeforeNotify import Network.Bugsnag.Exception +import Network.Bugsnag.MetaData import Network.HTTP.Client.TLS (getGlobalManager) notifyBugsnag :: Exception.Exception e => Settings -> e -> IO () @@ -31,10 +38,21 @@ reportEvent Settings {..} event = unless (null $ event_exceptions event) $ do buildEvent :: Exception.Exception e => BeforeNotify -> e -> Event buildEvent bn e = runBeforeNotify bn e $ - defaultEvent {event_exceptions = [ex]} + defaultEvent + { event_exceptions = [ex] + , event_metaData = unMetaData <$> metaDataFromException e + } where ex = bugsnagExceptionFromSomeException $ Exception.toException e +metaDataFromException :: Exception.Exception e => e -> Maybe MetaData +metaDataFromException = + metaDataFromAnnotatedException + <=< (fromException @(AnnotatedException SomeException) . toException) + +metaDataFromAnnotatedException :: AnnotatedException e -> Maybe MetaData +metaDataFromAnnotatedException = fmap fold . nonEmpty . fst . tryAnnotations . Annotated.annotations + globalBeforeNotify :: Settings -> BeforeNotify globalBeforeNotify Settings {..} = filterExceptions (not . ignoreException) diff --git a/bugsnag/test/Examples.hs b/bugsnag/test/Examples.hs index 0b8018f..2fdd2be 100644 --- a/bugsnag/test/Examples.hs +++ b/bugsnag/test/Examples.hs @@ -11,6 +11,7 @@ module Examples where import Prelude import Control.Exception +import Control.Exception.Annotated (checkpointCallStack) import Data.Bugsnag import GHC.Stack (HasCallStack) import Network.Bugsnag.Exception @@ -47,3 +48,6 @@ brokenFunction'' = sillyHead'' [] sillyHead'' :: HasCallStack => [a] -> IO a sillyHead'' (x : _) = pure x sillyHead'' _ = throwString "empty list\n and message with newlines\n\n" + +brokenFunctionAnnotated :: HasCallStack => IO a +brokenFunctionAnnotated = checkpointCallStack $ sillyHead' [] diff --git a/bugsnag/test/Network/Bugsnag/ExceptionSpec.hs b/bugsnag/test/Network/Bugsnag/ExceptionSpec.hs index 2b1defa..52f145b 100644 --- a/bugsnag/test/Network/Bugsnag/ExceptionSpec.hs +++ b/bugsnag/test/Network/Bugsnag/ExceptionSpec.hs @@ -22,75 +22,94 @@ spec = do let frame = head $ exception_stacktrace ex stackFrame_file frame `shouldBe` "test/Examples.hs" - stackFrame_lineNumber frame `shouldBe` 27 + stackFrame_lineNumber frame `shouldBe` 28 -- different versions of GHC disagree on where splices start stackFrame_columnNumber frame `shouldSatisfy` (`elem` [Just 36, Just 37]) stackFrame_method frame `shouldBe` "brokenFunctionIO" stackFrame_inProject frame `shouldBe` Just True - describe "bugsnagExceptionFromSomeException" $ do - it "sets errorClass" $ do - let ex = - bugsnagExceptionFromSomeException $ - toException $ - userError "Oops" - - exception_errorClass ex `shouldBe` "IOException" - exception_message ex `shouldBe` Just "user error (Oops)" - - it "can parse errors with callstacks" $ do - e <- evaluate brokenFunction `catch` pure - - let ex = bugsnagExceptionFromSomeException e - exception_errorClass ex `shouldBe` "ErrorCall" - exception_message ex `shouldBe` Just "empty list" - exception_stacktrace ex `shouldSatisfy` ((== 3) . length) - - let frame = head $ exception_stacktrace ex - stackFrame_file frame `shouldBe` "test/Examples.hs" - stackFrame_lineNumber frame `shouldBe` 35 - stackFrame_columnNumber frame `shouldBe` Just 15 - stackFrame_method frame `shouldBe` "error" - - map stackFrame_method (exception_stacktrace ex) - `shouldBe` ["error", "sillyHead", "brokenFunction"] - - it "also parses StringException" $ do - e <- brokenFunction' `catch` pure - - let ex = bugsnagExceptionFromSomeException e - exception_errorClass ex `shouldBe` "StringException" - exception_message ex `shouldBe` Just "empty list" - exception_stacktrace ex `shouldSatisfy` ((== 3) . length) - - let frame = head $ exception_stacktrace ex - stackFrame_file frame `shouldBe` "test/Examples.hs" - stackFrame_lineNumber frame `shouldBe` 42 - stackFrame_columnNumber frame `shouldBe` Just 16 - stackFrame_method frame `shouldBe` "throwString" - - map stackFrame_method (exception_stacktrace ex) - `shouldBe` ["throwString", "sillyHead'", "brokenFunction'"] - - it "also parses StringExceptions with newlines" $ do - e <- brokenFunction'' `catch` pure - - let ex = bugsnagExceptionFromSomeException e - exception_errorClass ex `shouldBe` "StringException" - exception_message ex - `shouldBe` Just - "empty list\n and message with newlines\n\n" - exception_stacktrace ex `shouldSatisfy` ((== 3) . length) - - let frame = head $ exception_stacktrace ex - stackFrame_file frame `shouldBe` "test/Examples.hs" - stackFrame_lineNumber frame `shouldBe` 49 - stackFrame_columnNumber frame `shouldBe` Just 17 - stackFrame_method frame `shouldBe` "throwString" - - map stackFrame_method (exception_stacktrace ex) - `shouldBe` [ "throwString" - , "sillyHead''" - , "brokenFunction''" - ] + describe "bugsnagExceptionFromSomeException" $ do + it "sets errorClass" $ do + let ex = + bugsnagExceptionFromSomeException $ + toException $ + userError "Oops" + + exception_errorClass ex `shouldBe` "IOException" + exception_message ex `shouldBe` Just "user error (Oops)" + + it "can parse errors with callstacks" $ do + e <- evaluate brokenFunction `catch` pure + + let ex = bugsnagExceptionFromSomeException e + exception_errorClass ex `shouldBe` "ErrorCall" + exception_message ex `shouldBe` Just "empty list" + exception_stacktrace ex `shouldSatisfy` ((== 3) . length) + + let frame = head $ exception_stacktrace ex + stackFrame_file frame `shouldBe` "test/Examples.hs" + stackFrame_lineNumber frame `shouldBe` 36 + stackFrame_columnNumber frame `shouldBe` Just 15 + stackFrame_method frame `shouldBe` "error" + + map stackFrame_method (exception_stacktrace ex) + `shouldBe` ["error", "sillyHead", "brokenFunction"] + + it "parses StringException" $ do + e <- brokenFunction' `catch` pure + + let ex = bugsnagExceptionFromSomeException e + exception_errorClass ex `shouldBe` "StringException" + exception_message ex `shouldBe` Just "empty list" + exception_stacktrace ex `shouldSatisfy` ((== 3) . length) + + let frame = head $ exception_stacktrace ex + stackFrame_file frame `shouldBe` "test/Examples.hs" + stackFrame_lineNumber frame `shouldBe` 43 + stackFrame_columnNumber frame `shouldBe` Just 16 + stackFrame_method frame `shouldBe` "throwString" + + map stackFrame_method (exception_stacktrace ex) + `shouldBe` ["throwString", "sillyHead'", "brokenFunction'"] + + it "parses StringExceptions with newlines" $ do + e <- brokenFunction'' `catch` pure + + let ex = bugsnagExceptionFromSomeException e + exception_errorClass ex `shouldBe` "StringException" + exception_message ex + `shouldBe` Just + "empty list\n and message with newlines\n\n" + exception_stacktrace ex `shouldSatisfy` ((== 3) . length) + + let frame = head $ exception_stacktrace ex + stackFrame_file frame `shouldBe` "test/Examples.hs" + stackFrame_lineNumber frame `shouldBe` 50 + stackFrame_columnNumber frame `shouldBe` Just 17 + stackFrame_method frame `shouldBe` "throwString" + + map stackFrame_method (exception_stacktrace ex) + `shouldBe` [ "throwString" + , "sillyHead''" + , "brokenFunction''" + ] + + it "parses (AnnotatedException StringException)" $ do + e <- brokenFunctionAnnotated `catch` pure + + let ex = bugsnagExceptionFromSomeException e + exception_errorClass ex `shouldBe` "StringException" + exception_message ex `shouldBe` Just "empty list" + exception_stacktrace ex `shouldSatisfy` ((== 2) . length) + + let frame = head $ exception_stacktrace ex + stackFrame_file frame `shouldBe` "test/Examples.hs" + stackFrame_lineNumber frame `shouldBe` 53 + stackFrame_columnNumber frame `shouldBe` Just 27 + stackFrame_method frame `shouldBe` "checkpointCallStack" + + map stackFrame_method (exception_stacktrace ex) + `shouldBe` [ "checkpointCallStack" + , "brokenFunctionAnnotated" + ]