{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE UndecidableInstances  #-}

module Streaming.Internal (
    -- * The free monad transformer
    -- $stream
    Stream (..)

    -- * Introducing a stream
    , unfold
    , replicates
    , repeats
    , repeatsM
    , effect
    , wrap
    , yields
    , streamBuild
    , cycles
    , delays
    , never
    , untilJust

    -- * Eliminating a stream
    , intercalates
    , concats
    , iterT
    , iterTM
    , destroy
    , streamFold

    -- * Inspecting a stream wrap by wrap
    , inspect

    -- * Transforming streams
    , maps
    , mapsM
    , mapsPost
    , mapsMPost
    , hoistUnexposed
    , decompose
    , mapsM_
    , run
    , distribute
    , groups
--    , groupInL

    -- *  Splitting streams
    , chunksOf
    , splitsAt
    , takes
    , cutoff
    -- , period
    -- , periods

    -- * Zipping and unzipping streams
    , zipsWith
    , zipsWith'
    , zips
    , unzips
    , interleaves
    , separate
    , unseparate
    , expand
    , expandPost


    -- * Assorted Data.Functor.x help
    , switch

    -- *  For use in implementation
    , unexposed
    , hoistExposed
    , hoistExposedPost
    , mapsExposed
    , mapsMExposed
    , destroyExposed

   ) where

import Control.Applicative
import Control.Concurrent (threadDelay)
import Control.Monad
import Control.Monad.Error.Class
import Control.Monad.Fail as Fail
import Control.Monad.Morph
import Control.Monad.Reader.Class
import Control.Monad.State.Class
import Control.Monad.Trans
import Data.Data (Typeable)
import Data.Function ( on )
import Data.Functor.Classes
import Data.Functor.Compose
import Data.Functor.Sum
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))

-- $setup
-- >>> import Streaming.Prelude as S

{- $stream

    The 'Stream' data type is equivalent to @FreeT@ and can represent any effectful
    succession of steps, where the form of the steps or 'commands' is
    specified by the first (functor) parameter.

> data Stream f m r = Step !(f (Stream f m r)) | Effect (m (Stream f m r)) | Return r

    The /producer/ concept uses the simple functor @ (a,_) @ \- or the stricter
    @ Of a _ @. Then the news at each step or layer is just: an individual item of type @a@.
    Since @Stream (Of a) m r@ is equivalent to @Pipe.Producer a m r@, much of
    the @pipes@ @Prelude@ can easily be mirrored in a @streaming@ @Prelude@. Similarly,
    a simple @Consumer a m r@ or @Parser a m r@ concept arises when the base functor is
    @ (a -> _) @ . @Stream ((->) input) m result@ consumes @input@ until it returns a
    @result@.

    To avoid breaking reasoning principles, the constructors
    should not be used directly. A pattern-match should go by way of 'inspect' \
    \- or, in the producer case, 'Streaming.Prelude.next'
    The constructors are exported by the 'Internal' module.
-}
data Stream f m r = Step !(f (Stream f m r))
                  | Effect (m (Stream f m r))
                  | Return r
#if __GLASGOW_HASKELL__ >= 710
                  deriving (Typeable)
#endif

-- The most obvious approach would probably be
--
-- s1 == s2 = eqUnexposed (unexposed s1) (unexposed s2)
--
-- but that seems to actually be rather hard (especially if performance
-- matters even a little bit). Using `inspect` instead
-- is nice and simple. The main downside is the rather weird-looking
-- constraint it imposes. We *could* write
--
-- instance (Monad m, Eq r, Eq1 m, Eq1 f) => Eq (Stream f m r)
--
-- but there are an awful lot more Eq instances in the wild than
-- Eq1 instances. Maybe some day soon we'll have implication constraints
-- and everything will be beautiful.
instance (Monad m, Eq (m (Either r (f (Stream f m r)))))
         => Eq (Stream f m r) where
  Stream f m r
s1 == :: Stream f m r -> Stream f m r -> Bool
== Stream f m r
s2 = Stream f m r -> m (Either r (f (Stream f m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream f m r
s1 m (Either r (f (Stream f m r)))
-> m (Either r (f (Stream f m r))) -> Bool
forall a. Eq a => a -> a -> Bool
== Stream f m r -> m (Either r (f (Stream f m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream f m r
s2

-- See the notes on Eq.
instance (Monad m, Ord (m (Either r (f (Stream f m r)))))
         => Ord (Stream f m r) where
  compare :: Stream f m r -> Stream f m r -> Ordering
compare = m (Either r (f (Stream f m r)))
-> m (Either r (f (Stream f m r))) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (m (Either r (f (Stream f m r)))
 -> m (Either r (f (Stream f m r))) -> Ordering)
-> (Stream f m r -> m (Either r (f (Stream f m r))))
-> Stream f m r
-> Stream f m r
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Stream f m r -> m (Either r (f (Stream f m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect
  < :: Stream f m r -> Stream f m r -> Bool
(<) = m (Either r (f (Stream f m r)))
-> m (Either r (f (Stream f m r))) -> Bool
forall a. Ord a => a -> a -> Bool
(<) (m (Either r (f (Stream f m r)))
 -> m (Either r (f (Stream f m r))) -> Bool)
-> (Stream f m r -> m (Either r (f (Stream f m r))))
-> Stream f m r
-> Stream f m r
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Stream f m r -> m (Either r (f (Stream f m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect
  > :: Stream f m r -> Stream f m r -> Bool
(>) = m (Either r (f (Stream f m r)))
-> m (Either r (f (Stream f m r))) -> Bool
forall a. Ord a => a -> a -> Bool
(>) (m (Either r (f (Stream f m r)))
 -> m (Either r (f (Stream f m r))) -> Bool)
-> (Stream f m r -> m (Either r (f (Stream f m r))))
-> Stream f m r
-> Stream f m r
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Stream f m r -> m (Either r (f (Stream f m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect
  <= :: Stream f m r -> Stream f m r -> Bool
(<=) = m (Either r (f (Stream f m r)))
-> m (Either r (f (Stream f m r))) -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (m (Either r (f (Stream f m r)))
 -> m (Either r (f (Stream f m r))) -> Bool)
-> (Stream f m r -> m (Either r (f (Stream f m r))))
-> Stream f m r
-> Stream f m r
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Stream f m r -> m (Either r (f (Stream f m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect
  >= :: Stream f m r -> Stream f m r -> Bool
(>=) = m (Either r (f (Stream f m r)))
-> m (Either r (f (Stream f m r))) -> Bool
forall a. Ord a => a -> a -> Bool
(>=) (m (Either r (f (Stream f m r)))
 -> m (Either r (f (Stream f m r))) -> Bool)
-> (Stream f m r -> m (Either r (f (Stream f m r))))
-> Stream f m r
-> Stream f m r
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Stream f m r -> m (Either r (f (Stream f m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect

#if MIN_VERSION_base(4,9,0)

-- We could avoid a Show1 constraint for our Show1 instance by sneakily
-- mapping everything to a single known type, but there's really no way
-- to do that for Eq1 or Ord1.
instance (Monad m, Functor f, Eq1 m, Eq1 f) => Eq1 (Stream f m) where
  liftEq :: (a -> b -> Bool) -> Stream f m a -> Stream f m b -> Bool
liftEq a -> b -> Bool
eq Stream f m a
xs Stream f m b
ys = Stream f m a -> Stream f m b -> Bool
liftEqExposed (Stream f m a -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r.
(Functor f, Monad m) =>
Stream f m r -> Stream f m r
unexposed Stream f m a
xs) (Stream f m b -> Stream f m b
forall (f :: * -> *) (m :: * -> *) r.
(Functor f, Monad m) =>
Stream f m r -> Stream f m r
unexposed Stream f m b
ys)
    where
      liftEqExposed :: Stream f m a -> Stream f m b -> Bool
liftEqExposed (Return a
x) (Return b
y) = a -> b -> Bool
eq a
x b
y
      liftEqExposed (Effect m (Stream f m a)
m) (Effect m (Stream f m b)
n) = (Stream f m a -> Stream f m b -> Bool)
-> m (Stream f m a) -> m (Stream f m b) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq Stream f m a -> Stream f m b -> Bool
liftEqExposed m (Stream f m a)
m m (Stream f m b)
n
      liftEqExposed (Step f (Stream f m a)
f)   (Step f (Stream f m b)
g)   = (Stream f m a -> Stream f m b -> Bool)
-> f (Stream f m a) -> f (Stream f m b) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq Stream f m a -> Stream f m b -> Bool
liftEqExposed f (Stream f m a)
f f (Stream f m b)
g
      liftEqExposed Stream f m a
_ Stream f m b
_ = Bool
False

instance (Monad m, Functor f, Ord1 m, Ord1 f) => Ord1 (Stream f m) where
  liftCompare :: (a -> b -> Ordering) -> Stream f m a -> Stream f m b -> Ordering
liftCompare a -> b -> Ordering
cmp Stream f m a
xs Stream f m b
ys = Stream f m a -> Stream f m b -> Ordering
liftCmpExposed (Stream f m a -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r.
(Functor f, Monad m) =>
Stream f m r -> Stream f m r
unexposed Stream f m a
xs) (Stream f m b -> Stream f m b
forall (f :: * -> *) (m :: * -> *) r.
(Functor f, Monad m) =>
Stream f m r -> Stream f m r
unexposed Stream f m b
ys)
    where
      liftCmpExposed :: Stream f m a -> Stream f m b -> Ordering
liftCmpExposed (Return a
x) (Return b
y) = a -> b -> Ordering
cmp a
x b
y
      liftCmpExposed (Effect m (Stream f m a)
m) (Effect m (Stream f m b)
n) = (Stream f m a -> Stream f m b -> Ordering)
-> m (Stream f m a) -> m (Stream f m b) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare Stream f m a -> Stream f m b -> Ordering
liftCmpExposed m (Stream f m a)
m m (Stream f m b)
n
      liftCmpExposed (Step f (Stream f m a)
f)   (Step f (Stream f m b)
g)   = (Stream f m a -> Stream f m b -> Ordering)
-> f (Stream f m a) -> f (Stream f m b) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare Stream f m a -> Stream f m b -> Ordering
liftCmpExposed f (Stream f m a)
f f (Stream f m b)
g
      liftCmpExposed (Return a
_) Stream f m b
_ = Ordering
LT
      liftCmpExposed Stream f m a
_ (Return b
_) = Ordering
GT
      liftCmpExposed Stream f m a
_ Stream f m b
_ = [Char] -> Ordering
forall a. HasCallStack => [Char] -> a
error [Char]
"liftCmpExposed: stream was exposed!"

#endif

-- We could get a much less scary implementation using Show1, but
-- Show1 instances aren't nearly as common as Show instances.
--
-- How does this
-- funny-looking instance work?
--
-- We 'inspect' the stream to produce @m (Either r (Stream f m r))@.
-- Then we work under @m@ to produce @m ShowSWrapper@. That's almost
-- like producing @m String@, except that a @ShowSWrapper@ can be
-- shown at any precedence. So the 'Show' instance for @m@ can show
-- the contents at the correct precedence.
instance (Monad m, Show r, Show (m ShowSWrapper), Show (f (Stream f m r)))
         => Show (Stream f m r) where
  showsPrec :: Int -> Stream f m r -> ShowS
showsPrec Int
p Stream f m r
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                     [Char] -> ShowS
showString [Char]
"Effect " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> m ShowSWrapper -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (m ShowSWrapper -> ShowS) -> m ShowSWrapper -> ShowS
forall a b. (a -> b) -> a -> b
$
    ((Either r (f (Stream f m r)) -> ShowSWrapper)
 -> m (Either r (f (Stream f m r))) -> m ShowSWrapper)
-> m (Either r (f (Stream f m r)))
-> (Either r (f (Stream f m r)) -> ShowSWrapper)
-> m ShowSWrapper
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Either r (f (Stream f m r)) -> ShowSWrapper)
-> m (Either r (f (Stream f m r))) -> m ShowSWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stream f m r -> m (Either r (f (Stream f m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream f m r
xs) ((Either r (f (Stream f m r)) -> ShowSWrapper) -> m ShowSWrapper)
-> (Either r (f (Stream f m r)) -> ShowSWrapper) -> m ShowSWrapper
forall a b. (a -> b) -> a -> b
$ \Either r (f (Stream f m r))
front ->
      (Int -> ShowS) -> ShowSWrapper
SS ((Int -> ShowS) -> ShowSWrapper) -> (Int -> ShowS) -> ShowSWrapper
forall a b. (a -> b) -> a -> b
$ \Int
d -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        case Either r (f (Stream f m r))
front of
          Left  r
r -> [Char] -> ShowS
showString [Char]
"Return " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 r
r
          Right f (Stream f m r)
f -> [Char] -> ShowS
showString [Char]
"Step "   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f (Stream f m r) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 f (Stream f m r)
f)

#if MIN_VERSION_base(4,9,0)

instance (Monad m, Functor f, Show (m ShowSWrapper), Show (f ShowSWrapper))
         => Show1 (Stream f m) where
  liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Stream f m a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p Stream f m a
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                     [Char] -> ShowS
showString [Char]
"Effect " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> m ShowSWrapper -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (m ShowSWrapper -> ShowS) -> m ShowSWrapper -> ShowS
forall a b. (a -> b) -> a -> b
$
    ((Either a (f (Stream f m a)) -> ShowSWrapper)
 -> m (Either a (f (Stream f m a))) -> m ShowSWrapper)
-> m (Either a (f (Stream f m a)))
-> (Either a (f (Stream f m a)) -> ShowSWrapper)
-> m ShowSWrapper
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Either a (f (Stream f m a)) -> ShowSWrapper)
-> m (Either a (f (Stream f m a))) -> m ShowSWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stream f m a -> m (Either a (f (Stream f m a)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream f m a
xs) ((Either a (f (Stream f m a)) -> ShowSWrapper) -> m ShowSWrapper)
-> (Either a (f (Stream f m a)) -> ShowSWrapper) -> m ShowSWrapper
forall a b. (a -> b) -> a -> b
$ \Either a (f (Stream f m a))
front ->
      (Int -> ShowS) -> ShowSWrapper
SS ((Int -> ShowS) -> ShowSWrapper) -> (Int -> ShowS) -> ShowSWrapper
forall a b. (a -> b) -> a -> b
$ \Int
d -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        case Either a (f (Stream f m a))
front of
          Left  a
r -> [Char] -> ShowS
showString [Char]
"Return " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sp Int
11 a
r
          Right f (Stream f m a)
f -> [Char] -> ShowS
showString [Char]
"Step "   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                     Int -> f ShowSWrapper -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ((Stream f m a -> ShowSWrapper)
-> f (Stream f m a) -> f ShowSWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> ShowS) -> ShowSWrapper
SS ((Int -> ShowS) -> ShowSWrapper)
-> (Stream f m a -> Int -> ShowS) -> Stream f m a -> ShowSWrapper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Stream f m a
str Int
i -> (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Stream f m a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
i Stream f m a
str)) f (Stream f m a)
f))

#endif

newtype ShowSWrapper = SS (Int -> ShowS)
instance Show ShowSWrapper where
  showsPrec :: Int -> ShowSWrapper -> ShowS
showsPrec Int
p (SS Int -> ShowS
s) = Int -> ShowS
s Int
p

-- | Operates covariantly on the stream result, not on its elements:
--
-- @
-- Stream (Of a) m r
--            ^    ^
--            |    `--- This is what `Functor` and `Applicative` use
--            `--- This is what functions like S.map/S.zipWith use
-- @
instance (Functor f, Monad m) => Functor (Stream f m) where
  fmap :: (a -> b) -> Stream f m a -> Stream f m b
fmap a -> b
f = Stream f m a -> Stream f m b
loop where
    loop :: Stream f m a -> Stream f m b
loop Stream f m a
stream = case Stream f m a
stream of
      Return a
r -> b -> Stream f m b
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (a -> b
f a
r)
      Effect m (Stream f m a)
m -> m (Stream f m b) -> Stream f m b
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (do {Stream f m a
stream' <- m (Stream f m a)
m; Stream f m b -> m (Stream f m b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream f m a -> Stream f m b
loop Stream f m a
stream')})
      Step   f (Stream f m a)
g -> f (Stream f m b) -> Stream f m b
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m a -> Stream f m b)
-> f (Stream f m a) -> f (Stream f m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f m b
loop f (Stream f m a)
g)
  {-# INLINABLE fmap #-}
  a
a <$ :: a -> Stream f m b -> Stream f m a
<$ Stream f m b
stream0 = Stream f m b -> Stream f m a
loop Stream f m b
stream0 where
    loop :: Stream f m b -> Stream f m a
loop Stream f m b
stream = case Stream f m b
stream of
      Return b
_ -> a -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return a
a
      Effect m (Stream f m b)
m -> m (Stream f m a) -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (do {Stream f m b
stream' <- m (Stream f m b)
m; Stream f m a -> m (Stream f m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream f m b -> Stream f m a
loop Stream f m b
stream')})
      Step   f (Stream f m b)
f -> f (Stream f m a) -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m b -> Stream f m a)
-> f (Stream f m b) -> f (Stream f m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m b -> Stream f m a
loop f (Stream f m b)
f)
  {-# INLINABLE (<$) #-}

instance (Functor f, Monad m) => Monad (Stream f m) where
  return :: a -> Stream f m a
return = a -> Stream f m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  >> :: Stream f m a -> Stream f m b -> Stream f m b
(>>) = Stream f m a -> Stream f m b -> Stream f m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# INLINE (>>) #-}
  -- (>>=) = _bind
  -- {-# INLINE (>>=) #-}
  --
  Stream f m a
stream >>= :: Stream f m a -> (a -> Stream f m b) -> Stream f m b
>>= a -> Stream f m b
f =
    Stream f m a -> Stream f m b
loop Stream f m a
stream where
    loop :: Stream f m a -> Stream f m b
loop Stream f m a
stream0 = case Stream f m a
stream0 of
      Step f (Stream f m a)
fstr -> f (Stream f m b) -> Stream f m b
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m a -> Stream f m b)
-> f (Stream f m a) -> f (Stream f m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f m b
loop f (Stream f m a)
fstr)
      Effect m (Stream f m a)
m  -> m (Stream f m b) -> Stream f m b
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream f m a -> Stream f m b)
-> m (Stream f m a) -> m (Stream f m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f m b
loop m (Stream f m a)
m)
      Return a
r  -> a -> Stream f m b
f a
r
  {-# INLINABLE (>>=) #-}

#if !(MIN_VERSION_base(4,13,0))
  fail = lift . Prelude.fail
  {-# INLINE fail #-}
#endif

instance (Functor f, MonadFail m) => MonadFail (Stream f m) where
  fail :: [Char] -> Stream f m a
fail = m a -> Stream f m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Stream f m a) -> ([Char] -> m a) -> [Char] -> Stream f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail
  {-# INLINE fail #-}

-- _bind
--     :: (Functor f, Monad m)
--     => Stream f m r
--     -> (r -> Stream f m s)
--     -> Stream f m s
-- _bind p0 f = go p0 where
--     go p = case p of
--       Step fstr  -> Step (fmap go fstr)
--       Effect m   -> Effect (m >>= \s -> return (go s))
--       Return r  -> f r
-- {-# INLINABLE _bind #-}
--
-- see https://github.com/Gabriel439/Haskell-Pipes-Library/pull/163
-- for a plan to delay inlining and manage interaction with other operations.

-- {-# RULES
    -- "_bind (Step    fstr) f" forall  fstr f .
    --     _bind (Step fstr) f = Step (fmap (\p -> _bind p f) fstr);
    -- "_bind (Effect      m) f" forall m    f .
    --     _bind (Effect   m) f = Effect (m >>= \p -> return (_bind p f));
    -- "_bind (Return     r) f" forall r    f .
    --     _bind (Return  r) f = f r;
--  #-}

instance (Functor f, Monad m) => Applicative (Stream f m) where
  pure :: a -> Stream f m a
pure = a -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return
  {-# INLINE pure #-}
  Stream f m (a -> b)
streamf <*> :: Stream f m (a -> b) -> Stream f m a -> Stream f m b
<*> Stream f m a
streamx = do {a -> b
f <- Stream f m (a -> b)
streamf; a
x <- Stream f m a
streamx; b -> Stream f m b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x)}
  {-# INLINE (<*>) #-}
  Stream f m a
stream1 *> :: Stream f m a -> Stream f m b -> Stream f m b
*> Stream f m b
stream2 = Stream f m a -> Stream f m b
loop Stream f m a
stream1 where
    loop :: Stream f m a -> Stream f m b
loop Stream f m a
stream = case Stream f m a
stream of
      Return a
_ -> Stream f m b
stream2
      Effect m (Stream f m a)
m -> m (Stream f m b) -> Stream f m b
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream f m a -> Stream f m b)
-> m (Stream f m a) -> m (Stream f m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f m b
loop m (Stream f m a)
m)
      Step f (Stream f m a)
f   -> f (Stream f m b) -> Stream f m b
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m a -> Stream f m b)
-> f (Stream f m a) -> f (Stream f m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f m b
loop f (Stream f m a)
f)
  {-# INLINABLE (*>) #-}


{- | The 'Alternative' instance glues streams together stepwise.

> empty = never
> (<|>) = zipsWith (liftA2 (,))

   See also 'never', 'untilJust' and 'delays'
-}
instance (Applicative f, Monad m) => Alternative (Stream f m) where
  empty :: Stream f m a
empty = Stream f m a
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Applicative f) =>
Stream f m r
never
  {-# INLINE empty #-}

  Stream f m a
str <|> :: Stream f m a -> Stream f m a -> Stream f m a
<|> Stream f m a
str' = (forall x y p. (x -> y -> p) -> f x -> f y -> f p)
-> Stream f m a -> Stream f m a -> Stream f m a
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (m :: * -> *) r.
Monad m =>
(forall x y p. (x -> y -> p) -> f x -> g y -> h p)
-> Stream f m r -> Stream g m r -> Stream h m r
zipsWith' forall x y p. (x -> y -> p) -> f x -> f y -> f p
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Stream f m a
str Stream f m a
str'
  {-# INLINE (<|>) #-}

instance (Functor f, Monad m, Semigroup w) => Semigroup (Stream f m w) where
  Stream f m w
a <> :: Stream f m w -> Stream f m w -> Stream f m w
<> Stream f m w
b = Stream f m w
a Stream f m w -> (w -> Stream f m w) -> Stream f m w
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \w
w -> (w -> w) -> Stream f m w -> Stream f m w
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w
w w -> w -> w
forall a. Semigroup a => a -> a -> a
<>) Stream f m w
b
  {-# INLINE (<>) #-}

instance (Functor f, Monad m, Monoid w) => Monoid (Stream f m w) where
  mempty :: Stream f m w
mempty = w -> Stream f m w
forall (m :: * -> *) a. Monad m => a -> m a
return w
forall a. Monoid a => a
mempty
  {-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
  mappend a b = a >>= \w -> fmap (w `mappend`) b
  {-# INLINE mappend #-}
#endif

instance (Applicative f, Monad m) => MonadPlus (Stream f m) where
  mzero :: Stream f m a
mzero = Stream f m a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: Stream f m a -> Stream f m a -> Stream f m a
mplus = Stream f m a -> Stream f m a -> Stream f m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Functor f => MonadTrans (Stream f) where
  lift :: m a -> Stream f m a
lift = m (Stream f m a) -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m a) -> Stream f m a)
-> (m a -> m (Stream f m a)) -> m a -> Stream f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Stream f m a) -> m a -> m (Stream f m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return
  {-# INLINE lift #-}

instance Functor f => MFunctor (Stream f) where
  hoist :: (forall a. m a -> n a) -> Stream f m b -> Stream f n b
hoist forall a. m a -> n a
trans = Stream f m b -> Stream f n b
loop  where
    loop :: Stream f m b -> Stream f n b
loop Stream f m b
stream = case Stream f m b
stream of
      Return b
r -> b -> Stream f n b
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return b
r
      Effect m (Stream f m b)
m -> n (Stream f n b) -> Stream f n b
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f n b) -> n (Stream f n b)
forall a. m a -> n a
trans ((Stream f m b -> Stream f n b)
-> m (Stream f m b) -> m (Stream f n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m b -> Stream f n b
loop m (Stream f m b)
m))
      Step f (Stream f m b)
f   -> f (Stream f n b) -> Stream f n b
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m b -> Stream f n b)
-> f (Stream f m b) -> f (Stream f n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m b -> Stream f n b
loop f (Stream f m b)
f)
  {-# INLINABLE hoist #-}


instance Functor f => MMonad (Stream f) where
  embed :: (forall a. m a -> Stream f n a) -> Stream f m b -> Stream f n b
embed forall a. m a -> Stream f n a
phi = Stream f m b -> Stream f n b
loop where
    loop :: Stream f m b -> Stream f n b
loop Stream f m b
stream = case Stream f m b
stream of
      Return b
r -> b -> Stream f n b
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return b
r
      Effect m (Stream f m b)
m -> m (Stream f m b) -> Stream f n (Stream f m b)
forall a. m a -> Stream f n a
phi m (Stream f m b)
m Stream f n (Stream f m b)
-> (Stream f m b -> Stream f n b) -> Stream f n b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream f m b -> Stream f n b
loop
      Step   f (Stream f m b)
f -> f (Stream f n b) -> Stream f n b
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m b -> Stream f n b)
-> f (Stream f m b) -> f (Stream f n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m b -> Stream f n b
loop f (Stream f m b)
f)
  {-# INLINABLE embed #-}

instance (MonadIO m, Functor f) => MonadIO (Stream f m) where
  liftIO :: IO a -> Stream f m a
liftIO = m (Stream f m a) -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m a) -> Stream f m a)
-> (IO a -> m (Stream f m a)) -> IO a -> Stream f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Stream f m a) -> m a -> m (Stream f m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (m a -> m (Stream f m a))
-> (IO a -> m a) -> IO a -> m (Stream f m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  {-# INLINE liftIO #-}

instance (Functor f, MonadReader r m) => MonadReader r (Stream f m) where
  ask :: Stream f m r
ask = m r -> Stream f m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  {-# INLINE ask #-}
  local :: (r -> r) -> Stream f m a -> Stream f m a
local r -> r
f = (forall a. m a -> m a) -> Stream f m a -> Stream f m a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f)
  {-# INLINE local #-}

instance (Functor f, MonadState s m) => MonadState s (Stream f m) where
  get :: Stream f m s
get = m s -> Stream f m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  {-# INLINE get #-}
  put :: s -> Stream f m ()
put = m () -> Stream f m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Stream f m ()) -> (s -> m ()) -> s -> Stream f m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  {-# INLINE put #-}
#if MIN_VERSION_mtl(2,1,1)
  state :: (s -> (a, s)) -> Stream f m a
state s -> (a, s)
f = m a -> Stream f m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (a, s)
f)
  {-# INLINE state #-}
#endif

instance (Functor f, MonadError e m) => MonadError e (Stream f m) where
  throwError :: e -> Stream f m a
throwError = m a -> Stream f m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Stream f m a) -> (e -> m a) -> e -> Stream f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  {-# INLINE throwError #-}
  Stream f m a
str catchError :: Stream f m a -> (e -> Stream f m a) -> Stream f m a
`catchError` e -> Stream f m a
f = Stream f m a -> Stream f m a
loop Stream f m a
str where
    loop :: Stream f m a -> Stream f m a
loop Stream f m a
x = case Stream f m a
x of
      Return a
r -> a -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return a
r
      Effect m (Stream f m a)
m -> m (Stream f m a) -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m a) -> Stream f m a)
-> m (Stream f m a) -> Stream f m a
forall a b. (a -> b) -> a -> b
$ (Stream f m a -> Stream f m a)
-> m (Stream f m a) -> m (Stream f m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f m a
loop m (Stream f m a)
m m (Stream f m a) -> (e -> m (Stream f m a)) -> m (Stream f m a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (Stream f m a -> m (Stream f m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream f m a -> m (Stream f m a))
-> (e -> Stream f m a) -> e -> m (Stream f m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Stream f m a
f)
      Step   f (Stream f m a)
g -> f (Stream f m a) -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m a -> Stream f m a)
-> f (Stream f m a) -> f (Stream f m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f m a
loop f (Stream f m a)
g)
  {-# INLINABLE catchError #-}

{-| Map a stream to its church encoding; compare @Data.List.foldr@.
    'destroyExposed' may be more efficient in some cases when
    applicable, but it is less safe.

    @
    destroy s construct eff done
      = eff . iterT (return . construct . fmap eff) . fmap done $ s
    @
-}
destroy
  :: (Functor f, Monad m) =>
     Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
destroy :: Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
destroy Stream f m r
stream0 f b -> b
construct m b -> b
theEffect r -> b
done = m b -> b
theEffect (Stream f m r -> m b
loop Stream f m r
stream0) where
  loop :: Stream f m r -> m b
loop Stream f m r
stream = case Stream f m r
stream of
    Return r
r -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> b
done r
r)
    Effect m (Stream f m r)
m -> m (Stream f m r)
m m (Stream f m r) -> (Stream f m r -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream f m r -> m b
loop
    Step f (Stream f m r)
fs  -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (f b -> b
construct ((Stream f m r -> b) -> f (Stream f m r) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m b -> b
theEffect (m b -> b) -> (Stream f m r -> m b) -> Stream f m r -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream f m r -> m b
loop) f (Stream f m r)
fs))
{-# INLINABLE destroy #-}


{-| 'streamFold' reorders the arguments of 'destroy' to be more akin
    to @foldr@  It is more convenient to query in ghci to figure out
    what kind of \'algebra\' you need to write.

>>> :t streamFold return join
(Monad m, Functor f) =>
     (f (m a) -> m a) -> Stream f m a -> m a        -- iterT

>>> :t streamFold return (join . lift)
(Monad m, Monad (t m), Functor f, MonadTrans t) =>
     (f (t m a) -> t m a) -> Stream f m a -> t m a  -- iterTM

>>> :t streamFold return effect
(Monad m, Functor f, Functor g) =>
     (f (Stream g m r) -> Stream g m r) -> Stream f m r -> Stream g m r

>>> :t \f -> streamFold return effect (wrap . f)
(Monad m, Functor f, Functor g) =>
     (f (Stream g m a) -> g (Stream g m a))
     -> Stream f m a -> Stream g m a                 -- maps

>>> :t \f -> streamFold return effect (effect . fmap wrap . f)
(Monad m, Functor f, Functor g) =>
     (f (Stream g m a) -> m (g (Stream g m a)))
     -> Stream f m a -> Stream g m a                 -- mapped

@
    streamFold done eff construct
       = eff . iterT (return . construct . fmap eff) . fmap done
@
-}
streamFold
  :: (Functor f, Monad m) =>
     (r -> b) -> (m b -> b) ->  (f b -> b) -> Stream f m r -> b
streamFold :: (r -> b) -> (m b -> b) -> (f b -> b) -> Stream f m r -> b
streamFold r -> b
done m b -> b
theEffect f b -> b
construct Stream f m r
stream  = Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
forall (f :: * -> *) (m :: * -> *) r b.
(Functor f, Monad m) =>
Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
destroy Stream f m r
stream f b -> b
construct m b -> b
theEffect r -> b
done
{-# INLINE streamFold #-}

{- | Reflect a church-encoded stream; cp. @GHC.Exts.build@

> streamFold return_ effect_ step_ (streamBuild psi) = psi return_ effect_ step_
-}
streamBuild
  :: (forall b . (r -> b) -> (m b -> b) -> (f b -> b) ->  b) ->  Stream f m r
streamBuild :: (forall b. (r -> b) -> (m b -> b) -> (f b -> b) -> b)
-> Stream f m r
streamBuild = \forall b. (r -> b) -> (m b -> b) -> (f b -> b) -> b
phi -> (r -> Stream f m r)
-> (m (Stream f m r) -> Stream f m r)
-> (f (Stream f m r) -> Stream f m r)
-> Stream f m r
forall b. (r -> b) -> (m b -> b) -> (f b -> b) -> b
phi r -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step
{-# INLINE streamBuild #-}


{-| Inspect the first stage of a freely layered sequence.
    Compare @Pipes.next@ and the replica @Streaming.Prelude.next@.
    This is the 'uncons' for the general 'unfold'.

> unfold inspect = id
> Streaming.Prelude.unfoldr StreamingPrelude.next = id
-}
inspect :: Monad m =>
     Stream f m r -> m (Either r (f (Stream f m r)))
inspect :: Stream f m r -> m (Either r (f (Stream f m r)))
inspect = Stream f m r -> m (Either r (f (Stream f m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
loop where
  loop :: Stream f m a -> m (Either a (f (Stream f m a)))
loop Stream f m a
stream = case Stream f m a
stream of
    Return a
r -> Either a (f (Stream f m a)) -> m (Either a (f (Stream f m a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either a (f (Stream f m a))
forall a b. a -> Either a b
Left a
r)
    Effect m (Stream f m a)
m -> m (Stream f m a)
m m (Stream f m a)
-> (Stream f m a -> m (Either a (f (Stream f m a))))
-> m (Either a (f (Stream f m a)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream f m a -> m (Either a (f (Stream f m a)))
loop
    Step f (Stream f m a)
fs  -> Either a (f (Stream f m a)) -> m (Either a (f (Stream f m a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (f (Stream f m a) -> Either a (f (Stream f m a))
forall a b. b -> Either a b
Right f (Stream f m a)
fs)
{-# INLINABLE inspect #-}

{-| Build a @Stream@ by unfolding steps starting from a seed. See also
    the specialized 'Streaming.Prelude.unfoldr' in the prelude.

> unfold inspect = id -- modulo the quotient we work with
> unfold Pipes.next :: Monad m => Producer a m r -> Stream ((,) a) m r
> unfold (curry (:>) . Pipes.next) :: Monad m => Producer a m r -> Stream (Of a) m r

-}
unfold :: (Monad m, Functor f)
        => (s -> m (Either r (f s)))
        -> s -> Stream f m r
unfold :: (s -> m (Either r (f s))) -> s -> Stream f m r
unfold s -> m (Either r (f s))
step = s -> Stream f m r
loop where
  loop :: s -> Stream f m r
loop s
s0 = m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) -> Stream f m r)
-> m (Stream f m r) -> Stream f m r
forall a b. (a -> b) -> a -> b
$ do
    Either r (f s)
e <- s -> m (Either r (f s))
step s
s0
    Stream f m r -> m (Stream f m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream f m r -> m (Stream f m r))
-> Stream f m r -> m (Stream f m r)
forall a b. (a -> b) -> a -> b
$ case Either r (f s)
e of
       Left  r
r  -> r -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
       Right f s
fs -> f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((s -> Stream f m r) -> f s -> f (Stream f m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Stream f m r
loop f s
fs)
{-# INLINABLE unfold #-}


{- | Map layers of one functor to another with a transformation. Compare
     hoist, which has a similar effect on the 'monadic' parameter.

> maps id = id
> maps f . maps g = maps (f . g)

-}
maps :: (Monad m, Functor f)
     => (forall x . f x -> g x) -> Stream f m r -> Stream g m r
maps :: (forall x. f x -> g x) -> Stream f m r -> Stream g m r
maps forall x. f x -> g x
phi = Stream f m r -> Stream g m r
loop where
  loop :: Stream f m r -> Stream g m r
loop Stream f m r
stream = case Stream f m r
stream of
    Return r
r -> r -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream f m r)
m -> m (Stream g m r) -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream f m r -> Stream g m r)
-> m (Stream f m r) -> m (Stream g m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream g m r
loop m (Stream f m r)
m)
    Step   f (Stream f m r)
f -> g (Stream g m r) -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream g m r) -> g (Stream g m r)
forall x. f x -> g x
phi ((Stream f m r -> Stream g m r)
-> f (Stream f m r) -> f (Stream g m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream g m r
loop f (Stream f m r)
f))
{-# INLINABLE maps #-}


{- | Map layers of one functor to another with a transformation involving the base monad.
     'maps' is more fundamental than @mapsM@, which is best understood as a convenience
     for effecting this frequent composition:

> mapsM phi = decompose . maps (Compose . phi)

     The streaming prelude exports the same function under the better name @mapped@,
     which overlaps with the lens libraries.

-}
mapsM :: (Monad m, Functor f) => (forall x . f x -> m (g x)) -> Stream f m r -> Stream g m r
mapsM :: (forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r
mapsM forall x. f x -> m (g x)
phi = Stream f m r -> Stream g m r
loop where
  loop :: Stream f m r -> Stream g m r
loop Stream f m r
stream = case Stream f m r
stream of
    Return r
r -> r -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream f m r)
m -> m (Stream g m r) -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream f m r -> Stream g m r)
-> m (Stream f m r) -> m (Stream g m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream g m r
loop m (Stream f m r)
m)
    Step   f (Stream f m r)
f -> m (Stream g m r) -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((g (Stream g m r) -> Stream g m r)
-> m (g (Stream g m r)) -> m (Stream g m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g (Stream g m r) -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream g m r) -> m (g (Stream g m r))
forall x. f x -> m (g x)
phi ((Stream f m r -> Stream g m r)
-> f (Stream f m r) -> f (Stream g m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream g m r
loop f (Stream f m r)
f)))
{-# INLINABLE mapsM #-}

{- | Map layers of one functor to another with a transformation. Compare
     hoist, which has a similar effect on the 'monadic' parameter.

> mapsPost id = id
> mapsPost f . mapsPost g = mapsPost (f . g)
> mapsPost f = maps f

     @mapsPost@ is essentially the same as 'maps', but it imposes a 'Functor' constraint on
     its target functor rather than its source functor. It should be preferred if 'fmap'
     is cheaper for the target functor than for the source functor.
-}
mapsPost :: forall m f g r. (Monad m, Functor g)
         => (forall x. f x -> g x)
         -> Stream f m r -> Stream g m r
mapsPost :: (forall x. f x -> g x) -> Stream f m r -> Stream g m r
mapsPost forall x. f x -> g x
phi = Stream f m r -> Stream g m r
loop where
  loop :: Stream f m r -> Stream g m r
  loop :: Stream f m r -> Stream g m r
loop Stream f m r
stream = case Stream f m r
stream of
    Return r
r -> r -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream f m r)
m -> m (Stream g m r) -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream f m r -> Stream g m r)
-> m (Stream f m r) -> m (Stream g m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream g m r
loop m (Stream f m r)
m)
    Step   f (Stream f m r)
f -> g (Stream g m r) -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (g (Stream g m r) -> Stream g m r)
-> g (Stream g m r) -> Stream g m r
forall a b. (a -> b) -> a -> b
$ (Stream f m r -> Stream g m r)
-> g (Stream f m r) -> g (Stream g m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream g m r
loop (g (Stream f m r) -> g (Stream g m r))
-> g (Stream f m r) -> g (Stream g m r)
forall a b. (a -> b) -> a -> b
$ f (Stream f m r) -> g (Stream f m r)
forall x. f x -> g x
phi f (Stream f m r)
f
{-# INLINABLE mapsPost #-}

{- | Map layers of one functor to another with a transformation involving the base monad.
     @mapsMPost@ is essentially the same as 'mapsM', but it imposes a 'Functor' constraint on
     its target functor rather than its source functor. It should be preferred if 'fmap'
     is cheaper for the target functor than for the source functor.

     @mapsPost@ is more fundamental than @mapsMPost@, which is best understood as a convenience
     for effecting this frequent composition:

> mapsMPost phi = decompose . mapsPost (Compose . phi)

     The streaming prelude exports the same function under the better name @mappedPost@,
     which overlaps with the lens libraries.

-}
mapsMPost :: forall m f g r. (Monad m, Functor g)
       => (forall x. f x -> m (g x))
       -> Stream f m r -> Stream g m r
mapsMPost :: (forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r
mapsMPost forall x. f x -> m (g x)
phi = Stream f m r -> Stream g m r
loop where
  loop :: Stream f m r -> Stream g m r
  loop :: Stream f m r -> Stream g m r
loop Stream f m r
stream = case Stream f m r
stream of
    Return r
r -> r -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream f m r)
m -> m (Stream g m r) -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream f m r -> Stream g m r)
-> m (Stream f m r) -> m (Stream g m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream g m r
loop m (Stream f m r)
m)
    Step   f (Stream f m r)
f -> m (Stream g m r) -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream g m r) -> Stream g m r)
-> m (Stream g m r) -> Stream g m r
forall a b. (a -> b) -> a -> b
$ (g (Stream f m r) -> Stream g m r)
-> m (g (Stream f m r)) -> m (Stream g m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (g (Stream g m r) -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (g (Stream g m r) -> Stream g m r)
-> (g (Stream f m r) -> g (Stream g m r))
-> g (Stream f m r)
-> Stream g m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stream f m r -> Stream g m r)
-> g (Stream f m r) -> g (Stream g m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream g m r
loop) (f (Stream f m r) -> m (g (Stream f m r))
forall x. f x -> m (g x)
phi f (Stream f m r)
f)
{-# INLINABLE mapsMPost #-}

{-| Rearrange a succession of layers of the form @Compose m (f x)@.

   we could as well define @decompose@ by @mapsM@:

> decompose = mapped getCompose

  but @mapped@ is best understood as:

> mapped phi = decompose . maps (Compose . phi)

  since @maps@ and @hoist@ are the really fundamental operations that preserve the
  shape of the stream:

> maps  :: (Monad m, Functor f) => (forall x. f x -> g x) -> Stream f m r -> Stream g m r
> hoist :: (Monad m, Functor f) => (forall a. m a -> n a) -> Stream f m r -> Stream f n r

-}
decompose :: (Monad m, Functor f) => Stream (Compose m f) m r -> Stream f m r
decompose :: Stream (Compose m f) m r -> Stream f m r
decompose = Stream (Compose m f) m r -> Stream f m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
Stream (Compose m f) m r -> Stream f m r
loop where
  loop :: Stream (Compose m f) m r -> Stream f m r
loop Stream (Compose m f) m r
stream = case Stream (Compose m f) m r
stream of
    Return r
r -> r -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Compose m f) m r)
m -> m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Compose m f) m r -> Stream f m r)
-> m (Stream (Compose m f) m r) -> m (Stream f m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Compose m f) m r -> Stream f m r
loop m (Stream (Compose m f) m r)
m)
    Step (Compose m (f (Stream (Compose m f) m r))
mstr) -> m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) -> Stream f m r)
-> m (Stream f m r) -> Stream f m r
forall a b. (a -> b) -> a -> b
$ do
      f (Stream (Compose m f) m r)
str <- m (f (Stream (Compose m f) m r))
mstr
      Stream f m r -> m (Stream f m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream (Compose m f) m r -> Stream f m r)
-> f (Stream (Compose m f) m r) -> f (Stream f m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Compose m f) m r -> Stream f m r
loop f (Stream (Compose m f) m r)
str))


{-| Run the effects in a stream that merely layers effects.
-}
run :: Monad m => Stream m m r -> m r
run :: Stream m m r -> m r
run = Stream m m r -> m r
forall (m :: * -> *) b. Monad m => Stream m m b -> m b
loop where
  loop :: Stream m m b -> m b
loop Stream m m b
stream = case Stream m m b
stream of
    Return b
r   -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
    Effect  m (Stream m m b)
m  -> m (Stream m m b)
m m (Stream m m b) -> (Stream m m b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream m m b -> m b
loop
    Step m (Stream m m b)
mrest -> m (Stream m m b)
mrest m (Stream m m b) -> (Stream m m b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream m m b -> m b
loop
{-# INLINABLE run #-}


{-| Map each layer to an effect, and run them all.
-}
mapsM_ :: (Functor f, Monad m) => (forall x . f x -> m x) -> Stream f m r -> m r
mapsM_ :: (forall x. f x -> m x) -> Stream f m r -> m r
mapsM_ forall x. f x -> m x
f = Stream m m r -> m r
forall (m :: * -> *) b. Monad m => Stream m m b -> m b
run (Stream m m r -> m r)
-> (Stream f m r -> Stream m m r) -> Stream f m r -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. f x -> m x) -> Stream f m r -> Stream m m r
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f) =>
(forall x. f x -> g x) -> Stream f m r -> Stream g m r
maps forall x. f x -> m x
f
{-# INLINE mapsM_ #-}


{-| Interpolate a layer at each segment. This specializes to e.g.

> intercalates :: (Monad m, Functor f) => Stream f m () -> Stream (Stream f m) m r -> Stream f m r
-}
intercalates :: (Monad m, Monad (t m), MonadTrans t) =>
     t m x -> Stream (t m) m r -> t m r
intercalates :: t m x -> Stream (t m) m r -> t m r
intercalates t m x
sep = Stream (t m) m r -> t m r
go0
  where
    go0 :: Stream (t m) m r -> t m r
go0 Stream (t m) m r
f = case Stream (t m) m r
f of
      Return r
r  -> r -> t m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
      Effect m (Stream (t m) m r)
m  -> m (Stream (t m) m r) -> t m (Stream (t m) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Stream (t m) m r)
m t m (Stream (t m) m r) -> (Stream (t m) m r -> t m r) -> t m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (t m) m r -> t m r
go0
      Step t m (Stream (t m) m r)
fstr -> do
        Stream (t m) m r
f' <- t m (Stream (t m) m r)
fstr
        Stream (t m) m r -> t m r
go1 Stream (t m) m r
f'
    go1 :: Stream (t m) m r -> t m r
go1 Stream (t m) m r
f = case Stream (t m) m r
f of
      Return r
r  -> r -> t m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
      Effect m (Stream (t m) m r)
m  -> m (Stream (t m) m r) -> t m (Stream (t m) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Stream (t m) m r)
m t m (Stream (t m) m r) -> (Stream (t m) m r -> t m r) -> t m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (t m) m r -> t m r
go1
      Step t m (Stream (t m) m r)
fstr ->  do
        x
_  <- t m x
sep
        Stream (t m) m r
f' <- t m (Stream (t m) m r)
fstr
        Stream (t m) m r -> t m r
go1 Stream (t m) m r
f'
{-# INLINABLE intercalates #-}

{-| Specialized fold following the usage of @Control.Monad.Trans.Free@

> iterTM alg = streamFold return (join . lift)
> iterTM alg = iterT alg . hoist lift
-}
iterTM ::
  (Functor f, Monad m, MonadTrans t,
   Monad (t m)) =>
  (f (t m a) -> t m a) -> Stream f m a -> t m a
iterTM :: (f (t m a) -> t m a) -> Stream f m a -> t m a
iterTM f (t m a) -> t m a
out Stream f m a
stream = Stream f m a
-> (f (t m a) -> t m a)
-> (m (t m a) -> t m a)
-> (a -> t m a)
-> t m a
forall (f :: * -> *) (m :: * -> *) r b.
(Functor f, Monad m) =>
Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
destroyExposed Stream f m a
stream f (t m a) -> t m a
out (t m (t m a) -> t m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (t m (t m a) -> t m a)
-> (m (t m a) -> t m (t m a)) -> m (t m a) -> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (t m a) -> t m (t m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE iterTM #-}

{-| Specialized fold following the usage of @Control.Monad.Trans.Free@

> iterT alg = streamFold return join alg
> iterT alg = runIdentityT . iterTM (IdentityT . alg . fmap runIdentityT)
-}
iterT ::
  (Functor f, Monad m) => (f (m a) -> m a) -> Stream f m a -> m a
iterT :: (f (m a) -> m a) -> Stream f m a -> m a
iterT f (m a) -> m a
out Stream f m a
stream = Stream f m a
-> (f (m a) -> m a) -> (m (m a) -> m a) -> (a -> m a) -> m a
forall (f :: * -> *) (m :: * -> *) r b.
(Functor f, Monad m) =>
Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
destroyExposed Stream f m a
stream f (m a) -> m a
out m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE iterT #-}

{-| Dissolves the segmentation into layers of @Stream f m@ layers.

-}
concats :: (Monad m, Functor f) => Stream (Stream f m) m r -> Stream f m r
concats :: Stream (Stream f m) m r -> Stream f m r
concats  = Stream (Stream f m) m r -> Stream f m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) b.
(MonadTrans t, Monad m, Monad (t m)) =>
Stream (t m) m b -> t m b
loop where
  loop :: Stream (t m) m b -> t m b
loop Stream (t m) m b
stream = case Stream (t m) m b
stream of
    Return b
r -> b -> t m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
    Effect m (Stream (t m) m b)
m -> m (Stream (t m) m b) -> t m (Stream (t m) m b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Stream (t m) m b)
m t m (Stream (t m) m b) -> (Stream (t m) m b -> t m b) -> t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (t m) m b -> t m b
loop
    Step t m (Stream (t m) m b)
fs  -> t m (Stream (t m) m b)
fs t m (Stream (t m) m b) -> (Stream (t m) m b -> t m b) -> t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (t m) m b -> t m b
loop
{-# INLINE concats #-}

{-| Split a succession of layers after some number, returning a streaming or
    effectful pair.

>>> rest <- S.print $ S.splitAt 1 $ each [1..3]
1
>>> S.print rest
2
3

> splitAt 0 = return
> splitAt n >=> splitAt m = splitAt (m+n)

    Thus, e.g.

>>> rest <- S.print $ splitsAt 2 >=> splitsAt 2 $ each [1..5]
1
2
3
4
>>> S.print rest
5

-}
splitsAt :: (Monad m, Functor f) => Int -> Stream f m r -> Stream f m (Stream f m r)
splitsAt :: Int -> Stream f m r -> Stream f m (Stream f m r)
splitsAt  = Int -> Stream f m r -> Stream f m (Stream f m r)
forall a (m :: * -> *) (f :: * -> *) r.
(Ord a, Num a, Functor m, Functor f) =>
a -> Stream f m r -> Stream f m (Stream f m r)
loop  where
  loop :: a -> Stream f m r -> Stream f m (Stream f m r)
loop !a
n Stream f m r
stream
    | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0    = Stream f m r -> Stream f m (Stream f m r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return Stream f m r
stream
    | Bool
otherwise = case Stream f m r
stream of
        Return r
r -> Stream f m r -> Stream f m (Stream f m r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (r -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r)
        Effect m (Stream f m r)
m -> m (Stream f m (Stream f m r)) -> Stream f m (Stream f m r)
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream f m r -> Stream f m (Stream f m r))
-> m (Stream f m r) -> m (Stream f m (Stream f m r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Stream f m r -> Stream f m (Stream f m r)
loop a
n) m (Stream f m r)
m)
        Step f (Stream f m r)
fs  -> case a
n of
          a
0 -> Stream f m r -> Stream f m (Stream f m r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step f (Stream f m r)
fs)
          a
_ -> f (Stream f m (Stream f m r)) -> Stream f m (Stream f m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m r -> Stream f m (Stream f m r))
-> f (Stream f m r) -> f (Stream f m (Stream f m r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Stream f m r -> Stream f m (Stream f m r)
loop (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1)) f (Stream f m r)
fs)
{-# INLINABLE splitsAt #-}

{- Functor-general take.

   @takes 3@ can take three individual values

>>> S.print $ takes 3 $ each [1..]
1
2
3


    or three sub-streams

>>> S.print $ mapped S.toList $ takes 3 $ chunksOf 2 $ each [1..]
[1,2]
[3,4]
[5,6]

   Or, using 'Data.ByteString.Streaming.Char' (here called @Q@),
   three byte streams.

>>> Q.stdout $ Q.unlines $ takes 3 $ Q.lines $ Q.chunk "a\nb\nc\nd\ne\nf"
a
b
c

-}
takes :: (Monad m, Functor f) => Int -> Stream f m r -> Stream f m ()
takes :: Int -> Stream f m r -> Stream f m ()
takes Int
n = Stream f m (Stream f m r) -> Stream f m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Stream f m (Stream f m r) -> Stream f m ())
-> (Stream f m r -> Stream f m (Stream f m r))
-> Stream f m r
-> Stream f m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Stream f m r -> Stream f m (Stream f m r)
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
Int -> Stream f m r -> Stream f m (Stream f m r)
splitsAt Int
n
{-# INLINE takes #-}

{-| Break a stream into substreams each with n functorial layers.

>>>  S.print $ mapped S.sum $ chunksOf 2 $ each [1,1,1,1,1]
2
2
1
-}
chunksOf :: (Monad m, Functor f) => Int -> Stream f m r -> Stream (Stream f m) m r
chunksOf :: Int -> Stream f m r -> Stream (Stream f m) m r
chunksOf Int
n0 = Stream f m r -> Stream (Stream f m) m r
loop where
  loop :: Stream f m r -> Stream (Stream f m) m r
loop Stream f m r
stream = case Stream f m r
stream of
    Return r
r  -> r -> Stream (Stream f m) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream f m r)
m  -> m (Stream (Stream f m) m r) -> Stream (Stream f m) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream f m r -> Stream (Stream f m) m r)
-> m (Stream f m r) -> m (Stream (Stream f m) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream (Stream f m) m r
loop m (Stream f m r)
m)
    Step f (Stream f m r)
fs   -> Stream f m (Stream (Stream f m) m r) -> Stream (Stream f m) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream f m (Stream (Stream f m) m r))
-> Stream f m (Stream (Stream f m) m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m r -> Stream f m (Stream (Stream f m) m r))
-> f (Stream f m r) -> f (Stream f m (Stream (Stream f m) m r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Stream f m r -> Stream (Stream f m) m r)
-> Stream f m (Stream f m r)
-> Stream f m (Stream (Stream f m) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream (Stream f m) m r
loop (Stream f m (Stream f m r) -> Stream f m (Stream (Stream f m) m r))
-> (Stream f m r -> Stream f m (Stream f m r))
-> Stream f m r
-> Stream f m (Stream (Stream f m) m r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Stream f m r -> Stream f m (Stream f m r)
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
Int -> Stream f m r -> Stream f m (Stream f m r)
splitsAt (Int
n0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) f (Stream f m r)
fs))
{-# INLINABLE chunksOf #-}

{- | Make it possible to \'run\' the underlying transformed monad.
-}
distribute :: (Monad m, Functor f, MonadTrans t, MFunctor t, Monad (t (Stream f m)))
           => Stream f (t m) r -> t (Stream f m) r
distribute :: Stream f (t m) r -> t (Stream f m) r
distribute = Stream f (t m) r -> t (Stream f m) r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) (f :: * -> *) a.
(MonadTrans t, MFunctor t, Monad (t (Stream f m)), Monad m,
 Functor f) =>
Stream f (t m) a -> t (Stream f m) a
loop where
  loop :: Stream f (t m) a -> t (Stream f m) a
loop Stream f (t m) a
stream = case Stream f (t m) a
stream of
    Return a
r     -> Stream f m a -> t (Stream f m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> Stream f m a
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return a
r)
    Effect t m (Stream f (t m) a)
tmstr -> (forall a. m a -> Stream f m a)
-> t m (Stream f (t m) a) -> t (Stream f m) (Stream f (t m) a)
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> Stream f m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift t m (Stream f (t m) a)
tmstr t (Stream f m) (Stream f (t m) a)
-> (Stream f (t m) a -> t (Stream f m) a) -> t (Stream f m) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream f (t m) a -> t (Stream f m) a
loop
    Step f (Stream f (t m) a)
fstr    -> t (Stream f m) (t (Stream f m) a) -> t (Stream f m) a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Stream f m (t (Stream f m) a) -> t (Stream f m) (t (Stream f m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (f (Stream f m (t (Stream f m) a)) -> Stream f m (t (Stream f m) a)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f (t m) a -> Stream f m (t (Stream f m) a))
-> f (Stream f (t m) a) -> f (Stream f m (t (Stream f m) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t (Stream f m) a -> Stream f m (t (Stream f m) a)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (t (Stream f m) a -> Stream f m (t (Stream f m) a))
-> (Stream f (t m) a -> t (Stream f m) a)
-> Stream f (t m) a
-> Stream f m (t (Stream f m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream f (t m) a -> t (Stream f m) a
loop) f (Stream f (t m) a)
fstr)))
{-# INLINABLE distribute #-}

-- | Repeat a functorial layer (a \"command\" or \"instruction\") forever.
repeats :: (Monad m, Functor f) => f () -> Stream f m r
repeats :: f () -> Stream f m r
repeats f ()
f = Stream f m r
loop where
  loop :: Stream f m r
loop = m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream f m r -> m (Stream f m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Stream f m r
loop Stream f m r -> f () -> f (Stream f m r)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
f)))

-- | Repeat an effect containing a functorial layer, command or instruction forever.
repeatsM :: (Monad m, Functor f) => m (f ()) -> Stream f m r
repeatsM :: m (f ()) -> Stream f m r
repeatsM m (f ())
mf = Stream f m r
loop where
  loop :: Stream f m r
loop = m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) -> Stream f m r)
-> m (Stream f m r) -> Stream f m r
forall a b. (a -> b) -> a -> b
$ do
     f ()
f <- m (f ())
mf
     Stream f m r -> m (Stream f m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream f m r -> m (Stream f m r))
-> Stream f m r -> m (Stream f m r)
forall a b. (a -> b) -> a -> b
$ f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream f m r) -> Stream f m r)
-> f (Stream f m r) -> Stream f m r
forall a b. (a -> b) -> a -> b
$ Stream f m r
loop Stream f m r -> f () -> f (Stream f m r)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
f

{- | Repeat a functorial layer, command or instruction a fixed number of times.

> replicates n = takes n . repeats
-}
replicates :: (Monad m, Functor f) => Int -> f () -> Stream f m ()
replicates :: Int -> f () -> Stream f m ()
replicates Int
n f ()
f = Int -> Stream f m Any -> Stream f m (Stream f m Any)
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
Int -> Stream f m r -> Stream f m (Stream f m r)
splitsAt Int
n (f () -> Stream f m Any
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f () -> Stream f m r
repeats f ()
f) Stream f m (Stream f m Any) -> Stream f m () -> Stream f m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Stream f m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-| Construct an infinite stream by cycling a finite one

> cycles = forever

>>>
-}

cycles :: (Monad m, Functor f) =>  Stream f m () -> Stream f m r
cycles :: Stream f m () -> Stream f m r
cycles = Stream f m () -> Stream f m r
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever

-- | A less-efficient version of 'hoist' that works properly even when its
-- argument is not a monad morphism.
--
-- > hoistUnexposed = hoist . unexposed
hoistUnexposed :: (Monad m, Functor f)
               => (forall a. m a -> n a)
               -> Stream f m r -> Stream f n r
hoistUnexposed :: (forall a. m a -> n a) -> Stream f m r -> Stream f n r
hoistUnexposed forall a. m a -> n a
trans = Stream f m r -> Stream f n r
loop where
  loop :: Stream f m r -> Stream f n r
loop = n (Stream f n r) -> Stream f n r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (n (Stream f n r) -> Stream f n r)
-> (Stream f m r -> n (Stream f n r))
-> Stream f m r
-> Stream f n r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Stream f n r) -> n (Stream f n r)
forall a. m a -> n a
trans (m (Stream f n r) -> n (Stream f n r))
-> (Stream f m r -> m (Stream f n r))
-> Stream f m r
-> n (Stream f n r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> m (Stream f n r))
-> (f (Stream f m r) -> m (Stream f n r))
-> Stream f m r
-> m (Stream f n r)
forall (m :: * -> *) r a (f :: * -> *).
Monad m =>
(r -> m a) -> (f (Stream f m r) -> m a) -> Stream f m r -> m a
inspectC (Stream f n r -> m (Stream f n r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream f n r -> m (Stream f n r))
-> (r -> Stream f n r) -> r -> m (Stream f n r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Stream f n r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return) (Stream f n r -> m (Stream f n r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream f n r -> m (Stream f n r))
-> (f (Stream f m r) -> Stream f n r)
-> f (Stream f m r)
-> m (Stream f n r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Stream f n r) -> Stream f n r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream f n r) -> Stream f n r)
-> (f (Stream f m r) -> f (Stream f n r))
-> f (Stream f m r)
-> Stream f n r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stream f m r -> Stream f n r)
-> f (Stream f m r) -> f (Stream f n r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream f n r
loop)
{-# INLINABLE hoistUnexposed #-}

-- A version of 'inspect' that takes explicit continuations.
inspectC :: Monad m => (r -> m a) -> (f (Stream f m r) -> m a) -> Stream f m r -> m a
inspectC :: (r -> m a) -> (f (Stream f m r) -> m a) -> Stream f m r -> m a
inspectC r -> m a
f f (Stream f m r) -> m a
g = Stream f m r -> m a
loop where
  loop :: Stream f m r -> m a
loop (Return r
r) = r -> m a
f r
r
  loop (Step f (Stream f m r)
x)   = f (Stream f m r) -> m a
g f (Stream f m r)
x
  loop (Effect m (Stream f m r)
m) = m (Stream f m r)
m m (Stream f m r) -> (Stream f m r -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream f m r -> m a
loop
{-# INLINE inspectC #-}

-- | The same as 'hoist', but explicitly named to indicate that it
-- is not entirely safe. In particular, its argument must be a monad
-- morphism.
hoistExposed :: (Functor m, Functor f) => (forall b. m b -> n b) -> Stream f m a -> Stream f n a
hoistExposed :: (forall b. m b -> n b) -> Stream f m a -> Stream f n a
hoistExposed forall b. m b -> n b
trans = Stream f m a -> Stream f n a
loop where
  loop :: Stream f m a -> Stream f n a
loop Stream f m a
stream = case Stream f m a
stream of
    Return a
r -> a -> Stream f n a
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return a
r
    Effect m (Stream f m a)
m -> n (Stream f n a) -> Stream f n a
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f n a) -> n (Stream f n a)
forall b. m b -> n b
trans ((Stream f m a -> Stream f n a)
-> m (Stream f m a) -> m (Stream f n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f n a
loop m (Stream f m a)
m))
    Step f (Stream f m a)
f   -> f (Stream f n a) -> Stream f n a
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m a -> Stream f n a)
-> f (Stream f m a) -> f (Stream f n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f n a
loop f (Stream f m a)
f)
{-# INLINABLE hoistExposed #-}

-- | The same as 'hoistExposed', but with a 'Functor' constraint on
-- the target rather than the source. This must be used only with
-- a monad morphism.
hoistExposedPost :: (Functor n, Functor f) => (forall b. m b -> n b) -> Stream f m a -> Stream f n a
hoistExposedPost :: (forall b. m b -> n b) -> Stream f m a -> Stream f n a
hoistExposedPost forall b. m b -> n b
trans = Stream f m a -> Stream f n a
loop where
  loop :: Stream f m a -> Stream f n a
loop Stream f m a
stream = case Stream f m a
stream of
    Return a
r -> a -> Stream f n a
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return a
r
    Effect m (Stream f m a)
m -> n (Stream f n a) -> Stream f n a
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream f m a -> Stream f n a)
-> n (Stream f m a) -> n (Stream f n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f n a
loop (m (Stream f m a) -> n (Stream f m a)
forall b. m b -> n b
trans m (Stream f m a)
m))
    Step   f (Stream f m a)
f -> f (Stream f n a) -> Stream f n a
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m a -> Stream f n a)
-> f (Stream f m a) -> f (Stream f n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m a -> Stream f n a
loop f (Stream f m a)
f)
{-# INLINABLE hoistExposedPost #-}

{-# DEPRECATED mapsExposed "Use maps instead." #-}
mapsExposed :: (Monad m, Functor f)
     => (forall x . f x -> g x) -> Stream f m r -> Stream g m r
mapsExposed :: (forall x. f x -> g x) -> Stream f m r -> Stream g m r
mapsExposed = (forall x. f x -> g x) -> Stream f m r -> Stream g m r
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f) =>
(forall x. f x -> g x) -> Stream f m r -> Stream g m r
maps
{-# INLINABLE mapsExposed #-}

{-# DEPRECATED mapsMExposed "Use mapsM instead." #-}
mapsMExposed :: (Monad m, Functor f)
     => (forall x . f x -> m (g x)) -> Stream f m r -> Stream g m r
mapsMExposed :: (forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r
mapsMExposed = (forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f) =>
(forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r
mapsM
{-# INLINABLE mapsMExposed #-}

{-| Map a stream directly to its church encoding; compare @Data.List.foldr@
    It permits distinctions that should be hidden, as can be seen from
    e.g.

    @isPure stream = destroyExposed (const True) (const False) (const True)@

    and similar nonsense.  The crucial
    constraint is that the @m x -> x@ argument is an /Eilenberg-Moore algebra/.
    See Atkey, "Reasoning about Stream Processing with Effects"

    When in doubt, use 'destroy' instead.
-}
destroyExposed
  :: (Functor f, Monad m) =>
     Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
destroyExposed :: Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
destroyExposed Stream f m r
stream0 f b -> b
construct m b -> b
theEffect r -> b
done = Stream f m r -> b
loop Stream f m r
stream0 where
  loop :: Stream f m r -> b
loop Stream f m r
stream = case Stream f m r
stream of
    Return r
r -> r -> b
done r
r
    Effect m (Stream f m r)
m -> m b -> b
theEffect ((Stream f m r -> b) -> m (Stream f m r) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> b
loop m (Stream f m r)
m)
    Step f (Stream f m r)
fs  -> f b -> b
construct ((Stream f m r -> b) -> f (Stream f m r) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> b
loop f (Stream f m r)
fs)
{-# INLINABLE destroyExposed #-}


{-| This is akin to the @observe@ of @Pipes.Internal@ . It reeffects the layering
    in instances of @Stream f m r@ so that it replicates that of
    @FreeT@.

-}
unexposed :: (Functor f, Monad m) => Stream f m r -> Stream f m r
unexposed :: Stream f m r -> Stream f m r
unexposed = m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) -> Stream f m r)
-> (Stream f m r -> m (Stream f m r))
-> Stream f m r
-> Stream f m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream f m r -> m (Stream f m r)
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
Stream f m r -> m (Stream f m r)
loop where
  loop :: Stream f m r -> m (Stream f m r)
loop Stream f m r
stream = case Stream f m r
stream of
    Return r
r -> Stream f m r -> m (Stream f m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r)
    Effect m (Stream f m r)
m -> m (Stream f m r)
m m (Stream f m r)
-> (Stream f m r -> m (Stream f m r)) -> m (Stream f m r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream f m r -> m (Stream f m r)
loop
    Step   f (Stream f m r)
f -> Stream f m r -> m (Stream f m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m r -> Stream f m r)
-> f (Stream f m r) -> f (Stream f m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) -> Stream f m r)
-> (Stream f m r -> m (Stream f m r))
-> Stream f m r
-> Stream f m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream f m r -> m (Stream f m r)
loop) f (Stream f m r)
f))
{-# INLINABLE unexposed #-}


{-| Wrap a new layer of a stream. So, e.g.

> S.cons :: Monad m => a -> Stream (Of a) m r -> Stream (Of a) m r
> S.cons a str = wrap (a :> str)

   and, recursively:

> S.each :: (Monad m, Foldable t) => t a -> Stream (Of a) m ()
> S.each = foldr (\a b -> wrap (a :> b)) (return ())

   The two operations

> wrap :: (Monad m, Functor f )   => f (Stream f m r) -> Stream f m r
> effect :: (Monad m, Functor f ) => m (Stream f m r) -> Stream f m r

   are fundamental. We can define the parallel operations @yields@ and @lift@ in
   terms of them

> yields :: (Monad m, Functor f )  => f r -> Stream f m r
> yields = wrap . fmap return
> lift ::  (Monad m, Functor f )   => m r -> Stream f m r
> lift = effect . fmap return

-}
wrap :: (Monad m, Functor f ) => f (Stream f m r) -> Stream f m r
wrap :: f (Stream f m r) -> Stream f m r
wrap = f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step
{-# INLINE wrap #-}


{- | Wrap an effect that returns a stream

> effect = join . lift

-}
effect :: (Monad m, Functor f ) => m (Stream f m r) -> Stream f m r
effect :: m (Stream f m r) -> Stream f m r
effect = m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect
{-# INLINE effect #-}


{-| @yields@ is like @lift@ for items in the streamed functor.
    It makes a singleton or one-layer succession.

> lift :: (Monad m, Functor f)    => m r -> Stream f m r
> yields ::  (Monad m, Functor f) => f r -> Stream f m r

    Viewed in another light, it is like a functor-general version of @yield@:

> S.yield a = yields (a :> ())

-}

yields ::  (Monad m, Functor f) => f r -> Stream f m r
yields :: f r -> Stream f m r
yields f r
fr = f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((r -> Stream f m r) -> f r -> f (Stream f m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return f r
fr)
{-# INLINE yields #-}

{-
Note that if the first stream produces Return, we don't inspect
(and potentially run effects from) the second stream. We used to
do that. Aside from being (arguably) a bit strange, this also runs
into a bit of trouble with MonadPlus laws. Most MonadPlus instances
try to satisfy either left distribution or left catch. Let's first
consider left distribution:

(x <|> y) >>= k = (x >>= k) <|> (y >>= k)

[xy_1, xy_2, xy_3, ..., xy_o | r_xy] >>= k
=
[x_1,  x_2,  x_3, ..., x_m | r_x] >>= k
<|>
[y_1,  y_2,  y_3, ..., y_n | r_y] >>= k

x and y may have different lengths, and k may produce an utterly
arbitrary stream from each result, so left distribution seems
quite hopeless.

Now let's consider left catch:

zipsWith' liftA2 (return a) b = return a

To satisfy this, we can't run any effects from the second stream
if the first is finished.
-}

-- | Zip two streams together. The 'zipsWith'' function should generally
-- be preferred for efficiency.
zipsWith :: forall f g h m r. (Monad m, Functor h)
  => (forall x y . f x -> g y -> h (x,y))
  -> Stream f m r -> Stream g m r -> Stream h m r
zipsWith :: (forall x y. f x -> g y -> h (x, y))
-> Stream f m r -> Stream g m r -> Stream h m r
zipsWith forall x y. f x -> g y -> h (x, y)
phi = (forall x y p. (x -> y -> p) -> f x -> g y -> h p)
-> Stream f m r -> Stream g m r -> Stream h m r
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (m :: * -> *) r.
Monad m =>
(forall x y p. (x -> y -> p) -> f x -> g y -> h p)
-> Stream f m r -> Stream g m r -> Stream h m r
zipsWith' ((forall x y p. (x -> y -> p) -> f x -> g y -> h p)
 -> Stream f m r -> Stream g m r -> Stream h m r)
-> (forall x y p. (x -> y -> p) -> f x -> g y -> h p)
-> Stream f m r
-> Stream g m r
-> Stream h m r
forall a b. (a -> b) -> a -> b
$ \x -> y -> p
xyp f x
fx g y
gy -> (\(x
x,y
y) -> x -> y -> p
xyp x
x y
y) ((x, y) -> p) -> h (x, y) -> h p
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x -> g y -> h (x, y)
forall x y. f x -> g y -> h (x, y)
phi f x
fx g y
gy
{-# INLINABLE zipsWith #-}
-- Somewhat surprisingly, GHC is *much* more willing to specialize
-- zipsWith if it's defined in terms of zipsWith'. Fortunately, zipsWith'
-- seems like a better function anyway, so I guess that's not a big problem.

-- | Zip two streams together.
zipsWith' :: forall f g h m r. Monad m
  => (forall x y p . (x -> y -> p) -> f x -> g y -> h p)
  -> Stream f m r -> Stream g m r -> Stream h m r
zipsWith' :: (forall x y p. (x -> y -> p) -> f x -> g y -> h p)
-> Stream f m r -> Stream g m r -> Stream h m r
zipsWith' forall x y p. (x -> y -> p) -> f x -> g y -> h p
phi = Stream f m r -> Stream g m r -> Stream h m r
loop
  where
    loop :: Stream f m r -> Stream g m r -> Stream h m r
    loop :: Stream f m r -> Stream g m r -> Stream h m r
loop Stream f m r
s Stream g m r
t = case Stream f m r
s of
       Return r
r -> r -> Stream h m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
       Step f (Stream f m r)
fs  -> case Stream g m r
t of
         Return r
r -> r -> Stream h m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
         Step g (Stream g m r)
gs  -> h (Stream h m r) -> Stream h m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (h (Stream h m r) -> Stream h m r)
-> h (Stream h m r) -> Stream h m r
forall a b. (a -> b) -> a -> b
$ (Stream f m r -> Stream g m r -> Stream h m r)
-> f (Stream f m r) -> g (Stream g m r) -> h (Stream h m r)
forall x y p. (x -> y -> p) -> f x -> g y -> h p
phi Stream f m r -> Stream g m r -> Stream h m r
loop f (Stream f m r)
fs g (Stream g m r)
gs
         Effect m (Stream g m r)
n -> m (Stream h m r) -> Stream h m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream h m r) -> Stream h m r)
-> m (Stream h m r) -> Stream h m r
forall a b. (a -> b) -> a -> b
$ (Stream g m r -> Stream h m r)
-> m (Stream g m r) -> m (Stream h m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stream f m r -> Stream g m r -> Stream h m r
loop Stream f m r
s) m (Stream g m r)
n
       Effect m (Stream f m r)
m -> m (Stream h m r) -> Stream h m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream h m r) -> Stream h m r)
-> m (Stream h m r) -> Stream h m r
forall a b. (a -> b) -> a -> b
$ (Stream f m r -> Stream h m r)
-> m (Stream f m r) -> m (Stream h m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Stream f m r -> Stream g m r -> Stream h m r)
-> Stream g m r -> Stream f m r -> Stream h m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Stream f m r -> Stream g m r -> Stream h m r
loop Stream g m r
t) m (Stream f m r)
m
{-# INLINABLE zipsWith' #-}

zips :: (Monad m, Functor f, Functor g)
     => Stream f m r -> Stream g m r -> Stream (Compose f g) m r
zips :: Stream f m r -> Stream g m r -> Stream (Compose f g) m r
zips = (forall x y p. (x -> y -> p) -> f x -> g y -> Compose f g p)
-> Stream f m r -> Stream g m r -> Stream (Compose f g) m r
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (m :: * -> *) r.
Monad m =>
(forall x y p. (x -> y -> p) -> f x -> g y -> h p)
-> Stream f m r -> Stream g m r -> Stream h m r
zipsWith' forall x y p. (x -> y -> p) -> f x -> g y -> Compose f g p
forall (f :: * -> *) (g :: * -> *) t t a.
(Functor f, Functor g) =>
(t -> t -> a) -> f t -> g t -> Compose f g a
go where
  go :: (t -> t -> a) -> f t -> g t -> Compose f g a
go t -> t -> a
p f t
fx g t
gy = f (g a) -> Compose f g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((t -> g a) -> f t -> f (g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
x -> (t -> a) -> g t -> g a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
y -> t -> t -> a
p t
x t
y) g t
gy) f t
fx)
{-# INLINE zips #-}



{-| Interleave functor layers, with the effects of the first preceding
    the effects of the second. When the first stream runs out, any remaining
    effects in the second are ignored.

> interleaves = zipsWith (liftA2 (,))

>>> let paste = \a b -> interleaves (Q.lines a) (maps (Q.cons' '\t') (Q.lines b))
>>> Q.stdout $ Q.unlines $ paste "hello\nworld\n" "goodbye\nworld\n"
hello	goodbye
world	world

-}

interleaves
  :: (Monad m, Applicative h) =>
     Stream h m r -> Stream h m r -> Stream h m r
interleaves :: Stream h m r -> Stream h m r -> Stream h m r
interleaves = (forall x y p. (x -> y -> p) -> h x -> h y -> h p)
-> Stream h m r -> Stream h m r -> Stream h m r
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (m :: * -> *) r.
Monad m =>
(forall x y p. (x -> y -> p) -> f x -> g y -> h p)
-> Stream f m r -> Stream g m r -> Stream h m r
zipsWith' forall x y p. (x -> y -> p) -> h x -> h y -> h p
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
{-# INLINE interleaves #-}


{-| Swap the order of functors in a sum of functors.

>>> S.toList $ S.print $ separate $ maps S.switch $ maps (S.distinguish (=='a')) $ S.each "banana"
'a'
'a'
'a'
"bnn" :> ()
>>> S.toList $ S.print $ separate $ maps (S.distinguish (=='a')) $ S.each "banana"
'b'
'n'
'n'
"aaa" :> ()
-}
switch :: Sum f g r -> Sum g f r
switch :: Sum f g r -> Sum g f r
switch Sum f g r
s = case Sum f g r
s of InL f r
a -> f r -> Sum g f r
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR f r
a; InR g r
a -> g r -> Sum g f r
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL g r
a
{-# INLINE switch #-}



{-| Given a stream on a sum of functors, make it a stream on the left functor,
    with the streaming on the other functor as the governing monad. This is
    useful for acting on one or the other functor with a fold, leaving the
    other material for another treatment. It generalizes
    'Data.Either.partitionEithers', but actually streams properly.

>>> let odd_even = S.maps (S.distinguish even) $ S.each [1..10::Int]
>>> :t separate odd_even
separate odd_even
  :: Monad m => Stream (Of Int) (Stream (Of Int) m) ()

    Now, for example, it is convenient to fold on the left and right values separately:

>>> S.toList $ S.toList $ separate odd_even
[2,4,6,8,10] :> ([1,3,5,7,9] :> ())


   Or we can write them to separate files or whatever:

>>> S.writeFile "even.txt" . S.show $ S.writeFile "odd.txt" . S.show $ S.separate odd_even
>>> :! cat even.txt
2
4
6
8
10
>>> :! cat odd.txt
1
3
5
7
9

   Of course, in the special case of @Stream (Of a) m r@, we can achieve the above
   effects more simply by using 'Streaming.Prelude.copy'

>>> S.toList . S.filter even $ S.toList . S.filter odd $ S.copy $ each [1..10::Int]
[2,4,6,8,10] :> ([1,3,5,7,9] :> ())


    But 'separate' and 'unseparate' are functor-general.

-}

separate :: (Monad m, Functor f, Functor g) => Stream (Sum f g) m r -> Stream f (Stream g m) r
separate :: Stream (Sum f g) m r -> Stream f (Stream g m) r
separate Stream (Sum f g) m r
str = Stream (Sum f g) m r
-> (Sum f g (Stream f (Stream g m) r) -> Stream f (Stream g m) r)
-> (m (Stream f (Stream g m) r) -> Stream f (Stream g m) r)
-> (r -> Stream f (Stream g m) r)
-> Stream f (Stream g m) r
forall (f :: * -> *) (m :: * -> *) r b.
(Functor f, Monad m) =>
Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
destroyExposed
  Stream (Sum f g) m r
str
  (\Sum f g (Stream f (Stream g m) r)
x -> case Sum f g (Stream f (Stream g m) r)
x of InL f (Stream f (Stream g m) r)
fss -> f (Stream f (Stream g m) r) -> Stream f (Stream g m) r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap f (Stream f (Stream g m) r)
fss; InR g (Stream f (Stream g m) r)
gss -> Stream g m (Stream f (Stream g m) r) -> Stream f (Stream g m) r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
m (Stream f m r) -> Stream f m r
effect (g (Stream f (Stream g m) r) -> Stream g m (Stream f (Stream g m) r)
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f r -> Stream f m r
yields g (Stream f (Stream g m) r)
gss))
  (Stream g m (Stream f (Stream g m) r) -> Stream f (Stream g m) r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
m (Stream f m r) -> Stream f m r
effect (Stream g m (Stream f (Stream g m) r) -> Stream f (Stream g m) r)
-> (m (Stream f (Stream g m) r)
    -> Stream g m (Stream f (Stream g m) r))
-> m (Stream f (Stream g m) r)
-> Stream f (Stream g m) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Stream f (Stream g m) r) -> Stream g m (Stream f (Stream g m) r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift)
  r -> Stream f (Stream g m) r
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINABLE separate #-}



unseparate :: (Monad m, Functor f, Functor g) =>  Stream f (Stream g m) r -> Stream (Sum f g) m r
unseparate :: Stream f (Stream g m) r -> Stream (Sum f g) m r
unseparate Stream f (Stream g m) r
str = Stream f (Stream g m) r
-> (f (Stream (Sum f g) m r) -> Stream (Sum f g) m r)
-> (Stream g m (Stream (Sum f g) m r) -> Stream (Sum f g) m r)
-> (r -> Stream (Sum f g) m r)
-> Stream (Sum f g) m r
forall (f :: * -> *) (m :: * -> *) r b.
(Functor f, Monad m) =>
Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
destroyExposed
  Stream f (Stream g m) r
str
  (Sum f g (Stream (Sum f g) m r) -> Stream (Sum f g) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (Sum f g (Stream (Sum f g) m r) -> Stream (Sum f g) m r)
-> (f (Stream (Sum f g) m r) -> Sum f g (Stream (Sum f g) m r))
-> f (Stream (Sum f g) m r)
-> Stream (Sum f g) m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Stream (Sum f g) m r) -> Sum f g (Stream (Sum f g) m r)
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL)
  (Stream (Sum f g) m (Stream (Sum f g) m r) -> Stream (Sum f g) m r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Stream (Sum f g) m (Stream (Sum f g) m r) -> Stream (Sum f g) m r)
-> (Stream g m (Stream (Sum f g) m r)
    -> Stream (Sum f g) m (Stream (Sum f g) m r))
-> Stream g m (Stream (Sum f g) m r)
-> Stream (Sum f g) m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. g x -> Sum f g x)
-> Stream g m (Stream (Sum f g) m r)
-> Stream (Sum f g) m (Stream (Sum f g) m r)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f) =>
(forall x. f x -> g x) -> Stream f m r -> Stream g m r
maps forall x. g x -> Sum f g x
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR)
  r -> Stream (Sum f g) m r
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINABLE unseparate #-}

-- | If 'Of' had a @Comonad@ instance, then we'd have
--
-- @copy = expand extend@
--
-- See 'expandPost' for a version that requires a @Functor g@
-- instance instead.
expand :: (Monad m, Functor f)
       => (forall a b. (g a -> b) -> f a -> h b)
       -> Stream f m r -> Stream g (Stream h m) r
expand :: (forall a b. (g a -> b) -> f a -> h b)
-> Stream f m r -> Stream g (Stream h m) r
expand forall a b. (g a -> b) -> f a -> h b
ext = Stream f m r -> Stream g (Stream h m) r
loop where
  loop :: Stream f m r -> Stream g (Stream h m) r
loop (Return r
r) = r -> Stream g (Stream h m) r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
  loop (Step f (Stream f m r)
f)   = Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r)
-> Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r
forall a b. (a -> b) -> a -> b
$ h (Stream h m (Stream g (Stream h m) r))
-> Stream h m (Stream g (Stream h m) r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (h (Stream h m (Stream g (Stream h m) r))
 -> Stream h m (Stream g (Stream h m) r))
-> h (Stream h m (Stream g (Stream h m) r))
-> Stream h m (Stream g (Stream h m) r)
forall a b. (a -> b) -> a -> b
$ (g (Stream g (Stream h m) r)
 -> Stream h m (Stream g (Stream h m) r))
-> f (Stream g (Stream h m) r)
-> h (Stream h m (Stream g (Stream h m) r))
forall a b. (g a -> b) -> f a -> h b
ext (Stream g (Stream h m) r -> Stream h m (Stream g (Stream h m) r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (Stream g (Stream h m) r -> Stream h m (Stream g (Stream h m) r))
-> (g (Stream g (Stream h m) r) -> Stream g (Stream h m) r)
-> g (Stream g (Stream h m) r)
-> Stream h m (Stream g (Stream h m) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g (Stream g (Stream h m) r) -> Stream g (Stream h m) r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step) ((Stream f m r -> Stream g (Stream h m) r)
-> f (Stream f m r) -> f (Stream g (Stream h m) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream g (Stream h m) r
loop f (Stream f m r)
f)
  loop (Effect m (Stream f m r)
m) = Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r)
-> Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r
forall a b. (a -> b) -> a -> b
$ m (Stream h m (Stream g (Stream h m) r))
-> Stream h m (Stream g (Stream h m) r)
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream h m (Stream g (Stream h m) r))
 -> Stream h m (Stream g (Stream h m) r))
-> m (Stream h m (Stream g (Stream h m) r))
-> Stream h m (Stream g (Stream h m) r)
forall a b. (a -> b) -> a -> b
$ (Stream f m r -> Stream h m (Stream g (Stream h m) r))
-> m (Stream f m r) -> m (Stream h m (Stream g (Stream h m) r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stream g (Stream h m) r -> Stream h m (Stream g (Stream h m) r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (Stream g (Stream h m) r -> Stream h m (Stream g (Stream h m) r))
-> (Stream f m r -> Stream g (Stream h m) r)
-> Stream f m r
-> Stream h m (Stream g (Stream h m) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream f m r -> Stream g (Stream h m) r
loop) m (Stream f m r)
m
{-# INLINABLE expand #-}

-- | If 'Of' had a @Comonad@ instance, then we'd have
--
-- @copy = expandPost extend@
--
-- See 'expand' for a version that requires a @Functor f@ instance
-- instead.
expandPost :: (Monad m, Functor g)
       => (forall a b. (g a -> b) -> f a -> h b)
       -> Stream f m r -> Stream g (Stream h m) r
expandPost :: (forall a b. (g a -> b) -> f a -> h b)
-> Stream f m r -> Stream g (Stream h m) r
expandPost forall a b. (g a -> b) -> f a -> h b
ext = Stream f m r -> Stream g (Stream h m) r
loop where
  loop :: Stream f m r -> Stream g (Stream h m) r
loop (Return r
r) = r -> Stream g (Stream h m) r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
  loop (Step f (Stream f m r)
f)   = Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r)
-> Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r
forall a b. (a -> b) -> a -> b
$ h (Stream h m (Stream g (Stream h m) r))
-> Stream h m (Stream g (Stream h m) r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (h (Stream h m (Stream g (Stream h m) r))
 -> Stream h m (Stream g (Stream h m) r))
-> h (Stream h m (Stream g (Stream h m) r))
-> Stream h m (Stream g (Stream h m) r)
forall a b. (a -> b) -> a -> b
$ (g (Stream f m r) -> Stream h m (Stream g (Stream h m) r))
-> f (Stream f m r) -> h (Stream h m (Stream g (Stream h m) r))
forall a b. (g a -> b) -> f a -> h b
ext (Stream g (Stream h m) r -> Stream h m (Stream g (Stream h m) r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (Stream g (Stream h m) r -> Stream h m (Stream g (Stream h m) r))
-> (g (Stream f m r) -> Stream g (Stream h m) r)
-> g (Stream f m r)
-> Stream h m (Stream g (Stream h m) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g (Stream g (Stream h m) r) -> Stream g (Stream h m) r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (g (Stream g (Stream h m) r) -> Stream g (Stream h m) r)
-> (g (Stream f m r) -> g (Stream g (Stream h m) r))
-> g (Stream f m r)
-> Stream g (Stream h m) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stream f m r -> Stream g (Stream h m) r)
-> g (Stream f m r) -> g (Stream g (Stream h m) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream f m r -> Stream g (Stream h m) r
loop) f (Stream f m r)
f
  loop (Effect m (Stream f m r)
m) = Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r)
-> Stream h m (Stream g (Stream h m) r) -> Stream g (Stream h m) r
forall a b. (a -> b) -> a -> b
$ m (Stream h m (Stream g (Stream h m) r))
-> Stream h m (Stream g (Stream h m) r)
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream h m (Stream g (Stream h m) r))
 -> Stream h m (Stream g (Stream h m) r))
-> m (Stream h m (Stream g (Stream h m) r))
-> Stream h m (Stream g (Stream h m) r)
forall a b. (a -> b) -> a -> b
$ (Stream f m r -> Stream h m (Stream g (Stream h m) r))
-> m (Stream f m r) -> m (Stream h m (Stream g (Stream h m) r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stream g (Stream h m) r -> Stream h m (Stream g (Stream h m) r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (Stream g (Stream h m) r -> Stream h m (Stream g (Stream h m) r))
-> (Stream f m r -> Stream g (Stream h m) r)
-> Stream f m r
-> Stream h m (Stream g (Stream h m) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream f m r -> Stream g (Stream h m) r
loop) m (Stream f m r)
m
{-# INLINABLE expandPost #-}

unzips :: (Monad m, Functor f, Functor g) =>
   Stream (Compose f g) m r ->  Stream f (Stream g m) r
unzips :: Stream (Compose f g) m r -> Stream f (Stream g m) r
unzips Stream (Compose f g) m r
str = Stream (Compose f g) m r
-> (Compose f g (Stream f (Stream g m) r)
    -> Stream f (Stream g m) r)
-> (m (Stream f (Stream g m) r) -> Stream f (Stream g m) r)
-> (r -> Stream f (Stream g m) r)
-> Stream f (Stream g m) r
forall (f :: * -> *) (m :: * -> *) r b.
(Functor f, Monad m) =>
Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
destroyExposed
  Stream (Compose f g) m r
str
  (\(Compose f (g (Stream f (Stream g m) r))
fgstr) -> f (Stream f (Stream g m) r) -> Stream f (Stream g m) r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((g (Stream f (Stream g m) r) -> Stream f (Stream g m) r)
-> f (g (Stream f (Stream g m) r)) -> f (Stream f (Stream g m) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stream g m (Stream f (Stream g m) r) -> Stream f (Stream g m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream g m (Stream f (Stream g m) r) -> Stream f (Stream g m) r)
-> (g (Stream f (Stream g m) r)
    -> Stream g m (Stream f (Stream g m) r))
-> g (Stream f (Stream g m) r)
-> Stream f (Stream g m) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g (Stream f (Stream g m) r) -> Stream g m (Stream f (Stream g m) r)
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f r -> Stream f m r
yields) f (g (Stream f (Stream g m) r))
fgstr))
  (Stream g m (Stream f (Stream g m) r) -> Stream f (Stream g m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream g m (Stream f (Stream g m) r) -> Stream f (Stream g m) r)
-> (m (Stream f (Stream g m) r)
    -> Stream g m (Stream f (Stream g m) r))
-> m (Stream f (Stream g m) r)
-> Stream f (Stream g m) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Stream f (Stream g m) r) -> Stream g m (Stream f (Stream g m) r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift)
  r -> Stream f (Stream g m) r
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINABLE unzips #-}

{-| Group layers in an alternating stream into adjoining sub-streams
    of one type or another.
-}
groups :: (Monad m, Functor f, Functor g)
           => Stream (Sum f g) m r
           -> Stream (Sum (Stream f m) (Stream g m)) m r
groups :: Stream (Sum f g) m r -> Stream (Sum (Stream f m) (Stream g m)) m r
groups = Stream (Sum f g) m r -> Stream (Sum (Stream f m) (Stream g m)) m r
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f, Functor g) =>
Stream (Sum f g) m r -> Stream (Sum (Stream f m) (Stream g m)) m r
loop
  where
  loop :: Stream (Sum f g) m r -> Stream (Sum (Stream f m) (Stream g m)) m r
loop Stream (Sum f g) m r
str = do
    Either r (Sum f g (Stream (Sum f g) m r))
e <- m (Either r (Sum f g (Stream (Sum f g) m r)))
-> Stream
     (Sum (Stream f m) (Stream g m))
     m
     (Either r (Sum f g (Stream (Sum f g) m r)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (Sum f g (Stream (Sum f g) m r)))
 -> Stream
      (Sum (Stream f m) (Stream g m))
      m
      (Either r (Sum f g (Stream (Sum f g) m r))))
-> m (Either r (Sum f g (Stream (Sum f g) m r)))
-> Stream
     (Sum (Stream f m) (Stream g m))
     m
     (Either r (Sum f g (Stream (Sum f g) m r)))
forall a b. (a -> b) -> a -> b
$ Stream (Sum f g) m r
-> m (Either r (Sum f g (Stream (Sum f g) m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream (Sum f g) m r
str
    case Either r (Sum f g (Stream (Sum f g) m r))
e of
      Left r
r -> r -> Stream (Sum (Stream f m) (Stream g m)) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
      Right Sum f g (Stream (Sum f g) m r)
ostr -> case Sum f g (Stream (Sum f g) m r)
ostr of
        InR g (Stream (Sum f g) m r)
gstr -> Sum
  (Stream f m)
  (Stream g m)
  (Stream (Sum (Stream f m) (Stream g m)) m r)
-> Stream (Sum (Stream f m) (Stream g m)) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (Sum
   (Stream f m)
   (Stream g m)
   (Stream (Sum (Stream f m) (Stream g m)) m r)
 -> Stream (Sum (Stream f m) (Stream g m)) m r)
-> Sum
     (Stream f m)
     (Stream g m)
     (Stream (Sum (Stream f m) (Stream g m)) m r)
-> Stream (Sum (Stream f m) (Stream g m)) m r
forall a b. (a -> b) -> a -> b
$ Stream g m (Stream (Sum (Stream f m) (Stream g m)) m r)
-> Sum
     (Stream f m)
     (Stream g m)
     (Stream (Sum (Stream f m) (Stream g m)) m r)
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR ((Stream (Sum f g) m r
 -> Stream (Sum (Stream f m) (Stream g m)) m r)
-> Stream g m (Stream (Sum f g) m r)
-> Stream g m (Stream (Sum (Stream f m) (Stream g m)) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Sum f g) m r -> Stream (Sum (Stream f m) (Stream g m)) m r
loop (Stream (Sum f g) m r -> Stream g m (Stream (Sum f g) m r)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f, Functor g) =>
Stream (Sum f g) m r -> Stream g m (Stream (Sum f g) m r)
cleanR (Sum f g (Stream (Sum f g) m r) -> Stream (Sum f g) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (g (Stream (Sum f g) m r) -> Sum f g (Stream (Sum f g) m r)
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR g (Stream (Sum f g) m r)
gstr))))
        InL f (Stream (Sum f g) m r)
fstr -> Sum
  (Stream f m)
  (Stream g m)
  (Stream (Sum (Stream f m) (Stream g m)) m r)
-> Stream (Sum (Stream f m) (Stream g m)) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (Sum
   (Stream f m)
   (Stream g m)
   (Stream (Sum (Stream f m) (Stream g m)) m r)
 -> Stream (Sum (Stream f m) (Stream g m)) m r)
-> Sum
     (Stream f m)
     (Stream g m)
     (Stream (Sum (Stream f m) (Stream g m)) m r)
-> Stream (Sum (Stream f m) (Stream g m)) m r
forall a b. (a -> b) -> a -> b
$ Stream f m (Stream (Sum (Stream f m) (Stream g m)) m r)
-> Sum
     (Stream f m)
     (Stream g m)
     (Stream (Sum (Stream f m) (Stream g m)) m r)
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL ((Stream (Sum f g) m r
 -> Stream (Sum (Stream f m) (Stream g m)) m r)
-> Stream f m (Stream (Sum f g) m r)
-> Stream f m (Stream (Sum (Stream f m) (Stream g m)) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Sum f g) m r -> Stream (Sum (Stream f m) (Stream g m)) m r
loop (Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f, Functor g) =>
Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
cleanL (Sum f g (Stream (Sum f g) m r) -> Stream (Sum f g) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (f (Stream (Sum f g) m r) -> Sum f g (Stream (Sum f g) m r)
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL f (Stream (Sum f g) m r)
fstr))))

  cleanL  :: (Monad m, Functor f, Functor g) =>
       Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
  cleanL :: Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
cleanL = Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f, Functor g) =>
Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
go where
    go :: Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
go Stream (Sum f g) m r
s = do
     Either r (Sum f g (Stream (Sum f g) m r))
e <- m (Either r (Sum f g (Stream (Sum f g) m r)))
-> Stream f m (Either r (Sum f g (Stream (Sum f g) m r)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (Sum f g (Stream (Sum f g) m r)))
 -> Stream f m (Either r (Sum f g (Stream (Sum f g) m r))))
-> m (Either r (Sum f g (Stream (Sum f g) m r)))
-> Stream f m (Either r (Sum f g (Stream (Sum f g) m r)))
forall a b. (a -> b) -> a -> b
$ Stream (Sum f g) m r
-> m (Either r (Sum f g (Stream (Sum f g) m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream (Sum f g) m r
s
     case Either r (Sum f g (Stream (Sum f g) m r))
e of
      Left r
r           -> Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Stream (Sum f g) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
      Right (InL f (Stream (Sum f g) m r)
fstr) -> f (Stream f m (Stream (Sum f g) m r))
-> Stream f m (Stream (Sum f g) m r)
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap ((Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r))
-> f (Stream (Sum f g) m r)
-> f (Stream f m (Stream (Sum f g) m r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
go f (Stream (Sum f g) m r)
fstr)
      Right (InR g (Stream (Sum f g) m r)
gstr) -> Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sum f g (Stream (Sum f g) m r) -> Stream (Sum f g) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (g (Stream (Sum f g) m r) -> Sum f g (Stream (Sum f g) m r)
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR g (Stream (Sum f g) m r)
gstr))

  cleanR  :: (Monad m, Functor f, Functor g) =>
       Stream (Sum f g) m r -> Stream g m (Stream (Sum f g) m r)
  cleanR :: Stream (Sum f g) m r -> Stream g m (Stream (Sum f g) m r)
cleanR = Stream (Sum f g) m r -> Stream g m (Stream (Sum f g) m r)
forall (m :: * -> *) (f :: * -> *) (f :: * -> *) r.
(Monad m, Functor f, Functor f) =>
Stream (Sum f f) m r -> Stream f m (Stream (Sum f f) m r)
go where
    go :: Stream (Sum f f) m r -> Stream f m (Stream (Sum f f) m r)
go Stream (Sum f f) m r
s = do
     Either r (Sum f f (Stream (Sum f f) m r))
e <- m (Either r (Sum f f (Stream (Sum f f) m r)))
-> Stream f m (Either r (Sum f f (Stream (Sum f f) m r)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (Sum f f (Stream (Sum f f) m r)))
 -> Stream f m (Either r (Sum f f (Stream (Sum f f) m r))))
-> m (Either r (Sum f f (Stream (Sum f f) m r)))
-> Stream f m (Either r (Sum f f (Stream (Sum f f) m r)))
forall a b. (a -> b) -> a -> b
$ Stream (Sum f f) m r
-> m (Either r (Sum f f (Stream (Sum f f) m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream (Sum f f) m r
s
     case Either r (Sum f f (Stream (Sum f f) m r))
e of
      Left r
r           -> Stream (Sum f f) m r -> Stream f m (Stream (Sum f f) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Stream (Sum f f) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
      Right (InL f (Stream (Sum f f) m r)
fstr) -> Stream (Sum f f) m r -> Stream f m (Stream (Sum f f) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sum f f (Stream (Sum f f) m r) -> Stream (Sum f f) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (f (Stream (Sum f f) m r) -> Sum f f (Stream (Sum f f) m r)
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL f (Stream (Sum f f) m r)
fstr))
      Right (InR f (Stream (Sum f f) m r)
gstr) -> f (Stream f m (Stream (Sum f f) m r))
-> Stream f m (Stream (Sum f f) m r)
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap ((Stream (Sum f f) m r -> Stream f m (Stream (Sum f f) m r))
-> f (Stream (Sum f f) m r)
-> f (Stream f m (Stream (Sum f f) m r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Sum f f) m r -> Stream f m (Stream (Sum f f) m r)
go f (Stream (Sum f f) m r)
gstr)
{-# INLINABLE groups #-}

-- groupInL :: (Monad m, Functor f, Functor g)
--                      => Stream (Sum f g) m r
--                      -> Stream (Sum (Stream f m) g) m r
-- groupInL = loop
--   where
--   loop str = do
--     e <- lift $ inspect str
--     case e of
--       Left r -> return r
--       Right ostr -> case ostr of
--         InR gstr -> wrap $ InR (fmap loop gstr)
--         InL fstr -> wrap $ InL (fmap loop (cleanL (wrap (InL fstr))))
--   cleanL  :: (Monad m, Functor f, Functor g) =>
--        Stream (Sum f g) m r -> Stream f m (Stream (Sum f g) m r)
--   cleanL = loop where
--     loop s = dos
--      e <- lift $ inspect s
--      case e of
--       Left r           -> return (return r)
--       Right (InL fstr) -> wrap (fmap loop fstr)
--       Right (InR gstr) -> return (wrap (InR gstr))

{- | 'never' interleaves the pure applicative action with the return of the monad forever.
     It is the 'empty' of the 'Alternative' instance, thus

> never <|> a = a
> a <|> never = a

     and so on. If w is a monoid then @never :: Stream (Of w) m r@ is
     the infinite sequence of 'mempty', and
     @str1 \<|\> str2@ appends the elements monoidally until one of streams ends.
     Thus we have, e.g.

>>> S.stdoutLn $ S.take 2 $ S.stdinLn <|> S.repeat " " <|> S.stdinLn  <|> S.repeat " " <|> S.stdinLn
1<Enter>
2<Enter>
3<Enter>
1 2 3
4<Enter>
5<Enter>
6<Enter>
4 5 6

    This is equivalent to

>>> S.stdoutLn $ S.take 2 $ foldr (<|>) never [S.stdinLn, S.repeat " ", S.stdinLn, S.repeat " ", S.stdinLn ]

     Where 'f' is a monad, @(\<|\>)@ sequences the conjoined streams stepwise. See the
     definition of @paste@ <https://gist.github.com/michaelt/6c6843e6dd8030e95d58 here>,
     where the separate steps are bytestreams corresponding to the lines of a file.

     Given, say,

> data Branch r = Branch r r deriving Functor  -- add obvious applicative instance

    then @never :: Stream Branch Identity r@  is the pure infinite binary tree with
    (inaccessible) @r@s in its leaves. Given two binary trees, @tree1 \<|\> tree2@
    intersects them, preserving the leaves that came first,
    so @tree1 \<|\> never = tree1@

    @Stream Identity m r@ is an action in @m@ that is indefinitely delayed. Such an
    action can be constructed with e.g. 'untilJust'.

> untilJust :: (Monad m, Applicative f) => m (Maybe r) -> Stream f m r

    Given two such items, @\<|\>@ instance races them.
    It is thus the iterative monad transformer specially defined in
    <https://hackage.haskell.org/package/free-4.12.1/docs/Control-Monad-Trans-Iter.html Control.Monad.Trans.Iter>

    So, for example, we might write

>>> let justFour str = if length str == 4 then Just str else Nothing
>>> let four = untilJust (fmap justFour getLine)
>>> run four
one<Enter>
two<Enter>
three<Enter>
four<Enter>
"four"


    The 'Alternative' instance in
    <https://hackage.haskell.org/package/free-4.12.1/docs/Control-Monad-Trans-Free.html Control.Monad.Trans.Free>
    is avowedly wrong, though no explanation is given for this.


-}
never :: (Monad m, Applicative f) => Stream f m r
-- The Monad m constraint should really be an Applicative one,
-- but we still support old versions of base.
never :: Stream f m r
never =  let loop :: Stream f m r
loop = f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream f m r) -> Stream f m r)
-> f (Stream f m r) -> Stream f m r
forall a b. (a -> b) -> a -> b
$ Stream f m r -> f (Stream f m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream f m r -> m (Stream f m r)
forall (m :: * -> *) a. Monad m => a -> m a
return Stream f m r
loop)) in Stream f m r
forall r. Stream f m r
loop
{-# INLINABLE never #-}


delays :: (MonadIO m, Applicative f) => Double -> Stream f m r
delays :: Double -> Stream f m r
delays Double
seconds = Stream f m r
loop where
  loop :: Stream f m r
loop = m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) -> Stream f m r)
-> m (Stream f m r) -> Stream f m r
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ()
threadDelay Int
delay) m () -> m (Stream f m r) -> m (Stream f m r)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream f m r -> m (Stream f m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Stream f m r -> f (Stream f m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stream f m r
loop))
  delay :: Int
delay = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
1000000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
seconds))
{-# INLINABLE delays #-}

-- {-| Permit streamed actions to proceed unless the clock has run out.
--
-- -}
-- period :: (MonadIO m, Functor f) => Double -> Stream f m r -> Stream f m (Stream f m r)
-- period seconds str = do
--     utc <- liftIO getCurrentTime
--     let loop s = do
--           utc' <- liftIO getCurrentTime
--           if diffUTCTime utc' utc > (cutoff / 1000000000)
--             then return s
--             else case s of
--               Return r -> Return (Return r)
--               Effect m -> Effect (fmap loop m)
--               Step f   -> Step (fmap loop f)
--     loop str
--   where
--   cutoff = fromInteger (truncate (1000000000 * seconds))
-- {-# INLINABLE period #-}
--
--
-- {-| Divide a succession of phases according to a specified time interval. If time runs out
--     while an action is proceeding, it is allowed to run to completion. The clock is only then
--     restarted.
-- -}
-- periods :: (MonadIO m, Functor f) => Double -> Stream f m r -> Stream (Stream f m) m r
-- periods seconds s = do
--   utc <- liftIO getCurrentTime
--   loop (addUTCTime cutoff utc) s
--
--   where
--   cutoff = fromInteger (truncate (1000000000 * seconds)) / 1000000000
--   loop final stream = do
--     utc <- liftIO getCurrentTime
--     if utc > final
--       then loop (addUTCTime cutoff utc) stream
--       else case stream of
--         Return r  -> Return r
--         Effect m  -> Effect $ fmap (loop final) m
--         Step fstr -> Step $ fmap (periods seconds) (cutoff_ final (Step fstr))
--
--         -- do
--         --   let sloop s = do
--         --         utc' <- liftIO getCurrentTime
--         --         if final < utc'
--         --           then return s
--         --           else case s of
--         --             Return r -> Return (Return r)
--         --             Effect m -> Effect (fmap sloop m)
--         --             Step f   -> Step (fmap sloop f)
--         --   Step (Step (fmap (fmap (periods seconds) . sloop) fstr))
--           -- str <- m
--           -- utc' <- liftIO getCurrentTime
--           -- if diffUTCTime utc' utc > (cutoff / 1000000000)
--           --   then return (loop utc' str)
--           --   else return (loop utc str)
--         -- Step fs   -> do
--         --   let check str = do
--         --         utc' <- liftIO getCurrentTime
--         --         loop utc' str
--         --
-- {-# INLINABLE periods #-}
--
-- cutoff_ final str = do
--     let loop s = do
--           utc' <- liftIO getCurrentTime
--           if utc' > final
--             then Return s
--             else case s of
--               Return r -> Return (Return r)
--               Effect m -> Effect (fmap loop m)
--               Step f   -> Step (fmap loop f)
--     loop str

{- | Repeat a

-}

untilJust :: (Monad m, Applicative f) => m (Maybe r) -> Stream f m r
untilJust :: m (Maybe r) -> Stream f m r
untilJust m (Maybe r)
act = Stream f m r
loop where
  loop :: Stream f m r
loop = m (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) -> Stream f m r)
-> m (Stream f m r) -> Stream f m r
forall a b. (a -> b) -> a -> b
$ do
    Maybe r
m <- m (Maybe r)
act
    Stream f m r -> m (Stream f m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream f m r -> m (Stream f m r))
-> Stream f m r -> m (Stream f m r)
forall a b. (a -> b) -> a -> b
$ case Maybe r
m of
      Maybe r
Nothing -> f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream f m r) -> Stream f m r)
-> f (Stream f m r) -> Stream f m r
forall a b. (a -> b) -> a -> b
$ Stream f m r -> f (Stream f m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stream f m r
loop
      Just r
a  -> r -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
a


cutoff :: (Monad m, Functor f) => Int -> Stream f m r -> Stream f m (Maybe r)
cutoff :: Int -> Stream f m r -> Stream f m (Maybe r)
cutoff = Int -> Stream f m r -> Stream f m (Maybe r)
forall t (m :: * -> *) (f :: * -> *) a.
(Eq t, Num t, Monad m, Functor f) =>
t -> Stream f m a -> Stream f m (Maybe a)
loop where
  loop :: t -> Stream f m a -> Stream f m (Maybe a)
loop t
0 Stream f m a
_ = Maybe a -> Stream f m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  loop t
n Stream f m a
str = do
      Either a (f (Stream f m a))
e <- m (Either a (f (Stream f m a)))
-> Stream f m (Either a (f (Stream f m a)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either a (f (Stream f m a)))
 -> Stream f m (Either a (f (Stream f m a))))
-> m (Either a (f (Stream f m a)))
-> Stream f m (Either a (f (Stream f m a)))
forall a b. (a -> b) -> a -> b
$ Stream f m a -> m (Either a (f (Stream f m a)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream f m a
str
      case Either a (f (Stream f m a))
e of
        Left a
r -> Maybe a -> Stream f m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
r)
        Right f (Stream f m a)
frest -> f (Stream f m (Maybe a)) -> Stream f m (Maybe a)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream f m (Maybe a)) -> Stream f m (Maybe a))
-> f (Stream f m (Maybe a)) -> Stream f m (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Stream f m a -> Stream f m (Maybe a))
-> f (Stream f m a) -> f (Stream f m (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t -> Stream f m a -> Stream f m (Maybe a)
loop (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)) f (Stream f m a)
frest