#include "inline.hs"

-- |
-- Module      : Streamly.Internal.Data.Unfold
-- Copyright   : (c) 2019 Composewell Technologies
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- To run the examples in this module:
--
-- >>> import qualified Streamly.Data.Fold as Fold
-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold
--
-- = Unfolds and Streams
--
-- An 'Unfold' type is the same as the direct style 'Stream' type except that
-- it uses an inject function to determine the initial state of the stream
-- based on an input.  A stream is a special case of Unfold when the static
-- input is unit or Void.
--
-- This allows an important optimization to occur in several cases, making the
-- 'Unfold' a more efficient abstraction. Consider the 'concatMap' and
-- 'unfoldMany' operations, the latter is more efficient.  'concatMap'
-- generates a new stream object from each element in the stream by applying
-- the supplied function to the element, the stream object includes the "step"
-- function as well as the initial "state" of the stream.  Since the stream is
-- generated dynamically the compiler does not know the step function or the
-- state type statically at compile time, therefore, it cannot inline it. On
-- the other hand in case of 'unfoldMany' the compiler has visibility into
-- the unfold's state generation function, therefore, the compiler knows all
-- the types statically and it can inline the inject as well as the step
-- functions, generating efficient code. Essentially, the stream is not opaque
-- to the consumer in case of unfolds, the consumer knows how to generate the
-- stream from a seed using a known "inject" and "step" functions.
--
-- A Stream is like a data object whereas unfold is like a function.  Being
-- function like, an Unfold is an instance of 'Category' and 'Arrow' type
-- classes.
--
-- = Unfolds and Folds
--
-- Streams forcing a closed control flow loop can be categorized under
-- two types, unfolds and folds, both of these are duals of each other.
--
-- Unfold streams are really generators of a sequence of elements, we can also
-- call them pull style streams. These are lazy producers of streams. On each
-- evaluation the producer generates the next element.  A consumer can
-- therefore pull elements from the stream whenever it wants to.  A stream
-- consumer can multiplex pull streams by pulling elements from the chosen
-- streams, therefore, pull streams allow merging or multiplexing.  On the
-- other hand, with this representation we cannot split or demultiplex a
-- stream.  So really these are stream sources that can be generated from a
-- seed and can be merged or zipped into a single stream.
--
-- The dual of Unfolds are Folds. Folds can also be called as push style
-- streams or reducers. These are strict consumers of streams. We keep pushing
-- elements to a fold and we can extract the result at any point. A driver can
-- choose which fold to push to and can also push the same element to multiple
-- folds. Therefore, folds allow splitting or demultiplexing a stream. On the
-- other hand, we cannot merge streams using this representation. So really
-- these are stream consumers that reduce the stream to a single value, these
-- consumers can be composed such that a stream can be split over multiple
-- consumers.
--
-- Performance:
--
-- Composing a tree or graph of computations with unfolds can be much more
-- efficient compared to composing with the Monad instance.  The reason is that
-- unfolds allow the compiler to statically know the state and optimize it
-- using stream fusion whereas it is not possible with the monad bind because
-- the state is determined dynamically.

-- Open control flow style streams can also have two representations. StreamK
-- is a producer style representation. We can also have a consumer style
-- representation. We can use that for composable folds in StreamK
-- representation.
--

-- = Performance Notes
--
-- 'Unfold' representation is more efficient than using streams when combining
-- streams.  'Unfold' type allows multiple unfold actions to be composed into a
-- single unfold function in an efficient manner by enabling the compiler to
-- perform stream fusion optimization.
-- @Unfold m a b@ can be considered roughly equivalent to an action @a -> t m
-- b@ (where @t@ is a stream type). Instead of using an 'Unfold' one could just
-- use a function of the shape @a -> t m b@. However, working with stream types
-- like t'Streamly.SerialT' does not allow the compiler to perform stream fusion
-- optimization when merging, appending or concatenating multiple streams.
-- Even though stream based combinator have excellent performance, they are
-- much less efficient when compared to combinators using 'Unfold'.  For
-- example, the 'Streamly.Prelude.concatMap' combinator which uses @a -> t m b@
-- (where @t@ is a stream type) to generate streams is much less efficient
-- compared to 'Streamly.Prelude.unfoldMany'.
--
-- On the other hand, transformation operations on stream types are as
-- efficient as transformations on 'Unfold'.
--
-- We should note that in some cases working with stream types may be more
-- convenient compared to working with the 'Unfold' type.  However, if extra
-- performance boost is important then 'Unfold' based composition should be
-- preferred compared to stream based composition when merging or concatenating
-- streams.

module Streamly.Internal.Data.Unfold
    (
    -- * Unfold Type
      Step(..)
    , Unfold

    -- * Folding
    , fold
    -- pipe

    -- * Unfolds
    -- One to one correspondence with
    -- "Streamly.Internal.Data.Stream.IsStream.Generate"
    -- ** Basic Constructors
    , mkUnfoldM
    , mkUnfoldrM
    , unfoldrM
    , unfoldr
    , functionM
    , function
    , identity
    , nilM
    , consM

    -- ** From Values
    , fromEffect
    , fromPure

    -- ** Generators
    -- | Generate a monadic stream from a seed.
    , repeatM
    , replicateM
    , fromIndicesM
    , iterateM

    -- ** Enumerations
    -- *** Enumerate Num
    , enumerateFromStepNum
    , numFrom

    -- *** Enumerate Integral
    , enumerateFromStepIntegral
    , enumerateFromToIntegral
    , enumerateFromIntegral

    -- *** Enumerate Fractional
    -- | Use 'Num' enumerations for fractional or floating point number
    -- enumerations.
    , enumerateFromToFractional

    -- ** From Containers
    , fromList
    , fromListM

    , fromStream
    , fromStreamK
    , fromStreamD

    , fromSVar
    , fromProducer

    -- * Combinators
    -- ** Mapping on Input
    , lmap
    , lmapM
    , supply
    , supplyFirst
    , supplySecond
    , discardFirst
    , discardSecond
    , swap
    -- coapply
    -- comonad

    -- ** Mapping on Output
    , map
    , mapM
    , mapMWithInput

    -- ** Filtering
    , takeWhileM
    , takeWhile
    , take
    , filter
    , filterM
    , drop
    , dropWhile
    , dropWhileM

    -- ** Zipping
    , zipWithM
    , zipWith

    -- ** Cross product
    , crossWithM
    , crossWith
    , cross
    , apply

    -- ** Nesting
    , ConcatState (..)
    , many
    , concatMapM
    , bind

    -- ** Resource Management
    , gbracket_
    , gbracket
    , before
    , after
    , after_
    , finally
    , finally_
    , bracket
    , bracket_

    -- ** Exceptions
    , onException
    , handle
    )
where

import Control.Exception (Exception, fromException, mask_)
import Control.Monad ((>=>), when)
import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)
import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef)
import Data.Maybe (isNothing)
import Data.Void (Void)
import GHC.Types (SPEC(..))
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.IOFinalizer
    (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)
import Streamly.Internal.Data.Stream.StreamD.Type (Stream(..), Step(..))
import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)
import System.Mem (performMajorGC)

import qualified Prelude
import qualified Control.Monad.Catch as MC
import qualified Data.Tuple as Tuple
import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
import qualified Streamly.Internal.Data.Stream.StreamK as K (uncons)
import qualified Streamly.Internal.Data.Stream.StreamK.Type as K

import Streamly.Internal.Data.SVar
import Streamly.Internal.Data.Unfold.Type
import Prelude
       hiding (map, mapM, takeWhile, take, filter, const, zipWith
              , drop, dropWhile)

-- $setup
-- >>> import qualified Streamly.Data.Fold as Fold
-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold

-------------------------------------------------------------------------------
-- Input operations
-------------------------------------------------------------------------------

-- | Map an action on the input argument of the 'Unfold'.
--
-- @
-- lmapM f = Unfold.many (Unfold.functionM f)
-- @
--
-- /Since: 0.8.0/
{-# INLINE_NORMAL lmapM #-}
lmapM :: Monad m => (a -> m c) -> Unfold m c b -> Unfold m a b
lmapM :: (a -> m c) -> Unfold m c b -> Unfold m a b
lmapM a -> m c
f (Unfold s -> m (Step s b)
ustep c -> m s
uinject) = (s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold s -> m (Step s b)
ustep (a -> m c
f (a -> m c) -> (c -> m s) -> a -> m s
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> c -> m s
uinject)

-- | Supply the seed to an unfold closing the input end of the unfold.
--
-- @
-- supply a = Unfold.lmap (Prelude.const a)
-- @
--
-- /Pre-release/
--
{-# INLINE_NORMAL supply #-}
supply :: a -> Unfold m a b -> Unfold m Void b
supply :: a -> Unfold m a b -> Unfold m Void b
supply a
a = (Void -> a) -> Unfold m a b -> Unfold m Void b
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
lmap (a -> Void -> a
forall a b. a -> b -> a
Prelude.const a
a)

-- | Supply the first component of the tuple to an unfold that accepts a tuple
-- as a seed resulting in a fold that accepts the second component of the tuple
-- as a seed.
--
-- @
-- supplyFirst a = Unfold.lmap (a, )
-- @
--
-- /Pre-release/
--
{-# INLINE_NORMAL supplyFirst #-}
supplyFirst :: a -> Unfold m (a, b) c -> Unfold m b c
supplyFirst :: a -> Unfold m (a, b) c -> Unfold m b c
supplyFirst a
a = (b -> (a, b)) -> Unfold m (a, b) c -> Unfold m b c
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
lmap (a
a, )

-- | Supply the second component of the tuple to an unfold that accepts a tuple
-- as a seed resulting in a fold that accepts the first component of the tuple
-- as a seed.
--
-- @
-- supplySecond b = Unfold.lmap (, b)
-- @
--
-- /Pre-release/
--
{-# INLINE_NORMAL supplySecond #-}
supplySecond :: b -> Unfold m (a, b) c -> Unfold m a c
supplySecond :: b -> Unfold m (a, b) c -> Unfold m a c
supplySecond b
b = (a -> (a, b)) -> Unfold m (a, b) c -> Unfold m a c
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
lmap (, b
b)

-- | Convert an 'Unfold' into an unfold accepting a tuple as an argument,
-- using the argument of the original fold as the second element of tuple and
-- discarding the first element of the tuple.
--
-- @
-- discardFirst = Unfold.lmap snd
-- @
--
-- /Pre-release/
--
{-# INLINE_NORMAL discardFirst #-}
discardFirst :: Unfold m a b -> Unfold m (c, a) b
discardFirst :: Unfold m a b -> Unfold m (c, a) b
discardFirst = ((c, a) -> a) -> Unfold m a b -> Unfold m (c, a) b
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
lmap (c, a) -> a
forall a b. (a, b) -> b
snd

-- | Convert an 'Unfold' into an unfold accepting a tuple as an argument,
-- using the argument of the original fold as the first element of tuple and
-- discarding the second element of the tuple.
--
-- @
-- discardSecond = Unfold.lmap fst
-- @
--
-- /Pre-release/
--
{-# INLINE_NORMAL discardSecond #-}
discardSecond :: Unfold m a b -> Unfold m (a, c) b
discardSecond :: Unfold m a b -> Unfold m (a, c) b
discardSecond = ((a, c) -> a) -> Unfold m a b -> Unfold m (a, c) b
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
lmap (a, c) -> a
forall a b. (a, b) -> a
fst

-- | Convert an 'Unfold' that accepts a tuple as an argument into an unfold
-- that accepts a tuple with elements swapped.
--
-- @
-- swap = Unfold.lmap Tuple.swap
-- @
--
-- /Pre-release/
--
{-# INLINE_NORMAL swap #-}
swap :: Unfold m (a, c) b -> Unfold m (c, a) b
swap :: Unfold m (a, c) b -> Unfold m (c, a) b
swap = ((c, a) -> (a, c)) -> Unfold m (a, c) b -> Unfold m (c, a) b
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
lmap (c, a) -> (a, c)
forall a b. (a, b) -> (b, a)
Tuple.swap

-------------------------------------------------------------------------------
-- Output operations
-------------------------------------------------------------------------------

-- | Compose an 'Unfold' and a 'Fold'. Given an @Unfold m a b@ and a
-- @Fold m b c@, returns a monadic action @a -> m c@ representing the
-- application of the fold on the unfolded stream.
--
-- >>> Unfold.fold Fold.sum Unfold.fromList [1..100]
-- 5050
--
-- /Pre-release/
--
{-# INLINE_NORMAL fold #-}
fold :: Monad m => Fold m b c -> Unfold m a b -> a -> m c
fold :: Fold m b c -> Unfold m a b -> a -> m c
fold (Fold s -> b -> m (Step s c)
fstep m (Step s c)
initial s -> m c
extract) (Unfold s -> m (Step s b)
ustep a -> m s
inject) a
a = do
    Step s c
res <- m (Step s c)
initial
    case Step s c
res of
        FL.Partial s
x -> a -> m s
inject a
a m s -> (s -> m c) -> m c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SPEC -> s -> s -> m c
go SPEC
SPEC s
x
        FL.Done c
b -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
b

    where

    {-# INLINE_LATE go #-}
    go :: SPEC -> s -> s -> m c
go !SPEC
_ !s
fs s
st = do
        Step s b
r <- s -> m (Step s b)
ustep s
st
        case Step s b
r of
            Yield b
x s
s -> do
                Step s c
res <- s -> b -> m (Step s c)
fstep s
fs b
x
                case Step s c
res of
                    FL.Partial s
fs1 -> SPEC -> s -> s -> m c
go SPEC
SPEC s
fs1 s
s
                    FL.Done c
c -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
c
            Skip s
s -> SPEC -> s -> s -> m c
go SPEC
SPEC s
fs s
s
            Step s b
Stop -> s -> m c
extract s
fs

-- | Apply a monadic function to each element of the stream and replace it
-- with the output of the resulting action.
--
-- /Since: 0.8.0/
--
{-# INLINE_NORMAL mapM #-}
mapM :: Monad m => (b -> m c) -> Unfold m a b -> Unfold m a c
mapM :: (b -> m c) -> Unfold m a b -> Unfold m a c
mapM b -> m c
f (Unfold s -> m (Step s b)
ustep a -> m s
uinject) = (s -> m (Step s c)) -> (a -> m s) -> Unfold m a c
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold s -> m (Step s c)
step a -> m s
uinject
    where
    {-# INLINE_LATE step #-}
    step :: s -> m (Step s c)
step s
st = do
        Step s b
r <- s -> m (Step s b)
ustep s
st
        case Step s b
r of
            Yield b
x s
s -> b -> m c
f b
x m c -> (c -> m (Step s c)) -> m (Step s c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c
a -> Step s c -> m (Step s c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s c -> m (Step s c)) -> Step s c -> m (Step s c)
forall a b. (a -> b) -> a -> b
$ c -> s -> Step s c
forall s a. a -> s -> Step s a
Yield c
a s
s
            Skip s
s    -> Step s c -> m (Step s c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s c -> m (Step s c)) -> Step s c -> m (Step s c)
forall a b. (a -> b) -> a -> b
$ s -> Step s c
forall s a. s -> Step s a
Skip s
s
            Step s b
Stop      -> Step s c -> m (Step s c)
forall (m :: * -> *) a. Monad m => a -> m a
return Step s c
forall s a. Step s a
Stop

{-# INLINE_NORMAL mapMWithInput #-}
mapMWithInput :: Monad m => (a -> b -> m c) -> Unfold m a b -> Unfold m a c
mapMWithInput :: (a -> b -> m c) -> Unfold m a b -> Unfold m a c
mapMWithInput a -> b -> m c
f (Unfold s -> m (Step s b)
ustep a -> m s
uinject) = ((a, s) -> m (Step (a, s) c)) -> (a -> m (a, s)) -> Unfold m a c
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (a, s) -> m (Step (a, s) c)
step a -> m (a, s)
inject
    where
    inject :: a -> m (a, s)
inject a
a = do
        s
r <- a -> m s
uinject a
a
        (a, s) -> m (a, s)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, s
r)

    {-# INLINE_LATE step #-}
    step :: (a, s) -> m (Step (a, s) c)
step (a
inp, s
st) = do
        Step s b
r <- s -> m (Step s b)
ustep s
st
        case Step s b
r of
            Yield b
x s
s -> a -> b -> m c
f a
inp b
x m c -> (c -> m (Step (a, s) c)) -> m (Step (a, s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c
a -> Step (a, s) c -> m (Step (a, s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, s) c -> m (Step (a, s) c))
-> Step (a, s) c -> m (Step (a, s) c)
forall a b. (a -> b) -> a -> b
$ c -> (a, s) -> Step (a, s) c
forall s a. a -> s -> Step s a
Yield c
a (a
inp, s
s)
            Skip s
s    -> Step (a, s) c -> m (Step (a, s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, s) c -> m (Step (a, s) c))
-> Step (a, s) c -> m (Step (a, s) c)
forall a b. (a -> b) -> a -> b
$ (a, s) -> Step (a, s) c
forall s a. s -> Step s a
Skip (a
inp, s
s)
            Step s b
Stop      -> Step (a, s) c -> m (Step (a, s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (a, s) c
forall s a. Step s a
Stop

-------------------------------------------------------------------------------
-- Convert streams into unfolds
-------------------------------------------------------------------------------

{-# INLINE_NORMAL fromStreamD #-}
fromStreamD :: Monad m => Unfold m (Stream m a) a
fromStreamD :: Unfold m (Stream m a) a
fromStreamD = (Stream m a -> m (Step (Stream m a) a))
-> (Stream m a -> m (Stream m a)) -> Unfold m (Stream m a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Stream m a -> m (Step (Stream m a) a)
forall (m :: * -> *) a.
Monad m =>
Stream m a -> m (Step (Stream m a) a)
step Stream m a -> m (Stream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return
    where

    {-# INLINE_LATE step #-}
    step :: Stream m a -> m (Step (Stream m a) a)
step (UnStream State Stream m a -> s -> m (Step s a)
step1 s
state1) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
state1
        Step (Stream m a) a -> m (Step (Stream m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Stream m a) a -> m (Step (Stream m a) a))
-> Step (Stream m a) a -> m (Step (Stream m a) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
x s
s -> a -> Stream m a -> Step (Stream m a) a
forall s a. a -> s -> Step s a
Yield a
x ((State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m a -> s -> m (Step s a)
step1 s
s)
            Skip s
s    -> Stream m a -> Step (Stream m a) a
forall s a. s -> Step s a
Skip ((State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m a -> s -> m (Step s a)
step1 s
s)
            Step s a
Stop      -> Step (Stream m a) a
forall s a. Step s a
Stop

{-# INLINE_NORMAL fromStreamK #-}
fromStreamK :: Monad m => Unfold m (K.Stream m a) a
fromStreamK :: Unfold m (Stream m a) a
fromStreamK = (Stream m a -> m (Step (Stream m a) a))
-> (Stream m a -> m (Stream m a)) -> Unfold m (Stream m a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Stream m a -> m (Step (Stream m a) a)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, IsStream t) =>
t m a -> m (Step (t m a) a)
step Stream m a -> m (Stream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return

    where

    {-# INLINE_LATE step #-}
    step :: t m a -> m (Step (t m a) a)
step t m a
stream = do
        Maybe (a, t m a)
r <- t m a -> m (Maybe (a, t m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> m (Maybe (a, t m a))
K.uncons t m a
stream
        Step (t m a) a -> m (Step (t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (t m a) a -> m (Step (t m a) a))
-> Step (t m a) a -> m (Step (t m a) a)
forall a b. (a -> b) -> a -> b
$ case Maybe (a, t m a)
r of
            Just (a
x, t m a
xs) -> a -> t m a -> Step (t m a) a
forall s a. a -> s -> Step s a
Yield a
x t m a
xs
            Maybe (a, t m a)
Nothing -> Step (t m a) a
forall s a. Step s a
Stop

-- XXX Using Unfold.fromStreamD seems to be faster (using cross product test
-- case) than using fromStream even if it is implemented using fromStreamD.
--
-- | Convert a stream into an 'Unfold'. Note that a stream converted to an
-- 'Unfold' may not be as efficient as an 'Unfold' in some situations.
--
-- /Since: 0.8.0/
--
{-# INLINE_NORMAL fromStream #-}
fromStream :: (K.IsStream t, Monad m) => Unfold m (t m a) a
fromStream :: Unfold m (t m a) a
fromStream = (t m a -> Stream m a)
-> Unfold m (Stream m a) a -> Unfold m (t m a) a
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
lmap t m a -> Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
t m a -> Stream m a
K.toStream Unfold m (Stream m a) a
forall (m :: * -> *) a. Monad m => Unfold m (Stream m a) a
fromStreamK

-------------------------------------------------------------------------------
-- Unfolds
-------------------------------------------------------------------------------

-- | Lift a monadic function into an unfold generating a nil stream with a side
-- effect.
--
{-# INLINE nilM #-}
nilM :: Monad m => (a -> m c) -> Unfold m a b
nilM :: (a -> m c) -> Unfold m a b
nilM a -> m c
f = (a -> m (Step a b)) -> (a -> m a) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold a -> m (Step a b)
forall s a. a -> m (Step s a)
step a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    where
    {-# INLINE_LATE step #-}
    step :: a -> m (Step s a)
step a
x = a -> m c
f a
x m c -> m (Step s a) -> m (Step s a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step s a -> m (Step s a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step s a
forall s a. Step s a
Stop

-- | Prepend a monadic single element generator function to an 'Unfold'. The
-- same seed is used in the action as well as the unfold.
--
-- /Pre-release/
{-# INLINE_NORMAL consM #-}
consM :: Monad m => (a -> m b) -> Unfold m a b -> Unfold m a b
consM :: (a -> m b) -> Unfold m a b -> Unfold m a b
consM a -> m b
action Unfold m a b
unf = (Either a (Stream m b) -> m (Step (Either a (Stream m b)) b))
-> (a -> m (Either a (Stream m b))) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Either a (Stream m b) -> m (Step (Either a (Stream m b)) b)
forall a.
Either a (Stream m b) -> m (Step (Either a (Stream m b)) b)
step a -> m (Either a (Stream m b))
forall a b. a -> m (Either a b)
inject

    where

    inject :: a -> m (Either a b)
inject = Either a b -> m (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> m (Either a b))
-> (a -> Either a b) -> a -> m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left

    {-# INLINE_LATE step #-}
    step :: Either a (Stream m b) -> m (Step (Either a (Stream m b)) b)
step (Left a
a) =
        a -> m b
action a
a m b
-> (b -> m (Step (Either a (Stream m b)) b))
-> m (Step (Either a (Stream m b)) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> Step (Either a (Stream m b)) b
-> m (Step (Either a (Stream m b)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either a (Stream m b)) b
 -> m (Step (Either a (Stream m b)) b))
-> Step (Either a (Stream m b)) b
-> m (Step (Either a (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ b -> Either a (Stream m b) -> Step (Either a (Stream m b)) b
forall s a. a -> s -> Step s a
Yield b
r (Stream m b -> Either a (Stream m b)
forall a b. b -> Either a b
Right (Unfold m a b -> a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> a -> Stream m b
D.unfold Unfold m a b
unf a
a))
    step (Right (UnStream State Stream m b -> s -> m (Step s b)
step1 s
st)) = do
        Step s b
res <- State Stream m b -> s -> m (Step s b)
step1 State Stream m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s b
res of
            Yield b
x s
s -> Step (Either a (Stream m b)) b
-> m (Step (Either a (Stream m b)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either a (Stream m b)) b
 -> m (Step (Either a (Stream m b)) b))
-> Step (Either a (Stream m b)) b
-> m (Step (Either a (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ b -> Either a (Stream m b) -> Step (Either a (Stream m b)) b
forall s a. a -> s -> Step s a
Yield b
x (Stream m b -> Either a (Stream m b)
forall a b. b -> Either a b
Right ((State Stream m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b -> s -> m (Step s b)
step1 s
s))
            Skip s
s -> Step (Either a (Stream m b)) b
-> m (Step (Either a (Stream m b)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either a (Stream m b)) b
 -> m (Step (Either a (Stream m b)) b))
-> Step (Either a (Stream m b)) b
-> m (Step (Either a (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ Either a (Stream m b) -> Step (Either a (Stream m b)) b
forall s a. s -> Step s a
Skip (Stream m b -> Either a (Stream m b)
forall a b. b -> Either a b
Right ((State Stream m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b -> s -> m (Step s b)
step1 s
s))
            Step s b
Stop -> Step (Either a (Stream m b)) b
-> m (Step (Either a (Stream m b)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Either a (Stream m b)) b
forall s a. Step s a
Stop

-- | Convert a list of pure values to a 'Stream'
--
-- /Since: 0.8.0/
--
{-# INLINE_LATE fromList #-}
fromList :: Monad m => Unfold m [a] a
fromList :: Unfold m [a] a
fromList = ([a] -> m (Step [a] a)) -> ([a] -> m [a]) -> Unfold m [a] a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold [a] -> m (Step [a] a)
forall (m :: * -> *) a. Monad m => [a] -> m (Step [a] a)
step [a] -> m [a]
forall a. a -> m a
inject
  where
    inject :: a -> m a
inject = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    {-# INLINE_LATE step #-}
    step :: [a] -> m (Step [a] a)
step (a
x:[a]
xs) = Step [a] a -> m (Step [a] a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step [a] a -> m (Step [a] a)) -> Step [a] a -> m (Step [a] a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> Step [a] a
forall s a. a -> s -> Step s a
Yield a
x [a]
xs
    step []     = Step [a] a -> m (Step [a] a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step [a] a
forall s a. Step s a
Stop

-- | Convert a list of monadic values to a 'Stream'
--
-- /Since: 0.8.0/
--
{-# INLINE_LATE fromListM #-}
fromListM :: Monad m => Unfold m [m a] a
fromListM :: Unfold m [m a] a
fromListM = ([m a] -> m (Step [m a] a))
-> ([m a] -> m [m a]) -> Unfold m [m a] a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold [m a] -> m (Step [m a] a)
forall (m :: * -> *) a. Monad m => [m a] -> m (Step [m a] a)
step [m a] -> m [m a]
forall a. a -> m a
inject
  where
    inject :: a -> m a
inject = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    {-# INLINE_LATE step #-}
    step :: [m a] -> m (Step [m a] a)
step (m a
x:[m a]
xs) = m a
x m a -> (a -> m (Step [m a] a)) -> m (Step [m a] a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
r -> Step [m a] a -> m (Step [m a] a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step [m a] a -> m (Step [m a] a))
-> Step [m a] a -> m (Step [m a] a)
forall a b. (a -> b) -> a -> b
$ a -> [m a] -> Step [m a] a
forall s a. a -> s -> Step s a
Yield a
r [m a]
xs
    step []     = Step [m a] a -> m (Step [m a] a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step [m a] a
forall s a. Step s a
Stop

------------------------------------------------------------------------------
-- Specialized Generation
------------------------------------------------------------------------------

-- | Generates a stream replicating the seed @n@ times.
--
-- /Since: 0.8.0/
--
{-# INLINE replicateM #-}
replicateM :: Monad m => Int -> Unfold m (m a) a
replicateM :: Int -> Unfold m (m a) a
replicateM Int
n = ((m a, Int) -> m (Step (m a, Int) a))
-> (m a -> m (m a, Int)) -> Unfold m (m a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (m a, Int) -> m (Step (m a, Int) a)
forall b (m :: * -> *) a.
(Ord b, Num b, Monad m) =>
(m a, b) -> m (Step (m a, b) a)
step m a -> m (m a, Int)
forall (m :: * -> *) a. Monad m => a -> m (a, Int)
inject

    where

    inject :: a -> m (a, Int)
inject a
x = (a, Int) -> m (a, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, Int
n)

    {-# INLINE_LATE step #-}
    step :: (m a, b) -> m (Step (m a, b) a)
step (m a
x, b
i) =
        if b
i b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0
        then Step (m a, b) a -> m (Step (m a, b) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (m a, b) a
forall s a. Step s a
Stop
        else do
            a
x1 <- m a
x
            Step (m a, b) a -> m (Step (m a, b) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (m a, b) a -> m (Step (m a, b) a))
-> Step (m a, b) a -> m (Step (m a, b) a)
forall a b. (a -> b) -> a -> b
$ a -> (m a, b) -> Step (m a, b) a
forall s a. a -> s -> Step s a
Yield a
x1 (m a
x, b
i b -> b -> b
forall a. Num a => a -> a -> a
- b
1)

-- | Generates an infinite stream repeating the seed.
--
-- /Since: 0.8.0/
--
{-# INLINE repeatM #-}
repeatM :: Monad m => Unfold m (m a) a
repeatM :: Unfold m (m a) a
repeatM = (m a -> m (Step (m a) a)) -> (m a -> m (m a)) -> Unfold m (m a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold m a -> m (Step (m a) a)
forall (m :: * -> *) a. Monad m => m a -> m (Step (m a) a)
step m a -> m (m a)
forall (m :: * -> *) a. Monad m => a -> m a
return
    where
    {-# INLINE_LATE step #-}
    step :: m a -> m (Step (m a) a)
step m a
x = m a
x m a -> (a -> m (Step (m a) a)) -> m (Step (m a) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x1 -> Step (m a) a -> m (Step (m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (m a) a -> m (Step (m a) a))
-> Step (m a) a -> m (Step (m a) a)
forall a b. (a -> b) -> a -> b
$ a -> m a -> Step (m a) a
forall s a. a -> s -> Step s a
Yield a
x1 m a
x

-- | Generates an infinite stream starting with the given seed and applying the
-- given function repeatedly.
--
-- /Since: 0.8.0/
--
{-# INLINE iterateM #-}
iterateM :: Monad m => (a -> m a) -> Unfold m (m a) a
iterateM :: (a -> m a) -> Unfold m (m a) a
iterateM a -> m a
f = (a -> m (Step a a)) -> (m a -> m a) -> Unfold m (m a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold a -> m (Step a a)
step m a -> m a
forall a. a -> a
id
    where
    {-# INLINE_LATE step #-}
    step :: a -> m (Step a a)
step a
x = do
        a
fx <- a -> m a
f a
x
        Step a a -> m (Step a a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step a a -> m (Step a a)) -> Step a a -> m (Step a a)
forall a b. (a -> b) -> a -> b
$ a -> a -> Step a a
forall s a. a -> s -> Step s a
Yield a
x a
fx

-- | @fromIndicesM gen@ generates an infinite stream of values using @gen@
-- starting from the seed.
--
-- @
-- fromIndicesM f = Unfold.mapM f $ Unfold.enumerateFrom 0
-- @
--
-- /Pre-release/
--
{-# INLINE_NORMAL fromIndicesM #-}
fromIndicesM :: Monad m => (Int -> m a) -> Unfold m Int a
fromIndicesM :: (Int -> m a) -> Unfold m Int a
fromIndicesM Int -> m a
gen = (Int -> m (Step Int a)) -> (Int -> m Int) -> Unfold m Int a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Int -> m (Step Int a)
step Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return
  where
    {-# INLINE_LATE step #-}
    step :: Int -> m (Step Int a)
step Int
i = do
         a
x <- Int -> m a
gen Int
i
         Step Int a -> m (Step Int a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step Int a -> m (Step Int a)) -> Step Int a -> m (Step Int a)
forall a b. (a -> b) -> a -> b
$ a -> Int -> Step Int a
forall s a. a -> s -> Step s a
Yield a
x (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-------------------------------------------------------------------------------
-- Filtering
-------------------------------------------------------------------------------

-- |
-- >>> u = Unfold.take 2 Unfold.fromList
-- >>> Unfold.fold Fold.toList u [1..100]
-- [1,2]
--
-- /Since: 0.8.0/
--
{-# INLINE_NORMAL take #-}
take :: Monad m => Int -> Unfold m a b -> Unfold m a b
take :: Int -> Unfold m a b -> Unfold m a b
take Int
n (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = ((s, Int) -> m (Step (s, Int) b))
-> (a -> m (s, Int)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, Int) -> m (Step (s, Int) b)
step a -> m (s, Int)
forall b. Num b => a -> m (s, b)
inject
  where
    inject :: a -> m (s, b)
inject a
x = do
        s
s <- a -> m s
inject1 a
x
        (s, b) -> m (s, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, b
0)
    {-# INLINE_LATE step #-}
    step :: (s, Int) -> m (Step (s, Int) b)
step (s
st, Int
i) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = do
        Step s b
r <- s -> m (Step s b)
step1 s
st
        Step (s, Int) b -> m (Step (s, Int) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, Int) b -> m (Step (s, Int) b))
-> Step (s, Int) b -> m (Step (s, Int) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b -> (s, Int) -> Step (s, Int) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Skip s
s -> (s, Int) -> Step (s, Int) b
forall s a. s -> Step s a
Skip (s
s, Int
i)
            Step s b
Stop   -> Step (s, Int) b
forall s a. Step s a
Stop
    step (s
_, Int
_) = Step (s, Int) b -> m (Step (s, Int) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, Int) b
forall s a. Step s a
Stop

-- | Same as 'takeWhile' but with a monadic predicate.
--
-- /Since: 0.8.0/
--
{-# INLINE_NORMAL takeWhileM #-}
takeWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b
takeWhileM :: (b -> m Bool) -> Unfold m a b -> Unfold m a b
takeWhileM b -> m Bool
f (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = (s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold s -> m (Step s b)
step a -> m s
inject1
  where
    {-# INLINE_LATE step #-}
    step :: s -> m (Step s b)
step s
st = do
        Step s b
r <- s -> m (Step s b)
step1 s
st
        case Step s b
r of
            Yield b
x s
s -> do
                Bool
b <- b -> m Bool
f b
x
                Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ if Bool
b then b -> s -> Step s b
forall s a. a -> s -> Step s a
Yield b
x s
s else Step s b
forall s a. Step s a
Stop
            Skip s
s -> Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> Step s b
forall s a. s -> Step s a
Skip s
s
            Step s b
Stop   -> Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
forall s a. Step s a
Stop

-- | End the stream generated by the 'Unfold' as soon as the predicate fails
-- on an element.
--
-- /Since: 0.8.0/
--
{-# INLINE takeWhile #-}
takeWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b
takeWhile :: (b -> Bool) -> Unfold m a b -> Unfold m a b
takeWhile b -> Bool
f = (b -> m Bool) -> Unfold m a b -> Unfold m a b
forall (m :: * -> *) b a.
Monad m =>
(b -> m Bool) -> Unfold m a b -> Unfold m a b
takeWhileM (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (b -> Bool) -> b -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Bool
f)

-- | Same as 'filter' but with a monadic predicate.
--
-- /Since: 0.8.0/
--
{-# INLINE_NORMAL filterM #-}
filterM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b
filterM :: (b -> m Bool) -> Unfold m a b -> Unfold m a b
filterM b -> m Bool
f (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = (s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold s -> m (Step s b)
step a -> m s
inject1
  where
    {-# INLINE_LATE step #-}
    step :: s -> m (Step s b)
step s
st = do
        Step s b
r <- s -> m (Step s b)
step1 s
st
        case Step s b
r of
            Yield b
x s
s -> do
                Bool
b <- b -> m Bool
f b
x
                Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ if Bool
b then b -> s -> Step s b
forall s a. a -> s -> Step s a
Yield b
x s
s else s -> Step s b
forall s a. s -> Step s a
Skip s
s
            Skip s
s -> Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> Step s b
forall s a. s -> Step s a
Skip s
s
            Step s b
Stop   -> Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
forall s a. Step s a
Stop

-- | Include only those elements that pass a predicate.
--
-- /Since: 0.8.0/
--
{-# INLINE filter #-}
filter :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b
filter :: (b -> Bool) -> Unfold m a b -> Unfold m a b
filter b -> Bool
f = (b -> m Bool) -> Unfold m a b -> Unfold m a b
forall (m :: * -> *) b a.
Monad m =>
(b -> m Bool) -> Unfold m a b -> Unfold m a b
filterM (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (b -> Bool) -> b -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Bool
f)

-- | @drop n unf@ drops @n@ elements from the stream generated by @unf@.
--
-- /Since: 0.8.0/
--
{-# INLINE_NORMAL drop #-}
drop :: Monad m => Int -> Unfold m a b -> Unfold m a b
drop :: Int -> Unfold m a b -> Unfold m a b
drop Int
n (Unfold s -> m (Step s b)
step a -> m s
inject) = ((s, Int) -> m (Step (s, Int) b))
-> (a -> m (s, Int)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, Int) -> m (Step (s, Int) b)
forall b. (Ord b, Num b) => (s, b) -> m (Step (s, b) b)
step' a -> m (s, Int)
inject'

    where

    inject' :: a -> m (s, Int)
inject' a
a = do
        s
b <- a -> m s
inject a
a
        (s, Int) -> m (s, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
b, Int
n)

    {-# INLINE_LATE step' #-}
    step' :: (s, b) -> m (Step (s, b) b)
step' (s
st, b
i)
        | b
i b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0 = do
            Step s b
r <- s -> m (Step s b)
step s
st
            Step (s, b) b -> m (Step (s, b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
                (Step (s, b) b -> m (Step (s, b) b))
-> Step (s, b) b -> m (Step (s, b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
                      Yield b
_ s
s -> (s, b) -> Step (s, b) b
forall s a. s -> Step s a
Skip (s
s, b
i b -> b -> b
forall a. Num a => a -> a -> a
- b
1)
                      Skip s
s -> (s, b) -> Step (s, b) b
forall s a. s -> Step s a
Skip (s
s, b
i)
                      Step s b
Stop -> Step (s, b) b
forall s a. Step s a
Stop
        | Bool
otherwise = do
            Step s b
r <- s -> m (Step s b)
step s
st
            Step (s, b) b -> m (Step (s, b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
                (Step (s, b) b -> m (Step (s, b) b))
-> Step (s, b) b -> m (Step (s, b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
                      Yield b
x s
s -> b -> (s, b) -> Step (s, b) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, b
0)
                      Skip s
s -> (s, b) -> Step (s, b) b
forall s a. s -> Step s a
Skip (s
s, b
0)
                      Step s b
Stop -> Step (s, b) b
forall s a. Step s a
Stop

-- | @dropWhileM f unf@ drops elements from the stream generated by @unf@ while
-- the condition holds true. The condition function @f@ is /monadic/ in nature.
--
-- /Since: 0.8.0/
--
{-# INLINE_NORMAL dropWhileM #-}
dropWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b
dropWhileM :: (b -> m Bool) -> Unfold m a b -> Unfold m a b
dropWhileM b -> m Bool
f (Unfold s -> m (Step s b)
step a -> m s
inject) = (Either s s -> m (Step (Either s s) b))
-> (a -> m (Either s s)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Either s s -> m (Step (Either s s) b)
step' a -> m (Either s s)
forall b. a -> m (Either s b)
inject'

    where

    inject' :: a -> m (Either s b)
inject' a
a = do
        s
b <- a -> m s
inject a
a
        Either s b -> m (Either s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either s b -> m (Either s b)) -> Either s b -> m (Either s b)
forall a b. (a -> b) -> a -> b
$ s -> Either s b
forall a b. a -> Either a b
Left s
b

    {-# INLINE_LATE step' #-}
    step' :: Either s s -> m (Step (Either s s) b)
step' (Left s
st) = do
        Step s b
r <- s -> m (Step s b)
step s
st
        case Step s b
r of
            Yield b
x s
s -> do
                Bool
b <- b -> m Bool
f b
x
                Step (Either s s) b -> m (Step (Either s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step (Either s s) b -> m (Step (Either s s) b))
-> Step (Either s s) b -> m (Step (Either s s) b)
forall a b. (a -> b) -> a -> b
$ if Bool
b
                      then Either s s -> Step (Either s s) b
forall s a. s -> Step s a
Skip (s -> Either s s
forall a b. a -> Either a b
Left s
s)
                      else b -> Either s s -> Step (Either s s) b
forall s a. a -> s -> Step s a
Yield b
x (s -> Either s s
forall a b. b -> Either a b
Right s
s)
            Skip s
s -> Step (Either s s) b -> m (Step (Either s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s s) b -> m (Step (Either s s) b))
-> Step (Either s s) b -> m (Step (Either s s) b)
forall a b. (a -> b) -> a -> b
$ Either s s -> Step (Either s s) b
forall s a. s -> Step s a
Skip (s -> Either s s
forall a b. a -> Either a b
Left s
s)
            Step s b
Stop -> Step (Either s s) b -> m (Step (Either s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Either s s) b
forall s a. Step s a
Stop
    step' (Right s
st) = do
        Step s b
r <- s -> m (Step s b)
step s
st
        Step (Either s s) b -> m (Step (Either s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Either s s) b -> m (Step (Either s s) b))
-> Step (Either s s) b -> m (Step (Either s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
                  Yield b
x s
s -> b -> Either s s -> Step (Either s s) b
forall s a. a -> s -> Step s a
Yield b
x (s -> Either s s
forall a b. b -> Either a b
Right s
s)
                  Skip s
s -> Either s s -> Step (Either s s) b
forall s a. s -> Step s a
Skip (s -> Either s s
forall a b. b -> Either a b
Right s
s)
                  Step s b
Stop -> Step (Either s s) b
forall s a. Step s a
Stop

-- | Similar to 'dropWhileM' but with a pure condition function.
--
-- /Since: 0.8.0/
--
{-# INLINE dropWhile #-}
dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b
dropWhile :: (b -> Bool) -> Unfold m a b -> Unfold m a b
dropWhile b -> Bool
f = (b -> m Bool) -> Unfold m a b -> Unfold m a b
forall (m :: * -> *) b a.
Monad m =>
(b -> m Bool) -> Unfold m a b -> Unfold m a b
dropWhileM (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (b -> Bool) -> b -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Bool
f)

------------------------------------------------------------------------------
-- Enumeration of Num
------------------------------------------------------------------------------

-- | Generate an infinite stream starting from a starting value with increments
-- of the given stride.  The implementation is numerically stable for floating
-- point values.
--
-- Note 'enumerateFromStepIntegral' is faster for integrals.
--
-- /Pre-release/
--
{-# INLINE enumerateFromStepNum #-}
enumerateFromStepNum :: (Monad m, Num a) => a -> Unfold m a a
enumerateFromStepNum :: a -> Unfold m a a
enumerateFromStepNum a
stride = ((a, a) -> m (Step (a, a) a)) -> (a -> m (a, a)) -> Unfold m a a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (a, a) -> m (Step (a, a) a)
forall (m :: * -> *). Monad m => (a, a) -> m (Step (a, a) a)
step a -> m (a, a)
forall (m :: * -> *) b a. (Monad m, Num b) => a -> m (a, b)
inject

    where

    inject :: a -> m (a, b)
inject !a
from = (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
from, b
0)

    {-# INLINE_LATE step #-}
    step :: (a, a) -> m (Step (a, a) a)
step (a
from, !a
i) = Step (a, a) a -> m (Step (a, a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, a) a -> m (Step (a, a) a))
-> Step (a, a) a -> m (Step (a, a) a)
forall a b. (a -> b) -> a -> b
$ (a -> (a, a) -> Step (a, a) a
forall s a. a -> s -> Step s a
Yield (a -> (a, a) -> Step (a, a) a) -> a -> (a, a) -> Step (a, a) a
forall a b. (a -> b) -> a -> b
$! (a
from a -> a -> a
forall a. Num a => a -> a -> a
+ a
i a -> a -> a
forall a. Num a => a -> a -> a
* a
stride)) ((a, a) -> Step (a, a) a) -> (a, a) -> Step (a, a) a
forall a b. (a -> b) -> a -> b
$! (a
from, a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)

-- | @numFrom = enumerateFromStepNum 1@
--
-- /Pre-release/
--
{-# INLINE_NORMAL numFrom #-}
numFrom :: (Monad m, Num a) => Unfold m a a
numFrom :: Unfold m a a
numFrom = a -> Unfold m a a
forall (m :: * -> *) a. (Monad m, Num a) => a -> Unfold m a a
enumerateFromStepNum a
1

------------------------------------------------------------------------------
-- Enumeration of Integrals
------------------------------------------------------------------------------

-- | Can be used to enumerate unbounded integrals. This does not check for
-- overflow or underflow for bounded integrals.
{-# INLINE_NORMAL enumerateFromStepIntegral #-}
enumerateFromStepIntegral :: (Integral a, Monad m) => Unfold m (a, a) a
enumerateFromStepIntegral :: Unfold m (a, a) a
enumerateFromStepIntegral = ((a, a) -> m (Step (a, a) a))
-> ((a, a) -> m (a, a)) -> Unfold m (a, a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (a, a) -> m (Step (a, a) a)
forall (m :: * -> *) b.
(Monad m, Num b) =>
(b, b) -> m (Step (b, b) b)
step (a, a) -> m (a, a)
forall (m :: * -> *) a b. Monad m => (a, b) -> m (a, b)
inject
    where
    inject :: (a, b) -> m (a, b)
inject (a
from, b
stride) = a
from a -> m (a, b) -> m (a, b)
`seq` b
stride b -> m (a, b) -> m (a, b)
`seq` (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
from, b
stride)
    {-# INLINE_LATE step #-}
    step :: (b, b) -> m (Step (b, b) b)
step (b
x, b
stride) = Step (b, b) b -> m (Step (b, b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (b, b) b -> m (Step (b, b) b))
-> Step (b, b) b -> m (Step (b, b) b)
forall a b. (a -> b) -> a -> b
$ b -> (b, b) -> Step (b, b) b
forall s a. a -> s -> Step s a
Yield b
x ((b, b) -> Step (b, b) b) -> (b, b) -> Step (b, b) b
forall a b. (a -> b) -> a -> b
$! (b
x b -> b -> b
forall a. Num a => a -> a -> a
+ b
stride, b
stride)

-- We are assuming that "to" is constrained by the type to be within
-- max/min bounds.
{-# INLINE enumerateFromToIntegral #-}
enumerateFromToIntegral :: (Monad m, Integral a) => a -> Unfold m a a
enumerateFromToIntegral :: a -> Unfold m a a
enumerateFromToIntegral a
to =
    (a -> Bool) -> Unfold m a a -> Unfold m a a
forall (m :: * -> *) b a.
Monad m =>
(b -> Bool) -> Unfold m a b -> Unfold m a b
takeWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
to) (Unfold m a a -> Unfold m a a) -> Unfold m a a -> Unfold m a a
forall a b. (a -> b) -> a -> b
$ a -> Unfold m (a, a) a -> Unfold m a a
forall b (m :: * -> *) a c. b -> Unfold m (a, b) c -> Unfold m a c
supplySecond a
1 Unfold m (a, a) a
forall a (m :: * -> *). (Integral a, Monad m) => Unfold m (a, a) a
enumerateFromStepIntegral

{-# INLINE enumerateFromIntegral #-}
enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => Unfold m a a
enumerateFromIntegral :: Unfold m a a
enumerateFromIntegral = a -> Unfold m a a
forall (m :: * -> *) a. (Monad m, Integral a) => a -> Unfold m a a
enumerateFromToIntegral a
forall a. Bounded a => a
maxBound

------------------------------------------------------------------------------
-- Enumeration of Fractionals
------------------------------------------------------------------------------

-- | /Internal/
--
-- > enumerateFromToFractional to = takeWhile (<= to + 1 / 2) $ enumerateFromStepNum 1
--
{-# INLINE_NORMAL enumerateFromToFractional #-}
enumerateFromToFractional :: (Monad m, Fractional a, Ord a) => a -> Unfold m a a
enumerateFromToFractional :: a -> Unfold m a a
enumerateFromToFractional a
to =
    (a -> Bool) -> Unfold m a a -> Unfold m a a
forall (m :: * -> *) b a.
Monad m =>
(b -> Bool) -> Unfold m a b -> Unfold m a b
takeWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
to a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2) (Unfold m a a -> Unfold m a a) -> Unfold m a a -> Unfold m a a
forall a b. (a -> b) -> a -> b
$ a -> Unfold m a a
forall (m :: * -> *) a. (Monad m, Num a) => a -> Unfold m a a
enumerateFromStepNum a
1

-------------------------------------------------------------------------------
-- Generation from SVar
-------------------------------------------------------------------------------

data FromSVarState t m a =
      FromSVarInit (SVar t m a)
    | FromSVarRead (SVar t m a)
    | FromSVarLoop (SVar t m a) [ChildEvent a]
    | FromSVarDone (SVar t m a)

-- | /Internal/
--
{-# INLINE_NORMAL fromSVar #-}
fromSVar :: MonadAsync m => Unfold m (SVar t m a) a
fromSVar :: Unfold m (SVar t m a) a
fromSVar = (FromSVarState t m a -> m (Step (FromSVarState t m a) a))
-> (SVar t m a -> m (FromSVarState t m a))
-> Unfold m (SVar t m a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold FromSVarState t m a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(MonadIO m, MonadThrow m) =>
FromSVarState t m a -> m (Step (FromSVarState t m a) a)
step (FromSVarState t m a -> m (FromSVarState t m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FromSVarState t m a -> m (FromSVarState t m a))
-> (SVar t m a -> FromSVarState t m a)
-> SVar t m a
-> m (FromSVarState t m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SVar t m a -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> FromSVarState t m a
FromSVarInit)
    where

    {-# INLINE_LATE step #-}
    step :: FromSVarState t m a -> m (Step (FromSVarState t m a) a)
step (FromSVarInit SVar t m a
svar) = do
        IORef ()
ref <- IO (IORef ()) -> m (IORef ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef ()) -> m (IORef ())) -> IO (IORef ()) -> m (IORef ())
forall a b. (a -> b) -> a -> b
$ () -> IO (IORef ())
forall a. a -> IO (IORef a)
newIORef ()
        Weak (IORef ())
_ <- IO (Weak (IORef ())) -> m (Weak (IORef ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak (IORef ())) -> m (Weak (IORef ())))
-> IO (Weak (IORef ())) -> m (Weak (IORef ()))
forall a b. (a -> b) -> a -> b
$ IORef () -> IO () -> IO (Weak (IORef ()))
forall a. IORef a -> IO () -> IO (Weak (IORef a))
mkWeakIORef IORef ()
ref IO ()
hook
        -- when this copy of svar gets garbage collected "ref" will get
        -- garbage collected and our GC hook will be called.
        let sv :: SVar t m a
sv = SVar t m a
svar{svarRef :: Maybe (IORef ())
svarRef = IORef () -> Maybe (IORef ())
forall a. a -> Maybe a
Just IORef ()
ref}
        Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. s -> Step s a
Skip (SVar t m a -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> FromSVarState t m a
FromSVarRead SVar t m a
sv)

        where

        {-# NOINLINE hook #-}
        hook :: IO ()
hook = do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SVar t m a -> Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> Bool
svarInspectMode SVar t m a
svar) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Maybe AbsTime
r <- IO (Maybe AbsTime) -> IO (Maybe AbsTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AbsTime) -> IO (Maybe AbsTime))
-> IO (Maybe AbsTime) -> IO (Maybe AbsTime)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe AbsTime) -> IO (Maybe AbsTime)
forall a. IORef a -> IO a
readIORef (SVarStats -> IORef (Maybe AbsTime)
svarStopTime (SVar t m a -> SVarStats
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> SVarStats
svarStats SVar t m a
svar))
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AbsTime -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AbsTime
r) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    SVar t m a -> String -> IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> String -> IO ()
printSVar SVar t m a
svar String
"SVar Garbage Collected"
            SVar t m a -> IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> IO ()
cleanupSVar SVar t m a
svar
            -- If there are any SVars referenced by this SVar a GC will prompt
            -- them to be cleaned up quickly.
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SVar t m a -> Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> Bool
svarInspectMode SVar t m a
svar) IO ()
performMajorGC

    step (FromSVarRead SVar t m a
sv) = do
        [ChildEvent a]
list <- SVar t m a -> m [ChildEvent a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> m [ChildEvent a]
readOutputQ SVar t m a
sv
        -- Reversing the output is important to guarantee that we process the
        -- outputs in the same order as they were generated by the constituent
        -- streams.
        Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. s -> Step s a
Skip (FromSVarState t m a -> Step (FromSVarState t m a) a)
-> FromSVarState t m a -> Step (FromSVarState t m a) a
forall a b. (a -> b) -> a -> b
$ SVar t m a -> [ChildEvent a] -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> [ChildEvent a] -> FromSVarState t m a
FromSVarLoop SVar t m a
sv ([ChildEvent a] -> [ChildEvent a]
forall a. [a] -> [a]
Prelude.reverse [ChildEvent a]
list)

    step (FromSVarLoop SVar t m a
sv []) = do
        Bool
done <- SVar t m a -> m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> m Bool
postProcess SVar t m a
sv
        Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. s -> Step s a
Skip (FromSVarState t m a -> Step (FromSVarState t m a) a)
-> FromSVarState t m a -> Step (FromSVarState t m a) a
forall a b. (a -> b) -> a -> b
$ if Bool
done
                      then SVar t m a -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> FromSVarState t m a
FromSVarDone SVar t m a
sv
                      else SVar t m a -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> FromSVarState t m a
FromSVarRead SVar t m a
sv

    step (FromSVarLoop SVar t m a
sv (ChildEvent a
ev : [ChildEvent a]
es)) = do
        case ChildEvent a
ev of
            ChildYield a
a -> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ a -> FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. a -> s -> Step s a
Yield a
a (SVar t m a -> [ChildEvent a] -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> [ChildEvent a] -> FromSVarState t m a
FromSVarLoop SVar t m a
sv [ChildEvent a]
es)
            ChildStop ThreadId
tid Maybe SomeException
e -> do
                SVar t m a -> ThreadId -> m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> ThreadId -> m ()
accountThread SVar t m a
sv ThreadId
tid
                case Maybe SomeException
e of
                    Maybe SomeException
Nothing -> do
                        Bool
stop <- ThreadId -> m Bool
forall (m :: * -> *). MonadIO m => ThreadId -> m Bool
shouldStop ThreadId
tid
                        if Bool
stop
                        then do
                            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SVar t m a -> IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> IO ()
cleanupSVar SVar t m a
sv)
                            Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. s -> Step s a
Skip (SVar t m a -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> FromSVarState t m a
FromSVarDone SVar t m a
sv)
                        else Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. s -> Step s a
Skip (SVar t m a -> [ChildEvent a] -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> [ChildEvent a] -> FromSVarState t m a
FromSVarLoop SVar t m a
sv [ChildEvent a]
es)
                    Just SomeException
ex ->
                        case SomeException -> Maybe ThreadAbort
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex of
                            Just ThreadAbort
ThreadAbort ->
                                Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. s -> Step s a
Skip (SVar t m a -> [ChildEvent a] -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> [ChildEvent a] -> FromSVarState t m a
FromSVarLoop SVar t m a
sv [ChildEvent a]
es)
                            Maybe ThreadAbort
Nothing -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SVar t m a -> IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> IO ()
cleanupSVar SVar t m a
sv) m ()
-> m (Step (FromSVarState t m a) a)
-> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
MC.throwM SomeException
ex
        where

        shouldStop :: ThreadId -> m Bool
shouldStop ThreadId
tid =
            case SVar t m a -> SVarStopStyle
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> SVarStopStyle
svarStopStyle SVar t m a
sv of
                SVarStopStyle
StopNone -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                SVarStopStyle
StopAny -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                SVarStopStyle
StopBy -> do
                    ThreadId
sid <- IO ThreadId -> m ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> m ThreadId) -> IO ThreadId -> m ThreadId
forall a b. (a -> b) -> a -> b
$ IORef ThreadId -> IO ThreadId
forall a. IORef a -> IO a
readIORef (SVar t m a -> IORef ThreadId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> IORef ThreadId
svarStopBy SVar t m a
sv)
                    Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ThreadId
tid ThreadId -> ThreadId -> Bool
forall a. Eq a => a -> a -> Bool
== ThreadId
sid

    step (FromSVarDone SVar t m a
sv) = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SVar t m a -> Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> Bool
svarInspectMode SVar t m a
sv) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            AbsTime
t <- IO AbsTime -> m AbsTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AbsTime -> m AbsTime) -> IO AbsTime -> m AbsTime
forall a b. (a -> b) -> a -> b
$ Clock -> IO AbsTime
getTime Clock
Monotonic
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe AbsTime) -> Maybe AbsTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (SVarStats -> IORef (Maybe AbsTime)
svarStopTime (SVar t m a -> SVarStats
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> SVarStats
svarStats SVar t m a
sv)) (AbsTime -> Maybe AbsTime
forall a. a -> Maybe a
Just AbsTime
t)
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SVar t m a -> String -> IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> String -> IO ()
printSVar SVar t m a
sv String
"SVar Done"
        Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (FromSVarState t m a) a
forall s a. Step s a
Stop

-------------------------------------------------------------------------------
-- Process events received by a fold consumer from a stream producer
-------------------------------------------------------------------------------

-- XXX Have an error for "FromSVarInit" instead of undefined. The error can
-- redirect the user to report the failure to the developers.
-- | /Internal/
--
{-# INLINE_NORMAL fromProducer #-}
fromProducer :: MonadAsync m => Unfold m (SVar t m a) a
fromProducer :: Unfold m (SVar t m a) a
fromProducer = (FromSVarState t m a -> m (Step (FromSVarState t m a) a))
-> (SVar t m a -> m (FromSVarState t m a))
-> Unfold m (SVar t m a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold FromSVarState t m a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
MonadIO m =>
FromSVarState t m a -> m (Step (FromSVarState t m a) a)
step (FromSVarState t m a -> m (FromSVarState t m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FromSVarState t m a -> m (FromSVarState t m a))
-> (SVar t m a -> FromSVarState t m a)
-> SVar t m a
-> m (FromSVarState t m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SVar t m a -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> FromSVarState t m a
FromSVarRead)
    where

    {-# INLINE_LATE step #-}
    step :: FromSVarState t m a -> m (Step (FromSVarState t m a) a)
step (FromSVarRead SVar t m a
sv) = do
        [ChildEvent a]
list <- SVar t m a -> m [ChildEvent a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> m [ChildEvent a]
readOutputQ SVar t m a
sv
        -- Reversing the output is important to guarantee that we process the
        -- outputs in the same order as they were generated by the constituent
        -- streams.
        Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. s -> Step s a
Skip (FromSVarState t m a -> Step (FromSVarState t m a) a)
-> FromSVarState t m a -> Step (FromSVarState t m a) a
forall a b. (a -> b) -> a -> b
$ SVar t m a -> [ChildEvent a] -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> [ChildEvent a] -> FromSVarState t m a
FromSVarLoop SVar t m a
sv ([ChildEvent a] -> [ChildEvent a]
forall a. [a] -> [a]
Prelude.reverse [ChildEvent a]
list)

    step (FromSVarLoop SVar t m a
sv []) = Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. s -> Step s a
Skip (FromSVarState t m a -> Step (FromSVarState t m a) a)
-> FromSVarState t m a -> Step (FromSVarState t m a) a
forall a b. (a -> b) -> a -> b
$ SVar t m a -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> FromSVarState t m a
FromSVarRead SVar t m a
sv
    step (FromSVarLoop SVar t m a
sv (ChildEvent a
ev : [ChildEvent a]
es)) = do
        case ChildEvent a
ev of
            ChildYield a
a -> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ a -> FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. a -> s -> Step s a
Yield a
a (SVar t m a -> [ChildEvent a] -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> [ChildEvent a] -> FromSVarState t m a
FromSVarLoop SVar t m a
sv [ChildEvent a]
es)
            ChildStop ThreadId
tid Maybe SomeException
e -> do
                SVar t m a -> ThreadId -> m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> ThreadId -> m ()
accountThread SVar t m a
sv ThreadId
tid
                case Maybe SomeException
e of
                    Maybe SomeException
Nothing -> do
                        SVar t m a -> m ()
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
MonadIO m =>
SVar t m a -> m ()
sendStopToProducer SVar t m a
sv
                        Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a))
-> Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall a b. (a -> b) -> a -> b
$ FromSVarState t m a -> Step (FromSVarState t m a) a
forall s a. s -> Step s a
Skip (SVar t m a -> FromSVarState t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> FromSVarState t m a
FromSVarDone SVar t m a
sv)
                    Just SomeException
_ -> String -> m (Step (FromSVarState t m a) a)
forall a. HasCallStack => String -> a
error String
"Bug: fromProducer: received exception"

    step (FromSVarDone SVar t m a
sv) = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SVar t m a -> Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> Bool
svarInspectMode SVar t m a
sv) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            AbsTime
t <- IO AbsTime -> m AbsTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AbsTime -> m AbsTime) -> IO AbsTime -> m AbsTime
forall a b. (a -> b) -> a -> b
$ Clock -> IO AbsTime
getTime Clock
Monotonic
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe AbsTime) -> Maybe AbsTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (SVarStats -> IORef (Maybe AbsTime)
svarStopTime (SVar t m a -> SVarStats
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> SVarStats
svarStats SVar t m a
sv)) (AbsTime -> Maybe AbsTime
forall a. a -> Maybe a
Just AbsTime
t)
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SVar t m a -> String -> IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> String -> IO ()
printSVar SVar t m a
sv String
"SVar Done"
        Step (FromSVarState t m a) a -> m (Step (FromSVarState t m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (FromSVarState t m a) a
forall s a. Step s a
Stop

    step (FromSVarInit SVar t m a
_) = m (Step (FromSVarState t m a) a)
forall a. HasCallStack => a
undefined

------------------------------------------------------------------------------
-- Exceptions
------------------------------------------------------------------------------

-- | Like 'gbracket' but with following differences:
--
-- * alloc action @a -> m c@ runs with async exceptions enabled
-- * cleanup action @c -> m d@ won't run if the stream is garbage collected
--   after partial evaluation.
-- * does not require a 'MonadAsync' constraint.
--
-- /Inhibits stream fusion/
--
-- /Pre-release/
--
{-# INLINE_NORMAL gbracket_ #-}
gbracket_
    :: Monad m
    => (a -> m c)                           -- ^ before
    -> (forall s. m s -> m (Either e s))    -- ^ try (exception handling)
    -> (c -> m d)                           -- ^ after, on normal stop
    -> Unfold m (c, e) b                    -- ^ on exception
    -> Unfold m c b                         -- ^ unfold to run
    -> Unfold m a b
gbracket_ :: (a -> m c)
-> (forall s. m s -> m (Either e s))
-> (c -> m d)
-> Unfold m (c, e) b
-> Unfold m c b
-> Unfold m a b
gbracket_ a -> m c
bef forall s. m s -> m (Either e s)
exc c -> m d
aft (Unfold s -> m (Step s b)
estep (c, e) -> m s
einject) (Unfold s -> m (Step s b)
step1 c -> m s
inject1) =
    (Either s (s, c) -> m (Step (Either s (s, c)) b))
-> (a -> m (Either s (s, c))) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Either s (s, c) -> m (Step (Either s (s, c)) b)
step a -> m (Either s (s, c))
forall a. a -> m (Either a (s, c))
inject

    where

    inject :: a -> m (Either a (s, c))
inject a
x = do
        c
r <- a -> m c
bef a
x
        s
s <- c -> m s
inject1 c
r
        Either a (s, c) -> m (Either a (s, c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (s, c) -> m (Either a (s, c)))
-> Either a (s, c) -> m (Either a (s, c))
forall a b. (a -> b) -> a -> b
$ (s, c) -> Either a (s, c)
forall a b. b -> Either a b
Right (s
s, c
r)

    {-# INLINE_LATE step #-}
    step :: Either s (s, c) -> m (Step (Either s (s, c)) b)
step (Right (s
st, c
v)) = do
        Either e (Step s b)
res <- m (Step s b) -> m (Either e (Step s b))
forall s. m s -> m (Either e s)
exc (m (Step s b) -> m (Either e (Step s b)))
-> m (Step s b) -> m (Either e (Step s b))
forall a b. (a -> b) -> a -> b
$ s -> m (Step s b)
step1 s
st
        case Either e (Step s b)
res of
            Right Step s b
r -> case Step s b
r of
                Yield b
x s
s -> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b))
-> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall a b. (a -> b) -> a -> b
$ b -> Either s (s, c) -> Step (Either s (s, c)) b
forall s a. a -> s -> Step s a
Yield b
x ((s, c) -> Either s (s, c)
forall a b. b -> Either a b
Right (s
s, c
v))
                Skip s
s    -> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b))
-> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall a b. (a -> b) -> a -> b
$ Either s (s, c) -> Step (Either s (s, c)) b
forall s a. s -> Step s a
Skip ((s, c) -> Either s (s, c)
forall a b. b -> Either a b
Right (s
s, c
v))
                Step s b
Stop      -> c -> m d
aft c
v m d -> m (Step (Either s (s, c)) b) -> m (Step (Either s (s, c)) b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Either s (s, c)) b
forall s a. Step s a
Stop
            -- XXX Do not handle async exceptions, just rethrow them.
            Left e
e -> do
                s
r <- (c, e) -> m s
einject (c
v, e
e)
                Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b))
-> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall a b. (a -> b) -> a -> b
$ Either s (s, c) -> Step (Either s (s, c)) b
forall s a. s -> Step s a
Skip (s -> Either s (s, c)
forall a b. a -> Either a b
Left s
r)
    step (Left s
st) = do
        Step s b
res <- s -> m (Step s b)
estep s
st
        case Step s b
res of
            Yield b
x s
s -> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b))
-> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall a b. (a -> b) -> a -> b
$ b -> Either s (s, c) -> Step (Either s (s, c)) b
forall s a. a -> s -> Step s a
Yield b
x (s -> Either s (s, c)
forall a b. a -> Either a b
Left s
s)
            Skip s
s    -> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b))
-> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall a b. (a -> b) -> a -> b
$ Either s (s, c) -> Step (Either s (s, c)) b
forall s a. s -> Step s a
Skip (s -> Either s (s, c)
forall a b. a -> Either a b
Left s
s)
            Step s b
Stop      -> Step (Either s (s, c)) b -> m (Step (Either s (s, c)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Either s (s, c)) b
forall s a. Step s a
Stop

-- | Run the alloc action @a -> m c@ with async exceptions disabled but keeping
-- blocking operations interruptible (see 'Control.Exception.mask').  Use the
-- output @c@ as input to @Unfold m c b@ to generate an output stream. When
-- unfolding use the supplied @try@ operation @forall s. m s -> m (Either e s)@
-- to catch synchronous exceptions. If an exception occurs run the exception
-- handling unfold @Unfold m (c, e) b@.
--
-- The cleanup action @c -> m d@, runs whenever the stream ends normally, due
-- to a sync or async exception or if it gets garbage collected after a partial
-- lazy evaluation.  See 'bracket' for the semantics of the cleanup action.
--
-- 'gbracket' can express all other exception handling combinators.
--
-- /Inhibits stream fusion/
--
-- /Pre-release/
{-# INLINE_NORMAL gbracket #-}
gbracket
    :: (MonadIO m, MonadBaseControl IO m)
    => (a -> m c)                           -- ^ before
    -> (forall s. m s -> m (Either e s))    -- ^ try (exception handling)
    -> (c -> m d)                           -- ^ after, on normal stop, or GC
    -> Unfold m (c, e) b                    -- ^ on exception
    -> Unfold m c b                         -- ^ unfold to run
    -> Unfold m a b
gbracket :: (a -> m c)
-> (forall s. m s -> m (Either e s))
-> (c -> m d)
-> Unfold m (c, e) b
-> Unfold m c b
-> Unfold m a b
gbracket a -> m c
bef forall s. m s -> m (Either e s)
exc c -> m d
aft (Unfold s -> m (Step s b)
estep (c, e) -> m s
einject) (Unfold s -> m (Step s b)
step1 c -> m s
inject1) =
    (Either s (s, c, IOFinalizer)
 -> m (Step (Either s (s, c, IOFinalizer)) b))
-> (a -> m (Either s (s, c, IOFinalizer))) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Either s (s, c, IOFinalizer)
-> m (Step (Either s (s, c, IOFinalizer)) b)
step a -> m (Either s (s, c, IOFinalizer))
forall a. a -> m (Either a (s, c, IOFinalizer))
inject

    where

    inject :: a -> m (Either a (s, c, IOFinalizer))
inject a
x = do
        -- Mask asynchronous exceptions to make the execution of 'bef' and
        -- the registration of 'aft' atomic. See comment in 'D.gbracketIO'.
        (c
r, IOFinalizer
ref) <- (IO (StM m (c, IOFinalizer)) -> IO (StM m (c, IOFinalizer)))
-> m (c, IOFinalizer) -> m (c, IOFinalizer)
forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ IO (StM m (c, IOFinalizer)) -> IO (StM m (c, IOFinalizer))
forall a. IO a -> IO a
mask_ (m (c, IOFinalizer) -> m (c, IOFinalizer))
-> m (c, IOFinalizer) -> m (c, IOFinalizer)
forall a b. (a -> b) -> a -> b
$ do
            c
r <- a -> m c
bef a
x
            IOFinalizer
ref <- m d -> m IOFinalizer
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m a -> m IOFinalizer
newIOFinalizer (c -> m d
aft c
r)
            (c, IOFinalizer) -> m (c, IOFinalizer)
forall (m :: * -> *) a. Monad m => a -> m a
return (c
r, IOFinalizer
ref)
        s
s <- c -> m s
inject1 c
r
        Either a (s, c, IOFinalizer) -> m (Either a (s, c, IOFinalizer))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (s, c, IOFinalizer) -> m (Either a (s, c, IOFinalizer)))
-> Either a (s, c, IOFinalizer) -> m (Either a (s, c, IOFinalizer))
forall a b. (a -> b) -> a -> b
$ (s, c, IOFinalizer) -> Either a (s, c, IOFinalizer)
forall a b. b -> Either a b
Right (s
s, c
r, IOFinalizer
ref)

    {-# INLINE_LATE step #-}
    step :: Either s (s, c, IOFinalizer)
-> m (Step (Either s (s, c, IOFinalizer)) b)
step (Right (s
st, c
v, IOFinalizer
ref)) = do
        Either e (Step s b)
res <- m (Step s b) -> m (Either e (Step s b))
forall s. m s -> m (Either e s)
exc (m (Step s b) -> m (Either e (Step s b)))
-> m (Step s b) -> m (Either e (Step s b))
forall a b. (a -> b) -> a -> b
$ s -> m (Step s b)
step1 s
st
        case Either e (Step s b)
res of
            Right Step s b
r -> case Step s b
r of
                Yield b
x s
s -> Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c, IOFinalizer)) b
 -> m (Step (Either s (s, c, IOFinalizer)) b))
-> Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall a b. (a -> b) -> a -> b
$ b
-> Either s (s, c, IOFinalizer)
-> Step (Either s (s, c, IOFinalizer)) b
forall s a. a -> s -> Step s a
Yield b
x ((s, c, IOFinalizer) -> Either s (s, c, IOFinalizer)
forall a b. b -> Either a b
Right (s
s, c
v, IOFinalizer
ref))
                Skip s
s    -> Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c, IOFinalizer)) b
 -> m (Step (Either s (s, c, IOFinalizer)) b))
-> Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall a b. (a -> b) -> a -> b
$ Either s (s, c, IOFinalizer)
-> Step (Either s (s, c, IOFinalizer)) b
forall s a. s -> Step s a
Skip ((s, c, IOFinalizer) -> Either s (s, c, IOFinalizer)
forall a b. b -> Either a b
Right (s
s, c
v, IOFinalizer
ref))
                Step s b
Stop      -> do
                    IOFinalizer -> m ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
                    Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Either s (s, c, IOFinalizer)) b
forall s a. Step s a
Stop
            -- XXX Do not handle async exceptions, just rethrow them.
            Left e
e -> do
                -- Clearing of finalizer and running of exception handler must
                -- be atomic wrt async exceptions. Otherwise if we have cleared
                -- the finalizer and have not run the exception handler then we
                -- may leak the resource.
                s
r <- IOFinalizer -> m s -> m s
forall (m :: * -> *) a.
MonadBaseControl IO m =>
IOFinalizer -> m a -> m a
clearingIOFinalizer IOFinalizer
ref ((c, e) -> m s
einject (c
v, e
e))
                Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c, IOFinalizer)) b
 -> m (Step (Either s (s, c, IOFinalizer)) b))
-> Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall a b. (a -> b) -> a -> b
$ Either s (s, c, IOFinalizer)
-> Step (Either s (s, c, IOFinalizer)) b
forall s a. s -> Step s a
Skip (s -> Either s (s, c, IOFinalizer)
forall a b. a -> Either a b
Left s
r)
    step (Left s
st) = do
        Step s b
res <- s -> m (Step s b)
estep s
st
        case Step s b
res of
            Yield b
x s
s -> Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c, IOFinalizer)) b
 -> m (Step (Either s (s, c, IOFinalizer)) b))
-> Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall a b. (a -> b) -> a -> b
$ b
-> Either s (s, c, IOFinalizer)
-> Step (Either s (s, c, IOFinalizer)) b
forall s a. a -> s -> Step s a
Yield b
x (s -> Either s (s, c, IOFinalizer)
forall a b. a -> Either a b
Left s
s)
            Skip s
s    -> Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c, IOFinalizer)) b
 -> m (Step (Either s (s, c, IOFinalizer)) b))
-> Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall a b. (a -> b) -> a -> b
$ Either s (s, c, IOFinalizer)
-> Step (Either s (s, c, IOFinalizer)) b
forall s a. s -> Step s a
Skip (s -> Either s (s, c, IOFinalizer)
forall a b. a -> Either a b
Left s
s)
            Step s b
Stop      -> Step (Either s (s, c, IOFinalizer)) b
-> m (Step (Either s (s, c, IOFinalizer)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Either s (s, c, IOFinalizer)) b
forall s a. Step s a
Stop

-- | Run a side effect @a -> m c@ on the input @a@ before unfolding it using
-- @Unfold m a b@.
--
-- > before f = lmapM (\a -> f a >> return a)
--
-- /Pre-release/
{-# INLINE_NORMAL before #-}
before :: (a -> m c) -> Unfold m a b -> Unfold m a b
before :: (a -> m c) -> Unfold m a b -> Unfold m a b
before a -> m c
action (Unfold s -> m (Step s b)
step a -> m s
inject) = (s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold s -> m (Step s b)
step (a -> m c
action (a -> m c) -> (a -> m s) -> a -> m s
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m s
inject)

-- The custom implementation of "after_" is slightly faster (5-7%) than
-- "_after".  This is just to document and make sure that we can always use
-- gbracket to implement after_ The same applies to other combinators as well.
--
{-# INLINE_NORMAL _after #-}
_after :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b
_after :: (a -> m c) -> Unfold m a b -> Unfold m a b
_after a -> m c
aft = (a -> m a)
-> (forall s. m s -> m (Either Any s))
-> (a -> m c)
-> Unfold m (a, Any) b
-> Unfold m a b
-> Unfold m a b
forall (m :: * -> *) a c e d b.
Monad m =>
(a -> m c)
-> (forall s. m s -> m (Either e s))
-> (c -> m d)
-> Unfold m (c, e) b
-> Unfold m c b
-> Unfold m a b
gbracket_ a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((s -> Either Any s) -> m s -> m (Either Any s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Either Any s
forall a b. b -> Either a b
Right) a -> m c
aft Unfold m (a, Any) b
forall a. HasCallStack => a
undefined

-- | Like 'after' with following differences:
--
-- * action @a -> m c@ won't run if the stream is garbage collected
--   after partial evaluation.
-- * Monad @m@ does not require any other constraints.
--
-- /Pre-release/
{-# INLINE_NORMAL after_ #-}
after_ :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b
after_ :: (a -> m c) -> Unfold m a b -> Unfold m a b
after_ a -> m c
action (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = ((s, a) -> m (Step (s, a) b)) -> (a -> m (s, a)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, a) -> m (Step (s, a) b)
step a -> m (s, a)
inject

    where

    inject :: a -> m (s, a)
inject a
x = do
        s
s <- a -> m s
inject1 a
x
        (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
x)

    {-# INLINE_LATE step #-}
    step :: (s, a) -> m (Step (s, a) b)
step (s
st, a
v) = do
        Step s b
res <- s -> m (Step s b)
step1 s
st
        case Step s b
res of
            Yield b
x s
s -> Step (s, a) b -> m (Step (s, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, a) b -> m (Step (s, a) b))
-> Step (s, a) b -> m (Step (s, a) b)
forall a b. (a -> b) -> a -> b
$ b -> (s, a) -> Step (s, a) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, a
v)
            Skip s
s    -> Step (s, a) b -> m (Step (s, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, a) b -> m (Step (s, a) b))
-> Step (s, a) b -> m (Step (s, a) b)
forall a b. (a -> b) -> a -> b
$ (s, a) -> Step (s, a) b
forall s a. s -> Step s a
Skip (s
s, a
v)
            Step s b
Stop      -> a -> m c
action a
v m c -> m (Step (s, a) b) -> m (Step (s, a) b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step (s, a) b -> m (Step (s, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, a) b
forall s a. Step s a
Stop

-- | Unfold the input @a@ using @Unfold m a b@, run an action on @a@ whenever
-- the unfold stops normally, or if it is garbage collected after a partial
-- lazy evaluation.
--
-- The semantics of the action @a -> m c@ are similar to the cleanup action
-- semantics in 'bracket'.
--
-- /See also 'after_'/
--
-- /Pre-release/
{-# INLINE_NORMAL after #-}
after :: (MonadIO m, MonadBaseControl IO m)
    => (a -> m c) -> Unfold m a b -> Unfold m a b
after :: (a -> m c) -> Unfold m a b -> Unfold m a b
after a -> m c
action (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = ((s, IOFinalizer) -> m (Step (s, IOFinalizer) b))
-> (a -> m (s, IOFinalizer)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, IOFinalizer) -> m (Step (s, IOFinalizer) b)
step a -> m (s, IOFinalizer)
inject

    where

    inject :: a -> m (s, IOFinalizer)
inject a
x = do
        s
s <- a -> m s
inject1 a
x
        IOFinalizer
ref <- m c -> m IOFinalizer
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m a -> m IOFinalizer
newIOFinalizer (a -> m c
action a
x)
        (s, IOFinalizer) -> m (s, IOFinalizer)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, IOFinalizer
ref)

    {-# INLINE_LATE step #-}
    step :: (s, IOFinalizer) -> m (Step (s, IOFinalizer) b)
step (s
st, IOFinalizer
ref) = do
        Step s b
res <- s -> m (Step s b)
step1 s
st
        case Step s b
res of
            Yield b
x s
s -> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b))
-> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall a b. (a -> b) -> a -> b
$ b -> (s, IOFinalizer) -> Step (s, IOFinalizer) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, IOFinalizer
ref)
            Skip s
s    -> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b))
-> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall a b. (a -> b) -> a -> b
$ (s, IOFinalizer) -> Step (s, IOFinalizer) b
forall s a. s -> Step s a
Skip (s
s, IOFinalizer
ref)
            Step s b
Stop      -> do
                IOFinalizer -> m ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
                Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, IOFinalizer) b
forall s a. Step s a
Stop

{-# INLINE_NORMAL _onException #-}
_onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b
_onException :: (a -> m c) -> Unfold m a b -> Unfold m a b
_onException a -> m c
action =
    (a -> m a)
-> (forall s. m s -> m (Either SomeException s))
-> (a -> m ())
-> Unfold m (a, SomeException) b
-> Unfold m a b
-> Unfold m a b
forall (m :: * -> *) a c e d b.
Monad m =>
(a -> m c)
-> (forall s. m s -> m (Either e s))
-> (c -> m d)
-> Unfold m (c, e) b
-> Unfold m c b
-> Unfold m a b
gbracket_ a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return forall s. m s -> m (Either SomeException s)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
MC.try
        (\a
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        (((a, SomeException) -> m Any) -> Unfold m (a, SomeException) b
forall (m :: * -> *) a c b. Monad m => (a -> m c) -> Unfold m a b
nilM (\(a
a, SomeException
e :: MC.SomeException) -> a -> m c
action a
a m c -> m Any -> m Any
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m Any
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
MC.throwM SomeException
e))

-- | Unfold the input @a@ using @Unfold m a b@, run the action @a -> m c@ on
-- @a@ if the unfold aborts due to an exception.
--
-- /Inhibits stream fusion/
--
-- /Pre-release/
{-# INLINE_NORMAL onException #-}
onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b
onException :: (a -> m c) -> Unfold m a b -> Unfold m a b
onException a -> m c
action (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = ((s, a) -> m (Step (s, a) b)) -> (a -> m (s, a)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, a) -> m (Step (s, a) b)
step a -> m (s, a)
inject

    where

    inject :: a -> m (s, a)
inject a
x = do
        s
s <- a -> m s
inject1 a
x
        (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
x)

    {-# INLINE_LATE step #-}
    step :: (s, a) -> m (Step (s, a) b)
step (s
st, a
v) = do
        Step s b
res <- s -> m (Step s b)
step1 s
st m (Step s b) -> m c -> m (Step s b)
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`MC.onException` a -> m c
action a
v
        case Step s b
res of
            Yield b
x s
s -> Step (s, a) b -> m (Step (s, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, a) b -> m (Step (s, a) b))
-> Step (s, a) b -> m (Step (s, a) b)
forall a b. (a -> b) -> a -> b
$ b -> (s, a) -> Step (s, a) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, a
v)
            Skip s
s    -> Step (s, a) b -> m (Step (s, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, a) b -> m (Step (s, a) b))
-> Step (s, a) b -> m (Step (s, a) b)
forall a b. (a -> b) -> a -> b
$ (s, a) -> Step (s, a) b
forall s a. s -> Step s a
Skip (s
s, a
v)
            Step s b
Stop      -> Step (s, a) b -> m (Step (s, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, a) b
forall s a. Step s a
Stop

{-# INLINE_NORMAL _finally #-}
_finally :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b
_finally :: (a -> m c) -> Unfold m a b -> Unfold m a b
_finally a -> m c
action =
    (a -> m a)
-> (forall s. m s -> m (Either SomeException s))
-> (a -> m c)
-> Unfold m (a, SomeException) b
-> Unfold m a b
-> Unfold m a b
forall (m :: * -> *) a c e d b.
Monad m =>
(a -> m c)
-> (forall s. m s -> m (Either e s))
-> (c -> m d)
-> Unfold m (c, e) b
-> Unfold m c b
-> Unfold m a b
gbracket_ a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return forall s. m s -> m (Either SomeException s)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
MC.try a -> m c
action
        (((a, SomeException) -> m Any) -> Unfold m (a, SomeException) b
forall (m :: * -> *) a c b. Monad m => (a -> m c) -> Unfold m a b
nilM (\(a
a, SomeException
e :: MC.SomeException) -> a -> m c
action a
a m c -> m Any -> m Any
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m Any
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
MC.throwM SomeException
e))

-- | Like 'finally' with following differences:
--
-- * action @a -> m c@ won't run if the stream is garbage collected
--   after partial evaluation.
-- * does not require a 'MonadAsync' constraint.
--
-- /Inhibits stream fusion/
--
-- /Pre-release/
{-# INLINE_NORMAL finally_ #-}
finally_ :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b
finally_ :: (a -> m c) -> Unfold m a b -> Unfold m a b
finally_ a -> m c
action (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = ((s, a) -> m (Step (s, a) b)) -> (a -> m (s, a)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, a) -> m (Step (s, a) b)
step a -> m (s, a)
inject

    where

    inject :: a -> m (s, a)
inject a
x = do
        s
s <- a -> m s
inject1 a
x
        (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
x)

    {-# INLINE_LATE step #-}
    step :: (s, a) -> m (Step (s, a) b)
step (s
st, a
v) = do
        Step s b
res <- s -> m (Step s b)
step1 s
st m (Step s b) -> m c -> m (Step s b)
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`MC.onException` a -> m c
action a
v
        case Step s b
res of
            Yield b
x s
s -> Step (s, a) b -> m (Step (s, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, a) b -> m (Step (s, a) b))
-> Step (s, a) b -> m (Step (s, a) b)
forall a b. (a -> b) -> a -> b
$ b -> (s, a) -> Step (s, a) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, a
v)
            Skip s
s    -> Step (s, a) b -> m (Step (s, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, a) b -> m (Step (s, a) b))
-> Step (s, a) b -> m (Step (s, a) b)
forall a b. (a -> b) -> a -> b
$ (s, a) -> Step (s, a) b
forall s a. s -> Step s a
Skip (s
s, a
v)
            Step s b
Stop      -> a -> m c
action a
v m c -> m (Step (s, a) b) -> m (Step (s, a) b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step (s, a) b -> m (Step (s, a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, a) b
forall s a. Step s a
Stop

-- | Unfold the input @a@ using @Unfold m a b@, run an action on @a@ whenever
-- the unfold stops normally, aborts due to an exception or if it is garbage
-- collected after a partial lazy evaluation.
--
-- The semantics of the action @a -> m c@ are similar to the cleanup action
-- semantics in 'bracket'.
--
-- @
-- finally release = bracket return release
-- @
--
-- /See also 'finally_'/
--
-- /Inhibits stream fusion/
--
-- /Pre-release/
{-# INLINE_NORMAL finally #-}
finally :: (MonadAsync m, MonadCatch m)
    => (a -> m c) -> Unfold m a b -> Unfold m a b
finally :: (a -> m c) -> Unfold m a b -> Unfold m a b
finally a -> m c
action (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = ((s, IOFinalizer) -> m (Step (s, IOFinalizer) b))
-> (a -> m (s, IOFinalizer)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, IOFinalizer) -> m (Step (s, IOFinalizer) b)
step a -> m (s, IOFinalizer)
inject

    where

    inject :: a -> m (s, IOFinalizer)
inject a
x = do
        s
s <- a -> m s
inject1 a
x
        IOFinalizer
ref <- m c -> m IOFinalizer
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m a -> m IOFinalizer
newIOFinalizer (a -> m c
action a
x)
        (s, IOFinalizer) -> m (s, IOFinalizer)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, IOFinalizer
ref)

    {-# INLINE_LATE step #-}
    step :: (s, IOFinalizer) -> m (Step (s, IOFinalizer) b)
step (s
st, IOFinalizer
ref) = do
        Step s b
res <- s -> m (Step s b)
step1 s
st m (Step s b) -> m () -> m (Step s b)
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`MC.onException` IOFinalizer -> m ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
        case Step s b
res of
            Yield b
x s
s -> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b))
-> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall a b. (a -> b) -> a -> b
$ b -> (s, IOFinalizer) -> Step (s, IOFinalizer) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, IOFinalizer
ref)
            Skip s
s    -> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b))
-> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall a b. (a -> b) -> a -> b
$ (s, IOFinalizer) -> Step (s, IOFinalizer) b
forall s a. s -> Step s a
Skip (s
s, IOFinalizer
ref)
            Step s b
Stop      -> do
                IOFinalizer -> m ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
                Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, IOFinalizer) b
forall s a. Step s a
Stop

{-# INLINE_NORMAL _bracket #-}
_bracket :: MonadCatch m
    => (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
_bracket :: (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
_bracket a -> m c
bef c -> m d
aft =
    (a -> m c)
-> (forall s. m s -> m (Either SomeException s))
-> (c -> m d)
-> Unfold m (c, SomeException) b
-> Unfold m c b
-> Unfold m a b
forall (m :: * -> *) a c e d b.
Monad m =>
(a -> m c)
-> (forall s. m s -> m (Either e s))
-> (c -> m d)
-> Unfold m (c, e) b
-> Unfold m c b
-> Unfold m a b
gbracket_ a -> m c
bef forall s. m s -> m (Either SomeException s)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
MC.try c -> m d
aft (((c, SomeException) -> m Any) -> Unfold m (c, SomeException) b
forall (m :: * -> *) a c b. Monad m => (a -> m c) -> Unfold m a b
nilM (\(c
a, SomeException
e :: MC.SomeException) -> c -> m d
aft c
a m d -> m Any -> m Any
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    SomeException -> m Any
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
MC.throwM SomeException
e))

-- | Like 'bracket' but with following differences:
--
-- * alloc action @a -> m c@ runs with async exceptions enabled
-- * cleanup action @c -> m d@ won't run if the stream is garbage collected
--   after partial evaluation.
-- * does not require a 'MonadAsync' constraint.
--
-- /Inhibits stream fusion/
--
-- /Pre-release/
{-# INLINE_NORMAL bracket_ #-}
bracket_ :: MonadCatch m
    => (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
bracket_ :: (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
bracket_ a -> m c
bef c -> m d
aft (Unfold s -> m (Step s b)
step1 c -> m s
inject1) = ((s, c) -> m (Step (s, c) b)) -> (a -> m (s, c)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, c) -> m (Step (s, c) b)
step a -> m (s, c)
inject

    where

    inject :: a -> m (s, c)
inject a
x = do
        c
r <- a -> m c
bef a
x
        s
s <- c -> m s
inject1 c
r
        (s, c) -> m (s, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, c
r)

    {-# INLINE_LATE step #-}
    step :: (s, c) -> m (Step (s, c) b)
step (s
st, c
v) = do
        Step s b
res <- s -> m (Step s b)
step1 s
st m (Step s b) -> m d -> m (Step s b)
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`MC.onException` c -> m d
aft c
v
        case Step s b
res of
            Yield b
x s
s -> Step (s, c) b -> m (Step (s, c) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, c) b -> m (Step (s, c) b))
-> Step (s, c) b -> m (Step (s, c) b)
forall a b. (a -> b) -> a -> b
$ b -> (s, c) -> Step (s, c) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, c
v)
            Skip s
s    -> Step (s, c) b -> m (Step (s, c) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, c) b -> m (Step (s, c) b))
-> Step (s, c) b -> m (Step (s, c) b)
forall a b. (a -> b) -> a -> b
$ (s, c) -> Step (s, c) b
forall s a. s -> Step s a
Skip (s
s, c
v)
            Step s b
Stop      -> c -> m d
aft c
v m d -> m (Step (s, c) b) -> m (Step (s, c) b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step (s, c) b -> m (Step (s, c) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, c) b
forall s a. Step s a
Stop

-- | Run the alloc action @a -> m c@ with async exceptions disabled but keeping
-- blocking operations interruptible (see 'Control.Exception.mask').  Use the
-- output @c@ as input to @Unfold m c b@ to generate an output stream.
--
-- @c@ is usually a resource under the state of monad @m@, e.g. a file
-- handle, that requires a cleanup after use. The cleanup action @c -> m d@,
-- runs whenever the stream ends normally, due to a sync or async exception or
-- if it gets garbage collected after a partial lazy evaluation.
--
-- 'bracket' only guarantees that the cleanup action runs, and it runs with
-- async exceptions enabled. The action must ensure that it can successfully
-- cleanup the resource in the face of sync or async exceptions.
--
-- When the stream ends normally or on a sync exception, cleanup action runs
-- immediately in the current thread context, whereas in other cases it runs in
-- the GC context, therefore, cleanup may be delayed until the GC gets to run.
--
-- /See also: 'bracket_', 'gbracket'/
--
-- /Inhibits stream fusion/
--
-- /Pre-release/
{-# INLINE_NORMAL bracket #-}
bracket :: (MonadAsync m, MonadCatch m)
    => (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
bracket :: (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
bracket a -> m c
bef c -> m d
aft (Unfold s -> m (Step s b)
step1 c -> m s
inject1) = ((s, IOFinalizer) -> m (Step (s, IOFinalizer) b))
-> (a -> m (s, IOFinalizer)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, IOFinalizer) -> m (Step (s, IOFinalizer) b)
step a -> m (s, IOFinalizer)
inject

    where

    inject :: a -> m (s, IOFinalizer)
inject a
x = do
        -- Mask asynchronous exceptions to make the execution of 'bef' and
        -- the registration of 'aft' atomic. See comment in 'D.gbracketIO'.
        (c
r, IOFinalizer
ref) <- (IO (StM m (c, IOFinalizer)) -> IO (StM m (c, IOFinalizer)))
-> m (c, IOFinalizer) -> m (c, IOFinalizer)
forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ IO (StM m (c, IOFinalizer)) -> IO (StM m (c, IOFinalizer))
forall a. IO a -> IO a
mask_ (m (c, IOFinalizer) -> m (c, IOFinalizer))
-> m (c, IOFinalizer) -> m (c, IOFinalizer)
forall a b. (a -> b) -> a -> b
$ do
            c
r <- a -> m c
bef a
x
            IOFinalizer
ref <- m d -> m IOFinalizer
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m a -> m IOFinalizer
newIOFinalizer (c -> m d
aft c
r)
            (c, IOFinalizer) -> m (c, IOFinalizer)
forall (m :: * -> *) a. Monad m => a -> m a
return (c
r, IOFinalizer
ref)
        s
s <- c -> m s
inject1 c
r
        (s, IOFinalizer) -> m (s, IOFinalizer)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, IOFinalizer
ref)

    {-# INLINE_LATE step #-}
    step :: (s, IOFinalizer) -> m (Step (s, IOFinalizer) b)
step (s
st, IOFinalizer
ref) = do
        Step s b
res <- s -> m (Step s b)
step1 s
st m (Step s b) -> m () -> m (Step s b)
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`MC.onException` IOFinalizer -> m ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
        case Step s b
res of
            Yield b
x s
s -> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b))
-> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall a b. (a -> b) -> a -> b
$ b -> (s, IOFinalizer) -> Step (s, IOFinalizer) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, IOFinalizer
ref)
            Skip s
s    -> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b))
-> Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall a b. (a -> b) -> a -> b
$ (s, IOFinalizer) -> Step (s, IOFinalizer) b
forall s a. s -> Step s a
Skip (s
s, IOFinalizer
ref)
            Step s b
Stop      -> do
                IOFinalizer -> m ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
                Step (s, IOFinalizer) b -> m (Step (s, IOFinalizer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, IOFinalizer) b
forall s a. Step s a
Stop

-- | When unfolding @Unfold m a b@ if an exception @e@ occurs, unfold @e@ using
-- @Unfold m e b@.
--
-- /Inhibits stream fusion/
--
-- /Pre-release/
{-# INLINE_NORMAL handle #-}
handle :: (MonadCatch m, Exception e)
    => Unfold m e b -> Unfold m a b -> Unfold m a b
handle :: Unfold m e b -> Unfold m a b -> Unfold m a b
handle Unfold m e b
exc =
    (a -> m a)
-> (forall s. m s -> m (Either e s))
-> (a -> m ())
-> Unfold m (a, e) b
-> Unfold m a b
-> Unfold m a b
forall (m :: * -> *) a c e d b.
Monad m =>
(a -> m c)
-> (forall s. m s -> m (Either e s))
-> (c -> m d)
-> Unfold m (c, e) b
-> Unfold m c b
-> Unfold m a b
gbracket_ a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return forall s. m s -> m (Either e s)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
MC.try (\a
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Unfold m e b -> Unfold m (a, e) b
forall (m :: * -> *) a b c. Unfold m a b -> Unfold m (c, a) b
discardFirst Unfold m e b
exc)