on 79df417 help sign in
498 lines 18 kB history raw
1{-# LANGUAGE CPP #-}
2-- |
3-- Module : Streamly.Internal.Data.Stream.Exception
4-- Copyright : (c) 2020 Composewell Technologies and Contributors
5-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
8-- Portability : GHC
10module Streamly.Internal.Data.Stream.Exception
11 (
12 gbracket_
13 , gbracket
14 , before
15 , afterUnsafe
16 , afterIO
17 , bracketUnsafe
18 , bracketIO3
19 , bracketIO
20 , onException
21 , finallyUnsafe
22 , finallyIO
23 , ghandle
24 , handle
25 )
26where
28#include "inline.hs"
30import Control.Monad.IO.Class (MonadIO(..))
31import Control.Exception (Exception, SomeException, mask_)
32import Control.Monad.Catch (MonadCatch)
33import GHC.Exts (inline)
34import Streamly.Internal.Data.IOFinalizer
35 (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)
37import qualified Control.Monad.Catch as MC
39import Streamly.Internal.Data.Stream.Type
41#include "DocTestDataStream.hs"
43data GbracketState s1 s2 v
44 = GBracketInit
45 | GBracketNormal s1 v
46 | GBracketException s2
48-- | Like 'gbracket' but with following differences:
49--
50-- * alloc action @m c@ runs with async exceptions enabled
51-- * cleanup action @c -> m d@ won't run if the stream is garbage collected
52-- after partial evaluation.
53--
54-- /Inhibits stream fusion/
55--
56-- /Pre-release/
57--
58{-# INLINE_NORMAL gbracket_ #-}
59gbracket_
60 :: Monad m
61 => m c -- ^ before
62 -> (c -> m d) -- ^ after, on normal stop
63 -> (c -> e -> Stream m b -> m (Stream m b)) -- ^ on exception
64 -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)
65 -> (c -> Stream m b) -- ^ stream generator
66 -> Stream m b
67gbracket_ bef aft onExc ftry action =
68 Stream step GBracketInit
70 where
72 {-# INLINE_LATE step #-}
73 step _ GBracketInit = do
74 r <- bef
75 return $ Skip $ GBracketNormal (action r) r
77 step gst (GBracketNormal (UnStream step1 st) v) = do
78 res <- ftry $ step1 gst st
79 case res of
80 Right r -> case r of
81 Yield x s ->
82 return $ Yield x (GBracketNormal (Stream step1 s) v)
83 Skip s -> return $ Skip (GBracketNormal (Stream step1 s) v)
84 Stop -> aft v >> return Stop
85 -- XXX Do not handle async exceptions, just rethrow them.
86 Left e -> do
87 strm <- onExc v e (UnStream step1 st)
88 return $ Skip (GBracketException strm)
89 step gst (GBracketException (UnStream step1 st)) = do
90 res <- step1 gst st
91 case res of
92 Yield x s -> return $ Yield x (GBracketException (Stream step1 s))
93 Skip s -> return $ Skip (GBracketException (Stream step1 s))
94 Stop -> return Stop
96data GbracketIOState s1 s2 v wref
97 = GBracketIOInit
98 | GBracketIONormal s1 v wref
99 | GBracketIOException s2
101-- | Run the alloc action @m c@ with async exceptions disabled but keeping
102-- blocking operations interruptible (see 'Control.Exception.mask'). Use the
103-- output @c@ as input to @c -> Stream m b@ to generate an output stream. When
104-- generating the stream use the supplied @try@ operation @forall s. m s -> m
105-- (Either e s)@ to catch synchronous exceptions. If an exception occurs run
106-- the exception handler @c -> e -> Stream m b -> m (Stream m b)@. Note that
107-- 'gbracket' does not rethrow the exception, it has to be done by the
108-- exception handler if desired.
109--
110-- The cleanup action @c -> m d@, runs whenever the stream ends normally, due
111-- to a sync or async exception or if it gets garbage collected after a partial
112-- lazy evaluation. See 'bracket' for the semantics of the cleanup action.
113--
114-- 'gbracket' can express all other exception handling combinators.
115--
116-- /Inhibits stream fusion/
117--
118-- /Pre-release/
119{-# INLINE_NORMAL gbracket #-}
120gbracket
121 :: MonadIO m
122 => IO c -- ^ before
123 -> (c -> IO d1) -- ^ on normal stop
124 -> (c -> e -> Stream m b -> IO (Stream m b)) -- ^ on exception
125 -> (c -> IO d2) -- ^ on GC without normal stop or exception
126 -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)
127 -> (c -> Stream m b) -- ^ stream generator
128 -> Stream m b
129gbracket bef aft onExc onGC ftry action =
130 Stream step GBracketIOInit
132 where
134 -- If the stream is never evaluated the "aft" action will never be
135 -- called. For that to occur we will need the user of this API to pass a
136 -- weak pointer to us.
137 {-# INLINE_LATE step #-}
138 step _ GBracketIOInit = do
139 -- We mask asynchronous exceptions to make the execution
140 -- of 'bef' and the registration of 'aft' atomic.
141 -- A similar thing is done in the resourcet package: https://git.io/JvKV3
142 -- Tutorial: https://markkarpov.com/tutorial/exceptions.html
143 (r, ref) <- liftIO $ mask_ $ do
144 r <- bef
145 ref <- newIOFinalizer (onGC r)
146 return (r, ref)
147 return $ Skip $ GBracketIONormal (action r) r ref
149 step gst (GBracketIONormal (UnStream step1 st) v ref) = do
150 res <- ftry $ step1 gst st
151 case res of
152 Right r -> case r of
153 Yield x s ->
154 return $ Yield x (GBracketIONormal (Stream step1 s) v ref)
155 Skip s ->
156 return $ Skip (GBracketIONormal (Stream step1 s) v ref)
157 Stop ->
158 liftIO (clearingIOFinalizer ref (aft v)) >> return Stop
159 -- XXX Do not handle async exceptions, just rethrow them.
160 Left e -> do
161 -- Clearing of finalizer and running of exception handler must
162 -- be atomic wrt async exceptions. Otherwise if we have cleared
163 -- the finalizer and have not run the exception handler then we
164 -- may leak the resource.
165 stream <-
166 liftIO (clearingIOFinalizer ref (onExc v e (UnStream step1 st)))
167 return $ Skip (GBracketIOException stream)
168 step gst (GBracketIOException (UnStream step1 st)) = do
169 res <- step1 gst st
170 case res of
171 Yield x s ->
172 return $ Yield x (GBracketIOException (Stream step1 s))
173 Skip s -> return $ Skip (GBracketIOException (Stream step1 s))
174 Stop -> return Stop
176-- | Run the action @m b@ before the stream yields its first element.
177--
178-- Same as the following but more efficient due to fusion:
179--
180-- >>> before action xs = Stream.nilM action <> xs
181-- >>> before action xs = Stream.concatMap (const xs) (Stream.fromEffect action)
182--
183{-# INLINE_NORMAL before #-}
184before :: Monad m => m b -> Stream m a -> Stream m a
185before action (Stream step state) = Stream step' Nothing
187 where
189 {-# INLINE_LATE step' #-}
190 step' _ Nothing = action >> return (Skip (Just state))
192 step' gst (Just st) = do
193 res <- step gst st
194 case res of
195 Yield x s -> return $ Yield x (Just s)
196 Skip s -> return $ Skip (Just s)
197 Stop -> return Stop
199-- | Like 'after', with following differences:
200--
201-- * action @m b@ won't run if the stream is garbage collected
202-- after partial evaluation.
203-- * Monad @m@ does not require any other constraints.
204-- * has slightly better performance than 'after'.
205--
206-- Same as the following, but with stream fusion:
207--
208-- >>> afterUnsafe action xs = xs <> Stream.nilM action
209--
210-- /Pre-release/
211--
212{-# INLINE_NORMAL afterUnsafe #-}
213afterUnsafe :: Monad m => m b -> Stream m a -> Stream m a
214afterUnsafe action (Stream step state) = Stream step' state
216 where
218 {-# INLINE_LATE step' #-}
219 step' gst st = do
220 res <- step gst st
221 case res of
222 Yield x s -> return $ Yield x s
223 Skip s -> return $ Skip s
224 Stop -> action >> return Stop
226-- | Run the action @IO b@ whenever the stream is evaluated to completion, or
227-- if it is garbage collected after a partial lazy evaluation.
228--
229-- The semantics of the action @IO b@ are similar to the semantics of cleanup
230-- action in 'bracketIO'.
231--
232-- /See also 'afterUnsafe'/
233--
234{-# INLINE_NORMAL afterIO #-}
235afterIO :: MonadIO m
236 => IO b -> Stream m a -> Stream m a
237afterIO action (Stream step state) = Stream step' Nothing
239 where
241 {-# INLINE_LATE step' #-}
242 step' _ Nothing = do
243 ref <- liftIO $ newIOFinalizer action
244 return $ Skip $ Just (state, ref)
245 step' gst (Just (st, ref)) = do
246 res <- step gst st
247 case res of
248 Yield x s -> return $ Yield x (Just (s, ref))
249 Skip s -> return $ Skip (Just (s, ref))
250 Stop -> do
251 runIOFinalizer ref
252 return Stop
254-- XXX For high performance error checks in busy streams we may need another
255-- Error constructor in step.
257-- | Run the action @m b@ if the stream evaluation is aborted due to an
258-- exception. The exception is not caught, simply rethrown.
259--
260-- Observes exceptions only in the stream generation, and not in stream
261-- consumers.
262--
263-- /Inhibits stream fusion/
264--
265{-# INLINE_NORMAL onException #-}
266onException :: MonadCatch m => m b -> Stream m a -> Stream m a
267onException action stream =
268 gbracket_
269 (return ()) -- before
270 return -- after
271 (\_ (e :: MC.SomeException) _ -> action >> MC.throwM e)
272 (inline MC.try)
273 (const stream)
275{-# INLINE_NORMAL _onException #-}
276_onException :: MonadCatch m => m b -> Stream m a -> Stream m a
277_onException action (Stream step state) = Stream step' state
279 where
281 {-# INLINE_LATE step' #-}
282 step' gst st = do
283 res <- step gst st `MC.onException` action
284 case res of
285 Yield x s -> return $ Yield x s
286 Skip s -> return $ Skip s
287 Stop -> return Stop
289-- | Like 'bracket' but with following differences:
290--
291-- * alloc action @m b@ runs with async exceptions enabled
292-- * cleanup action @b -> m c@ won't run if the stream is garbage collected
293-- after partial evaluation.
294-- * has slightly better performance than 'bracketIO'.
295--
296-- /Inhibits stream fusion/
297--
298-- /Pre-release/
299--
300{-# INLINE_NORMAL bracketUnsafe #-}
301bracketUnsafe :: MonadCatch m
302 => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a
303bracketUnsafe bef aft =
304 gbracket_
305 bef
306 aft
307 (\a (e :: SomeException) _ -> aft a >> MC.throwM e)
308 (inline MC.try)
310-- For a use case of this see the "streamly-process" package. It needs to kill
311-- the process in case of exception or garbage collection, but waits for the
312-- process to terminate in normal cases.
314-- | Like 'bracketIO' but can use 3 separate cleanup actions depending on the
315-- mode of termination:
316--
317-- 1. When the stream stops normally
318-- 2. When the stream is garbage collected
319-- 3. When the stream encounters an exception
320--
321-- @bracketIO3 before onStop onGC onException action@ runs @action@ using the
322-- result of @before@. If the stream stops, @onStop@ action is executed, if the
323-- stream is abandoned @onGC@ is executed, if the stream encounters an
324-- exception @onException@ is executed.
325--
326-- The exception is not caught, it is rethrown.
327--
328-- /Inhibits stream fusion/
329--
330-- /Pre-release/
331{-# INLINE_NORMAL bracketIO3 #-}
332bracketIO3 :: (MonadIO m, MonadCatch m) =>
333 IO b
334 -> (b -> IO c)
335 -> (b -> IO d)
336 -> (b -> IO e)
337 -> (b -> Stream m a)
338 -> Stream m a
339bracketIO3 bef aft onExc onGC =
340 gbracket
341 bef
342 aft
343 (\a (e :: SomeException) _ -> onExc a >> MC.throwM e)
344 onGC
345 (inline MC.try)
347-- | Run the alloc action @IO b@ with async exceptions disabled but keeping
348-- blocking operations interruptible (see 'Control.Exception.mask'). Use the
349-- output @b@ of the IO action as input to the function @b -> Stream m a@ to
350-- generate an output stream.
351--
352-- @b@ is usually a resource under the IO monad, e.g. a file handle, that
353-- requires a cleanup after use. The cleanup action @b -> IO c@, runs whenever
354-- (1) the stream ends normally, (2) due to a sync or async exception or, (3)
355-- if it gets garbage collected after a partial lazy evaluation. The exception
356-- is not caught, it is rethrown.
357--
358-- 'bracketIO' only guarantees that the cleanup action runs, and it runs with
359-- async exceptions enabled. The action must ensure that it can successfully
360-- cleanup the resource in the face of sync or async exceptions.
361--
362-- When the stream ends normally or on a sync exception, cleanup action runs
363-- immediately in the current thread context, whereas in other cases it runs in
364-- the GC context, therefore, cleanup may be delayed until the GC gets to run.
365-- An example where GC based cleanup happens is when a stream is being folded
366-- but the fold terminates without draining the entire stream or if the
367-- consumer of the stream encounters an exception.
368--
369-- Observes exceptions only in the stream generation, and not in stream
370-- consumers.
371--
372-- /See also: 'bracketUnsafe'/
373--
374-- /Inhibits stream fusion/
375--
376{-# INLINE bracketIO #-}
377bracketIO :: (MonadIO m, MonadCatch m)
378 => IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a
379bracketIO bef aft = bracketIO3 bef aft aft aft
381data BracketState s v = BracketInit | BracketRun s v
383-- | Alternate (custom) implementation of 'bracket'.
384--
385{-# INLINE_NORMAL _bracket #-}
386_bracket :: MonadCatch m
387 => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a
388_bracket bef aft bet = Stream step' BracketInit
390 where
392 {-# INLINE_LATE step' #-}
393 step' _ BracketInit = bef >>= \x -> return (Skip (BracketRun (bet x) x))
395 -- NOTE: It is important to use UnStream instead of the Stream pattern
396 -- here, otherwise we get huge perf degradation, see note in concatMap.
397 step' gst (BracketRun (UnStream step state) v) = do
398 -- res <- step gst state `MC.onException` aft v
399 res <- inline MC.try $ step gst state
400 case res of
401 Left (e :: SomeException) -> aft v >> MC.throwM e >> return Stop
402 Right r -> case r of
403 Yield x s -> return $ Yield x (BracketRun (Stream step s) v)
404 Skip s -> return $ Skip (BracketRun (Stream step s) v)
405 Stop -> aft v >> return Stop
407-- | Like 'finally' with following differences:
408--
409-- * action @m b@ won't run if the stream is garbage collected
410-- after partial evaluation.
411-- * has slightly better performance than 'finallyIO'.
412--
413-- /Inhibits stream fusion/
414--
415-- /Pre-release/
416--
417{-# INLINE finallyUnsafe #-}
418finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a
419finallyUnsafe action xs = bracketUnsafe (return ()) (const action) (const xs)
421-- | Run the action @IO b@ whenever the stream stream stops normally, aborts
422-- due to an exception or if it is garbage collected after a partial lazy
423-- evaluation.
424--
425-- The semantics of running the action @IO b@ are similar to the cleanup action
426-- semantics described in 'bracketIO'.
427--
428-- >>> finallyIO release = Stream.bracketIO (return ()) (const release)
429--
430-- /See also 'finallyUnsafe'/
431--
432-- /Inhibits stream fusion/
433--
434{-# INLINE finallyIO #-}
435finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Stream m a -> Stream m a
436finallyIO action xs = bracketIO3 (return ()) act act act (const xs)
437 where act _ = action
439-- | Like 'handle' but the exception handler is also provided with the stream
440-- that generated the exception as input. The exception handler can thus
441-- re-evaluate the stream to retry the action that failed. The exception
442-- handler can again call 'ghandle' on it to retry the action multiple times.
443--
444-- This is highly experimental. In a stream of actions we can map the stream
445-- with a retry combinator to retry each action on failure.
446--
447-- /Inhibits stream fusion/
448--
449-- /Pre-release/
450--
451{-# INLINE_NORMAL ghandle #-}
452ghandle :: (MonadCatch m, Exception e)
453 => (e -> Stream m a -> m (Stream m a)) -> Stream m a -> Stream m a
454ghandle f stream =
455 gbracket_ (return ()) return (const f) (inline MC.try) (const stream)
457-- | When evaluating a stream if an exception occurs, stream evaluation aborts
458-- and the specified exception handler is run with the exception as argument.
459-- The exception is caught and handled unless the handler decides to rethrow
460-- it. Note that exception handling is not applied to the stream returned by
461-- the exception handler.
462--
463-- Observes exceptions only in the stream generation, and not in stream
464-- consumers.
465--
466-- /Inhibits stream fusion/
467--
468{-# INLINE_NORMAL handle #-}
469handle :: (MonadCatch m, Exception e)
470 => (e -> m (Stream m a)) -> Stream m a -> Stream m a
471handle f stream =
472 gbracket_ (return ()) return (\_ e _ -> f e) (inline MC.try) (const stream)
474-- | Alternate (custom) implementation of 'handle'.
475--
476{-# INLINE_NORMAL _handle #-}
477_handle :: (MonadCatch m, Exception e)
478 => (e -> Stream m a) -> Stream m a -> Stream m a
479_handle f (Stream step state) = Stream step' (Left state)
481 where
483 {-# INLINE_LATE step' #-}
484 step' gst (Left st) = do
485 res <- inline MC.try $ step gst st
486 case res of
487 Left e -> return $ Skip $ Right (f e)
488 Right r -> case r of
489 Yield x s -> return $ Yield x (Left s)
490 Skip s -> return $ Skip (Left s)
491 Stop -> return Stop
493 step' gst (Right (UnStream step1 st)) = do
494 res <- step1 gst st
495 case res of
496 Yield x s -> return $ Yield x (Right (Stream step1 s))
497 Skip s -> return $ Skip (Right (Stream step1 s))
498 Stop -> return Stop