diff --git a/bugsnag-haskell.cabal b/bugsnag-haskell.cabal --- a/bugsnag-haskell.cabal +++ b/bugsnag-haskell.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 01ab548c1cccbe4991f8fcdae7003425379acff61d3a52d709841c2d174fd35c +-- hash: caca4031fa35eb1fc2f6253201cfaafa49ed608ffdad9f181af64bc9fed36e8e name: bugsnag-haskell -version: 0.0.2.0 +version: 0.0.2.1 synopsis: Bugsnag error reporter for Haskell description: Please see README.md category: Web diff --git a/src/Network/Bugsnag/BeforeNotify.hs b/src/Network/Bugsnag/BeforeNotify.hs --- a/src/Network/Bugsnag/BeforeNotify.hs +++ b/src/Network/Bugsnag/BeforeNotify.hs @@ -10,6 +10,7 @@ , filterStackFrames , setStackFramesCode , setStackFramesInProject + , setStackFramesInProjectBy , setGroupingHash , setGroupingHashBy @@ -103,8 +104,12 @@ -- | Set @'bsIsInProject'@ using the given predicate, applied to the Filename setStackFramesInProject :: (FilePath -> Bool) -> BeforeNotify -setStackFramesInProject p = - updateStackFrames $ \sf -> sf { bsfInProject = Just $ p $ bsfFile sf } +setStackFramesInProject = setStackFramesInProjectBy bsfFile + +setStackFramesInProjectBy + :: (BugsnagStackFrame -> a) -> (a -> Bool) -> BeforeNotify +setStackFramesInProjectBy f p = + updateStackFrames $ \sf -> sf { bsfInProject = Just $ p $ f sf } -- | Set @'beGroupingHash'@ setGroupingHash :: Text -> BeforeNotify diff --git a/src/Network/Bugsnag/Exception/Parse.hs b/src/Network/Bugsnag/Exception/Parse.hs --- a/src/Network/Bugsnag/Exception/Parse.hs +++ b/src/Network/Bugsnag/Exception/Parse.hs @@ -37,6 +37,8 @@ parseStringException :: SomeException -> Either String MessageWithStackFrames parseStringException = parse' stringExceptionParser +-- brittany-disable-next-binding + errorCallParser :: Parser MessageWithStackFrames errorCallParser = MessageWithStackFrames <$> messageParser @@ -61,6 +63,8 @@ , bsfCode = Nothing } +-- brittany-disable-next-binding + stringExceptionParser :: Parser MessageWithStackFrames stringExceptionParser = MessageWithStackFrames <$> messageParser @@ -69,8 +73,7 @@ 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) + T.pack <$> manyTill anyChar (try $ eol *> string "Called from:" *> eol) stackFrameParser :: Parser BugsnagStackFrame stackFrameParser = do @@ -91,7 +94,8 @@ stackFrameLocationTill :: Parser a -> Parser (FilePath, Natural, Natural) stackFrameLocationTill p = do - result <- (,,) + result <- + (,,) <$> manyTill anyChar (char ':') <*> (read <$> manyTill digit (char ':')) <*> (read <$> manyTill digit (char ' ')) diff --git a/src/Network/Bugsnag/Notify.hs b/src/Network/Bugsnag/Notify.hs --- a/src/Network/Bugsnag/Notify.hs +++ b/src/Network/Bugsnag/Notify.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-deprecations #-} - module Network.Bugsnag.Notify ( notifyBugsnag , notifyBugsnagWith @@ -7,13 +5,16 @@ import Control.Exception (SomeException) import Control.Monad (when) +import Data.Maybe (isJust) import Network.Bugsnag.App import Network.Bugsnag.BeforeNotify +import Network.Bugsnag.CodeIndex import Network.Bugsnag.Event import Network.Bugsnag.Exception import Network.Bugsnag.Report import Network.Bugsnag.Reporter import Network.Bugsnag.Settings +import Network.Bugsnag.StackFrame -- | Notify Bugsnag of a single exception notifyBugsnag :: BugsnagSettings -> SomeException -> IO () @@ -30,10 +31,7 @@ let event = f . bsBeforeNotify settings - . setGroupingHashBy (bsGroupingHash settings) - . maybe id setStackFramesCode (bsCodeIndex settings) - . setStackFramesInProject (bsIsInProject settings) - . filterStackFrames (bsFilterStackFrames settings) + . modifyStackFrames (bsCodeIndex settings) . createApp settings . bugsnagEvent $ bugsnagExceptionFromSomeException ex @@ -50,6 +48,16 @@ -- | -- +-- If we have a @'CodeIndex'@ set the Code and then set InProject based on if we +-- found any. Otherwise we just assume everything is InProject. +-- +modifyStackFrames :: Maybe CodeIndex -> BeforeNotify +modifyStackFrames Nothing = setStackFramesInProject $ const True +modifyStackFrames (Just index) = + setStackFramesInProjectBy bsfCode isJust . setStackFramesCode index + +-- | +-- -- N.B. safe to clobber because we're only used on a fresh event. -- createApp :: BugsnagSettings -> BeforeNotify @@ -59,3 +67,4 @@ , baReleaseStage = Just $ bsReleaseStage settings } } + diff --git a/src/Network/Bugsnag/Settings.hs b/src/Network/Bugsnag/Settings.hs --- a/src/Network/Bugsnag/Settings.hs +++ b/src/Network/Bugsnag/Settings.hs @@ -20,7 +20,6 @@ import Network.Bugsnag.Event import Network.Bugsnag.Exception import Network.Bugsnag.ReleaseStage -import Network.Bugsnag.StackFrame import Network.HTTP.Client import Network.HTTP.Client.TLS @@ -63,24 +62,6 @@ -- pass this predicate. N.B. Something lower-level, like @'reportError'@ -- won't be aware of this. -- - , bsGroupingHash :: BugsnagEvent -> Maybe Text - -- ^ The grouping hash to use for any specific event - -- - -- Events (exceptions) which have the same hash will be counted as the same - -- exception. Use @Nothing@ (the default) to maintain Bugsnags automatic - -- behavior (group by top in-project stack-frame). - -- - , bsIsInProject :: FilePath -> Bool - -- ^ Predicate for in-project stack frames - -- - -- By default, all are considered in-project. - -- - , bsFilterStackFrames :: BugsnagStackFrame -> Bool - -- ^ Stack frame filter - -- - -- Return @True@ for any stack-frames that should be omitted from - -- notifications. - -- , bsHttpManager :: Manager -- ^ The HTTP @Manager@ used to emit notifications -- @@ -96,10 +77,6 @@ -- } -{-# DEPRECATED bsGroupingHash "use setGroupingHashBy with bsBeforeNotify" #-} -{-# DEPRECATED bsIsInProject "use setStackFramesInProject with bsBeforeNotify" #-} -{-# DEPRECATED bsFilterStackFrames "use filterStackFrames with bsBeforeNotify" #-} - -- | Construct settings purely, given an existing @'Manager'@ bugsnagSettings :: BugsnagApiKey -> Manager -> BugsnagSettings bugsnagSettings apiKey manager = BugsnagSettings @@ -109,9 +86,6 @@ , bsNotifyReleaseStages = [ProductionReleaseStage] , bsBeforeNotify = defaultBeforeNotify , bsIgnoreException = const False - , bsGroupingHash = const Nothing - , bsIsInProject = const True - , bsFilterStackFrames = const True , bsHttpManager = manager , bsCodeIndex = Nothing } diff --git a/src/Network/Bugsnag/StackFrame.hs b/src/Network/Bugsnag/StackFrame.hs --- a/src/Network/Bugsnag/StackFrame.hs +++ b/src/Network/Bugsnag/StackFrame.hs @@ -12,7 +12,6 @@ import Data.Aeson import Data.Aeson.Ext -import Data.Maybe (fromMaybe) import Data.Text (Text) import GHC.Generics import Instances.TH.Lift () @@ -30,14 +29,11 @@ -- | 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. +-- on the record. -- attachBugsnagCode :: CodeIndex -> BugsnagStackFrame -> BugsnagStackFrame -attachBugsnagCode index sf = sf - { bsfCode = if fromMaybe True $ bsfInProject sf - then findBugsnagCode (bsfFile sf) (bsfLineNumber sf) index - else Nothing - } +attachBugsnagCode index sf = + sf { bsfCode = findBugsnagCode (bsfFile sf) (bsfLineNumber sf) index } findBugsnagCode :: FilePath -> Natural -> CodeIndex -> Maybe BugsnagCode findBugsnagCode path n = fmap BugsnagCode . findSourceRange path (begin, n + 3) diff --git a/test/Network/BugsnagSpec.hs b/test/Network/BugsnagSpec.hs --- a/test/Network/BugsnagSpec.hs +++ b/test/Network/BugsnagSpec.hs @@ -14,22 +14,31 @@ brokenFunctionIO :: IO a brokenFunctionIO = throw $ bugsnagException - "IOException" "Something exploded" [$(currentStackFrame) "brokenFunctionIO"] + "IOException" + "Something exploded" + [$(currentStackFrame) "brokenFunctionIO"] brokenFunction :: HasCallStack => a brokenFunction = sillyHead [] `seq` undefined sillyHead :: HasCallStack => [a] -> a -sillyHead (x:_) = x +sillyHead (x : _) = x sillyHead _ = error "empty list" brokenFunction' :: HasCallStack => IO a brokenFunction' = sillyHead' [] sillyHead' :: HasCallStack => [a] -> IO a -sillyHead' (x:_) = pure x +sillyHead' (x : _) = pure x sillyHead' _ = throwString "empty list" +brokenFunction'' :: HasCallStack => IO a +brokenFunction'' = sillyHead'' [] + +sillyHead'' :: HasCallStack => [a] -> IO a +sillyHead'' (x : _) = pure x +sillyHead'' _ = throwString "empty list\n and message with newlines\n\n" + spec :: Spec spec = do describe "BugsnagException" $ do @@ -42,8 +51,8 @@ let frame = head $ beStacktrace ex bsfFile frame `shouldBe` "test/Network/BugsnagSpec.hs" - bsfLineNumber frame `shouldBe` 17 - bsfColumnNumber frame `shouldBe` Just 43 + bsfLineNumber frame `shouldBe` 19 + bsfColumnNumber frame `shouldBe` Just 8 bsfMethod frame `shouldBe` "brokenFunctionIO" bsfInProject frame `shouldBe` Just True @@ -58,7 +67,7 @@ let frame = head $ beStacktrace ex bsfFile frame `shouldBe` "test/Network/BugsnagSpec.hs" - bsfLineNumber frame `shouldBe` 24 + bsfLineNumber frame `shouldBe` 26 bsfColumnNumber frame `shouldBe` Just 15 bsfMethod frame `shouldBe` "error" @@ -75,9 +84,30 @@ let frame = head $ beStacktrace ex bsfFile frame `shouldBe` "test/Network/BugsnagSpec.hs" - bsfLineNumber frame `shouldBe` 31 + bsfLineNumber frame `shouldBe` 33 bsfColumnNumber frame `shouldBe` Just 16 bsfMethod frame `shouldBe` "throwString" map bsfMethod (beStacktrace ex) `shouldBe` ["throwString", "sillyHead'", "brokenFunction'"] + + it "also parses StringExceptions with newlines" $ do + e <- brokenFunction'' `catch` pure + + let ex = bugsnagExceptionFromSomeException e + beErrorClass ex `shouldBe` "SomeException" + beMessage ex `shouldBe` Just + "empty list\n and message with newlines\n\n" + beStacktrace ex `shouldSatisfy` ((== 3) . length) + + let frame = head $ beStacktrace ex + bsfFile frame `shouldBe` "test/Network/BugsnagSpec.hs" + bsfLineNumber frame `shouldBe` 40 + bsfColumnNumber frame `shouldBe` Just 17 + bsfMethod frame `shouldBe` "throwString" + + map bsfMethod (beStacktrace ex) + `shouldBe` [ "throwString" + , "sillyHead''" + , "brokenFunction''" + ]