-
Notifications
You must be signed in to change notification settings - Fork 3
/
AnnotatedSpec.hs
175 lines (143 loc) · 5.93 KB
/
AnnotatedSpec.hs
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# options_ghc -fno-warn-orphans -fno-warn-type-defaults #-}
module Control.Exception.AnnotatedSpec where
import Test.Hspec
import Control.Exception.Annotated
import qualified Control.Exception.Safe as Safe
data TextException = TestException
deriving (Eq, Show, Exception)
instance Eq SomeException where
e0 == e1 = show e0 == show e1
pass :: Expectation
pass = pure ()
spec :: Spec
spec = do
describe "AnnotatedException can fromException a" $ do
it "different type" $ do
fromException (toException TestException)
`shouldBe`
Just (new TestException)
it "SomeException" $ do
fromException (SomeException TestException)
`shouldBe`
Just (new (SomeException TestException))
it "nested AnnotatedException" $ do
fromException (toException (new (new TestException)))
`shouldBe`
Just (new TestException)
describe "throw" $ do
it "wraps exceptions" $ do
throw TestException
`shouldThrow`
\(AnnotatedException _ TestException) ->
True
describe "catch" $ do
it "catches located exceptions" $ do
Safe.throw TestException
`catch`
\(AnnotatedException [] TestException) ->
pass
it "catches regular exceptions" $ do
Safe.throw TestException
`catch`
\TestException ->
pass
it "catches SomeException" $ do
throw TestException
`catch`
\(SomeException _) ->
pass
it "catches located SomeExceptions" $ do
throw TestException
`catch`
\(AnnotatedException _ (_ :: SomeException)) ->
pass
describe "try" $ do
let subject :: (Exception e, Exception e') => e -> IO e'
subject exn = do
Left exn' <- try (throw exn)
pure exn'
describe "when throwing non-Annotated" $ do
it "can add an empty annotation for a non-Annotated exception" $ do
exn <- subject TestException
exn `shouldBe` AnnotatedException [] TestException
it "can catch a usual exception" $ do
exn <- subject TestException
exn `shouldBe` TestException
describe "when throwing Annotated" $ do
it "can catch a non-Annotated exception" $ do
exn <- subject $ new TestException
exn `shouldBe` TestException
it "can catch an Annotated exception" $ do
exn <- subject TestException
exn `shouldBe` new TestException
describe "nesting behavior" $ do
it "can catch at any level of nesting" $ do
subject TestException
>>= (`shouldBe` new TestException)
subject TestException
>>= (`shouldBe` new (new TestException))
subject TestException
>>= (`shouldBe` new (new (new TestException)))
describe "Safe.try" $ do
it "can catch a located exception" $ do
Left exn <- Safe.try (Safe.throw TestException)
exn `shouldBe` new TestException
it "does not catch an AnnotatedException" $ do
let action = do
Left exn <- Safe.try (Safe.throw $ new TestException)
exn `shouldBe` TestException
action `shouldThrow` (== new TestException)
describe "catches" $ do
it "is exported" $ do
let
_x :: IO a -> [Handler IO a] -> IO a
_x = catches
pass
describe "checkpoint" $ do
it "adds annotations" $ do
Left exn <- try (checkpoint "Here" (throw TestException))
exn `shouldBe` AnnotatedException ["Here"] TestException
it "adds two annotations" $ do
Left exn <- try $ do
checkpoint "Here" $ do
checkpoint "There" $ do
throw TestException
exn `shouldBe` AnnotatedException ["Here", "There"] TestException
it "adds three annotations" $ do
Left exn <- try $
checkpoint "Here" $
checkpoint "There" $
checkpoint "Everywhere" $
throw TestException
exn `shouldBe` AnnotatedException ["Here", "There", "Everywhere"] TestException
it "caught exceptions are propagated" $ do
eresp <- try $
checkpoint "Here" $
flip catch (\TestException -> pure "Hello") $
checkpoint "There" $
checkpoint "Everywhere" $
throw TestException
case eresp of
Left (AnnotatedException _ TestException) ->
expectationFailure "Should not be an exception"
Right resp ->
resp `shouldBe` "Hello"
it "works with error calls" $ do
eresp <- checkpoint "Yes" (error "Oh no") `catch`
\(SomeException _) -> pure "bar"
eresp `shouldBe` "bar"
it "works with non-handled exceptions" $ do
Left exn <- try $
checkpoint "Lmao" $
Safe.throw TestException
exn `shouldBe` AnnotatedException ["Lmao"] TestException
it "supports rethrowing" $ do
Left exn <- try $
checkpoint "A" $
flip catch (\TestException -> throw TestException) $
checkpoint "B" $
throw TestException
exn `shouldBe` AnnotatedException ["A", "B"] TestException