Skip to content

Commit 39b21f6

Browse files
natefaubionnatefaubion
committed
Cancellation
1 parent a147466 commit 39b21f6

File tree

2 files changed

+57
-29
lines changed

2 files changed

+57
-29
lines changed

‎src/Control/Monad/Eff/AVar.purs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -39,28 +39,28 @@ foreign import isEmptyVar ∷ ∀ eff a. AVar a → AVarEff eff Boolean
3939
killVar ∷ ∀ eff a. AVar a → Error → AVarEff eff Unit
4040
killVar avar err = Fn.runFn4 _killVar Left Right avar err
4141

42-
putVar ∷ ∀ eff a. AVar a → a → AVarCallback eff Unit → AVarEff eff Unit
42+
putVar ∷ ∀ eff a. AVar a → a → AVarCallback eff Unit → AVarEff eff (AVarEff eff Unit)
4343
putVar avar value cb = Fn.runFn5 _putVar Left Right avar value cb
4444

4545
tryPutVar ∷ ∀ eff a. AVar a → a → AVarEff eff Boolean
4646
tryPutVar avar value = Fn.runFn4 _tryPutVar Left Right avar value
4747

48-
takeVar ∷ ∀ eff a. AVar a → AVarCallback eff a → AVarEff eff Unit
48+
takeVar ∷ ∀ eff a. AVar a → AVarCallback eff a → AVarEff eff (AVarEff eff Unit)
4949
takeVar avar cb = Fn.runFn4 _takeVar Left Right avar cb
5050

5151
tryTakeVar ∷ ∀ eff a. AVar a → AVarEff eff (Maybe a)
5252
tryTakeVar avar = Fn.runFn5 _tryTakeVar Left Right Nothing Just avar
5353

54-
readVar ∷ ∀ eff a. AVar a → AVarCallback eff a → AVarEff eff Unit
54+
readVar ∷ ∀ eff a. AVar a → AVarCallback eff a → AVarEff eff (AVarEff eff Unit)
5555
readVar avar cb = Fn.runFn4 _readVar Left Right avar cb
5656

5757
tryReadVar ∷ ∀ eff a. AVar a → AVarEff eff (Maybe a)
5858
tryReadVar avar = Fn.runFn3 _tryReadVar Nothing Just avar
5959

6060
foreign import _killVar ∷ ∀ eff a. Fn.Fn4 (Error → Either Error a) (a → Either Error a) (AVar a) Error (AVarEff eff Unit)
61-
foreign import _putVar ∷ ∀ eff a. Fn.Fn5 (Error → Either Error a) (a → Either Error a) (AVar a) a (AVarCallback eff Unit) (AVarEff eff Unit)
61+
foreign import _putVar ∷ ∀ eff a. Fn.Fn5 (Error → Either Error a) (a → Either Error a) (AVar a) a (AVarCallback eff Unit) (AVarEff eff (AVarEff eff Unit))
6262
foreign import _tryPutVar ∷ ∀ eff a. Fn.Fn4 (Error → Either Error a) (a → Either Error a) (AVar a) a (AVarEff eff Boolean)
63-
foreign import _takeVar ∷ ∀ eff a. Fn.Fn4 (Error → Either Error a) (a → Either Error a) (AVar a) (AVarCallback eff a) (AVarEff eff Unit)
63+
foreign import _takeVar ∷ ∀ eff a. Fn.Fn4 (Error → Either Error a) (a → Either Error a) (AVar a) (AVarCallback eff a) (AVarEff eff (AVarEff eff Unit))
6464
foreign import _tryTakeVar ∷ ∀ eff a. Fn.Fn5 (Error → Either Error a) (a → Either Error a) (Maybe a) (a → Maybe a) (AVar a) (AVarEff eff (Maybe a))
65-
foreign import _readVar ∷ ∀ eff a. Fn.Fn4 (Error → Either Error a) (a → Either Error a) (AVar a) (AVarCallback eff a) (AVarEff eff Unit)
65+
foreign import _readVar ∷ ∀ eff a. Fn.Fn4 (Error → Either Error a) (a → Either Error a) (AVar a) (AVarCallback eff a) (AVarEff eff (AVarEff eff Unit))
6666
foreign import _tryReadVar ∷ ∀ eff a. Fn.Fn3 (Maybe a) (a → Maybe a) (AVar a) (AVarEff eff (Maybe a))

‎test/Main.purs

Lines changed: 51 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -61,78 +61,78 @@ test_put_take ∷ TestEff Unit
6161
test_put_take = test "put/take" do
6262
ref ← newRef ""
6363
var ← makeEmptyVar
64-
putVar var "foo" $ traverse_ \_ →
64+
_ ← putVar var "foo" $ traverse_ \_ →
6565
modifyRef ref (_ <> "bar")
66-
takeVar var $ traverse_ \val →
66+
_ ← takeVar var $ traverse_ \val →
6767
modifyRef ref (_ <> val)
6868
eq "barfoo" <$> readRef ref
6969

7070
test_put_read_take ∷ TestEff Unit
7171
test_put_read_take = test "put/read/take" do
7272
ref ← newRef ""
7373
var ← makeEmptyVar
74-
putVar var "foo" $ traverse_ \_ →
74+
_ ← putVar var "foo" $ traverse_ \_ →
7575
modifyRef ref (_ <> "bar")
76-
readVar var $ traverse_ \val →
76+
_ ← readVar var $ traverse_ \val →
7777
modifyRef ref (_ <> val <> "baz")
78-
takeVar var $ traverse_ \val →
78+
_ ← takeVar var $ traverse_ \val →
7979
modifyRef ref (_ <> val)
8080
eq "foobazfoobar" <$> readRef ref
8181

8282
test_take_put ∷ TestEff Unit
8383
test_take_put = test "take/put" do
8484
ref ← newRef ""
8585
var ← makeEmptyVar
86-
takeVar var $ traverse_ \val →
86+
_ ← takeVar var $ traverse_ \val →
8787
modifyRef ref (_ <> val)
88-
putVar var "foo" $ traverse_ \_ →
88+
_ ← putVar var "foo" $ traverse_ \_ →
8989
modifyRef ref (_ <> "bar")
9090
eq "foobar" <$> readRef ref
9191

9292
test_take_read_put ∷ TestEff Unit
9393
test_take_read_put = test "take/read/put" do
9494
ref ← newRef ""
9595
var ← makeEmptyVar
96-
takeVar var $ traverse_ \val →
96+
_ ← takeVar var $ traverse_ \val →
9797
modifyRef ref (_ <> val)
98-
readVar var $ traverse_ \val →
98+
_ ← readVar var $ traverse_ \val →
9999
modifyRef ref (_ <> val <> "baz")
100-
putVar var "foo" $ traverse_ \_ →
100+
_ ← putVar var "foo" $ traverse_ \_ →
101101
modifyRef ref (_ <> "bar")
102102
eq "foobazfoobar" <$> readRef ref
103103

104104
test_read_put_take ∷ TestEff Unit
105105
test_read_put_take = test "read/put/take" do
106106
ref ← newRef ""
107107
var ← makeEmptyVar
108-
readVar var $ traverse_ \val →
108+
_ ← readVar var $ traverse_ \val →
109109
modifyRef ref (_ <> val <> "baz")
110-
putVar var "foo" $ traverse_ \_ →
110+
_ ← putVar var "foo" $ traverse_ \_ →
111111
modifyRef ref (_ <> "bar")
112-
takeVar var $ traverse_ \val → do
112+
_ ← takeVar var $ traverse_ \val → do
113113
modifyRef ref (_ <> val)
114114
eq "foobazbarfoo" <$> readRef ref
115115

116116
test_read_take_put ∷ TestEff Unit
117117
test_read_take_put = test "read/take/put" do
118118
ref ← newRef ""
119119
var ← makeEmptyVar
120-
readVar var $ traverse_ \val → do
120+
_ ← readVar var $ traverse_ \val → do
121121
modifyRef ref (_ <> val <> "baz")
122-
takeVar var $ traverse_ \val' →
122+
void $ takeVar var $ traverse_ \val' →
123123
modifyRef ref (_ <> val')
124-
putVar var "foo" $ traverse_ \_ →
124+
_ ← putVar var "foo" $ traverse_ \_ →
125125
modifyRef ref (_ <> "bar")
126126
eq "foobazbarfoo" <$> readRef ref
127127

128128
test_kill_full ∷ TestEff Unit
129129
test_kill_full = test "kill/full" do
130130
ref ← newRef ""
131131
var ← makeEmptyVar
132-
putVar var "foo" $ traverse_ \_ →
132+
_ ← putVar var "foo" $ traverse_ \_ →
133133
modifyRef ref (_ <> "bar")
134134
killVar var (error "Die.")
135-
readVar var case _ of
135+
_ ← readVar var case _ of
136136
Left err → modifyRef ref (_ <> message err)
137137
Right _ → modifyRef ref (_ <> "BAD")
138138
eq "barDie." <$> readRef ref
@@ -142,7 +142,7 @@ test_kill_empty = test "kill/empty" do
142142
ref ← newRef ""
143143
var ← makeEmptyVar
144144
killVar var (error "Die.")
145-
readVar var case _ of
145+
_ ← readVar var case _ of
146146
Left err → modifyRef ref (_ <> message err)
147147
Right _ → modifyRef ref (_ <> "BAD")
148148
eq "Die." <$> readRef ref
@@ -155,13 +155,40 @@ test_kill_pending = test "kill/pending" do
155155
cb s = case _ of
156156
Left err → modifyRef ref (_ <> s <> message err)
157157
Right _ → modifyRef ref (_ <> "BAD")
158-
takeVar var (cb "a")
159-
takeVar var (cb "b")
160-
readVar var (cb "c")
161-
readVar var (cb "d")
158+
_ ← takeVar var (cb "a")
159+
_ ← takeVar var (cb "b")
160+
_ ← readVar var (cb "c")
161+
_ ← readVar var (cb "d")
162162
killVar var (error "-die.")
163163
eq "c-die.d-die.a-die.b-die." <$> readRef ref
164164

165+
test_cancel ∷ TestEff Unit
166+
test_cancel = test "cancel" do
167+
ref ← newRef ""
168+
v1 ← makeVar ""
169+
c1 ← putVar v1 "a" $ traverse_ \_ → modifyRef ref (_ <> "a")
170+
c2 ← putVar v1 "b" $ traverse_ \_ → modifyRef ref (_ <> "b")
171+
c3 ← putVar v1 "c" $ traverse_ \_ → modifyRef ref (_ <> "c")
172+
c2
173+
_ ← tryTakeVar v1
174+
_ ← tryTakeVar v1
175+
_ ← tryTakeVar v1
176+
v2 ← makeEmptyVar
177+
c4 ← takeVar v2 $ traverse_ \_ → modifyRef ref (_ <> "d")
178+
c5 ← takeVar v2 $ traverse_ \_ → modifyRef ref (_ <> "e")
179+
c6 ← takeVar v2 $ traverse_ \_ → modifyRef ref (_ <> "f")
180+
c5
181+
_ ← tryPutVar v2 "a"
182+
_ ← tryPutVar v2 "b"
183+
_ ← tryPutVar v2 "c"
184+
v3 ← makeEmptyVar
185+
c7 ← readVar v3 $ traverse_ \_ → modifyRef ref (_ <> "g")
186+
c8 ← readVar v3 $ traverse_ \_ → modifyRef ref (_ <> "h")
187+
c9 ← readVar v3 $ traverse_ \_ → modifyRef ref (_ <> "i")
188+
c8
189+
_ ← tryPutVar v3 "a"
190+
eq "acdfgi" <$> readRef ref
191+
165192
main ∷ TestEff Unit
166193
main = do
167194
test_tryRead_full
@@ -178,3 +205,4 @@ main = do
178205
test_kill_full
179206
test_kill_empty
180207
test_kill_pending
208+
test_cancel

0 commit comments

Comments
 (0)