-
Notifications
You must be signed in to change notification settings - Fork 68
/
Aff.purs
236 lines (183 loc) · 8.84 KB
/
Aff.purs
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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
module Control.Monad.Aff
( Aff()
, Canceler(..)
, PureAff(..)
, apathize
, attempt
, cancel
, cancelWith
, finally
, forkAff
, forkAll
, later
, later'
, launchAff
, liftEff'
, makeAff
, makeAff'
, nonCanceler
, runAff
)
where
import Prelude
import Control.Alt (Alt)
import Control.Alternative (Alternative)
import Control.Monad.Cont.Class (MonadCont)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Class (MonadEff)
import Control.Monad.Eff.Exception (Error(), EXCEPTION(), throwException, error)
import Control.Monad.Error.Class (MonadError, throwError)
import Control.Monad.Rec.Class (MonadRec, tailRecM)
import Control.MonadPlus (MonadPlus)
import Control.Plus (Plus)
import Data.Either (Either(..), either)
import Data.Foldable (Foldable, foldl)
import Data.Function (Fn2(), Fn3(), runFn2, runFn3)
import Data.Monoid (Monoid, mempty)
-- | An asynchronous computation with effects `e`. The computation either
-- | errors or produces a value of type `a`.
-- |
-- | This is moral equivalent of `ErrorT (ContT Unit (Eff e)) a`.
foreign import data Aff :: # ! -> * -> *
-- | A pure asynchronous computation, having no effects other than
-- | asynchronous computation.
type PureAff a = forall e. Aff e a
-- | A canceler is asynchronous function that can be used to attempt the
-- | cancelation of a computation. Returns a boolean flag indicating whether
-- | or not the cancellation was successful. Many computations may be composite,
-- | in such cases the flag indicates whether any part of the computation was
-- | successfully canceled. The flag should not be used for communication.
newtype Canceler e = Canceler (Error -> Aff e Boolean)
-- | Unwraps the canceler function from the newtype that wraps it.
cancel :: forall e. Canceler e -> Error -> Aff e Boolean
cancel (Canceler f) = f
-- | This function allows you to attach a custom canceler to an asynchronous
-- | computation. If the computation is canceled, then the custom canceler
-- | will be run along side the computation's own canceler.
cancelWith :: forall e a. Aff e a -> Canceler e -> Aff e a
cancelWith aff c = runFn3 _cancelWith nonCanceler aff c
-- | Converts the asynchronous computation into a synchronous one. All values
-- | are ignored, and if the computation produces an error, it is thrown.
-- |
-- | Catching exceptions by using `catchException` with the resulting Eff
-- | computation is not recommended, as exceptions may end up being thrown
-- | asynchronously, in which case they cannot be caught.
-- |
-- | If you do need to handle exceptions, you can use `runAff` instead, or
-- | you can handle the exception within the Aff computation, using
-- | `catchError` (or any of the other mechanisms).
launchAff :: forall e a. Aff e a -> Eff (err :: EXCEPTION | e) Unit
launchAff = runAff throwException (const (pure unit)) <<< liftEx
where
liftEx :: Aff e a -> Aff (err :: EXCEPTION | e) a
liftEx = _unsafeInterleaveAff
-- | Runs the asynchronous computation. You must supply an error callback and a
-- | success callback.
runAff :: forall e a. (Error -> Eff e Unit) -> (a -> Eff e Unit) -> Aff e a -> Eff e Unit
runAff ex f aff = runFn3 _runAff ex f aff
-- | Creates an asynchronous effect from a function that accepts error and
-- | success callbacks. This function can be used for asynchronous computations
-- | that cannot be canceled.
makeAff :: forall e a. ((Error -> Eff e Unit) -> (a -> Eff e Unit) -> Eff e Unit) -> Aff e a
makeAff h = makeAff' (\e a -> const nonCanceler <$> h e a)
-- | Creates an asynchronous effect from a function that accepts error and
-- | success callbacks, and returns a canceler for the computation. This
-- | function can be used for asynchronous computations that can be canceled.
makeAff' :: forall e a. ((Error -> Eff e Unit) -> (a -> Eff e Unit) -> Eff e (Canceler e)) -> Aff e a
makeAff' h = _makeAff h
-- | Runs the asynchronous computation off the current execution context.
later :: forall e a. Aff e a -> Aff e a
later = later' 0
-- | Runs the specified asynchronous computation later, by the specified
-- | number of milliseconds.
later' :: forall e a. Int -> Aff e a -> Aff e a
later' n aff = runFn3 _setTimeout nonCanceler n aff
-- | Compute `aff1`, followed by `aff2` regardless of whether `aff1` terminated successfully.
finally :: forall e a b. Aff e a -> Aff e b -> Aff e a
finally aff1 aff2 = do
x <- attempt aff1
aff2
either throwError pure x
-- | Forks the specified asynchronous computation so subsequent computations
-- | will not block on the result of the computation.
-- |
-- | Returns a canceler that can be used to attempt cancellation of the
-- | forked computation.
forkAff :: forall e a. Aff e a -> Aff e (Canceler e)
forkAff aff = runFn2 _forkAff nonCanceler aff
-- | Forks many asynchronous computation in a synchronous manner while being
-- | stack-safe up to the selected Foldable instance.
-- |
-- | Returns a canceler that can be used to attempt cancellation of all
-- | forked computations.
forkAll :: forall f e a. (Foldable f) => f (Aff e a) -> Aff e (Canceler e)
forkAll affs = runFn3 _forkAll nonCanceler foldl affs
-- | Promotes any error to the value level of the asynchronous monad.
attempt :: forall e a. Aff e a -> Aff e (Either Error a)
attempt aff = runFn3 _attempt Left Right aff
-- | Ignores any errors.
apathize :: forall e a. Aff e a -> Aff e Unit
apathize a = const unit <$> attempt a
-- | Lifts a synchronous computation and makes explicit any failure from exceptions.
liftEff' :: forall e a. Eff (err :: EXCEPTION | e) a -> Aff e (Either Error a)
liftEff' eff = attempt (_unsafeInterleaveAff (runFn2 _liftEff nonCanceler eff))
-- | A constant canceller that always returns false.
nonCanceler :: forall e. Canceler e
nonCanceler = Canceler (const (pure false))
-- | A constant canceller that always returns true.
alwaysCanceler :: forall e. Canceler e
alwaysCanceler = Canceler (const (pure true))
instance semigroupAff :: (Semigroup a) => Semigroup (Aff e a) where
append a b = (<>) <$> a <*> b
instance monoidAff :: (Monoid a) => Monoid (Aff e a) where
mempty = pure mempty
instance functorAff :: Functor (Aff e) where
map f fa = runFn2 _fmap f fa
instance applyAff :: Apply (Aff e) where
apply ff fa = runFn3 _bind alwaysCanceler ff (\f -> f <$> fa)
instance applicativeAff :: Applicative (Aff e) where
pure v = runFn2 _pure nonCanceler v
instance bindAff :: Bind (Aff e) where
bind fa f = runFn3 _bind alwaysCanceler fa f
instance monadAff :: Monad (Aff e)
instance monadEffAff :: MonadEff e (Aff e) where
liftEff eff = runFn2 _liftEff nonCanceler eff
-- | Allows users to catch and throw errors on the error channel of the
-- | asynchronous computation. See documentation in `purescript-transformers`.
instance monadErrorAff :: MonadError Error (Aff e) where
throwError e = runFn2 _throwError nonCanceler e
catchError aff ex = attempt aff >>= either ex pure
instance altAff :: Alt (Aff e) where
alt a1 a2 = attempt a1 >>= either (const a2) pure
instance plusAff :: Plus (Aff e) where
empty = throwError $ error "Always fails"
instance alternativeAff :: Alternative (Aff e)
instance monadPlusAff :: MonadPlus (Aff e)
instance monadRecAff :: MonadRec (Aff e) where
tailRecM f a = go 0 f a
where
go size f a = do
e <- f a
case e of
Left a' | size < 100 -> go (size + 1) f a'
| otherwise -> later (tailRecM f a')
Right b -> pure b
instance monadContAff :: MonadCont (Aff e) where
callCC f = makeAff (\eb cb -> runAff eb cb (f \a -> makeAff (\_ _ -> cb a)))
instance semigroupCanceler :: Semigroup (Canceler e) where
append (Canceler f1) (Canceler f2) = Canceler (\e -> (||) <$> f1 e <*> f2 e)
instance monoidCanceler :: Monoid (Canceler e) where
mempty = Canceler (const (pure true))
foreign import _cancelWith :: forall e a. Fn3 (Canceler e) (Aff e a) (Canceler e) (Aff e a)
foreign import _setTimeout :: forall e a. Fn3 (Canceler e) Int (Aff e a) (Aff e a)
foreign import _unsafeInterleaveAff :: forall e1 e2 a. Aff e1 a -> Aff e2 a
foreign import _forkAff :: forall e a. Fn2 (Canceler e) (Aff e a) (Aff e (Canceler e))
foreign import _forkAll :: forall f e a b. Fn3 (Canceler e) ((b -> a -> b) -> b -> f a -> b) (f (Aff e a)) (Aff e (Canceler e))
foreign import _makeAff :: forall e a. ((Error -> Eff e Unit) -> (a -> Eff e Unit) -> Eff e (Canceler e)) -> Aff e a
foreign import _pure :: forall e a. Fn2 (Canceler e) a (Aff e a)
foreign import _throwError :: forall e a. Fn2 (Canceler e) Error (Aff e a)
foreign import _fmap :: forall e a b. Fn2 (a -> b) (Aff e a) (Aff e b)
foreign import _bind :: forall e a b. Fn3 (Canceler e) (Aff e a) (a -> Aff e b) (Aff e b)
foreign import _attempt :: forall e a. Fn3 (forall x y. x -> Either x y) (forall x y. y -> Either x y) (Aff e a) (Aff e (Either Error a))
foreign import _runAff :: forall e a. Fn3 (Error -> Eff e Unit) (a -> Eff e Unit) (Aff e a) (Eff e Unit)
foreign import _liftEff :: forall e a. Fn2 (Canceler e) (Eff e a) (Aff e a)