bugsnag 1.0.0.1 → 1.1.0.0

raw patch · 22 files changed

+743/−437 lines, 22 filesdep +aesondep +annotated-exceptionPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, annotated-exception

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−1
• README.md +4/−0
• bugsnag.cabal +10/−5
• src/Data/Aeson/Compat.hs +46/−0
• src/Data/Bugsnag.hs +2/−2
• src/Data/Bugsnag/Settings.hs +37/−41
• src/Network/Bugsnag.hs +5/−6
• src/Network/Bugsnag/BeforeNotify.hs +53/−51
• src/Network/Bugsnag/CodeIndex.hs +29/−27
• src/Network/Bugsnag/Device.hs +7/−6
• src/Network/Bugsnag/Exception.hs +119/−40
• src/Network/Bugsnag/Exception/Parse.hs +67/−62
• src/Network/Bugsnag/MetaData.hs +95/−0
• src/Network/Bugsnag/Notify.hs +50/−26
• src/Network/Bugsnag/StackFrame.hs +35/−32
• test/Examples.hs +12/−6
• test/Network/Bugsnag/BeforeNotifySpec.hs +24/−23
• test/Network/Bugsnag/CodeIndexSpec.hs +29/−26
• test/Network/Bugsnag/DeviceSpec.hs +12/−13
• test/Network/Bugsnag/ExceptionSpec.hs +87/−68
• test/Spec.hs +1/−1
• test/fixtures/index-project/Foo.hs +1/−1

@@ -1,6 +1,23 @@-## [_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) 

@@ -1,5 +1,9 @@ # Bugsnag error reporter for Haskell +[![Hackage](https://img.shields.io/hackage/v/bugsnag.svg?style=flat)](https://hackage.haskell.org/package/bugsnag)+[![Stackage Nightly](http://stackage.org/package/bugsnag/badge/nightly)](http://stackage.org/nightly/package/bugsnag)+[![Stackage LTS](http://stackage.org/package/bugsnag/badge/lts)](http://stackage.org/lts/package/bugsnag)+ Catch exceptions in your Haskell code and report then to Bugsnag.  ## Configuration

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               bugsnag-version:            1.0.0.1+version:            1.1.0.0 license:            MIT license-file:       LICENSE maintainer:         pbrisbin@gmail.com@@ -29,11 +29,12 @@         Network.Bugsnag.Device         Network.Bugsnag.Exception         Network.Bugsnag.Exception.Parse+        Network.Bugsnag.MetaData         Network.Bugsnag.Notify         Network.Bugsnag.StackFrame      hs-source-dirs:     src-    other-modules:      Paths_bugsnag+    other-modules:      Data.Aeson.Compat     default-language:   Haskell2010     default-extensions:         BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor@@ -46,6 +47,8 @@      build-depends:         Glob >=0.9.0,+        aeson >=1.3.1.1,+        annotated-exception >=0.2.0.2,         base >=4.11.0 && <5,         bugsnag-hs >=0.2.0.8,         bytestring >=0.10.8.2,@@ -57,6 +60,7 @@         text >=1.2.3.1,         th-lift-instances >=0.1.11,         ua-parser >=0.7.7.0,+        unliftio >=0.2.9.0,         unordered-containers >=0.2.9.0  executable example-cli@@ -75,7 +79,7 @@      build-depends:         base >=4.11.0 && <5,-        bugsnag -any+        bugsnag      if !flag(examples)         buildable: False@@ -96,7 +100,7 @@      build-depends:         base >=4.11.0 && <5,-        bugsnag -any+        bugsnag      if !flag(examples)         buildable: False@@ -124,7 +128,8 @@         TypeApplications TypeFamilies      build-depends:+        annotated-exception >=0.2.0.2,         base >=4.11.0 && <5,-        bugsnag -any,+        bugsnag,         hspec >=2.5.5,         unliftio >=0.2.9.0

@@ -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

@@ -2,7 +2,7 @@  -- | Re-exports the @Network.Bugsnag@ provided by @bugsnag-hs@ as @Data.Bugsnag@ module Data.Bugsnag-    ( module Network.Bugsnag-    ) where+  ( module Network.Bugsnag+  ) where  import "bugsnag-hs" Network.Bugsnag

@@ -1,7 +1,7 @@ module Data.Bugsnag.Settings-    ( Settings(..)-    , defaultSettings-    ) where+  ( Settings (..)+  , defaultSettings+  ) where  import Prelude @@ -12,46 +12,42 @@ import Network.HTTP.Client (HttpException)  data Settings = Settings-    { settings_apiKey :: ApiKey-    -- ^ Your Integration API Key-    , settings_appVersion :: Maybe Text-    -- ^ The version of your application-    ---    -- Marking bugs as Fixed and having them auto-reopen in new versions-    -- requires you set this.-    ---    , settings_releaseStage :: Text-    -- ^ The current release-stage, Production by default-    , settings_enabledReleaseStages :: [Text]-    -- ^ Which release-stages to notify in. Only Production by default-    , settings_beforeNotify :: BeforeNotify-    -- ^ Modify any events before they are sent-    ---    -- For example to attach a user, or set the context.-    ---    , settings_ignoreException :: Exception -> Bool-    -- ^ Exception filtering-    ---    -- Functions like 'notifyBugsnag' will do nothing with exceptions that pass-    -- this predicate. N.B. Something lower-level, like 'reportError' won't be-    -- aware of this.-    ---    , settings_onNotifyException :: HttpException -> IO ()-    -- ^ How to handle an exception reporting error events-    ---    -- Default is to ignore.-    ---    , settings_codeIndex :: 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.-    ---    }+  { settings_apiKey :: ApiKey+  -- ^ Your Integration API Key+  , settings_appVersion :: Maybe Text+  -- ^ The version of your application+  --+  -- Marking bugs as Fixed and having them auto-reopen in new versions+  -- requires you set this.+  , settings_releaseStage :: Text+  -- ^ The current release-stage, Production by default+  , settings_enabledReleaseStages :: [Text]+  -- ^ Which release-stages to notify in. Only Production by default+  , settings_beforeNotify :: BeforeNotify+  -- ^ Modify any events before they are sent+  --+  -- For example to attach a user, or set the context.+  , settings_ignoreException :: Exception -> Bool+  -- ^ Exception filtering+  --+  -- Functions like 'notifyBugsnag' will do nothing with exceptions that pass+  -- this predicate. N.B. Something lower-level, like 'reportError' won't be+  -- aware of this.+  , settings_onNotifyException :: HttpException -> IO ()+  -- ^ How to handle an exception reporting error events+  --+  -- Default is to ignore.+  , settings_codeIndex :: 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.+  }  defaultSettings :: Text -> Settings-defaultSettings k = Settings+defaultSettings k =+  Settings     { settings_apiKey = apiKey k     , settings_appVersion = Nothing     , settings_releaseStage = "production"

@@ -1,12 +1,11 @@ module Network.Bugsnag-    (-    -- * Notifying-      notifyBugsnag-    , notifyBugsnagWith+  ( -- * Notifying+    notifyBugsnag+  , notifyBugsnagWith      -- * Modifying events on notification-    , module Network.Bugsnag.BeforeNotify-    ) where+  , module Network.Bugsnag.BeforeNotify+  ) where  import Network.Bugsnag.BeforeNotify import Network.Bugsnag.Notify

@@ -1,34 +1,35 @@ module Network.Bugsnag.BeforeNotify-    ( BeforeNotify-    , beforeNotify-    , runBeforeNotify+  ( BeforeNotify+  , beforeNotify+  , runBeforeNotify      -- * Modifying the underlying Exceptions-    , updateExceptions-    , filterExceptions-    , updateStackFrames-    , filterStackFrames-    , setStackFramesCode-    , setStackFramesInProject-    , setStackFramesInProjectByFile-    , setStackFramesInProjectBy+  , updateExceptions+  , filterExceptions+  , updateStackFrames+  , filterStackFrames+  , setStackFramesCode+  , setStackFramesInProject+  , setStackFramesInProjectByFile+  , setStackFramesInProjectBy      -- * Modifying the Event-    , updateEvent-    , updateEventFromOriginalException-    , setGroupingHash-    , setGroupingHashBy-    , setDevice-    , setContext-    , setRequest-    , setWarningSeverity-    , setErrorSeverity-    , setInfoSeverity-    ) where+  , updateEvent+  , updateEventFromOriginalException+  , setGroupingHash+  , setGroupingHashBy+  , setDevice+  , setContext+  , setRequest+  , setWarningSeverity+  , setErrorSeverity+  , setInfoSeverity+  ) where  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)@@ -44,57 +45,56 @@ -- '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-    { _unBeforeNotify :: forall e. Exception.Exception e => e -> Event -> Event-    }+  { _unBeforeNotify :: forall e. Exception.Exception e => e -> Event -> Event+  }  instance Semigroup BeforeNotify where-    BeforeNotify f <> BeforeNotify g = BeforeNotify $ \e -> f e . g e+  BeforeNotify f <> BeforeNotify g = BeforeNotify $ \e -> f e . g e  instance Monoid BeforeNotify where-    mempty = BeforeNotify $ const id+  mempty = BeforeNotify $ const id  beforeNotify-    :: (forall e . Exception.Exception e => e -> Event -> Event)-    -> BeforeNotify+  :: (forall e. Exception.Exception e => e -> Event -> Event)+  -> BeforeNotify beforeNotify = BeforeNotify  runBeforeNotify :: Exception.Exception e => BeforeNotify -> e -> Event -> Event runBeforeNotify (BeforeNotify f) = f  updateExceptions :: (Exception -> Exception) -> BeforeNotify-updateExceptions f = updateEvent-    $ \event -> event { event_exceptions = map f $ event_exceptions event }+updateExceptions f = updateEvent $+  \event -> event {event_exceptions = map f $ event_exceptions event}  filterExceptions :: (Exception -> Bool) -> BeforeNotify filterExceptions p = updateEvent $ \event ->-    event { event_exceptions = filter p $ event_exceptions event }+  event {event_exceptions = filter p $ event_exceptions event}  updateStackFrames :: (StackFrame -> StackFrame) -> BeforeNotify-updateStackFrames f = updateExceptions-    $ \e -> e { exception_stacktrace = map f $ exception_stacktrace e }+updateStackFrames f = updateExceptions $+  \e -> e {exception_stacktrace = map f $ exception_stacktrace e}  filterStackFrames :: (StackFrame -> Bool) -> BeforeNotify-filterStackFrames p = updateExceptions-    $ \e -> e { exception_stacktrace = filter p $ exception_stacktrace e }+filterStackFrames p = updateExceptions $+  \e -> e {exception_stacktrace = filter p $ exception_stacktrace e}  setStackFramesCode :: CodeIndex -> BeforeNotify setStackFramesCode =-    (setStackFramesInProjectBy (isJust . stackFrame_code) <>)-        . updateStackFrames-        . attachBugsnagCode+  (setStackFramesInProjectBy (isJust . stackFrame_code) <>)+    . updateStackFrames+    . attachBugsnagCode  setStackFramesInProject :: Bool -> BeforeNotify setStackFramesInProject = setStackFramesInProjectBy . const  setStackFramesInProjectByFile :: (FilePath -> Bool) -> BeforeNotify setStackFramesInProjectByFile f =-    setStackFramesInProjectBy $ f . unpack . stackFrame_file+  setStackFramesInProjectBy $ f . unpack . stackFrame_file  setStackFramesInProjectBy :: (StackFrame -> Bool) -> BeforeNotify setStackFramesInProjectBy f =-    updateStackFrames $ \sf -> sf { stackFrame_inProject = Just $ f sf }+  updateStackFrames $ \sf -> sf {stackFrame_inProject = Just $ f sf}  updateEvent :: (Event -> Event) -> BeforeNotify updateEvent f = beforeNotify $ \_e event -> f event@@ -123,38 +123,40 @@ -- -- 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+  :: forall e. Exception.Exception e => (e -> BeforeNotify) -> BeforeNotify updateEventFromOriginalException f = beforeNotify $ \e event ->-    let bn = maybe mempty f $ Exception.fromException $ Exception.toException e-    in runBeforeNotify bn e event+  let bn =+        maybe mempty (f . Annotated.exception) $+          Exception.fromException $+            Exception.toException e+  in  runBeforeNotify bn e event  setGroupingHash :: Text -> BeforeNotify setGroupingHash hash = setGroupingHashBy $ const $ Just hash  setGroupingHashBy :: (Event -> Maybe Text) -> BeforeNotify setGroupingHashBy f =-    updateEvent $ \event -> event { event_groupingHash = f event }+  updateEvent $ \event -> event {event_groupingHash = f event}  -- | Set the Event's Context setContext :: Text -> BeforeNotify setContext context =-    updateEvent $ \event -> event { event_context = Just context }+  updateEvent $ \event -> event {event_context = Just context}  -- | Set the Event's Request -- -- See 'bugsnagRequestFromWaiRequest'--- setRequest :: Request -> BeforeNotify setRequest request =-    updateEvent $ \event -> event { event_request = Just request }+  updateEvent $ \event -> event {event_request = Just request}  -- | Set the Event's Device -- -- See 'bugsnagDeviceFromWaiRequest'--- setDevice :: Device -> BeforeNotify-setDevice device = updateEvent $ \event -> event { event_device = Just device }+setDevice device = updateEvent $ \event -> event {event_device = Just device}  -- | Set to 'ErrorSeverity' setErrorSeverity :: BeforeNotify@@ -170,4 +172,4 @@  setSeverity :: Severity -> BeforeNotify setSeverity severity =-    updateEvent $ \event -> event { event_severity = Just severity }+  updateEvent $ \event -> event {event_severity = Just severity}

@@ -13,12 +13,11 @@ -- source code in memory during the life of your process. And in larger -- projects, it will embed substantial amounts of source code in a single file, -- which can significantly degrade compilation time.--- module Network.Bugsnag.CodeIndex-    ( CodeIndex-    , buildCodeIndex-    , findSourceRange-    ) where+  ( CodeIndex+  , buildCodeIndex+  , findSourceRange+  ) where  import Prelude @@ -32,42 +31,45 @@ import Language.Haskell.TH.Syntax import System.FilePath.Glob (glob) +{-# ANN module ("HLint: ignore Unused LANGUAGE pragma" :: String) #-}+ newtype CodeIndex = CodeIndex-    { unCodeIndex :: Map FilePath FileIndex-    }-    deriving stock (Lift, Show)+  { unCodeIndex :: Map FilePath FileIndex+  }+  deriving stock (Lift, Show)  buildCodeIndex :: String -> Q Exp buildCodeIndex p = do-    index <- qRunIO $ buildCodeIndex' p-    [|index|]+  index <- qRunIO $ buildCodeIndex' p+  [|$(lift 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+  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 Int Text-    , fiLastLine :: Int-    }-    deriving stock (Lift, Show)+  { fiSourceLines :: Map Int Text+  , fiLastLine :: Int+  }+  deriving stock (Lift, Show)  buildFileIndex :: FilePath -> IO FileIndex buildFileIndex path = do-    lns <- T.lines <$> T.readFile path+  lns <- T.lines <$> T.readFile path -    pure FileIndex-        { fiSourceLines = Map.fromList $ zip [0 ..] lns-        , fiLastLine = length lns - 1-        }+  pure+    FileIndex+      { fiSourceLines = Map.fromList $ zip [0 ..] lns+      , fiLastLine = length lns - 1+      }  findSourceRange :: FilePath -> (Int, Int) -> CodeIndex -> Maybe [(Int, Text)] findSourceRange path (begin, end) index = do-    FileIndex {..} <- Map.lookup path $ unCodeIndex index+  FileIndex {..} <- Map.lookup path $ unCodeIndex index -    for [begin .. min end fiLastLine]-        $ \n -> (n, ) <$> Map.lookup n fiSourceLines+  for [begin .. min end fiLastLine] $+    \n -> (n,) <$> Map.lookup n fiSourceLines

@@ -1,6 +1,6 @@ module Network.Bugsnag.Device-    ( bugsnagDeviceFromUserAgent-    ) where+  ( bugsnagDeviceFromUserAgent+  ) where  import Prelude @@ -12,7 +12,8 @@ import Web.UAParser  bugsnagDeviceFromUserAgent :: ByteString -> Device-bugsnagDeviceFromUserAgent userAgent = defaultDevice+bugsnagDeviceFromUserAgent userAgent =+  defaultDevice     { device_osName = osrFamily <$> osResult     , device_osVersion = do         result <- osResult@@ -29,6 +30,6 @@         v3 <- readMaybe . unpack =<< uarV3 result         pure $ pack $ showVersion $ makeVersion [v1, v2, v3]     }-  where-    uaResult = parseUA userAgent-    osResult = parseOS userAgent+ where+  uaResult = parseUA userAgent+  osResult = parseOS userAgent

@@ -1,61 +1,140 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ExistentialQuantification #-}  module Network.Bugsnag.Exception-    ( AsException(..)-    , bugsnagExceptionFromSomeException-    ) where+  ( AsException (..)+  , bugsnagExceptionFromSomeException+  ) where  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-    { unAsException :: Exception-    }-    deriving newtype Show-    deriving anyclass Exception.Exception+  { unAsException :: Exception+  }+  deriving newtype (Show)+  deriving anyclass (Exception.Exception)  -- | Construct a 'Exception' from a 'SomeException' bugsnagExceptionFromSomeException :: SomeException -> Exception-bugsnagExceptionFromSomeException ex = fromMaybe fallback $ asum-    [ unAsException <$> fromException ex-    , bugsnagExceptionWithParser parseErrorCall <$> fromException ex-    ]-  where-    fallback = (bugsnagExceptionWithParser parseStringException ex)-        { exception_errorClass = (\(SomeException e) -> exErrorClass e) ex-        }+bugsnagExceptionFromSomeException ex =+  fromMaybe defaultException $+    asum+      [ bugsnagExceptionFromAnnotatedAsException <$> fromException ex+      , bugsnagExceptionFromStringException <$> fromException ex+      , bugsnagExceptionFromAnnotatedStringException <$> fromException ex+      , bugsnagExceptionFromAnnotatedException <$> fromException 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 = defaultException-    { exception_errorClass = exErrorClass ex-    , exception_message = Just $ pack $ displayException ex-    , exception_stacktrace = []+-- | When a 'StringException' is thrown, we use its message and trace.+bugsnagExceptionFromStringException :: StringException -> Exception+bugsnagExceptionFromStringException (StringException message stack) =+  defaultException+    { 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+    }

@@ -1,17 +1,19 @@ -- | -- -- Parse error messages for @'HasCallStack'@ information.--- module Network.Bugsnag.Exception.Parse-    ( MessageWithStackFrames(..)-    , parseErrorCall-    , parseStringException-    ) where+  ( MessageWithStackFrames (..)+  , parseErrorCall+  , parseStringException+  ) where  import Prelude  import qualified Control.Exception as Exception-    (ErrorCall, Exception, SomeException)+  ( ErrorCall+  , Exception+  , SomeException+  ) import Control.Monad (void) import Data.Bifunctor (first) import Data.Bugsnag@@ -20,9 +22,9 @@ import Text.Parsec.String  data MessageWithStackFrames = MessageWithStackFrames-    { mwsfMessage :: Text-    , mwsfStackFrames :: [StackFrame]-    }+  { mwsfMessage :: Text+  , mwsfStackFrames :: [StackFrame]+  }  -- | Parse an @'ErrorCall'@ for @'HasCallStack'@ information parseErrorCall :: Exception.ErrorCall -> Either String MessageWithStackFrames@@ -33,86 +35,89 @@ -- 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-    :: Exception.SomeException -> Either String MessageWithStackFrames+  :: Exception.SomeException -> Either String MessageWithStackFrames parseStringException = parse' stringExceptionParser  -- brittany-disable-next-binding  errorCallParser :: Parser MessageWithStackFrames-errorCallParser = MessageWithStackFrames+errorCallParser =+  MessageWithStackFrames     <$> messageParser     <*> manyTill stackFrameParser eof-  where-    messageParser :: Parser Text-    messageParser = do-        msg <- pack <$> manyTill anyChar eol-        msg <$ (string "CallStack (from HasCallStack):" *> eol)+ where+  messageParser :: Parser Text+  messageParser = do+    msg <- pack <$> manyTill anyChar eol+    msg <$ (string "CallStack (from HasCallStack):" *> eol) -    stackFrameParser :: Parser StackFrame-    stackFrameParser = do-        func <- stackFrameFunctionTill $ string ", called at "-        (path, ln, cl) <- stackFrameLocationTill $ eol <|> eof+  stackFrameParser :: Parser StackFrame+  stackFrameParser = do+    func <- stackFrameFunctionTill $ string ", called at "+    (path, ln, cl) <- stackFrameLocationTill $ eol <|> eof -        pure defaultStackFrame-            { stackFrame_file = pack path-            , stackFrame_lineNumber = ln-            , stackFrame_columnNumber = Just cl-            , stackFrame_method = func-            , stackFrame_inProject = Just True-            , stackFrame_code = Nothing-            }+    pure+      defaultStackFrame+        { stackFrame_file = pack path+        , stackFrame_lineNumber = ln+        , stackFrame_columnNumber = Just cl+        , stackFrame_method = func+        , stackFrame_inProject = Just True+        , stackFrame_code = Nothing+        }  -- brittany-disable-next-binding  stringExceptionParser :: Parser MessageWithStackFrames-stringExceptionParser = MessageWithStackFrames+stringExceptionParser =+  MessageWithStackFrames     <$> messageParser     <*> manyTill stackFrameParser eof-  where-    messageParser :: Parser Text-    messageParser = do-        manyTill anyChar (try $ string "throwString called with:") *> eol *> eol-        pack <$> manyTill anyChar (try $ eol *> string "Called from:" *> eol)+ where+  messageParser :: Parser Text+  messageParser = do+    manyTill anyChar (try $ string "throwString called with:") *> eol *> eol+    pack <$> manyTill anyChar (try $ eol *> string "Called from:" *> eol) -    stackFrameParser :: Parser StackFrame-    stackFrameParser = do-        func <- stackFrameFunctionTill $ string " ("-        (path, ln, cl) <- stackFrameLocationTill $ char ')' *> eol <|> eof+  stackFrameParser :: Parser StackFrame+  stackFrameParser = do+    func <- stackFrameFunctionTill $ string " ("+    (path, ln, cl) <- stackFrameLocationTill $ char ')' *> eol <|> eof -        pure defaultStackFrame-            { stackFrame_file = pack path-            , stackFrame_lineNumber = ln-            , stackFrame_columnNumber = Just cl-            , stackFrame_method = func-            , stackFrame_inProject = Just True-            , stackFrame_code = Nothing-            }+    pure+      defaultStackFrame+        { stackFrame_file = pack path+        , stackFrame_lineNumber = ln+        , stackFrame_columnNumber = Just cl+        , stackFrame_method = func+        , stackFrame_inProject = Just True+        , stackFrame_code = Nothing+        }  stackFrameFunctionTill :: Parser a -> Parser Text stackFrameFunctionTill p = spaces *> (pack <$> manyTill anyChar p)  stackFrameLocationTill :: Parser a -> Parser (FilePath, Int, Int) stackFrameLocationTill p = do-    result <--        (,,)-        <$> manyTill anyChar (char ':')-        <*> (read <$> manyTill digit (char ':'))-        <*> (read <$> manyTill digit (char ' '))+  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 p-    pure result+  -- 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 p+  pure result  parse'-    :: Exception.Exception e-    => Parser MessageWithStackFrames-    -> e-    -> Either String MessageWithStackFrames+  :: Exception.Exception e+  => Parser MessageWithStackFrames+  -> e+  -> Either String MessageWithStackFrames parse' p = first show . parse (p <* eof) "<error>" . show  eol :: Parser ()

@@ -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 <https://bugsnagerrorreportingapi.docs.apiary.io/#reference/0/notify/send-error-reports>+--+-- @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": {+-- >         ...+-- >     }+-- > }

@@ -1,51 +1,75 @@ module Network.Bugsnag.Notify-    ( notifyBugsnag-    , notifyBugsnagWith-    ) where+  ( notifyBugsnag+  , notifyBugsnagWith+  ) where  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 () notifyBugsnag = notifyBugsnagWith mempty  notifyBugsnagWith-    :: Exception.Exception e => BeforeNotify -> Settings -> e -> IO ()+  :: Exception.Exception e => BeforeNotify -> Settings -> e -> IO () notifyBugsnagWith f settings = reportEvent settings . buildEvent bn-    where bn = f <> globalBeforeNotify settings+ where+  bn = f <> globalBeforeNotify settings  reportEvent :: Settings -> Event -> IO () reportEvent Settings {..} event = unless (null $ event_exceptions event) $ do-    m <- getGlobalManager-    result <- sendEvents m settings_apiKey [event]-    either settings_onNotifyException pure result+  m <- getGlobalManager+  result <- sendEvents m settings_apiKey [event]+  either settings_onNotifyException pure result  buildEvent :: Exception.Exception e => BeforeNotify -> e -> Event-buildEvent bn e = runBeforeNotify bn e-    $ defaultEvent { event_exceptions = [ex] }-    where ex = bugsnagExceptionFromSomeException $ Exception.toException e+buildEvent bn e =+  runBeforeNotify bn e $+    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)-        <> settings_beforeNotify-        <> maybe mempty setStackFramesCode settings_codeIndex-        <> updateEvent setApp-  where-    ignoreException e-        | settings_releaseStage `notElem` settings_enabledReleaseStages = True-        | otherwise = settings_ignoreException e+  filterExceptions (not . ignoreException)+    <> settings_beforeNotify+    <> maybe mempty setStackFramesCode settings_codeIndex+    <> updateEvent setApp+ where+  ignoreException e+    | settings_releaseStage `notElem` settings_enabledReleaseStages = True+    | otherwise = settings_ignoreException e -    setApp event = event-        { event_app = Just $ defaultApp-            { app_version = settings_appVersion-            , app_releaseStage = Just settings_releaseStage-            }-        }+  setApp event =+    event+      { event_app =+          Just $+            defaultApp+              { app_version = settings_appVersion+              , app_releaseStage = Just settings_releaseStage+              }+      }

@@ -2,9 +2,9 @@ {-# LANGUAGE TemplateHaskell #-}  module Network.Bugsnag.StackFrame-    ( attachBugsnagCode-    , currentStackFrame-    ) where+  ( attachBugsnagCode+  , currentStackFrame+  ) where  import Prelude @@ -20,27 +20,28 @@ -- -- Looks up the content in the Index by File/LineNumber and, if found, sets it -- on the record.--- attachBugsnagCode :: CodeIndex -> StackFrame -> StackFrame-attachBugsnagCode index sf = sf-    { stackFrame_code = findBugsnagCode-        (unpack $ stackFrame_file sf)-        (stackFrame_lineNumber sf)-        index+attachBugsnagCode index sf =+  sf+    { stackFrame_code =+        findBugsnagCode+          (unpack $ stackFrame_file sf)+          (stackFrame_lineNumber sf)+          index     }  findBugsnagCode :: FilePath -> Int -> CodeIndex -> Maybe (HashMap Int Text)-findBugsnagCode path n = fmap HashMap.fromList+findBugsnagCode path n =+  fmap HashMap.fromList     . findSourceRange path (begin, n + 3)-  where-    begin-        | n < 3 = 0-        | otherwise = n - 3+ where+  begin+    | n < 3 = 0+    | otherwise = n - 3  -- | Construct a 'StackFrame' from the point of this splice -- -- Unfortunately there's no way to know the function, so that must be given:--- currentStackFrame :: Q Exp currentStackFrame = [|locStackFrame $(qLocation >>= liftLoc)|] @@ -48,26 +49,28 @@  locStackFrame :: Loc -> Text -> StackFrame locStackFrame (Loc path _ _ (ls, cs) _) func =-    defaultStackFrame-        { stackFrame_file = pack path-        , stackFrame_lineNumber = ls-        , stackFrame_columnNumber = Just cs-        , stackFrame_method = func-        , stackFrame_inProject = Just True-        -- N.B. this assumes we're unlikely to see adoption within libraries, or-        -- that such a thing would even work. If this function's used, it's-        -- assumed to be in end-user code.-        , stackFrame_code = Nothing-        }+  defaultStackFrame+    { stackFrame_file = pack path+    , stackFrame_lineNumber = ls+    , stackFrame_columnNumber = Just cs+    , stackFrame_method = func+    , stackFrame_inProject = Just True+    , -- N.B. this assumes we're unlikely to see adoption within libraries, or+      -- that such a thing would even work. If this function's used, it's+      -- assumed to be in end-user code.+      stackFrame_code = Nothing+    }  -- brittany-disable-next-binding  -- Taken from monad-logger liftLoc :: Loc -> Q Exp-liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc-    $(lift a)-    $(lift b)-    $(lift c)-    ($(lift d1), $(lift d2))-    ($(lift e1), $(lift e2))+liftLoc (Loc a b c (d1, d2) (e1, e2)) =+  [|+    Loc+      $(lift a)+      $(lift b)+      $(lift c)+      ($(lift d1), $(lift d2))+      ($(lift e1), $(lift e2))     |]

@@ -6,12 +6,12 @@ -- These are used in the test suite but are define here so that, hopefully, the -- path/line/column will remain stable even if we re-organize the tests -- themselves--- module Examples where  import Prelude  import Control.Exception+import Control.Exception.Annotated (checkpointCallStack) import Data.Bugsnag import GHC.Stack (HasCallStack) import Network.Bugsnag.Exception@@ -19,11 +19,14 @@ import UnliftIO.Exception (throwString)  brokenFunctionIO :: IO a-brokenFunctionIO = throw $ AsException $ defaultException-    { exception_errorClass = "IOException"-    , exception_message = Just "Something exploded"-    , exception_stacktrace = [$(currentStackFrame) "brokenFunctionIO"]-    }+brokenFunctionIO =+  throw $+    AsException $+      defaultException+        { exception_errorClass = "IOException"+        , exception_message = Just "Something exploded"+        , exception_stacktrace = [$(currentStackFrame) "brokenFunctionIO"]+        }  brokenFunction :: HasCallStack => a brokenFunction = sillyHead [] `seq` undefined@@ -45,3 +48,6 @@ 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' []

@@ -1,7 +1,6 @@ module Network.Bugsnag.BeforeNotifySpec-    ( spec-    ) where-+  ( spec+  ) where  import Prelude @@ -11,34 +10,36 @@ import Test.Hspec  data FooException = FooException-    deriving stock Show-    deriving anyclass Exception+  deriving stock (Show)+  deriving anyclass (Exception)  data BarException = BarException-    deriving stock Show-    deriving anyclass Exception+  deriving stock (Show)+  deriving anyclass (Exception)  data BazException = BazException-    deriving stock Show-    deriving anyclass Exception+  deriving stock (Show)+  deriving anyclass (Exception)  spec :: Spec spec = do-    describe "updateEventFromOriginalException" $ do-        it "can update based on unknown exception types" $ do-            let asFoo FooException = setGroupingHash "Saw Foo"-                asBar BarException = setGroupingHash "Saw Bar"+  describe "updateEventFromOriginalException" $ do+    it "can update based on unknown exception types" $ do+      let+        asFoo FooException = setGroupingHash "Saw Foo"+        asBar BarException = setGroupingHash "Saw Bar" -                bn = mconcat-                    [ updateEventFromOriginalException asFoo-                    , updateEventFromOriginalException asBar-                    ]+        bn =+          mconcat+            [ updateEventFromOriginalException asFoo+            , updateEventFromOriginalException asBar+            ] -            event_groupingHash (runBeforeNotify bn FooException defaultEvent)-                `shouldBe` Just "Saw Foo"+      event_groupingHash (runBeforeNotify bn FooException defaultEvent)+        `shouldBe` Just "Saw Foo" -            event_groupingHash (runBeforeNotify bn BarException defaultEvent)-                `shouldBe` Just "Saw Bar"+      event_groupingHash (runBeforeNotify bn BarException defaultEvent)+        `shouldBe` Just "Saw Bar" -            event_groupingHash (runBeforeNotify bn BazException defaultEvent)-                `shouldBe` Nothing+      event_groupingHash (runBeforeNotify bn BazException defaultEvent)+        `shouldBe` Nothing

@@ -2,8 +2,8 @@ {-# OPTIONS_GHC -fno-warn-missing-local-signatures #-}  module Network.Bugsnag.CodeIndexSpec-    ( spec-    ) where+  ( spec+  ) where  import Prelude @@ -12,34 +12,37 @@  spec :: Spec spec = do-    describe "CodeIndex" $ do-        let index = $(buildCodeIndex "test/fixtures/index-project/**/*.hs")+  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")-                    ]+    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+      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")]+    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+      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)+    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 []+      findSourceRange path range index `shouldBe` Just [] -        it "handles missing files" $ do-            findSourceRange "nope.hs" (0, 3) index `shouldBe` Nothing+    it "handles missing files" $ do+      findSourceRange "nope.hs" (0, 3) index `shouldBe` Nothing

@@ -1,23 +1,22 @@ module Network.Bugsnag.DeviceSpec-    ( spec-    ) where+  ( spec+  ) where  import Prelude -import Data.Bugsnag (Device(..))+import Data.Bugsnag (Device (..)) import Network.Bugsnag.Device import Test.Hspec  spec :: Spec spec = do-    describe "bugsnagDeviceFromUserAgent" $ do-        it "best-effort sniffs from UserAgent" $ do-            let-                device =-                    bugsnagDeviceFromUserAgent-                        "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/64.0.3282.119 Safari/537.36"+  describe "bugsnagDeviceFromUserAgent" $ do+    it "best-effort sniffs from UserAgent" $ do+      let device =+            bugsnagDeviceFromUserAgent+              "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/64.0.3282.119 Safari/537.36" -            device_osName device `shouldBe` Just "Linux"-            device_osVersion device `shouldBe` Nothing-            device_browserName device `shouldBe` Just "Chrome"-            device_browserVersion device `shouldBe` Just "64.0.3282"+      device_osName device `shouldBe` Just "Linux"+      device_osVersion device `shouldBe` Nothing+      device_browserName device `shouldBe` Just "Chrome"+      device_browserVersion device `shouldBe` Just "64.0.3282"

@@ -1,6 +1,6 @@ module Network.Bugsnag.ExceptionSpec-    ( spec-    ) where+  ( spec+  ) where  import Prelude @@ -12,85 +12,104 @@  spec :: Spec spec = do-    describe "AsException" $ do-        it "can throw and catch a Bugsnag.Exception" $ do-            AsException ex <- brokenFunctionIO `catch` pure+  describe "AsException" $ do+    it "can throw and catch a Bugsnag.Exception" $ do+      AsException ex <- brokenFunctionIO `catch` pure -            exception_errorClass ex `shouldBe` "IOException"-            exception_message ex `shouldBe` Just "Something exploded"-            exception_stacktrace ex `shouldSatisfy` (not . null)+      exception_errorClass ex `shouldBe` "IOException"+      exception_message ex `shouldBe` Just "Something exploded"+      exception_stacktrace ex `shouldSatisfy` (not . null) -            let frame = head $ exception_stacktrace ex-            stackFrame_file frame `shouldBe` "test/Examples.hs"-            stackFrame_lineNumber frame `shouldBe` 25-            -- different versions of GHC disagree on where splices start-            stackFrame_columnNumber frame-                `shouldSatisfy` (`elem` [Just 32, Just 33])-            stackFrame_method frame `shouldBe` "brokenFunctionIO"-            stackFrame_inProject frame `shouldBe` Just True+      let frame = head $ exception_stacktrace ex+      stackFrame_file frame `shouldBe` "test/Examples.hs"+      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"+  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)"+      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+    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 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` 33-                stackFrame_columnNumber frame `shouldBe` Just 15-                stackFrame_method frame `shouldBe` "error"+      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"]+      map stackFrame_method (exception_stacktrace ex)+        `shouldBe` ["error", "sillyHead", "brokenFunction"] -            it "also parses StringException" $ do-                e <- brokenFunction' `catch` pure+    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 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` 40-                stackFrame_columnNumber frame `shouldBe` Just 16-                stackFrame_method frame `shouldBe` "throwString"+      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'"]+      map stackFrame_method (exception_stacktrace ex)+        `shouldBe` ["throwString", "sillyHead'", "brokenFunction'"] -            it "also parses StringExceptions with newlines" $ do-                e <- brokenFunction'' `catch` pure+    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 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` 47-                stackFrame_columnNumber frame `shouldBe` Just 17-                stackFrame_method frame `shouldBe` "throwString"+      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''"-                               ]+      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"+                   ]

@@ -1,2 +1,2 @@-{-# OPTIONS_GHC -Wno-missing-export-lists #-} {-# OPTIONS_GHC -F -pgmF hspec-discover #-}+{-# OPTIONS_GHC -Wno-missing-export-lists #-}

@@ -1,7 +1,7 @@ module Foo where  data What = What-    deriving Show+  deriving (Show)  what :: Int -> Maybe What what 0 = Just What