@@ -3,16 +3,23 @@ module Control.Monad.Eff.AVar
3
3
, AVAR
4
4
, AVarEff
5
5
, AVarCallback
6
+ , AVarStatus (..)
6
7
, makeVar
7
8
, makeEmptyVar
8
- , isEmptyVar
9
9
, takeVar
10
10
, tryTakeVar
11
11
, putVar
12
12
, tryPutVar
13
13
, readVar
14
14
, tryReadVar
15
15
, killVar
16
+ , status
17
+ , isEmptyVar
18
+ , isFilledVar
19
+ , isKilledVar
20
+ , isEmpty
21
+ , isFilled
22
+ , isKilled
16
23
) where
17
24
18
25
import Prelude
@@ -30,59 +37,114 @@ foreign import data AVar ∷ Type → Type
30
37
31
38
foreign import data AVAR ∷ Effect
32
39
40
+ data AVarStatus a
41
+ = Killed Error
42
+ | Filled a
43
+ | Empty
44
+
33
45
-- | Creates a fresh AVar.
34
46
foreign import makeEmptyVar ∷ ∀ eff a . AVarEff eff (AVar a )
35
47
36
48
-- | Creates a fresh AVar with an initial value.
37
49
foreign import makeVar ∷ ∀ eff a . a → AVarEff eff (AVar a )
38
50
39
- -- | Synchronously checks whether an AVar currently has a value.
40
- foreign import isEmptyVar ∷ ∀ eff a . AVar a → AVarEff eff Boolean
41
-
42
51
-- | Kills the AVar with an exception. All pending and future actions will
43
52
-- | resolve immediately with the provided exception.
44
- killVar ∷ ∀ eff a . AVar a → Error → AVarEff eff Unit
45
- killVar avar err = Fn .runFn4 _killVar Left Right avar err
53
+ killVar ∷ ∀ eff a . Error → AVar a → AVarEff eff Unit
54
+ killVar err avar = Fn .runFn3 _killVar ffiUtil err avar
46
55
47
56
-- | Sets the value of the AVar. If the AVar is already filled, it will be
48
57
-- | queued until the value is emptied. Multiple puts will resolve in order as
49
58
-- | the AVar becomes available. Returns an effect which will remove the
50
59
-- | callback from the pending queue.
51
- putVar ∷ ∀ eff a . AVar a → a → AVarCallback eff Unit → AVarEff eff (AVarEff eff Unit )
52
- putVar avar value cb = Fn .runFn5 _putVar Left Right avar value cb
60
+ putVar ∷ ∀ eff a . a → AVar a → AVarCallback eff Unit → AVarEff eff (AVarEff eff Unit )
61
+ putVar value avar cb = Fn .runFn4 _putVar ffiUtil value avar cb
53
62
54
63
-- | Attempts to synchronously fill an AVar. If the AVar is already filled,
55
64
-- | this will do nothing. Returns true or false depending on if it succeeded.
56
- tryPutVar ∷ ∀ eff a . AVar a → a → AVarEff eff Boolean
57
- tryPutVar avar value = Fn .runFn4 _tryPutVar Left Right avar value
65
+ tryPutVar ∷ ∀ eff a . a → AVar a → AVarEff eff Boolean
66
+ tryPutVar value avar = Fn .runFn3 _tryPutVar ffiUtil value avar
58
67
59
68
-- | Takes the AVar value, leaving it empty. If the AVar is already empty,
60
69
-- | the callback will be queued until the AVar is filled. Multiple takes will
61
70
-- | resolve in order as the AVar fills. Returns an effect which will remove
62
71
-- | the callback from the pending queue.
63
72
takeVar ∷ ∀ eff a . AVar a → AVarCallback eff a → AVarEff eff (AVarEff eff Unit )
64
- takeVar avar cb = Fn .runFn4 _takeVar Left Right avar cb
73
+ takeVar avar cb = Fn .runFn3 _takeVar ffiUtil avar cb
65
74
66
75
-- | Attempts to synchronously take an AVar value, leaving it empty. If the
67
76
-- | AVar is empty, this will return `Nothing`.
68
77
tryTakeVar ∷ ∀ eff a . AVar a → AVarEff eff (Maybe a )
69
- tryTakeVar avar = Fn .runFn5 _tryTakeVar Left Right Nothing Just avar
78
+ tryTakeVar avar = Fn .runFn2 _tryTakeVar ffiUtil avar
70
79
71
80
-- | Reads the AVar value. Unlike `takeVar`, this will not leave the AVar empty.
72
81
-- | If the AVar is empty, this will queue until it is filled. Multiple reads
73
82
-- | will resolve at the same time, as soon as possible.
74
83
readVar ∷ ∀ eff a . AVar a → AVarCallback eff a → AVarEff eff (AVarEff eff Unit )
75
- readVar avar cb = Fn .runFn4 _readVar Left Right avar cb
84
+ readVar avar cb = Fn .runFn3 _readVar ffiUtil avar cb
76
85
77
86
-- | Attempts to synchronously read an AVar. If the AVar is empty, this will
78
87
-- | return `Nothing`.
79
88
tryReadVar ∷ ∀ eff a . AVar a → AVarEff eff (Maybe a )
80
- tryReadVar avar = Fn .runFn3 _tryReadVar Nothing Just avar
81
-
82
- foreign import _killVar ∷ ∀ eff a . Fn.Fn4 (∀ x y . x → Either x y ) (∀ x y . y → Either x y ) (AVar a ) Error (AVarEff eff Unit )
83
- foreign import _putVar ∷ ∀ eff a . Fn.Fn5 (∀ x y . x → Either x y ) (∀ x y . y → Either x y ) (AVar a ) a (AVarCallback eff Unit ) (AVarEff eff (AVarEff eff Unit ))
84
- foreign import _tryPutVar ∷ ∀ eff a . Fn.Fn4 (∀ x y . x → Either x y ) (∀ x y . y → Either x y ) (AVar a ) a (AVarEff eff Boolean )
85
- foreign import _takeVar ∷ ∀ eff a . Fn.Fn4 (∀ x y . x → Either x y ) (∀ x y . y → Either x y ) (AVar a ) (AVarCallback eff a ) (AVarEff eff (AVarEff eff Unit ))
86
- foreign import _tryTakeVar ∷ ∀ eff a . Fn.Fn5 (∀ x y . x → Either x y ) (∀ x y . y → Either x y ) (Maybe a ) (a → Maybe a ) (AVar a ) (AVarEff eff (Maybe a ))
87
- foreign import _readVar ∷ ∀ eff a . Fn.Fn4 (∀ x y . x → Either x y ) (∀ x y . y → Either x y ) (AVar a ) (AVarCallback eff a ) (AVarEff eff (AVarEff eff Unit ))
88
- foreign import _tryReadVar ∷ ∀ eff a . Fn.Fn3 (Maybe a ) (a → Maybe a ) (AVar a ) (AVarEff eff (Maybe a ))
89
+ tryReadVar avar = Fn .runFn2 _tryReadVar ffiUtil avar
90
+
91
+ -- | Synchronously checks the status of an AVar.
92
+ status ∷ ∀ eff a . AVar a → AVarEff eff (AVarStatus a )
93
+ status avar = Fn .runFn2 _status ffiUtil avar
94
+
95
+ -- | Synchronously checks whether an AVar currently is empty.
96
+ isEmptyVar ∷ ∀ eff a . AVar a → AVarEff eff Boolean
97
+ isEmptyVar = map isEmpty <<< status
98
+
99
+ -- | Synchronously checks whether an AVar currently has a value.
100
+ isFilledVar ∷ ∀ eff a . AVar a → AVarEff eff Boolean
101
+ isFilledVar = map isFilled <<< status
102
+
103
+ -- | Synchronously checks whether an AVar has been killed.
104
+ isKilledVar ∷ ∀ eff a . AVar a → AVarEff eff Boolean
105
+ isKilledVar = map isKilled <<< status
106
+
107
+ isEmpty ∷ ∀ a . AVarStatus a → Boolean
108
+ isEmpty = case _ of
109
+ Empty → true
110
+ _ → false
111
+
112
+ isFilled ∷ ∀ a . AVarStatus a → Boolean
113
+ isFilled = case _ of
114
+ Filled _ → true
115
+ _ → false
116
+
117
+ isKilled ∷ ∀ a . AVarStatus a → Boolean
118
+ isKilled = case _ of
119
+ Killed _ → true
120
+ _ → false
121
+
122
+ foreign import _killVar ∷ ∀ eff a . Fn.Fn3 FFIUtil Error (AVar a ) (AVarEff eff Unit )
123
+ foreign import _putVar ∷ ∀ eff a . Fn.Fn4 FFIUtil a (AVar a ) (AVarCallback eff Unit ) (AVarEff eff (AVarEff eff Unit ))
124
+ foreign import _tryPutVar ∷ ∀ eff a . Fn.Fn3 FFIUtil a (AVar a ) (AVarEff eff Boolean )
125
+ foreign import _takeVar ∷ ∀ eff a . Fn.Fn3 FFIUtil (AVar a ) (AVarCallback eff a ) (AVarEff eff (AVarEff eff Unit ))
126
+ foreign import _tryTakeVar ∷ ∀ eff a . Fn.Fn2 FFIUtil (AVar a ) (AVarEff eff (Maybe a ))
127
+ foreign import _readVar ∷ ∀ eff a . Fn.Fn3 FFIUtil (AVar a ) (AVarCallback eff a ) (AVarEff eff (AVarEff eff Unit ))
128
+ foreign import _tryReadVar ∷ ∀ eff a . Fn.Fn2 FFIUtil (AVar a ) (AVarEff eff (Maybe a ))
129
+ foreign import _status ∷ ∀ eff a . Fn.Fn2 FFIUtil (AVar a ) (AVarEff eff (AVarStatus a ))
130
+
131
+ type FFIUtil =
132
+ { left ∷ ∀ a b . a → Either a b
133
+ , right ∷ ∀ a b . b → Either a b
134
+ , nothing ∷ ∀ a . Maybe a
135
+ , just ∷ ∀ a . a → Maybe a
136
+ , killed ∷ ∀ a . Error → AVarStatus a
137
+ , filled ∷ ∀ a . a → AVarStatus a
138
+ , empty ∷ ∀ a . AVarStatus a
139
+ }
140
+
141
+ ffiUtil ∷ FFIUtil
142
+ ffiUtil =
143
+ { left: Left
144
+ , right: Right
145
+ , nothing: Nothing
146
+ , just: Just
147
+ , killed: Killed
148
+ , filled: Filled
149
+ , empty: Empty
150
+ }
0 commit comments