bugsnag-haskell 0.0.1.3 → 0.0.2.0

raw patch · 12 files changed

+358/−78 lines, 12 filesdep +Globdep +containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: Glob, containers

API changes (from Hackage documentation)

Files

• bugsnag-haskell.cabal +8/−3
• src/Network/Bugsnag/BeforeNotify.hs +58/−9
• src/Network/Bugsnag/CodeIndex.hs +62/−0
• src/Network/Bugsnag/Event.hs +27/−11
• src/Network/Bugsnag/Exception.hs +9/−9
• src/Network/Bugsnag/Exception/Parse.hs +78/−22
• src/Network/Bugsnag/Notify.hs +1/−1
• src/Network/Bugsnag/Settings.hs +12/−12
• src/Network/Bugsnag/StackFrame.hs +27/−2
• test/Network/Bugsnag/CodeIndexSpec.hs +43/−0
• test/Network/Bugsnag/ReportSpec.hs +6/−7
• test/Network/BugsnagSpec.hs +27/−2

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 36962ecc46dfa7d5ab30da6797310d06145ecdd5d2d487ab6f1ec237b259e721+-- hash: 01ab548c1cccbe4991f8fcdae7003425379acff61d3a52d709841c2d174fd35c  name:           bugsnag-haskell-version:        0.0.1.3+version:        0.0.2.0 synopsis:       Bugsnag error reporter for Haskell description:    Please see README.md category:       Web@@ -27,10 +27,12 @@       src   ghc-options: -Wall   build-depends:-      aeson >=1.3.0.0+      Glob >=0.9.0+    , aeson >=1.3.0.0     , base >=4.8.0 && <5     , bytestring     , case-insensitive+    , containers     , http-client     , http-client-tls     , http-conduit@@ -50,6 +52,7 @@       Network.Bugsnag.App       Network.Bugsnag.BeforeNotify       Network.Bugsnag.Breadcrumb+      Network.Bugsnag.CodeIndex       Network.Bugsnag.Device       Network.Bugsnag.Event       Network.Bugsnag.Exception@@ -160,7 +163,9 @@     , hspec     , text     , time+    , unliftio   other-modules:+      Network.Bugsnag.CodeIndexSpec       Network.Bugsnag.ReportSpec       Network.BugsnagSpec       Paths_bugsnag_haskell

@@ -6,12 +6,16 @@      -- * Modifying the Exception     , updateException+    , updateStackFrames     , filterStackFrames+    , setStackFramesCode     , setStackFramesInProject     , setGroupingHash     , setGroupingHashBy      -- * Modifying the Event+    , updateEventFromException+    , updateEventFromOriginalException     , updateEventFromSession     , updateEventFromWaiRequest @@ -29,7 +33,10 @@     , setInfoSeverity     ) where +import Control.Exception (Exception, fromException)+import Data.Maybe (fromMaybe) import Data.Text (Text)+import Network.Bugsnag.CodeIndex import Network.Bugsnag.Device import Network.Bugsnag.Event import Network.Bugsnag.Exception@@ -63,9 +70,6 @@  -- | Modify just the Exception part of an Event ----- Technically this will modify all exceptions in the Event, but if you're using--- this library normally, there will be only one.--- -- This may be used to set more specific information for exception types in -- scope in your application: --@@ -81,20 +85,26 @@ -- >         _ -> ex -- updateException :: (BugsnagException -> BugsnagException) -> BeforeNotify-updateException f event = event { beExceptions = f <$> beExceptions event }+updateException f event = event { beException = f $ beException event } +-- | Apply a function to each @'BugsnagStackFrame'@ in the Exception+updateStackFrames :: (BugsnagStackFrame -> BugsnagStackFrame) -> BeforeNotify+updateStackFrames f =+    updateException $ \ex -> ex { beStacktrace = map f $ beStacktrace ex }+ -- | Filter out StackFrames matching a predicate filterStackFrames :: (BugsnagStackFrame -> Bool) -> BeforeNotify filterStackFrames p =     updateException $ \ex -> ex { beStacktrace = filter p $ beStacktrace ex } +-- | Set @'bsfCode'@ using the given index+setStackFramesCode :: CodeIndex -> BeforeNotify+setStackFramesCode = updateStackFrames . attachBugsnagCode+ -- | Set @'bsIsInProject'@ using the given predicate, applied to the Filename setStackFramesInProject :: (FilePath -> Bool) -> BeforeNotify-setStackFramesInProject p = updateException-    $ \ex -> ex { beStacktrace = map updateStackFrames $ beStacktrace ex }-  where-    updateStackFrames :: BugsnagStackFrame -> BugsnagStackFrame-    updateStackFrames sf = sf { bsfInProject = Just $ p $ bsfFile sf }+setStackFramesInProject p =+    updateStackFrames $ \sf -> sf { bsfInProject = Just $ p $ bsfFile sf }  -- | Set @'beGroupingHash'@ setGroupingHash :: Text -> BeforeNotify@@ -103,6 +113,45 @@ -- | Set @'beGroupingHash'@ based on the Event setGroupingHashBy :: (BugsnagEvent -> Maybe Text) -> BeforeNotify setGroupingHashBy f event = event { beGroupingHash = f event }++-- | Update the @'BugsnagEvent'@ based on its @'BugsnagException'@+--+-- Use this instead of @'updateException'@ if you want to do other things to the+-- Event, such as set its @'beGroupingHash'@ based on the Exception.+--+updateEventFromException :: (BugsnagException -> BeforeNotify) -> BeforeNotify+updateEventFromException f event = f (beException event) event++-- | Update the @'BugsnagEvent'@ 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' $ \ex -> ex+--         { beErrorClass = sqlErrorCode+--         , beMessage = sqlErrorMessage+--         }+-- @+--+-- If there is no original exception, or the cast fails, the event is unchanged.+--+updateEventFromOriginalException+    :: Exception e => (e -> BeforeNotify) -> BeforeNotify+updateEventFromOriginalException f event = fromMaybe event $ do+    someException <- beOriginalException $ beException event+    yourException <- fromException someException+    pure $ f yourException event  -- | Set the events @'BugsnagEvent'@ and @'BugsnagDevice'@ updateEventFromWaiRequest :: Request -> BeforeNotify

@@ -0,0 +1,62 @@+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+module Network.Bugsnag.CodeIndex+    ( CodeIndex+    , buildCodeIndex+    , findSourceRange+    ) where++import Data.List (genericLength)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Data.Traversable (for)+import Instances.TH.Lift ()+import Language.Haskell.TH.Syntax+import Numeric.Natural (Natural)+import System.FilePath.Glob (glob)++newtype CodeIndex = CodeIndex+    { unCodeIndex :: Map FilePath FileIndex }+    deriving (Lift, Show)++buildCodeIndex :: String -> Q Exp+buildCodeIndex p = do+    index <- qRunIO $ buildCodeIndex' p+    [|index|]++buildCodeIndex' :: String -> IO CodeIndex+buildCodeIndex' p = do+    paths <- glob p+    CodeIndex . Map.fromList <$> traverse indexPath paths+  where+    indexPath :: FilePath -> IO (FilePath, FileIndex)+    indexPath fp = (fp, ) <$> buildFileIndex fp++data FileIndex = FileIndex+    { fiSourceLines :: Map Natural Text+    , fiLastLine :: Natural+    }+    deriving (Lift, Show)++buildFileIndex :: FilePath -> IO FileIndex+buildFileIndex path = do+    lns <- T.lines <$> T.readFile path++    pure FileIndex+        { fiSourceLines = Map.fromList $ zip [0 ..] lns+        , fiLastLine = genericLength lns - 1+        }++findSourceRange+    :: FilePath -> (Natural, Natural) -> CodeIndex -> Maybe [(Natural, Text)]+findSourceRange path (begin, end) index = do+    FileIndex {..} <- Map.lookup path $ unCodeIndex index++    for [begin .. min end fiLastLine]+        $ \n -> (n, ) <$> Map.lookup n fiSourceLines

@@ -1,15 +1,13 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} module Network.Bugsnag.Event     ( BugsnagEvent(..)     , bugsnagEvent     ) where  import Data.Aeson-import Data.Aeson.Ext-import Data.List.NonEmpty (NonEmpty)+import Data.Aeson.Types import Data.Text (Text)-import GHC.Generics import Network.Bugsnag.App import Network.Bugsnag.Breadcrumb import Network.Bugsnag.Device@@ -20,7 +18,7 @@ import Network.Bugsnag.User  data BugsnagEvent = BugsnagEvent-    { beExceptions :: NonEmpty BugsnagException+    { beException :: BugsnagException     , beBreadcrumbs :: Maybe [BugsnagBreadcrumb]     , beRequest :: Maybe BugsnagRequest     , beThreads :: Maybe [BugsnagThread]@@ -37,15 +35,33 @@     -- and I'm not sure yet how to resolve the naming clash with BugsnagSession.     , beMetaData :: Maybe Value     }-    deriving Generic  instance ToJSON BugsnagEvent where-    toJSON = genericToJSON $ bsAesonOptions "be"-    toEncoding = genericToEncoding $ bsAesonOptions "be"+    -- | Explicit instance needed to send @'beException'@ as @exceptions@+    toJSON BugsnagEvent {..} = object+        $ "exceptions" .= [beException]+        : concat+            [ "breadcrumbs" .=? beBreadcrumbs+            , "request" .=? beRequest+            , "threads" .=? beThreads+            , "context" .=? beContext+            , "groupingHash" .=? beGroupingHash+            , "unhandled" .=? beUnhandled+            , "severity" .=? beSeverity+            , "severityReason" .=? beSeverityReason+            , "user" .=? beUser+            , "app" .=? beApp+            , "device" .=? beDevice+            , "metaData" .=? beMetaData+            ]+      where+        -- For implementing "omit Nothing fields"+        (.=?) :: ToJSON v => Text -> Maybe v -> [Pair]+        (.=?) k = maybe [] (pure . (k .=)) -bugsnagEvent :: NonEmpty BugsnagException -> BugsnagEvent-bugsnagEvent exceptions = BugsnagEvent-    { beExceptions = exceptions+bugsnagEvent :: BugsnagException -> BugsnagEvent+bugsnagEvent exception = BugsnagEvent+    { beException = exception     , beBreadcrumbs = Nothing     , beRequest = Nothing     , beThreads = Nothing

@@ -74,7 +74,7 @@ -- bugsnagExceptionFromSomeException :: SomeException -> BugsnagException bugsnagExceptionFromSomeException ex =-    foldr go (bugsnagExceptionFromException ex) exCasters+    foldr go (bugsnagExceptionWithParser parseStringException ex) exCasters   where     go :: Caster -> BugsnagException -> BugsnagException     go (Caster caster) res = maybe res caster $ fromException ex@@ -82,7 +82,7 @@ exCasters :: [Caster] exCasters =     [ Caster id-    , Caster bugsnagExceptionFromErrorCall+    , Caster $ bugsnagExceptionWithParser parseErrorCall     , Caster $ bugsnagExceptionFromException @IOException     , Caster $ bugsnagExceptionFromException @ArithException     , Caster $ bugsnagExceptionFromException @ArrayException@@ -103,13 +103,13 @@     , Caster $ bugsnagExceptionFromException @TypeError     ] --- | Construct a @'BugsnagException'@ from an @'ErrorCall'@------ This type of exception may have @'HasCallStack'@ information.----bugsnagExceptionFromErrorCall :: ErrorCall -> BugsnagException-bugsnagExceptionFromErrorCall ex =-    case parseErrorCall ex of+bugsnagExceptionWithParser+    :: Exception e+    => (e -> Either String MessageWithStackFrames)+    -> e+    -> BugsnagException+bugsnagExceptionWithParser p ex =+    case p ex of         Left _ -> bugsnagExceptionFromException ex         Right (MessageWithStackFrames message stacktrace) ->             bugsnagException (exErrorClass ex) message stacktrace

@@ -6,14 +6,16 @@ module Network.Bugsnag.Exception.Parse     ( MessageWithStackFrames(..)     , parseErrorCall+    , parseStringException     ) where -import Control.Exception (ErrorCall)+import Control.Exception (ErrorCall, Exception, SomeException) import Control.Monad (void) import Data.Bifunctor (first) import Data.Text (Text) import qualified Data.Text as T import Network.Bugsnag.StackFrame+import Numeric.Natural import Text.Parsec import Text.Parsec.String @@ -24,35 +26,89 @@  -- | Parse an @'ErrorCall'@ for @'HasCallStack'@ information parseErrorCall :: ErrorCall -> Either String MessageWithStackFrames-parseErrorCall = first show . parse (errorCallParser <* eof) "<error>" . show+parseErrorCall = parse' errorCallParser +-- | Parse a @'StringException'@ for @'HasCallStack'@ information+--+-- We accept this as @'SomeException'@ so that this library doesn't depend on+-- any one concrete library that has @'throwString'@ (there are two right now,+-- sigh.)+--+parseStringException :: SomeException -> Either String MessageWithStackFrames+parseStringException = parse' stringExceptionParser+ errorCallParser :: Parser MessageWithStackFrames errorCallParser = MessageWithStackFrames-    <$> (T.pack <$> manyTill anyChar eol)-    <*> (csHeader *> manyTill stackFrameParser eof)+    <$> messageParser+    <*> manyTill stackFrameParser eof+  where+    messageParser :: Parser Text+    messageParser = do+        msg <- T.pack <$> manyTill anyChar eol+        msg <$ (string "CallStack (from HasCallStack):" *> eol) -csHeader :: Parser ()-csHeader = string "CallStack (from HasCallStack):" *> eol+    stackFrameParser :: Parser BugsnagStackFrame+    stackFrameParser = do+        func <- stackFrameFunctionTill $ string ", called at "+        (path, ln, cl) <- stackFrameLocationTill $ eol <|> eof -stackFrameParser :: Parser BugsnagStackFrame-stackFrameParser = do-    func <- spaces *> (T.pack <$> manyTill anyChar (char ','))-    path <- string " called at " *> manyTill anyChar (char ':')-    ln <- read <$> manyTill digit (char ':')-    cl <- read <$> manyTill digit (char ' ')+        pure BugsnagStackFrame+            { bsfFile = path+            , bsfLineNumber = ln+            , bsfColumnNumber = Just cl+            , bsfMethod = func+            , bsfInProject = Just True+            , bsfCode = Nothing+            } -    void $ string "in " -- package:module+stringExceptionParser :: Parser MessageWithStackFrames+stringExceptionParser = MessageWithStackFrames+    <$> messageParser+    <*> manyTill stackFrameParser eof+  where+    messageParser :: Parser Text+    messageParser = do+        manyTill anyChar (try $ string "throwString called with:") *> eol *> eol+        msg <- T.pack <$> manyTill anyChar eol+        msg <$ (string "Called from:" *> eol)++    stackFrameParser :: Parser BugsnagStackFrame+    stackFrameParser = do+        func <- stackFrameFunctionTill $ string " ("+        (path, ln, cl) <- stackFrameLocationTill $ char ')' *> eol <|> eof++        pure BugsnagStackFrame+            { bsfFile = path+            , bsfLineNumber = ln+            , bsfColumnNumber = Just cl+            , bsfMethod = func+            , bsfInProject = Just True+            , bsfCode = Nothing+            }++stackFrameFunctionTill :: Parser a -> Parser Text+stackFrameFunctionTill p = spaces *> (T.pack <$> manyTill anyChar p)++stackFrameLocationTill :: Parser a -> Parser (FilePath, Natural, Natural)+stackFrameLocationTill p = do+    result <- (,,)+        <$> manyTill anyChar (char ':')+        <*> (read <$> manyTill digit (char ':'))+        <*> (read <$> manyTill digit (char ' '))++    -- Ignore the "in package:module" part. TODO: we could use this to set+    -- bsfInProject if we had some more knowledge about project packages.+    void $ string "in "     void $ manyTill anyChar $ char ':'-    void $ manyTill anyChar $ eol <|> eof+    void $ manyTill anyChar p+    pure result -    pure BugsnagStackFrame-        { bsfFile = path-        , bsfLineNumber = ln-        , bsfColumnNumber = Just cl-        , bsfMethod = func-        , bsfInProject = Just True-        , bsfCode = Nothing-        }+parse'+    :: Exception e+    => Parser MessageWithStackFrames+    -> e+    -> Either String MessageWithStackFrames+parse' p = first show . parse (p <* eof) "<error>" . show  eol :: Parser () eol = void endOfLine

@@ -31,11 +31,11 @@             f                 . bsBeforeNotify settings                 . setGroupingHashBy (bsGroupingHash settings)+                . maybe id setStackFramesCode (bsCodeIndex settings)                 . setStackFramesInProject (bsIsInProject settings)                 . filterStackFrames (bsFilterStackFrames settings)                 . createApp settings                 . bugsnagEvent-                . pure                 $ bugsnagExceptionFromSomeException ex          manager = bsHttpManager settings

@@ -12,11 +12,11 @@     ) where  import Data.Aeson (FromJSON)-import qualified Data.List.NonEmpty as NE import Data.String import Data.Text (Text) import qualified Data.Text as T import Network.Bugsnag.BeforeNotify+import Network.Bugsnag.CodeIndex import Network.Bugsnag.Event import Network.Bugsnag.Exception import Network.Bugsnag.ReleaseStage@@ -87,6 +87,13 @@     -- It's more efficient, and ensures proper resource cleanup, to share a     -- single manager across an application. Must be TLS-enabled.     --+    , bsCodeIndex :: 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.+    --     }  {-# DEPRECATED bsGroupingHash "use setGroupingHashBy with bsBeforeNotify" #-}@@ -106,13 +113,14 @@     , bsIsInProject = const True     , bsFilterStackFrames = const True     , bsHttpManager = manager+    , bsCodeIndex = Nothing     }  -- | Should this @'BugsnagEvent'@ trigger notification? -- -- >>> :set -XOverloadedStrings -- >>> settings <- newBugsnagSettings ""--- >>> let event = bugsnagEvent $ pure $ bugsnagException "" "" []+-- >>> let event = bugsnagEvent $ bugsnagException "" "" [] -- >>> bugsnagShouldNotify settings event -- True --@@ -125,7 +133,7 @@ -- -- >>> let ignore = (== "IgnoreMe") . beErrorClass -- >>> let ignoreSettings = settings { bsIgnoreException = ignore }--- >>> let ignoreEvent = bugsnagEvent $ pure $ bugsnagException "IgnoreMe" "" []+-- >>> let ignoreEvent = bugsnagEvent $ bugsnagException "IgnoreMe" "" [] -- >>> bugsnagShouldNotify ignoreSettings event -- True --@@ -135,16 +143,8 @@ bugsnagShouldNotify :: BugsnagSettings -> BugsnagEvent -> Bool bugsnagShouldNotify settings event     | bsReleaseStage settings `notElem` bsNotifyReleaseStages settings = False-    | bsIgnoreException settings exception = False+    | bsIgnoreException settings $ beException event = False     | otherwise = True-  where-    exception-        | NE.length (beExceptions event) == 1 = NE.head $ beExceptions event-        | otherwise = error $ unlines-            [ "Library misused. Event must have exactly one Exception when"-            , " going through our notifyBugsnag functions. To send more than"-            , " one Exception, drop down to reportError."-            ]  -- | Construct settings with a new, TLS-enabled @'Manager'@ --

@@ -4,6 +4,7 @@ {-# LANGUAGE TemplateHaskell #-} module Network.Bugsnag.StackFrame     ( BugsnagCode(..)+    , attachBugsnagCode     , BugsnagStackFrame(..)     , bugsnagStackFrame     , currentStackFrame@@ -11,20 +12,40 @@  import Data.Aeson import Data.Aeson.Ext+import Data.Maybe (fromMaybe) import Data.Text (Text) import GHC.Generics import Instances.TH.Lift () import Language.Haskell.TH.Syntax+import Network.Bugsnag.CodeIndex import Numeric.Natural (Natural)  -- | Lines of code surrounding the error ----- Pairs of @(line-number, line-of-code)@, up to 3 on either side. There's no--- real way to support this in Haskell, so we always send @Nothing@.+-- Pairs of @(line-number, line-of-code)@, up to 3 on either side. -- newtype BugsnagCode = BugsnagCode [(Natural, Text)]     deriving (Show, ToJSON) +-- | Attempt to attach a @'BugsnagCode'@ to a @'BugsnagStackFrame'@+--+-- Looks up the content in the Index by File/LineNumber and, if found, sets it+-- on the record. N.B. this will only operate on in-project StackFrames.+--+attachBugsnagCode :: CodeIndex -> BugsnagStackFrame -> BugsnagStackFrame+attachBugsnagCode index sf = sf+    { bsfCode = if fromMaybe True $ bsfInProject sf+        then findBugsnagCode (bsfFile sf) (bsfLineNumber sf) index+        else Nothing+    }++findBugsnagCode :: FilePath -> Natural -> CodeIndex -> Maybe BugsnagCode+findBugsnagCode path n = fmap BugsnagCode . findSourceRange path (begin, n + 3)+  where+    begin+        | n < 3 = 0+        | otherwise = n - 3+ data BugsnagStackFrame = BugsnagStackFrame     { bsfFile :: FilePath     , bsfLineNumber :: Natural@@ -61,6 +82,8 @@ currentStackFrame :: Q Exp currentStackFrame = [|locStackFrame $(qLocation >>= liftLoc)|] +-- brittany-disable-next-binding+ locStackFrame :: Loc -> Text -> BugsnagStackFrame locStackFrame (Loc path _ _ (ls, cs) _) func =     BugsnagStackFrame@@ -74,6 +97,8 @@         -- assumed to be in end-user code.         , bsfCode = Nothing         }++-- brittany-disable-next-binding  -- Taken from monad-logger liftLoc :: Loc -> Q Exp

@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Network.Bugsnag.CodeIndexSpec+    ( spec+    ) where++import Test.Hspec++import Network.Bugsnag.CodeIndex++spec :: Spec+spec = do+    describe "CodeIndex" $ do+        let index = $(buildCodeIndex "test/fixtures/index-project/**/*.hs")++        it "can find ranges within the file" $ do+            let path = "test/fixtures/index-project/Foo.hs"+                range = (0, 3)+                sourceLines =+                    [ (0, "module Foo where")+                    , (1, "")+                    , (2, "data What = What")+                    , (3, "    deriving Show")+                    ]++            findSourceRange path range index `shouldBe` Just sourceLines++        it "handles ranges that extend beyond bounds" $ do+            let path = "test/fixtures/index-project/Foo.hs"+                range = (6, 10)+                sourceLines =+                    [(6, "what 0 = Just What"), (7, "what _ = Nothing")]++            findSourceRange path range index `shouldBe` Just sourceLines++        it "handles ranges that are totally beyond bounds" $ do+            let path = "test/fixtures/index-project/Foo.hs"+                range = (10, 12)++            findSourceRange path range index `shouldBe` Just []++        it "handles missing files" $ do+            findSourceRange "nope.hs" (0, 3) index `shouldBe` Nothing

@@ -18,12 +18,11 @@         it "is right for a minimally-specified report" $ do             let report =                     bugsnagReport-                        [ bugsnagEvent $ pure-                            $ bugsnagException-                                "errorClass"-                                "message"-                                [ bugsnagStackFrame "src/Foo/Bar.hs" 10 "myFunction"-                                ]+                        [ bugsnagEvent $ bugsnagException+                            "errorClass"+                            "message"+                            [ bugsnagStackFrame "src/Foo/Bar.hs" 10 "myFunction"+                            ]                         ]              -- N.B. we don't worry about the notifier object since it would need@@ -52,7 +51,7 @@                         { brNotifier = bugsnagNotifier                         , brEvents =                             [ BugsnagEvent-                                { beExceptions = pure BugsnagException+                                { beException = BugsnagException                                     { beErrorClass = "errorClass"                                     , beMessage = Just "message"                                     , beStacktrace =

@@ -10,6 +10,7 @@  import Control.Exception import Network.Bugsnag+import UnliftIO.Exception (throwString)  brokenFunctionIO :: IO a brokenFunctionIO = throw $ bugsnagException@@ -22,6 +23,13 @@ sillyHead (x:_) = x sillyHead _ = error "empty list" +brokenFunction' :: HasCallStack => IO a+brokenFunction' = sillyHead' []++sillyHead' :: HasCallStack => [a] -> IO a+sillyHead' (x:_) = pure x+sillyHead' _ = throwString "empty list"+ spec :: Spec spec = do     describe "BugsnagException" $ do@@ -34,7 +42,7 @@              let frame = head $ beStacktrace ex             bsfFile frame `shouldBe` "test/Network/BugsnagSpec.hs"-            bsfLineNumber frame `shouldBe` 16+            bsfLineNumber frame `shouldBe` 17             bsfColumnNumber frame `shouldBe` Just 43             bsfMethod frame `shouldBe` "brokenFunctionIO"             bsfInProject frame `shouldBe` Just True@@ -50,9 +58,26 @@                  let frame = head $ beStacktrace ex                 bsfFile frame `shouldBe` "test/Network/BugsnagSpec.hs"-                bsfLineNumber frame `shouldBe` 23+                bsfLineNumber frame `shouldBe` 24                 bsfColumnNumber frame `shouldBe` Just 15                 bsfMethod frame `shouldBe` "error"                  map bsfMethod (beStacktrace ex)                     `shouldBe` ["error", "sillyHead", "brokenFunction"]++            it "also parses StringException" $ do+                e <- brokenFunction' `catch` pure++                let ex = bugsnagExceptionFromSomeException e+                beErrorClass ex `shouldBe` "SomeException"+                beMessage ex `shouldBe` Just "empty list"+                beStacktrace ex `shouldSatisfy` ((== 3) . length)++                let frame = head $ beStacktrace ex+                bsfFile frame `shouldBe` "test/Network/BugsnagSpec.hs"+                bsfLineNumber frame `shouldBe` 31+                bsfColumnNumber frame `shouldBe` Just 16+                bsfMethod frame `shouldBe` "throwString"++                map bsfMethod (beStacktrace ex)+                    `shouldBe` ["throwString", "sillyHead'", "brokenFunction'"]