git.iko.soy/streamly
on 9ad7fca help sign in
streamly/src/Streamly/Internal/Data/Unfold.hs
761 lines 25 kB history raw
1{-# OPTIONS_HADDOCK hide #-}
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE CPP #-}
4{-# LANGUAGE ExistentialQuantification #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE PatternSynonyms #-}
7{-# LANGUAGE RankNTypes #-}
8{-# LANGUAGE RecordWildCards #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TupleSections #-}
12#include "inline.hs"
14-- |
15-- Module : Streamly.Internal.Data.Unfold
16-- Copyright : (c) 2019 Composewell Technologies
17-- License : BSD3
18-- Maintainer : streamly@composewell.com
19-- Stability : experimental
20-- Portability : GHC
21--
22-- Streams forcing a closed control flow loop can be categorized under
23-- two types, unfolds and folds, both of these are duals of each other.
24--
25-- Unfold streams are really generators of a sequence of elements, we can also
26-- call them pull style streams. These are lazy producers of streams. On each
27-- evaluation the producer generates the next element. A consumer can
28-- therefore pull elements from the stream whenever it wants to. A stream
29-- consumer can multiplex pull streams by pulling elements from the chosen
30-- streams, therefore, pull streams allow merging or multiplexing. On the
31-- other hand, with this representation we cannot split or demultiplex a
32-- stream. So really these are stream sources that can be generated from a
33-- seed and can be merged or zipped into a single stream.
34--
35-- The dual of Unfolds are Folds. Folds can also be called as push style
36-- streams or reducers. These are strict consumers of streams. We keep pushing
37-- elements to a fold and we can extract the result at any point. A driver can
38-- choose which fold to push to and can also push the same element to multiple
39-- folds. Therefore, folds allow splitting or demultiplexing a stream. On the
40-- other hand, we cannot merge streams using this representation. So really
41-- these are stream consumers that reduce the stream to a single value, these
42-- consumers can be composed such that a stream can be split over multiple
43-- consumers.
44--
45-- Performance:
46--
47-- Composing a tree or graph of computations with unfolds can be much more
48-- efficient compared to composing with the Monad instance. The reason is that
49-- unfolds allow the compiler to statically know the state and optimize it
50-- using stream fusion whereas it is not possible with the monad bind because
51-- the state is determined dynamically.
53-- Open control flow style streams can also have two representations. StreamK
54-- is a producer style representation. We can also have a consumer style
55-- representation. We can use that for composable folds in StreamK
56-- representation.
57--
58module Streamly.Internal.Data.Unfold
59 (
60 -- * Unfold Type
61 Unfold
63 -- * Operations on Input
64 , lmap
65 , supply
66 , supplyFirst
67 , supplySecond
68 , discardFirst
69 , discardSecond
70 , swap
71 -- coapply
72 -- comonad
74 -- * Operations on Output
75 , fold
76 -- pipe
78 -- * Unfolds
79 , fromStream
80 , fromStream1
81 , fromStream2
82 , nilM
83 , consM
84 , effect
85 , singleton
86 , identity
87 , const
88 , replicateM
89 , fromList
90 , fromListM
91 , enumerateFromStepIntegral
92 , enumerateFromToIntegral
93 , enumerateFromIntegral
95 -- * Transformations
96 , map
98 -- * Filtering
99 , takeWhileM
100 , takeWhile
101 , take
102 , filter
103 , filterM
105 -- * Nesting
106 , concat
107 , concatMapM
108 , outerProduct
110 -- * Exceptions
111 , gbracket
112 , before
113 , after
114 , onException
115 , finally
116 , bracket
117 , handle
118 )
119where
121import Control.Exception (Exception)
122import Data.Void (Void)
123import GHC.Types (SPEC(..))
124import Prelude hiding (concat, map, takeWhile, take, filter, const)
126import Streamly.Streams.StreamD.Type (Stream(..), Step(..))
127#if __GLASGOW_HASKELL__ < 800
128import Streamly.Streams.StreamD.Type (pattern Stream)
129#endif
130import Streamly.Internal.Data.Unfold.Types (Unfold(..))
131import Streamly.Internal.Data.Fold.Types (Fold(..))
132import Streamly.Internal.Data.SVar (defState)
133import Control.Monad.Catch (MonadCatch)
135import qualified Prelude
136import qualified Control.Monad.Catch as MC
137import qualified Data.Tuple as Tuple
138import qualified Streamly.Streams.StreamK as K
139import qualified Streamly.Streams.StreamD as D
141-------------------------------------------------------------------------------
142-- Input operations
143-------------------------------------------------------------------------------
145-- | Map a function on the input argument of the 'Unfold'.
146--
147-- /Internal/
148{-# INLINE_NORMAL lmap #-}
149lmap :: (a -> c) -> Unfold m c b -> Unfold m a b
150lmap f (Unfold ustep uinject) = Unfold ustep (uinject . f)
152-- | Supply the seed to an unfold closing the input end of the unfold.
153--
154-- /Internal/
155--
156{-# INLINE_NORMAL supply #-}
157supply :: Unfold m a b -> a -> Unfold m Void b
158supply unf a = lmap (Prelude.const a) unf
160-- | Supply the first component of the tuple to an unfold that accepts a tuple
161-- as a seed resulting in a fold that accepts the second component of the tuple
162-- as a seed.
163--
164-- /Internal/
165--
166{-# INLINE_NORMAL supplyFirst #-}
167supplyFirst :: Unfold m (a, b) c -> a -> Unfold m b c
168supplyFirst unf a = lmap (a, ) unf
170-- | Supply the second component of the tuple to an unfold that accepts a tuple
171-- as a seed resulting in a fold that accepts the first component of the tuple
172-- as a seed.
173--
174-- /Internal/
175--
176{-# INLINE_NORMAL supplySecond #-}
177supplySecond :: Unfold m (a, b) c -> b -> Unfold m a c
178supplySecond unf b = lmap (, b) unf
180-- | Convert an 'Unfold' into an unfold accepting a tuple as an argument,
181-- using the argument of the original fold as the second element of tuple and
182-- discarding the first element of the tuple.
183--
184-- /Internal/
185--
186{-# INLINE_NORMAL discardFirst #-}
187discardFirst :: Unfold m a b -> Unfold m (c, a) b
188discardFirst = lmap snd
190-- | Convert an 'Unfold' into an unfold accepting a tuple as an argument,
191-- using the argument of the original fold as the first element of tuple and
192-- discarding the second element of the tuple.
193--
194-- /Internal/
195--
196{-# INLINE_NORMAL discardSecond #-}
197discardSecond :: Unfold m a b -> Unfold m (a, c) b
198discardSecond = lmap fst
200-- | Convert an 'Unfold' that accepts a tuple as an argument into an unfold
201-- that accepts a tuple with elements swapped.
202--
203-- /Internal/
204--
205{-# INLINE_NORMAL swap #-}
206swap :: Unfold m (a, c) b -> Unfold m (c, a) b
207swap = lmap Tuple.swap
209-------------------------------------------------------------------------------
210-- Output operations
211-------------------------------------------------------------------------------
213-- | Compose an 'Unfold' and a 'Fold'. Given an @Unfold m a b@ and a
214-- @Fold m b c@, returns a monadic action @a -> m c@ representing the
215-- application of the fold on the unfolded stream.
216--
217-- /Internal/
218--
219{-# INLINE_NORMAL fold #-}
220fold :: Monad m => Unfold m a b -> Fold m b c -> a -> m c
221fold (Unfold ustep inject) (Fold fstep initial extract) a =
222 initial >>= \x -> inject a >>= go SPEC x
223 where
224 -- XXX !acc?
225 {-# INLINE_LATE go #-}
226 go !_ acc st = acc `seq` do
227 r <- ustep st
228 case r of
229 Yield x s -> do
230 acc' <- fstep acc x
231 go SPEC acc' s
232 Skip s -> go SPEC acc s
233 Stop -> extract acc
235{-# INLINE_NORMAL map #-}
236map :: Monad m => (b -> c) -> Unfold m a b -> Unfold m a c
237map f (Unfold ustep uinject) = Unfold step uinject
238 where
239 {-# INLINE_LATE step #-}
240 step st = do
241 r <- ustep st
242 return $ case r of
243 Yield x s -> Yield (f x) s
244 Skip s -> Skip s
245 Stop -> Stop
247-------------------------------------------------------------------------------
248-- Convert streams into unfolds
249-------------------------------------------------------------------------------
251{-# INLINE_LATE streamStep #-}
252streamStep :: Monad m => Stream m a -> m (Step (Stream m a) a)
253streamStep (Stream step1 state) = do
254 r <- step1 defState state
255 return $ case r of
256 Yield x s -> Yield x (Stream step1 s)
257 Skip s -> Skip (Stream step1 s)
258 Stop -> Stop
260-- | Convert a stream into an 'Unfold'. Note that a stream converted to an
261-- 'Unfold' may not be as efficient as an 'Unfold' in some situations.
262--
263-- /Internal/
264fromStream :: (K.IsStream t, Monad m) => t m b -> Unfold m Void b
265fromStream str = Unfold streamStep (\_ -> return $ D.toStreamD str)
267-- | Convert a single argument stream generator function into an
268-- 'Unfold'. Note that a stream converted to an 'Unfold' may not be as
269-- efficient as an 'Unfold' in some situations.
270--
271-- /Internal/
272fromStream1 :: (K.IsStream t, Monad m) => (a -> t m b) -> Unfold m a b
273fromStream1 f = Unfold streamStep (return . D.toStreamD . f)
275-- | Convert a two argument stream generator function into an 'Unfold'. Note
276-- that a stream converted to an 'Unfold' may not be as efficient as an
277-- 'Unfold' in some situations.
278--
279-- /Internal/
280fromStream2 :: (K.IsStream t, Monad m)
281 => (a -> b -> t m c) -> Unfold m (a, b) c
282fromStream2 f = Unfold streamStep (\(a, b) -> return $ D.toStreamD $ f a b)
284-------------------------------------------------------------------------------
285-- Unfolds
286-------------------------------------------------------------------------------
288-- | Lift a monadic function into an unfold generating a nil stream with a side
289-- effect.
290--
291{-# INLINE nilM #-}
292nilM :: Monad m => (a -> m c) -> Unfold m a b
293nilM f = Unfold step return
294 where
295 {-# INLINE_LATE step #-}
296 step x = f x >> return Stop
298-- | Prepend a monadic single element generator function to an 'Unfold'.
299--
300-- /Internal/
301{-# INLINE_NORMAL consM #-}
302consM :: Monad m => (a -> m b) -> Unfold m a b -> Unfold m a b
303consM action unf = Unfold step inject
305 where
307 inject = return . Left
309 {-# INLINE_LATE step #-}
310 step (Left a) = do
311 action a >>= \r -> return $ Yield r (Right (D.unfold unf a))
312 step (Right (UnStream step1 st)) = do
313 res <- step1 defState st
314 case res of
315 Yield x s -> return $ Yield x (Right (Stream step1 s))
316 Skip s -> return $ Skip (Right (Stream step1 s))
317 Stop -> return Stop
319-- | Lift a monadic effect into an unfold generating a singleton stream.
320--
321{-# INLINE effect #-}
322effect :: Monad m => m b -> Unfold m Void b
323effect eff = Unfold step inject
324 where
325 inject _ = return True
326 {-# INLINE_LATE step #-}
327 step True = eff >>= \r -> return $ Yield r False
328 step False = return Stop
330-- | Lift a monadic function into an unfold generating a singleton stream.
331--
332{-# INLINE singleton #-}
333singleton :: Monad m => (a -> m b) -> Unfold m a b
334singleton f = Unfold step inject
335 where
336 inject x = return $ Just x
337 {-# INLINE_LATE step #-}
338 step (Just x) = f x >>= \r -> return $ Yield r Nothing
339 step Nothing = return Stop
341-- | Identity unfold. Generates a singleton stream with the seed as the only
342-- element in the stream.
343--
344-- > identity = singleton return
345--
346{-# INLINE identity #-}
347identity :: Monad m => Unfold m a a
348identity = singleton return
350const :: Monad m => m b -> Unfold m a b
351const m = Unfold step inject
352 where
353 inject _ = return ()
354 step () = m >>= \r -> return $ Yield r ()
356-- | Generates a stream replicating the seed @n@ times.
357--
358{-# INLINE replicateM #-}
359replicateM :: Monad m => Int -> Unfold m a a
360replicateM n = Unfold step inject
361 where
362 inject x = return (x, n)
363 {-# INLINE_LATE step #-}
364 step (x, i) = return $
365 if i <= 0
366 then Stop
367 else Yield x (x, (i - 1))
369-- | Convert a list of pure values to a 'Stream'
370{-# INLINE_LATE fromList #-}
371fromList :: Monad m => Unfold m [a] a
372fromList = Unfold step inject
373 where
374 inject x = return x
375 {-# INLINE_LATE step #-}
376 step (x:xs) = return $ Yield x xs
377 step [] = return Stop
379-- | Convert a list of monadic values to a 'Stream'
380{-# INLINE_LATE fromListM #-}
381fromListM :: Monad m => Unfold m [m a] a
382fromListM = Unfold step inject
383 where
384 inject x = return x
385 {-# INLINE_LATE step #-}
386 step (x:xs) = x >>= \r -> return $ Yield r xs
387 step [] = return Stop
389-------------------------------------------------------------------------------
390-- Filtering
391-------------------------------------------------------------------------------
393{-# INLINE_NORMAL take #-}
394take :: Monad m => Int -> Unfold m a b -> Unfold m a b
395take n (Unfold step1 inject1) = Unfold step inject
396 where
397 inject x = do
398 s <- inject1 x
399 return (s, 0)
400 {-# INLINE_LATE step #-}
401 step (st, i) | i < n = do
402 r <- step1 st
403 return $ case r of
404 Yield x s -> Yield x (s, i + 1)
405 Skip s -> Skip (s, i)
406 Stop -> Stop
407 step (_, _) = return Stop
409{-# INLINE_NORMAL takeWhileM #-}
410takeWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b
411takeWhileM f (Unfold step1 inject1) = Unfold step inject1
412 where
413 {-# INLINE_LATE step #-}
414 step st = do
415 r <- step1 st
416 case r of
417 Yield x s -> do
418 b <- f x
419 return $ if b then Yield x s else Stop
420 Skip s -> return $ Skip s
421 Stop -> return Stop
423{-# INLINE takeWhile #-}
424takeWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b
425takeWhile f = takeWhileM (return . f)
427{-# INLINE_NORMAL filterM #-}
428filterM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b
429filterM f (Unfold step1 inject1) = Unfold step inject1
430 where
431 {-# INLINE_LATE step #-}
432 step st = do
433 r <- step1 st
434 case r of
435 Yield x s -> do
436 b <- f x
437 return $ if b then Yield x s else Skip s
438 Skip s -> return $ Skip s
439 Stop -> return Stop
441{-# INLINE filter #-}
442filter :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b
443filter f = filterM (return . f)
445-------------------------------------------------------------------------------
446-- Enumeration
447-------------------------------------------------------------------------------
449-- | Can be used to enumerate unbounded integrals. This does not check for
450-- overflow or underflow for bounded integrals.
451{-# INLINE_NORMAL enumerateFromStepIntegral #-}
452enumerateFromStepIntegral :: (Integral a, Monad m) => Unfold m (a, a) a
453enumerateFromStepIntegral = Unfold step inject
454 where
455 inject (from, stride) = from `seq` stride `seq` return (from, stride)
456 {-# INLINE_LATE step #-}
457 step !(x, stride) = return $ Yield x $! (x + stride, stride)
459-- We are assuming that "to" is constrained by the type to be within
460-- max/min bounds.
461{-# INLINE enumerateFromToIntegral #-}
462enumerateFromToIntegral :: (Monad m, Integral a) => a -> Unfold m a a
463enumerateFromToIntegral to =
464 takeWhile (<= to) $ supplySecond enumerateFromStepIntegral 1
466{-# INLINE enumerateFromIntegral #-}
467enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => Unfold m a a
468enumerateFromIntegral = enumerateFromToIntegral maxBound
470-------------------------------------------------------------------------------
471-- Nested
472-------------------------------------------------------------------------------
474data ConcatState s1 s2 = ConcatOuter s1 | ConcatInner s1 s2
476{-# INLINE_NORMAL concat #-}
477concat :: Monad m => Unfold m a b -> Unfold m b c -> Unfold m a c
478concat (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject
479 where
480 inject x = do
481 s <- inject1 x
482 return $ ConcatOuter s
484 {-# INLINE_LATE step #-}
485 step (ConcatOuter st) = do
486 r <- step1 st
487 case r of
488 Yield x s -> do
489 innerSt <- inject2 x
490 return $ Skip (ConcatInner s innerSt)
491 Skip s -> return $ Skip (ConcatOuter s)
492 Stop -> return Stop
494 step (ConcatInner ost ist) = do
495 r <- step2 ist
496 return $ case r of
497 Yield x s -> Yield x (ConcatInner ost s)
498 Skip s -> Skip (ConcatInner ost s)
499 Stop -> Skip (ConcatOuter ost)
501data OuterProductState s1 s2 sy x y =
502 OuterProductOuter s1 y | OuterProductInner s1 sy s2 x
504{-# INLINE_NORMAL outerProduct #-}
505outerProduct :: Monad m
506 => Unfold m a b -> Unfold m c d -> Unfold m (a, c) (b, d)
507outerProduct (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject
508 where
509 inject (x, y) = do
510 s1 <- inject1 x
511 return $ OuterProductOuter s1 y
513 {-# INLINE_LATE step #-}
514 step (OuterProductOuter st1 sy) = do
515 r <- step1 st1
516 case r of
517 Yield x s -> do
518 s2 <- inject2 sy
519 return $ Skip (OuterProductInner s sy s2 x)
520 Skip s -> return $ Skip (OuterProductOuter s sy)
521 Stop -> return Stop
523 step (OuterProductInner ost sy ist x) = do
524 r <- step2 ist
525 return $ case r of
526 Yield y s -> Yield (x, y) (OuterProductInner ost sy s x)
527 Skip s -> Skip (OuterProductInner ost sy s x)
528 Stop -> Skip (OuterProductOuter ost sy)
530-- XXX This can be used to implement a Monad instance for "Unfold m ()".
532data ConcatMapState s1 s2 = ConcatMapOuter s1 | ConcatMapInner s1 s2
534{-# INLINE_NORMAL concatMapM #-}
535concatMapM :: Monad m
536 => (b -> m (Unfold m () c)) -> Unfold m a b -> Unfold m a c
537concatMapM f (Unfold step1 inject1) = Unfold step inject
538 where
539 inject x = do
540 s <- inject1 x
541 return $ ConcatMapOuter s
543 {-# INLINE_LATE step #-}
544 step (ConcatMapOuter st) = do
545 r <- step1 st
546 case r of
547 Yield x s -> do
548 Unfold step2 inject2 <- f x
549 innerSt <- inject2 ()
550 return $ Skip (ConcatMapInner s (Stream (\_ ss -> step2 ss)
551 innerSt))
552 Skip s -> return $ Skip (ConcatMapOuter s)
553 Stop -> return Stop
555 step (ConcatMapInner ost (UnStream istep ist)) = do
556 r <- istep defState ist
557 return $ case r of
558 Yield x s -> Yield x (ConcatMapInner ost (Stream istep s))
559 Skip s -> Skip (ConcatMapInner ost (Stream istep s))
560 Stop -> Skip (ConcatMapOuter ost)
562------------------------------------------------------------------------------
563-- Exceptions
564------------------------------------------------------------------------------
566-- | The most general bracketing and exception combinator. All other
567-- combinators can be expressed in terms of this combinator. This can also be
568-- used for cases which are not covered by the standard combinators.
569--
570-- /Internal/
571--
572{-# INLINE_NORMAL gbracket #-}
573gbracket
574 :: Monad m
575 => (a -> m c) -- ^ before
576 -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)
577 -> (c -> m d) -- ^ after, on normal stop
578 -> Unfold m (c, e) b -- ^ on exception
579 -> Unfold m c b -- ^ unfold to run
580 -> Unfold m a b
581gbracket bef exc aft (Unfold estep einject) (Unfold step1 inject1) =
582 Unfold step inject
584 where
586 inject x = do
587 r <- bef x
588 s <- inject1 r
589 return $ Right (s, r)
591 {-# INLINE_LATE step #-}
592 step (Right (st, v)) = do
593 res <- exc $ step1 st
594 case res of
595 Right r -> case r of
596 Yield x s -> return $ Yield x (Right (s, v))
597 Skip s -> return $ Skip (Right (s, v))
598 Stop -> aft v >> return Stop
599 Left e -> do
600 r <- einject (v, e)
601 return $ Skip (Left r)
602 step (Left st) = do
603 res <- estep st
604 case res of
605 Yield x s -> return $ Yield x (Left s)
606 Skip s -> return $ Skip (Left s)
607 Stop -> return Stop
609-- The custom implementation of "before" is slightly faster (5-7%) than
610-- "_before". This is just to document and make sure that we can always use
611-- gbracket to implement before. The same applies to other combinators as well.
612--
613{-# INLINE_NORMAL _before #-}
614_before :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b
615_before action unf = gbracket (\x -> action x >> return x) (fmap Right)
616 (\_ -> return ()) undefined unf
618-- | Run a side effect before the unfold yields its first element.
619--
620-- /Internal/
621{-# INLINE_NORMAL before #-}
622before :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b
623before action (Unfold step1 inject1) = Unfold step inject
625 where
627 inject x = do
628 _ <- action x
629 st <- inject1 x
630 return st
632 {-# INLINE_LATE step #-}
633 step st = do
634 res <- step1 st
635 case res of
636 Yield x s -> return $ Yield x s
637 Skip s -> return $ Skip s
638 Stop -> return Stop
640{-# INLINE_NORMAL _after #-}
641_after :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b
642_after aft = gbracket return (fmap Right) aft undefined
644-- | Run a side effect whenever the unfold stops normally.
645--
646-- /Internal/
647{-# INLINE_NORMAL after #-}
648after :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b
649after action (Unfold step1 inject1) = Unfold step inject
651 where
653 inject x = do
654 s <- inject1 x
655 return (s, x)
657 {-# INLINE_LATE step #-}
658 step (st, v) = do
659 res <- step1 st
660 case res of
661 Yield x s -> return $ Yield x (s, v)
662 Skip s -> return $ Skip (s, v)
663 Stop -> action v >> return Stop
665{-# INLINE_NORMAL _onException #-}
666_onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b
667_onException action unf =
668 gbracket return MC.try
669 (\_ -> return ())
670 (nilM (\(a, (_ :: MC.SomeException)) -> action a)) unf
672-- | Run a side effect whenever the unfold aborts due to an exception.
673--
674-- /Internal/
675{-# INLINE_NORMAL onException #-}
676onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b
677onException action (Unfold step1 inject1) = Unfold step inject
679 where
681 inject x = do
682 s <- inject1 x
683 return (s, x)
685 {-# INLINE_LATE step #-}
686 step (st, v) = do
687 res <- step1 st `MC.onException` action v
688 case res of
689 Yield x s -> return $ Yield x (s, v)
690 Skip s -> return $ Skip (s, v)
691 Stop -> return Stop
693{-# INLINE_NORMAL _finally #-}
694_finally :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b
695_finally action unf =
696 gbracket return MC.try action
697 (nilM (\(a, (_ :: MC.SomeException)) -> action a)) unf
699-- | Run a side effect whenever the unfold stops normally or aborts due to an
700-- exception.
701--
702-- /Internal/
703{-# INLINE_NORMAL finally #-}
704finally :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b
705finally action (Unfold step1 inject1) = Unfold step inject
707 where
709 inject x = do
710 s <- inject1 x
711 return (s, x)
713 {-# INLINE_LATE step #-}
714 step (st, v) = do
715 res <- step1 st `MC.onException` action v
716 case res of
717 Yield x s -> return $ Yield x (s, v)
718 Skip s -> return $ Skip (s, v)
719 Stop -> action v >> return Stop
721{-# INLINE_NORMAL _bracket #-}
722_bracket :: MonadCatch m
723 => (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
724_bracket bef aft unf =
725 gbracket bef MC.try aft (nilM (\(a, (_ :: MC.SomeException)) -> aft a)) unf
727-- | @bracket before after between@ runs the @before@ action and then unfolds
728-- its output using the @between@ unfold. When the @between@ unfold is done or
729-- if an exception occurs then the @after@ action is run with the output of
730-- @before@ as argument.
731--
732-- /Internal/
733{-# INLINE_NORMAL bracket #-}
734bracket :: MonadCatch m
735 => (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
736bracket bef aft (Unfold step1 inject1) = Unfold step inject
738 where
740 inject x = do
741 r <- bef x
742 s <- inject1 r
743 return (s, r)
745 {-# INLINE_LATE step #-}
746 step (st, v) = do
747 res <- step1 st `MC.onException` aft v
748 case res of
749 Yield x s -> return $ Yield x (s, v)
750 Skip s -> return $ Skip (s, v)
751 Stop -> aft v >> return Stop
753-- | When unfolding if an exception occurs, unfold the exception using the
754-- exception unfold supplied as the first argument to 'handle'.
755--
756-- /Internal/
757{-# INLINE_NORMAL handle #-}
758handle :: (MonadCatch m, Exception e)
759 => Unfold m e b -> Unfold m a b -> Unfold m a b
760handle exc unf =
761 gbracket return MC.try (\_ -> return ()) (discardFirst exc) unf