{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE PatternSynonyms           #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TupleSections             #-}

#include "inline.hs"

-- |
-- Module      : Streamly.Internal.Data.Unfold
-- Copyright   : (c) 2019 Composewell Technologies
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- 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.
--
module Streamly.Internal.Data.Unfold
    (
    -- * Unfold Type
      Unfold

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

    -- * Operations on Output
    , fold
    -- pipe

    -- * Unfolds
    , fromStream
    , fromStream1
    , fromStream2
    , nilM
    , consM
    , effect
    , singletonM
    , singleton
    , identity
    , const
    , replicateM
    , repeatM
    , fromList
    , fromListM
    , enumerateFromStepIntegral
    , enumerateFromToIntegral
    , enumerateFromIntegral

    -- * Transformations
    , map
    , mapM
    , mapMWithInput

    -- * Filtering
    , takeWhileM
    , takeWhile
    , take
    , filter
    , filterM

    -- * Zipping
    , zipWithM
    , zipWith
    , teeZipWith

    -- * Nesting
    , concat
    , concatMapM
    , outerProduct

    -- * Exceptions
    , gbracket
    , gbracketIO
    , before
    , after
    , afterIO
    , onException
    , finally
    , finallyIO
    , bracket
    , bracketIO
    , handle
    )
where

import Control.Exception (Exception, mask_)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)
import Data.Void (Void)
import GHC.Types (SPEC(..))
import Prelude
       hiding (concat, map, mapM, takeWhile, take, filter, const, zipWith)

import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Stream.StreamD.Type (Stream(..), Step(..))
#if __GLASGOW_HASKELL__ < 800
import Streamly.Internal.Data.Stream.StreamD.Type (pattern Stream)
#endif
import Streamly.Internal.Data.Unfold.Types (Unfold(..))
import Streamly.Internal.Data.Fold.Types (Fold(..))
import Streamly.Internal.Data.SVar (defState, MonadAsync)
import Control.Monad.Catch (MonadCatch)

import qualified Prelude
import qualified Control.Monad.Catch as MC
import qualified Data.Tuple as Tuple
import qualified Streamly.Internal.Data.Stream.StreamK as K
import qualified Streamly.Internal.Data.Stream.StreamD as D

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

-- | Map a function on the input argument of the 'Unfold'.
--
-- @
-- lmap f = concat (singleton f)
-- @
--
-- /Internal/
{-# INLINE_NORMAL lmap #-}
lmap :: (a -> c) -> Unfold m c b -> Unfold m a b
lmap :: (a -> c) -> Unfold m c b -> Unfold m a b
lmap a -> 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 (c -> m s
uinject (c -> m s) -> (a -> c) -> a -> m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c
f)

-- | Map an action on the input argument of the 'Unfold'.
--
-- @
-- lmapM f = concat (singletonM f)
-- @
--
-- /Internal/
{-# 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
x -> a -> m c
f a
x m c -> (c -> m s) -> m s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> m s
uinject)

-- XXX change the signature to the following?
-- supply :: a -> Unfold m a b -> Unfold m Void b
--
-- | Supply the seed to an unfold closing the input end of the unfold.
--
-- /Internal/
--
{-# INLINE_NORMAL supply #-}
supply :: Unfold m a b -> a -> Unfold m Void b
supply :: Unfold m a b -> a -> Unfold m Void b
supply Unfold m a b
unf 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) Unfold m a b
unf

-- XXX change the signature to the following?
-- supplyFirst :: a -> Unfold m (a, b) c -> Unfold m b c
--
-- | 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.
--
-- /Internal/
--
{-# INLINE_NORMAL supplyFirst #-}
supplyFirst :: Unfold m (a, b) c -> a -> Unfold m b c
supplyFirst :: Unfold m (a, b) c -> a -> Unfold m b c
supplyFirst Unfold m (a, b) c
unf 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, ) Unfold m (a, b) c
unf

-- XXX change the signature to the following?
-- supplySecond :: b -> Unfold m (a, b) c -> Unfold m a c
--
-- | 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.
--
-- /Internal/
--
{-# INLINE_NORMAL supplySecond #-}
supplySecond :: Unfold m (a, b) c -> b -> Unfold m a c
supplySecond :: Unfold m (a, b) c -> b -> Unfold m a c
supplySecond Unfold m (a, b) c
unf 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) Unfold m (a, b) c
unf

-- | 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.
--
-- /Internal/
--
{-# 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.
--
-- /Internal/
--
{-# 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.
--
-- /Internal/
--
{-# 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.
--
-- /Internal/
--
{-# INLINE_NORMAL fold #-}
fold :: Monad m => Unfold m a b -> Fold m b c -> a -> m c
fold :: Unfold m a b -> Fold m b c -> a -> m c
fold (Unfold s -> m (Step s b)
ustep a -> m s
inject) (Fold s -> b -> m s
fstep m s
initial s -> m c
extract) a
a =
    m s
initial m s -> (s -> m c) -> m c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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
  where
    -- XXX !acc?
    {-# INLINE_LATE go #-}
    go :: SPEC -> s -> s -> m c
go !SPEC
_ s
acc s
st = s
acc s -> m c -> m c
`seq` 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
                s
acc' <- s -> b -> m s
fstep s
acc b
x
                SPEC -> s -> s -> m c
go SPEC
SPEC s
acc' s
s
            Skip s
s -> SPEC -> s -> s -> m c
go SPEC
SPEC s
acc s
s
            Step s b
Stop   -> s -> m c
extract s
acc

{-# INLINE_NORMAL map #-}
map :: Monad m => (b -> c) -> Unfold m a b -> Unfold m a c
map :: (b -> c) -> Unfold m a b -> Unfold m a c
map b -> 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
        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
$ case Step s b
r of
            Yield b
x s
s -> c -> s -> Step s c
forall s a. a -> s -> Step s a
Yield (b -> c
f b
x) s
s
            Skip s
s    -> s -> Step s c
forall s a. s -> Step s a
Skip s
s
            Step s b
Stop      -> Step s c
forall s a. Step s a
Stop

{-# 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 -> m (Step s c)) -> Step s c -> m (Step s c)
forall a b. (a -> b) -> a -> b
$ 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 -> m (Step (a, s) c))
-> Step (a, s) c -> m (Step (a, s) c)
forall a b. (a -> b) -> a -> b
$ Step (a, s) c
forall s a. Step s a
Stop

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

{-# INLINE_LATE streamStep #-}
streamStep :: Monad m => Stream m a -> m (Step (Stream m a) a)
streamStep :: Stream m a -> m (Step (Stream m a) a)
streamStep (Stream State Stream m a -> s -> m (Step s a)
step1 s
state) = 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
state
    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

-- | 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.
--
-- /Internal/
fromStream :: (K.IsStream t, Monad m) => t m b -> Unfold m Void b
fromStream :: t m b -> Unfold m Void b
fromStream t m b
str = (Stream m b -> m (Step (Stream m b) b))
-> (Void -> m (Stream m b)) -> Unfold m Void b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Stream m b -> m (Step (Stream m b) b)
forall (m :: * -> *) a.
Monad m =>
Stream m a -> m (Step (Stream m a) a)
streamStep (\Void
_ -> Stream m b -> m (Stream m b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream m b -> m (Stream m b)) -> Stream m b -> m (Stream m b)
forall a b. (a -> b) -> a -> b
$ t m b -> Stream m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
D.toStreamD t m b
str)

-- | Convert a single argument stream generator function into an
-- 'Unfold'. Note that a stream converted to an 'Unfold' may not be as
-- efficient as an 'Unfold' in some situations.
--
-- /Internal/
fromStream1 :: (K.IsStream t, Monad m) => (a -> t m b) -> Unfold m a b
fromStream1 :: (a -> t m b) -> Unfold m a b
fromStream1 a -> t m b
f = (Stream m b -> m (Step (Stream m b) b))
-> (a -> m (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 Stream m b -> m (Step (Stream m b) b)
forall (m :: * -> *) a.
Monad m =>
Stream m a -> m (Step (Stream m a) a)
streamStep (Stream m b -> m (Stream m b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream m b -> m (Stream m b))
-> (a -> Stream m b) -> a -> m (Stream m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t m b -> Stream m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
D.toStreamD (t m b -> Stream m b) -> (a -> t m b) -> a -> Stream m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> t m b
f)

-- | Convert a two argument stream generator function into an 'Unfold'. Note
-- that a stream converted to an 'Unfold' may not be as efficient as an
-- 'Unfold' in some situations.
--
-- /Internal/
fromStream2 :: (K.IsStream t, Monad m)
    => (a -> b -> t m c) -> Unfold m (a, b) c
fromStream2 :: (a -> b -> t m c) -> Unfold m (a, b) c
fromStream2 a -> b -> t m c
f = (Stream m c -> m (Step (Stream m c) c))
-> ((a, b) -> m (Stream m c)) -> Unfold m (a, b) c
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Stream m c -> m (Step (Stream m c) c)
forall (m :: * -> *) a.
Monad m =>
Stream m a -> m (Step (Stream m a) a)
streamStep (\(a
a, b
b) -> Stream m c -> m (Stream m c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream m c -> m (Stream m c)) -> Stream m c -> m (Stream m c)
forall a b. (a -> b) -> a -> b
$ t m c -> Stream m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
D.toStreamD (t m c -> Stream m c) -> t m c -> Stream m c
forall a b. (a -> b) -> a -> b
$ a -> b -> t m c
f a
a b
b)

-------------------------------------------------------------------------------
-- 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'.
--
-- /Internal/
{-# 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) = do
        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

-- | Lift a monadic effect into an unfold generating a singleton stream.
--
{-# INLINE effect #-}
effect :: Monad m => m b -> Unfold m Void b
effect :: m b -> Unfold m Void b
effect m b
eff = (Bool -> m (Step Bool b)) -> (Void -> m Bool) -> Unfold m Void b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Bool -> m (Step Bool b)
step Void -> m Bool
forall (m :: * -> *) p. Monad m => p -> m Bool
inject
    where
    inject :: p -> m Bool
inject p
_ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    {-# INLINE_LATE step #-}
    step :: Bool -> m (Step Bool b)
step Bool
True = m b
eff m b -> (b -> m (Step Bool b)) -> m (Step Bool b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> Step Bool b -> m (Step Bool b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step Bool b -> m (Step Bool b)) -> Step Bool b -> m (Step Bool b)
forall a b. (a -> b) -> a -> b
$ b -> Bool -> Step Bool b
forall s a. a -> s -> Step s a
Yield b
r Bool
False
    step Bool
False = Step Bool b -> m (Step Bool b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step Bool b
forall s a. Step s a
Stop

-- XXX change it to yieldM or change yieldM in Prelude to singletonM
--
-- | Lift a monadic function into an unfold generating a singleton stream.
--
{-# INLINE singletonM #-}
singletonM :: Monad m => (a -> m b) -> Unfold m a b
singletonM :: (a -> m b) -> Unfold m a b
singletonM a -> m b
f = (Maybe a -> m (Step (Maybe a) b))
-> (a -> m (Maybe a)) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold Maybe a -> m (Step (Maybe a) b)
forall a. Maybe a -> m (Step (Maybe a) b)
step a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m (Maybe a)
inject
    where
    inject :: a -> m (Maybe a)
inject a
x = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x
    {-# INLINE_LATE step #-}
    step :: Maybe a -> m (Step (Maybe a) b)
step (Just a
x) = a -> m b
f a
x m b -> (b -> m (Step (Maybe a) b)) -> m (Step (Maybe a) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> Step (Maybe a) b -> m (Step (Maybe a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe a) b -> m (Step (Maybe a) b))
-> Step (Maybe a) b -> m (Step (Maybe a) b)
forall a b. (a -> b) -> a -> b
$ b -> Maybe a -> Step (Maybe a) b
forall s a. a -> s -> Step s a
Yield b
r Maybe a
forall a. Maybe a
Nothing
    step Maybe a
Nothing = Step (Maybe a) b -> m (Step (Maybe a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Maybe a) b
forall s a. Step s a
Stop

-- | Lift a pure function into an unfold generating a singleton stream.
--
{-# INLINE singleton #-}
singleton :: Monad m => (a -> b) -> Unfold m a b
singleton :: (a -> b) -> Unfold m a b
singleton a -> b
f = (a -> m b) -> Unfold m a b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Unfold m a b
singletonM ((a -> m b) -> Unfold m a b) -> (a -> m b) -> Unfold m a b
forall a b. (a -> b) -> a -> b
$ b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

-- | Identity unfold. Generates a singleton stream with the seed as the only
-- element in the stream.
--
-- > identity = singletonM return
--
{-# INLINE identity #-}
identity :: Monad m => Unfold m a a
identity :: Unfold m a a
identity = (a -> m a) -> Unfold m a a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Unfold m a b
singletonM a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

const :: Monad m => m b -> Unfold m a b
const :: m b -> Unfold m a b
const m b
m = (() -> m (Step () b)) -> (a -> m ()) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold () -> m (Step () b)
step a -> m ()
forall (m :: * -> *) p. Monad m => p -> m ()
inject
    where
    inject :: p -> m ()
inject p
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    step :: () -> m (Step () b)
step () = m b
m m b -> (b -> m (Step () b)) -> m (Step () b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> Step () b -> m (Step () b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step () b -> m (Step () b)) -> Step () b -> m (Step () b)
forall a b. (a -> b) -> a -> b
$ b -> () -> Step () b
forall s a. a -> s -> Step s a
Yield b
r ()

-- | Generates a stream replicating the seed @n@ times.
--
{-# INLINE replicateM #-}
replicateM :: Monad m => Int -> Unfold m a a
replicateM :: Int -> Unfold m a a
replicateM Int
n = ((a, Int) -> m (Step (a, Int) a))
-> (a -> m (a, Int)) -> Unfold m a a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (a, Int) -> m (Step (a, Int) a)
forall (m :: * -> *) b a.
(Monad m, Ord b, Num b) =>
(a, b) -> m (Step (a, b) a)
step a -> 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 :: (a, b) -> m (Step (a, b) a)
step (a
x, b
i) = Step (a, b) a -> m (Step (a, b) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, b) a -> m (Step (a, b) a))
-> Step (a, b) a -> m (Step (a, b) a)
forall a b. (a -> b) -> a -> b
$
        if b
i b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0
        then Step (a, b) a
forall s a. Step s a
Stop
        else a -> (a, b) -> Step (a, b) a
forall s a. a -> s -> Step s a
Yield a
x (a
x, (b
i b -> b -> b
forall a. Num a => a -> a -> a
- b
1))

-- | Generates an infinite stream repeating the seed.
--
{-# INLINE repeatM #-}
repeatM :: Monad m => Unfold m a a
repeatM :: Unfold m a a
repeatM = (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 :: * -> *) s. Monad m => s -> m (Step s s)
step a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    where
    {-# INLINE_LATE step #-}
    step :: s -> m (Step s s)
step s
x = Step s s -> m (Step s s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s s -> m (Step s s)) -> Step s s -> m (Step s s)
forall a b. (a -> b) -> a -> b
$ s -> s -> Step s s
forall s a. a -> s -> Step s a
Yield s
x s
x

-- | Convert a list of pure values to a 'Stream'
{-# 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 (m :: * -> *) a. Monad m => a -> m a
inject
  where
    inject :: a -> m a
inject a
x = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    {-# 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'
{-# 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 (m :: * -> *) a. Monad m => a -> m a
inject
  where
    inject :: a -> m a
inject a
x = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    {-# 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

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

{-# 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

{-# 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

{-# 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)

{-# 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

{-# 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)

-------------------------------------------------------------------------------
-- Enumeration
-------------------------------------------------------------------------------

-- | 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
$ Unfold m (a, a) a -> a -> Unfold m a a
forall (m :: * -> *) a b c. Unfold m (a, b) c -> b -> Unfold m a c
supplySecond Unfold m (a, a) a
forall a (m :: * -> *). (Integral a, Monad m) => Unfold m (a, a) a
enumerateFromStepIntegral a
1

{-# 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

-------------------------------------------------------------------------------
-- Zipping
-------------------------------------------------------------------------------

{-# INLINE_NORMAL zipWithM #-}
zipWithM :: Monad m
    => (a -> b -> m c) -> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c
zipWithM :: (a -> b -> m c)
-> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c
zipWithM a -> b -> m c
f (Unfold s -> m (Step s a)
step1 x -> m s
inject1) (Unfold s -> m (Step s b)
step2 y -> m s
inject2) = ((s, s, Maybe a) -> m (Step (s, s, Maybe a) c))
-> ((x, y) -> m (s, s, Maybe a)) -> Unfold m (x, y) c
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, s, Maybe a) -> m (Step (s, s, Maybe a) c)
step (x, y) -> m (s, s, Maybe a)
forall a. (x, y) -> m (s, s, Maybe a)
inject

    where

    inject :: (x, y) -> m (s, s, Maybe a)
inject (x
x, y
y) = do
        s
s1 <- x -> m s
inject1 x
x
        s
s2 <- y -> m s
inject2 y
y
        (s, s, Maybe a) -> m (s, s, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s1, s
s2, Maybe a
forall a. Maybe a
Nothing)

    {-# INLINE_LATE step #-}
    step :: (s, s, Maybe a) -> m (Step (s, s, Maybe a) c)
step (s
s1, s
s2, Maybe a
Nothing) = do
        Step s a
r <- s -> m (Step s a)
step1 s
s1
        Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c))
-> Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall a b. (a -> b) -> a -> b
$
          case Step s a
r of
            Yield a
x s
s -> (s, s, Maybe a) -> Step (s, s, Maybe a) c
forall s a. s -> Step s a
Skip (s
s, s
s2, a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Skip s
s    -> (s, s, Maybe a) -> Step (s, s, Maybe a) c
forall s a. s -> Step s a
Skip (s
s, s
s2, Maybe a
forall a. Maybe a
Nothing)
            Step s a
Stop      -> Step (s, s, Maybe a) c
forall s a. Step s a
Stop

    step (s
s1, s
s2, Just a
x) = do
        Step s b
r <- s -> m (Step s b)
step2 s
s2
        case Step s b
r of
            Yield b
y s
s -> do
                c
z <- a -> b -> m c
f a
x b
y
                Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c))
-> Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall a b. (a -> b) -> a -> b
$ c -> (s, s, Maybe a) -> Step (s, s, Maybe a) c
forall s a. a -> s -> Step s a
Yield c
z (s
s1, s
s, Maybe a
forall a. Maybe a
Nothing)
            Skip s
s -> Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c))
-> Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall a b. (a -> b) -> a -> b
$ (s, s, Maybe a) -> Step (s, s, Maybe a) c
forall s a. s -> Step s a
Skip (s
s1, s
s, a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Step s b
Stop   -> Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, s, Maybe a) c
forall s a. Step s a
Stop

-- | Divide the input into two unfolds and then zip the outputs to a single
-- stream.
--
-- @
--   S.mapM_ print
-- $ S.concatUnfold (UF.zipWith (,) UF.identity (UF.singleton sqrt))
-- $ S.map (\x -> (x,x))
-- $ S.fromList [1..10]
-- @
--
-- /Internal/
--
{-# INLINE zipWith #-}
zipWith :: Monad m
    => (a -> b -> c) -> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c
zipWith :: (a -> b -> c) -> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c
zipWith a -> b -> c
f = (a -> b -> m c)
-> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c
forall (m :: * -> *) a b c x y.
Monad m =>
(a -> b -> m c)
-> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c
zipWithM (\a
a b
b -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> c
f a
a b
b))

-- | Distribute the input to two unfolds and then zip the outputs to a single
-- stream.
--
-- @
-- S.mapM_ print $ S.concatUnfold (UF.teeZipWith (,) UF.identity (UF.singleton sqrt)) $ S.fromList [1..10]
-- @
--
-- /Internal/
--
{-# INLINE_NORMAL teeZipWith #-}
teeZipWith :: Monad m
    => (a -> b -> c) -> Unfold m x a -> Unfold m x b -> Unfold m x c
teeZipWith :: (a -> b -> c) -> Unfold m x a -> Unfold m x b -> Unfold m x c
teeZipWith a -> b -> c
f Unfold m x a
unf1 Unfold m x b
unf2 = (x -> (x, x)) -> Unfold m (x, x) c -> Unfold m x c
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
lmap (\x
x -> (x
x,x
x)) (Unfold m (x, x) c -> Unfold m x c)
-> Unfold m (x, x) c -> Unfold m x c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> Unfold m x a -> Unfold m x b -> Unfold m (x, x) c
forall (m :: * -> *) a b c x y.
Monad m =>
(a -> b -> c) -> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c
zipWith a -> b -> c
f Unfold m x a
unf1 Unfold m x b
unf2

-------------------------------------------------------------------------------
-- Nested
-------------------------------------------------------------------------------

{-# ANN type ConcatState Fuse #-}
data ConcatState s1 s2 = ConcatOuter s1 | ConcatInner s1 s2

-- | Apply the second unfold to each output element of the first unfold and
-- flatten the output in a single stream.
--
-- /Internal/
--
{-# INLINE_NORMAL concat #-}
concat :: Monad m => Unfold m a b -> Unfold m b c -> Unfold m a c
concat :: Unfold m a b -> Unfold m b c -> Unfold m a c
concat (Unfold s -> m (Step s b)
step1 a -> m s
inject1) (Unfold s -> m (Step s c)
step2 b -> m s
inject2) = (ConcatState s s -> m (Step (ConcatState s s) c))
-> (a -> m (ConcatState s s)) -> Unfold m a c
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold ConcatState s s -> m (Step (ConcatState s s) c)
step a -> m (ConcatState s s)
forall s2. a -> m (ConcatState s s2)
inject
    where
    inject :: a -> m (ConcatState s s2)
inject a
x = do
        s
s <- a -> m s
inject1 a
x
        ConcatState s s2 -> m (ConcatState s s2)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConcatState s s2 -> m (ConcatState s s2))
-> ConcatState s s2 -> m (ConcatState s s2)
forall a b. (a -> b) -> a -> b
$ s -> ConcatState s s2
forall s1 s2. s1 -> ConcatState s1 s2
ConcatOuter s
s

    {-# INLINE_LATE step #-}
    step :: ConcatState s s -> m (Step (ConcatState s s) c)
step (ConcatOuter 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
                s
innerSt <- b -> m s
inject2 b
x
                Step (ConcatState s s) c -> m (Step (ConcatState s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatState s s) c -> m (Step (ConcatState s s) c))
-> Step (ConcatState s s) c -> m (Step (ConcatState s s) c)
forall a b. (a -> b) -> a -> b
$ ConcatState s s -> Step (ConcatState s s) c
forall s a. s -> Step s a
Skip (s -> s -> ConcatState s s
forall s1 s2. s1 -> s2 -> ConcatState s1 s2
ConcatInner s
s s
innerSt)
            Skip s
s    -> Step (ConcatState s s) c -> m (Step (ConcatState s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatState s s) c -> m (Step (ConcatState s s) c))
-> Step (ConcatState s s) c -> m (Step (ConcatState s s) c)
forall a b. (a -> b) -> a -> b
$ ConcatState s s -> Step (ConcatState s s) c
forall s a. s -> Step s a
Skip (s -> ConcatState s s
forall s1 s2. s1 -> ConcatState s1 s2
ConcatOuter s
s)
            Step s b
Stop      -> Step (ConcatState s s) c -> m (Step (ConcatState s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ConcatState s s) c
forall s a. Step s a
Stop

    step (ConcatInner s
ost s
ist) = do
        Step s c
r <- s -> m (Step s c)
step2 s
ist
        Step (ConcatState s s) c -> m (Step (ConcatState s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatState s s) c -> m (Step (ConcatState s s) c))
-> Step (ConcatState s s) c -> m (Step (ConcatState s s) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
s -> c -> ConcatState s s -> Step (ConcatState s s) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> ConcatState s s
forall s1 s2. s1 -> s2 -> ConcatState s1 s2
ConcatInner s
ost s
s)
            Skip s
s    -> ConcatState s s -> Step (ConcatState s s) c
forall s a. s -> Step s a
Skip (s -> s -> ConcatState s s
forall s1 s2. s1 -> s2 -> ConcatState s1 s2
ConcatInner s
ost s
s)
            Step s c
Stop      -> ConcatState s s -> Step (ConcatState s s) c
forall s a. s -> Step s a
Skip (s -> ConcatState s s
forall s1 s2. s1 -> ConcatState s1 s2
ConcatOuter s
ost)

data OuterProductState s1 s2 sy x y =
    OuterProductOuter s1 y | OuterProductInner s1 sy s2 x

-- | Create an outer product (vector product or cartesian product) of the
-- output streams of two unfolds.
--
{-# INLINE_NORMAL outerProduct #-}
outerProduct :: Monad m
    => Unfold m a b -> Unfold m c d -> Unfold m (a, c) (b, d)
outerProduct :: Unfold m a b -> Unfold m c d -> Unfold m (a, c) (b, d)
outerProduct (Unfold s -> m (Step s b)
step1 a -> m s
inject1) (Unfold s -> m (Step s d)
step2 c -> m s
inject2) = (OuterProductState s s c b c
 -> m (Step (OuterProductState s s c b c) (b, d)))
-> ((a, c) -> m (OuterProductState s s c b c))
-> Unfold m (a, c) (b, d)
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold OuterProductState s s c b c
-> m (Step (OuterProductState s s c b c) (b, d))
step (a, c) -> m (OuterProductState s s c b c)
forall y s2 sy x. (a, y) -> m (OuterProductState s s2 sy x y)
inject
    where
    inject :: (a, y) -> m (OuterProductState s s2 sy x y)
inject (a
x, y
y) = do
        s
s1 <- a -> m s
inject1 a
x
        OuterProductState s s2 sy x y -> m (OuterProductState s s2 sy x y)
forall (m :: * -> *) a. Monad m => a -> m a
return (OuterProductState s s2 sy x y
 -> m (OuterProductState s s2 sy x y))
-> OuterProductState s s2 sy x y
-> m (OuterProductState s s2 sy x y)
forall a b. (a -> b) -> a -> b
$ s -> y -> OuterProductState s s2 sy x y
forall s1 s2 sy x y. s1 -> y -> OuterProductState s1 s2 sy x y
OuterProductOuter s
s1 y
y

    {-# INLINE_LATE step #-}
    step :: OuterProductState s s c b c
-> m (Step (OuterProductState s s c b c) (b, d))
step (OuterProductOuter s
st1 c
sy) = do
        Step s b
r <- s -> m (Step s b)
step1 s
st1
        case Step s b
r of
            Yield b
x s
s -> do
                s
s2 <- c -> m s
inject2 c
sy
                Step (OuterProductState s s c b c) (b, d)
-> m (Step (OuterProductState s s c b c) (b, d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (OuterProductState s s c b c) (b, d)
 -> m (Step (OuterProductState s s c b c) (b, d)))
-> Step (OuterProductState s s c b c) (b, d)
-> m (Step (OuterProductState s s c b c) (b, d))
forall a b. (a -> b) -> a -> b
$ OuterProductState s s c b c
-> Step (OuterProductState s s c b c) (b, d)
forall s a. s -> Step s a
Skip (s -> c -> s -> b -> OuterProductState s s c b c
forall s1 s2 sy x y.
s1 -> sy -> s2 -> x -> OuterProductState s1 s2 sy x y
OuterProductInner s
s c
sy s
s2 b
x)
            Skip s
s    -> Step (OuterProductState s s c b c) (b, d)
-> m (Step (OuterProductState s s c b c) (b, d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (OuterProductState s s c b c) (b, d)
 -> m (Step (OuterProductState s s c b c) (b, d)))
-> Step (OuterProductState s s c b c) (b, d)
-> m (Step (OuterProductState s s c b c) (b, d))
forall a b. (a -> b) -> a -> b
$ OuterProductState s s c b c
-> Step (OuterProductState s s c b c) (b, d)
forall s a. s -> Step s a
Skip (s -> c -> OuterProductState s s c b c
forall s1 s2 sy x y. s1 -> y -> OuterProductState s1 s2 sy x y
OuterProductOuter s
s c
sy)
            Step s b
Stop      -> Step (OuterProductState s s c b c) (b, d)
-> m (Step (OuterProductState s s c b c) (b, d))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (OuterProductState s s c b c) (b, d)
forall s a. Step s a
Stop

    step (OuterProductInner s
ost c
sy s
ist b
x) = do
        Step s d
r <- s -> m (Step s d)
step2 s
ist
        Step (OuterProductState s s c b c) (b, d)
-> m (Step (OuterProductState s s c b c) (b, d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (OuterProductState s s c b c) (b, d)
 -> m (Step (OuterProductState s s c b c) (b, d)))
-> Step (OuterProductState s s c b c) (b, d)
-> m (Step (OuterProductState s s c b c) (b, d))
forall a b. (a -> b) -> a -> b
$ case Step s d
r of
            Yield d
y s
s -> (b, d)
-> OuterProductState s s c b c
-> Step (OuterProductState s s c b c) (b, d)
forall s a. a -> s -> Step s a
Yield (b
x, d
y) (s -> c -> s -> b -> OuterProductState s s c b c
forall s1 s2 sy x y.
s1 -> sy -> s2 -> x -> OuterProductState s1 s2 sy x y
OuterProductInner s
ost c
sy s
s b
x)
            Skip s
s    -> OuterProductState s s c b c
-> Step (OuterProductState s s c b c) (b, d)
forall s a. s -> Step s a
Skip (s -> c -> s -> b -> OuterProductState s s c b c
forall s1 s2 sy x y.
s1 -> sy -> s2 -> x -> OuterProductState s1 s2 sy x y
OuterProductInner s
ost c
sy s
s b
x)
            Step s d
Stop      -> OuterProductState s s c b c
-> Step (OuterProductState s s c b c) (b, d)
forall s a. s -> Step s a
Skip (s -> c -> OuterProductState s s c b c
forall s1 s2 sy x y. s1 -> y -> OuterProductState s1 s2 sy x y
OuterProductOuter s
ost c
sy)

-- XXX This can be used to implement a Monad instance for "Unfold m ()".

data ConcatMapState s1 s2 = ConcatMapOuter s1 | ConcatMapInner s1 s2

-- | Map an unfold generating action to each element of an unfold and
-- flattern the results into a single stream.
--
{-# INLINE_NORMAL concatMapM #-}
concatMapM :: Monad m
    => (b -> m (Unfold m () c)) -> Unfold m a b -> Unfold m a c
concatMapM :: (b -> m (Unfold m () c)) -> Unfold m a b -> Unfold m a c
concatMapM b -> m (Unfold m () c)
f (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = (ConcatMapState s (Stream m c)
 -> m (Step (ConcatMapState s (Stream m c)) c))
-> (a -> m (ConcatMapState s (Stream m c))) -> Unfold m a c
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold ConcatMapState s (Stream m c)
-> m (Step (ConcatMapState s (Stream m c)) c)
step a -> m (ConcatMapState s (Stream m c))
forall s2. a -> m (ConcatMapState s s2)
inject
    where
    inject :: a -> m (ConcatMapState s s2)
inject a
x = do
        s
s <- a -> m s
inject1 a
x
        ConcatMapState s s2 -> m (ConcatMapState s s2)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConcatMapState s s2 -> m (ConcatMapState s s2))
-> ConcatMapState s s2 -> m (ConcatMapState s s2)
forall a b. (a -> b) -> a -> b
$ s -> ConcatMapState s s2
forall s1 s2. s1 -> ConcatMapState s1 s2
ConcatMapOuter s
s

    {-# INLINE_LATE step #-}
    step :: ConcatMapState s (Stream m c)
-> m (Step (ConcatMapState s (Stream m c)) c)
step (ConcatMapOuter 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
                Unfold s -> m (Step s c)
step2 () -> m s
inject2 <- b -> m (Unfold m () c)
f b
x
                s
innerSt <- () -> m s
inject2 ()
                Step (ConcatMapState s (Stream m c)) c
-> m (Step (ConcatMapState s (Stream m c)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatMapState s (Stream m c)) c
 -> m (Step (ConcatMapState s (Stream m c)) c))
-> Step (ConcatMapState s (Stream m c)) c
-> m (Step (ConcatMapState s (Stream m c)) c)
forall a b. (a -> b) -> a -> b
$ ConcatMapState s (Stream m c)
-> Step (ConcatMapState s (Stream m c)) c
forall s a. s -> Step s a
Skip (s -> Stream m c -> ConcatMapState s (Stream m c)
forall s1 s2. s1 -> s2 -> ConcatMapState s1 s2
ConcatMapInner s
s ((State Stream m c -> s -> m (Step s c)) -> s -> Stream m c
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream (\State Stream m c
_ s
ss -> s -> m (Step s c)
step2 s
ss)
                                                        s
innerSt))
            Skip s
s    -> Step (ConcatMapState s (Stream m c)) c
-> m (Step (ConcatMapState s (Stream m c)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatMapState s (Stream m c)) c
 -> m (Step (ConcatMapState s (Stream m c)) c))
-> Step (ConcatMapState s (Stream m c)) c
-> m (Step (ConcatMapState s (Stream m c)) c)
forall a b. (a -> b) -> a -> b
$ ConcatMapState s (Stream m c)
-> Step (ConcatMapState s (Stream m c)) c
forall s a. s -> Step s a
Skip (s -> ConcatMapState s (Stream m c)
forall s1 s2. s1 -> ConcatMapState s1 s2
ConcatMapOuter s
s)
            Step s b
Stop      -> Step (ConcatMapState s (Stream m c)) c
-> m (Step (ConcatMapState s (Stream m c)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ConcatMapState s (Stream m c)) c
forall s a. Step s a
Stop

    step (ConcatMapInner s
ost (UnStream State Stream m c -> s -> m (Step s c)
istep s
ist)) = do
        Step s c
r <- State Stream m c -> s -> m (Step s c)
istep State Stream m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
ist
        Step (ConcatMapState s (Stream m c)) c
-> m (Step (ConcatMapState s (Stream m c)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatMapState s (Stream m c)) c
 -> m (Step (ConcatMapState s (Stream m c)) c))
-> Step (ConcatMapState s (Stream m c)) c
-> m (Step (ConcatMapState s (Stream m c)) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
s -> c
-> ConcatMapState s (Stream m c)
-> Step (ConcatMapState s (Stream m c)) c
forall s a. a -> s -> Step s a
Yield c
x (s -> Stream m c -> ConcatMapState s (Stream m c)
forall s1 s2. s1 -> s2 -> ConcatMapState s1 s2
ConcatMapInner s
ost ((State Stream m c -> s -> m (Step s c)) -> s -> Stream m c
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m c -> s -> m (Step s c)
istep s
s))
            Skip s
s    -> ConcatMapState s (Stream m c)
-> Step (ConcatMapState s (Stream m c)) c
forall s a. s -> Step s a
Skip (s -> Stream m c -> ConcatMapState s (Stream m c)
forall s1 s2. s1 -> s2 -> ConcatMapState s1 s2
ConcatMapInner s
ost ((State Stream m c -> s -> m (Step s c)) -> s -> Stream m c
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m c -> s -> m (Step s c)
istep s
s))
            Step s c
Stop      -> ConcatMapState s (Stream m c)
-> Step (ConcatMapState s (Stream m c)) c
forall s a. s -> Step s a
Skip (s -> ConcatMapState s (Stream m c)
forall s1 s2. s1 -> ConcatMapState s1 s2
ConcatMapOuter s
ost)

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

-- | The most general bracketing and exception combinator. All other
-- combinators can be expressed in terms of this combinator. This can also be
-- used for cases which are not covered by the standard combinators.
--
-- /Internal/
--
{-# 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
            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

-- | The most general bracketing and exception combinator. All other
-- combinators can be expressed in terms of this combinator. This can also be
-- used for cases which are not covered by the standard combinators.
--
-- /Internal/
--
{-# INLINE_NORMAL gbracketIO #-}
gbracketIO
    :: (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
gbracketIO :: (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
gbracketIO 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, IORef (Maybe (IO ())))
 -> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b))
-> (a -> m (Either s (s, c, IORef (Maybe (IO ())))))
-> 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, IORef (Maybe (IO ())))
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
step a -> m (Either s (s, c, IORef (Maybe (IO ()))))
forall a. a -> m (Either a (s, c, IORef (Maybe (IO ()))))
inject

    where

    inject :: a -> m (Either a (s, c, IORef (Maybe (IO ()))))
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, IORef (Maybe (IO ()))
ref) <- (IO (StM m (c, IORef (Maybe (IO ()))))
 -> IO (StM m (c, IORef (Maybe (IO ())))))
-> m (c, IORef (Maybe (IO ()))) -> m (c, IORef (Maybe (IO ())))
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, IORef (Maybe (IO ()))))
-> IO (StM m (c, IORef (Maybe (IO ()))))
forall a. IO a -> IO a
mask_ (m (c, IORef (Maybe (IO ()))) -> m (c, IORef (Maybe (IO ()))))
-> m (c, IORef (Maybe (IO ()))) -> m (c, IORef (Maybe (IO ())))
forall a b. (a -> b) -> a -> b
$ do
            c
r <- a -> m c
bef a
x
            IORef (Maybe (IO ()))
ref <- m d -> m (IORef (Maybe (IO ())))
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m a -> m (IORef (Maybe (IO ())))
D.newFinalizedIORef (c -> m d
aft c
r)
            (c, IORef (Maybe (IO ()))) -> m (c, IORef (Maybe (IO ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (c
r, IORef (Maybe (IO ()))
ref)
        s
s <- c -> m s
inject1 c
r
        Either a (s, c, IORef (Maybe (IO ())))
-> m (Either a (s, c, IORef (Maybe (IO ()))))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (s, c, IORef (Maybe (IO ())))
 -> m (Either a (s, c, IORef (Maybe (IO ())))))
-> Either a (s, c, IORef (Maybe (IO ())))
-> m (Either a (s, c, IORef (Maybe (IO ()))))
forall a b. (a -> b) -> a -> b
$ (s, c, IORef (Maybe (IO ())))
-> Either a (s, c, IORef (Maybe (IO ())))
forall a b. b -> Either a b
Right (s
s, c
r, IORef (Maybe (IO ()))
ref)

    {-# INLINE_LATE step #-}
    step :: Either s (s, c, IORef (Maybe (IO ())))
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
step (Right (s
st, c
v, IORef (Maybe (IO ()))
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, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c, IORef (Maybe (IO ())))) b
 -> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b))
-> Step (Either s (s, c, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall a b. (a -> b) -> a -> b
$ b
-> Either s (s, c, IORef (Maybe (IO ())))
-> Step (Either s (s, c, IORef (Maybe (IO ())))) b
forall s a. a -> s -> Step s a
Yield b
x ((s, c, IORef (Maybe (IO ())))
-> Either s (s, c, IORef (Maybe (IO ())))
forall a b. b -> Either a b
Right (s
s, c
v, IORef (Maybe (IO ()))
ref))
                Skip s
s    -> Step (Either s (s, c, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c, IORef (Maybe (IO ())))) b
 -> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b))
-> Step (Either s (s, c, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall a b. (a -> b) -> a -> b
$ Either s (s, c, IORef (Maybe (IO ())))
-> Step (Either s (s, c, IORef (Maybe (IO ())))) b
forall s a. s -> Step s a
Skip ((s, c, IORef (Maybe (IO ())))
-> Either s (s, c, IORef (Maybe (IO ())))
forall a b. b -> Either a b
Right (s
s, c
v, IORef (Maybe (IO ()))
ref))
                Step s b
Stop      -> do
                    IORef (Maybe (IO ())) -> m ()
forall (m :: * -> *). MonadIO m => IORef (Maybe (IO ())) -> m ()
D.runIORefFinalizer IORef (Maybe (IO ()))
ref
                    Step (Either s (s, c, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Either s (s, c, IORef (Maybe (IO ())))) b
forall s a. Step s a
Stop
            Left e
e -> do
                IORef (Maybe (IO ())) -> m ()
forall (m :: * -> *). MonadIO m => IORef (Maybe (IO ())) -> m ()
D.clearIORefFinalizer IORef (Maybe (IO ()))
ref
                s
r <- (c, e) -> m s
einject (c
v, e
e)
                Step (Either s (s, c, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c, IORef (Maybe (IO ())))) b
 -> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b))
-> Step (Either s (s, c, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall a b. (a -> b) -> a -> b
$ Either s (s, c, IORef (Maybe (IO ())))
-> Step (Either s (s, c, IORef (Maybe (IO ())))) b
forall s a. s -> Step s a
Skip (s -> Either s (s, c, IORef (Maybe (IO ())))
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, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c, IORef (Maybe (IO ())))) b
 -> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b))
-> Step (Either s (s, c, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall a b. (a -> b) -> a -> b
$ b
-> Either s (s, c, IORef (Maybe (IO ())))
-> Step (Either s (s, c, IORef (Maybe (IO ())))) b
forall s a. a -> s -> Step s a
Yield b
x (s -> Either s (s, c, IORef (Maybe (IO ())))
forall a b. a -> Either a b
Left s
s)
            Skip s
s    -> Step (Either s (s, c, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s (s, c, IORef (Maybe (IO ())))) b
 -> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b))
-> Step (Either s (s, c, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall a b. (a -> b) -> a -> b
$ Either s (s, c, IORef (Maybe (IO ())))
-> Step (Either s (s, c, IORef (Maybe (IO ())))) b
forall s a. s -> Step s a
Skip (s -> Either s (s, c, IORef (Maybe (IO ())))
forall a b. a -> Either a b
Left s
s)
            Step s b
Stop      -> Step (Either s (s, c, IORef (Maybe (IO ())))) b
-> m (Step (Either s (s, c, IORef (Maybe (IO ())))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Either s (s, c, IORef (Maybe (IO ())))) b
forall s a. Step s a
Stop

-- The custom implementation of "before" is slightly faster (5-7%) than
-- "_before".  This is just to document and make sure that we can always use
-- gbracket to implement before. The same applies to other combinators as well.
--
{-# INLINE_NORMAL _before #-}
_before :: Monad m => (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 m a b
unf = (a -> m a)
-> (forall s. m s -> m (Either Any s))
-> (a -> m ())
-> 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
x -> a -> m c
action a
x m c -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x) ((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 ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Unfold m (a, Any) b
forall a. HasCallStack => a
undefined Unfold m a b
unf

-- | Run a side effect before the unfold yields its first element.
--
-- /Internal/
{-# INLINE_NORMAL before #-}
before :: Monad m => (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)
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
inject

    where

    inject :: a -> m s
inject a
x = do
        c
_ <- a -> m c
action a
x
        s
st <- a -> m s
inject1 a
x
        s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
st

    {-# INLINE_LATE step #-}
    step :: s -> m (Step s b)
step s
st = 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 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
$ b -> s -> Step s b
forall s a. a -> s -> Step s a
Yield b
x 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

{-# 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

-- | Run a side effect whenever the unfold stops normally.
--
-- Prefer afterIO over this as the @after@ action in this combinator is not
-- executed if the unfold is partially evaluated lazily and then garbage
-- collected.
--
-- /Internal/
{-# 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

-- | Run a side effect whenever the unfold stops normally
-- or is garbage collected after a partial lazy evaluation.
--
-- /Internal/
{-# INLINE_NORMAL afterIO #-}
afterIO :: (MonadIO m, MonadBaseControl IO m)
    => (a -> m c) -> Unfold m a b -> Unfold m a b
afterIO :: (a -> m c) -> Unfold m a b -> Unfold m a b
afterIO a -> m c
action (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = ((s, IORef (Maybe (IO ())))
 -> m (Step (s, IORef (Maybe (IO ()))) b))
-> (a -> m (s, IORef (Maybe (IO ())))) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, IORef (Maybe (IO ()))) -> m (Step (s, IORef (Maybe (IO ()))) b)
step a -> m (s, IORef (Maybe (IO ())))
inject

    where

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

    {-# INLINE_LATE step #-}
    step :: (s, IORef (Maybe (IO ()))) -> m (Step (s, IORef (Maybe (IO ()))) b)
step (s
st, IORef (Maybe (IO ()))
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, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IORef (Maybe (IO ()))) b
 -> m (Step (s, IORef (Maybe (IO ()))) b))
-> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall a b. (a -> b) -> a -> b
$ b
-> (s, IORef (Maybe (IO ()))) -> Step (s, IORef (Maybe (IO ()))) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, IORef (Maybe (IO ()))
ref)
            Skip s
s    -> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IORef (Maybe (IO ()))) b
 -> m (Step (s, IORef (Maybe (IO ()))) b))
-> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall a b. (a -> b) -> a -> b
$ (s, IORef (Maybe (IO ()))) -> Step (s, IORef (Maybe (IO ()))) b
forall s a. s -> Step s a
Skip (s
s, IORef (Maybe (IO ()))
ref)
            Step s b
Stop      -> do
                IORef (Maybe (IO ())) -> m ()
forall (m :: * -> *). MonadIO m => IORef (Maybe (IO ())) -> m ()
D.runIORefFinalizer IORef (Maybe (IO ()))
ref
                Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, IORef (Maybe (IO ()))) 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 Unfold m a b
unf =
    (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 m a b
unf

-- | Run a side effect whenever the unfold aborts due to an exception.
--
-- /Internal/
{-# 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 Unfold m a b
unf =
    (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)) Unfold m a b
unf

-- | Run a side effect whenever the unfold stops normally or aborts due to an
-- exception.
--
-- Prefer finallyIO over this as the @after@ action in this combinator is not
-- executed if the unfold is partially evaluated lazily and then garbage
-- collected.
--
-- /Internal/
{-# 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

-- | Run a side effect whenever the unfold stops normally, aborts due to an
-- exception or if it is garbage collected after a partial lazy evaluation.
--
-- /Internal/
{-# INLINE_NORMAL finallyIO #-}
finallyIO :: (MonadAsync m, MonadCatch m)
    => (a -> m c) -> Unfold m a b -> Unfold m a b
finallyIO :: (a -> m c) -> Unfold m a b -> Unfold m a b
finallyIO a -> m c
action (Unfold s -> m (Step s b)
step1 a -> m s
inject1) = ((s, IORef (Maybe (IO ())))
 -> m (Step (s, IORef (Maybe (IO ()))) b))
-> (a -> m (s, IORef (Maybe (IO ())))) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, IORef (Maybe (IO ()))) -> m (Step (s, IORef (Maybe (IO ()))) b)
step a -> m (s, IORef (Maybe (IO ())))
inject

    where

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

    {-# INLINE_LATE step #-}
    step :: (s, IORef (Maybe (IO ()))) -> m (Step (s, IORef (Maybe (IO ()))) b)
step (s
st, IORef (Maybe (IO ()))
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` IORef (Maybe (IO ())) -> m ()
forall (m :: * -> *). MonadIO m => IORef (Maybe (IO ())) -> m ()
D.runIORefFinalizer IORef (Maybe (IO ()))
ref
        case Step s b
res of
            Yield b
x s
s -> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IORef (Maybe (IO ()))) b
 -> m (Step (s, IORef (Maybe (IO ()))) b))
-> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall a b. (a -> b) -> a -> b
$ b
-> (s, IORef (Maybe (IO ()))) -> Step (s, IORef (Maybe (IO ()))) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, IORef (Maybe (IO ()))
ref)
            Skip s
s    -> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IORef (Maybe (IO ()))) b
 -> m (Step (s, IORef (Maybe (IO ()))) b))
-> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall a b. (a -> b) -> a -> b
$ (s, IORef (Maybe (IO ()))) -> Step (s, IORef (Maybe (IO ()))) b
forall s a. s -> Step s a
Skip (s
s, IORef (Maybe (IO ()))
ref)
            Step s b
Stop      -> do
                IORef (Maybe (IO ())) -> m ()
forall (m :: * -> *). MonadIO m => IORef (Maybe (IO ())) -> m ()
D.runIORefFinalizer IORef (Maybe (IO ()))
ref
                Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, IORef (Maybe (IO ()))) 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 Unfold m c b
unf =
    (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)) Unfold m c b
unf

-- | @bracket before after between@ runs the @before@ action and then unfolds
-- its output using the @between@ unfold. When the @between@ unfold is done or
-- if an exception occurs then the @after@ action is run with the output of
-- @before@ as argument.
--
-- Prefer bracketIO over this as the @after@ action in this combinator is not
-- executed if the unfold is partially evaluated lazily and then garbage
-- collected.
--
-- /Internal/
{-# 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

-- | @bracket before after between@ runs the @before@ action and then unfolds
-- its output using the @between@ unfold. When the @between@ unfold is done or
-- if an exception occurs then the @after@ action is run with the output of
-- @before@ as argument. The after action is also executed if the unfold is
-- paritally evaluated and then garbage collected.
--
-- /Internal/
{-# INLINE_NORMAL bracketIO #-}
bracketIO :: (MonadAsync m, MonadCatch m)
    => (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
bracketIO :: (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
bracketIO a -> m c
bef c -> m d
aft (Unfold s -> m (Step s b)
step1 c -> m s
inject1) = ((s, IORef (Maybe (IO ())))
 -> m (Step (s, IORef (Maybe (IO ()))) b))
-> (a -> m (s, IORef (Maybe (IO ())))) -> Unfold m a b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (s, IORef (Maybe (IO ()))) -> m (Step (s, IORef (Maybe (IO ()))) b)
step a -> m (s, IORef (Maybe (IO ())))
inject

    where

    inject :: a -> m (s, IORef (Maybe (IO ())))
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, IORef (Maybe (IO ()))
ref) <- (IO (StM m (c, IORef (Maybe (IO ()))))
 -> IO (StM m (c, IORef (Maybe (IO ())))))
-> m (c, IORef (Maybe (IO ()))) -> m (c, IORef (Maybe (IO ())))
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, IORef (Maybe (IO ()))))
-> IO (StM m (c, IORef (Maybe (IO ()))))
forall a. IO a -> IO a
mask_ (m (c, IORef (Maybe (IO ()))) -> m (c, IORef (Maybe (IO ()))))
-> m (c, IORef (Maybe (IO ()))) -> m (c, IORef (Maybe (IO ())))
forall a b. (a -> b) -> a -> b
$ do
            c
r <- a -> m c
bef a
x
            IORef (Maybe (IO ()))
ref <- m d -> m (IORef (Maybe (IO ())))
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m a -> m (IORef (Maybe (IO ())))
D.newFinalizedIORef (c -> m d
aft c
r)
            (c, IORef (Maybe (IO ()))) -> m (c, IORef (Maybe (IO ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (c
r, IORef (Maybe (IO ()))
ref)
        s
s <- c -> m s
inject1 c
r
        (s, IORef (Maybe (IO ()))) -> m (s, IORef (Maybe (IO ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, IORef (Maybe (IO ()))
ref)

    {-# INLINE_LATE step #-}
    step :: (s, IORef (Maybe (IO ()))) -> m (Step (s, IORef (Maybe (IO ()))) b)
step (s
st, IORef (Maybe (IO ()))
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` IORef (Maybe (IO ())) -> m ()
forall (m :: * -> *). MonadIO m => IORef (Maybe (IO ())) -> m ()
D.runIORefFinalizer IORef (Maybe (IO ()))
ref
        case Step s b
res of
            Yield b
x s
s -> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IORef (Maybe (IO ()))) b
 -> m (Step (s, IORef (Maybe (IO ()))) b))
-> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall a b. (a -> b) -> a -> b
$ b
-> (s, IORef (Maybe (IO ()))) -> Step (s, IORef (Maybe (IO ()))) b
forall s a. a -> s -> Step s a
Yield b
x (s
s, IORef (Maybe (IO ()))
ref)
            Skip s
s    -> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, IORef (Maybe (IO ()))) b
 -> m (Step (s, IORef (Maybe (IO ()))) b))
-> Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall a b. (a -> b) -> a -> b
$ (s, IORef (Maybe (IO ()))) -> Step (s, IORef (Maybe (IO ()))) b
forall s a. s -> Step s a
Skip (s
s, IORef (Maybe (IO ()))
ref)
            Step s b
Stop      -> do
                IORef (Maybe (IO ())) -> m ()
forall (m :: * -> *). MonadIO m => IORef (Maybe (IO ())) -> m ()
D.runIORefFinalizer IORef (Maybe (IO ()))
ref
                Step (s, IORef (Maybe (IO ()))) b
-> m (Step (s, IORef (Maybe (IO ()))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, IORef (Maybe (IO ()))) b
forall s a. Step s a
Stop

-- | When unfolding if an exception occurs, unfold the exception using the
-- exception unfold supplied as the first argument to 'handle'.
--
-- /Internal/
{-# 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 Unfold m a b
unf =
    (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) Unfold m a b
unf