summaryrefslogtreecommitdiff
path: root/test/Network/BugsnagSpec.hs
blob: 59de9bab4849785a741b1a09a36251acdae5e0f9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.BugsnagSpec
    ( spec
    ) where

import Test.Hspec

import Control.Exception
import Network.Bugsnag
import UnliftIO.Exception (throwString)

brokenFunctionIO :: IO a
brokenFunctionIO = throw $ bugsnagException
    "IOException"
    "Something exploded"
    [$(currentStackFrame) "brokenFunctionIO"]

brokenFunction :: HasCallStack => a
brokenFunction = sillyHead [] `seq` undefined

sillyHead :: HasCallStack => [a] -> a
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"

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
        it "can be thrown and caught" $ do
            ex <- brokenFunctionIO `catch` pure

            beErrorClass ex `shouldBe` "IOException"
            beMessage ex `shouldBe` Just "Something exploded"
            beStacktrace ex `shouldSatisfy` (not . null)

            let frame = head $ beStacktrace ex
            bsfFile frame `shouldBe` "test/Network/BugsnagSpec.hs"
            bsfLineNumber frame `shouldBe` 19
            bsfColumnNumber frame `shouldBe` Just 8
            bsfMethod frame `shouldBe` "brokenFunctionIO"
            bsfInProject frame `shouldBe` Just True

        describe "bugsnagExceptionFromSomeException" $ do
            it "can parse errors with callstacks" $ do
                e <- evaluate brokenFunction `catch` pure

                let ex = bugsnagExceptionFromSomeException e
                beErrorClass ex `shouldBe` "ErrorCall"
                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` 26
                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` "StringException"
                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` 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` "StringException"
                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''"
                               ]