{-| The names exported by this module are closely modeled on those in @Prelude@ and @Data.List@,
    but also on
    <http://hackage.haskell.org/package/pipes-4.1.9/docs/Pipes-Prelude.html Pipes.Prelude>,
    <http://hackage.haskell.org/package/pipes-group-1.0.3/docs/Pipes-Group.html Pipes.Group>
    and <http://hackage.haskell.org/package/pipes-parse-3.0.6/docs/Pipes-Parse.html Pipes.Parse>.
    The module may be said to give independent expression to the conception of
    Producer \/ Source \/ Generator manipulation
    articulated in the latter two modules. Because we dispense with piping and
    conduiting, the distinction between all of these modules collapses. Some things are
    lost but much is gained: on the one hand, everything comes much closer to ordinary
    beginning Haskell programming and, on the other, acquires the plasticity of programming
    directly with a general free monad type. The leading type, @Stream (Of a) m r@ is chosen to permit an api
    that is as close as possible to that of @Data.List@ and the @Prelude@.

    Import qualified thus:

> import Streaming
> import qualified Streaming.Prelude as S

    For the examples below, one sometimes needs

> import Streaming.Prelude (each, yield, next, mapped, stdoutLn, stdinLn)
> import Data.Function ((&))

   Other libraries that come up in passing are

> import qualified Control.Foldl as L -- cabal install foldl
> import qualified Pipes as P
> import qualified Pipes.Prelude as P
> import qualified System.IO as IO

     Here are some correspondences between the types employed here and elsewhere:

>               streaming             |            pipes               |       conduit       |  io-streams
> -------------------------------------------------------------------------------------------------------------------
> Stream (Of a) m ()                  | Producer a m ()                | Source m a          | InputStream a
>                                     | ListT m a                      | ConduitM () o m ()  | Generator r ()
> -------------------------------------------------------------------------------------------------------------------
> Stream (Of a) m r                   | Producer a m r                 | ConduitM () o m r   | Generator a r
> -------------------------------------------------------------------------------------------------------------------
> Stream (Of a) m (Stream (Of a) m r) | Producer a m (Producer a m r)  |
> --------------------------------------------------------------------------------------------------------------------
> Stream (Stream (Of a) m) r          | FreeT (Producer a m) m r       |
> --------------------------------------------------------------------------------------------------------------------
> --------------------------------------------------------------------------------------------------------------------
> ByteString m ()                     | Producer ByteString m ()       | Source m ByteString  | InputStream ByteString
> --------------------------------------------------------------------------------------------------------------------
>
-}
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

module Streaming.Prelude (
    -- * Types
    Of (..)

    -- * Introducing streams of elements
    -- $producers
    , yield
    , each
    , stdinLn
    , readLn
    , fromHandle
    , readFile
    , iterate
    , iterateM
    , repeat
    , repeatM
    , replicate
    , untilLeft
    , untilRight
    , cycle
    , replicateM
    , enumFrom
    , enumFromThen
    , unfoldr



    -- * Consuming streams of elements
    -- $consumers
    , stdoutLn
    , stdoutLn'
    , mapM_
    , print
    , toHandle
    , writeFile
    , effects
    , erase
    , drained


    -- * Stream transformers
    -- $pipes
    , map
    , mapM
    , maps
    , mapsPost
    , mapped
    , mappedPost
    , for
    , with
    , subst
    , copy
    , duplicate
    , store
    , chain
    , sequence
    , nubOrd
    , nubOrdOn
    , nubInt
    , nubIntOn
    , filter
    , filterM
    , mapMaybeM
    , delay
    , intersperse
    , take
    , takeWhile
--    , takeWhile'
    , takeWhileM
    , drop
    , dropWhile
    , concat
    -- , elemIndices
    -- , findIndices
    , scan
    , scanM
    , scanned
    , read
    , show
    , cons
    , slidingWindow
    , slidingWindowMin
    , slidingWindowMinBy
    , slidingWindowMinOn
    , slidingWindowMax
    , slidingWindowMaxBy
    , slidingWindowMaxOn
    , wrapEffect

    -- * Splitting and inspecting streams of elements
    , next
    , uncons
    , splitAt
    , split
    , breaks
    , break
    , breakWhen
    , span
    , group
    , groupBy
 --   , groupedBy


    -- * Sum and Compose manipulation

    , distinguish
    , switch
    , separate
    , unseparate
    , eitherToSum
    , sumToEither
    , sumToCompose
    , composeToSum

    -- * Folds
    -- $folds
    , fold
    , fold_
    , foldM
    , foldM_
    , foldMap
    , foldMap_
    , all
    , all_
    , any
    , any_
    , sum
    , sum_
    , product
    , product_
    , head
    , head_
    , last
    , last_
    , elem
    , elem_
    , notElem
    , notElem_
    , length
    , length_
    , toList
    , toList_
    , mconcat
    , mconcat_
    , minimum
    , minimum_
    , maximum
    , maximum_
    , foldrM
    , foldrT


    -- , all
    -- , any
    -- , and
    -- , or
    -- , elem

    -- , find
    -- , findIndex
    -- , head
    -- , index
    -- , last
    -- , length
    -- , maximum
    -- , minimum
    -- , null

    -- * Zips and unzips
    , zip
    , zipWith
    , zip3
    , zipWith3
    , unzip
    , partitionEithers
    , partition

    -- * Merging streams
    -- $merging

    , merge
    , mergeOn
    , mergeBy

    -- * Maybes
    -- $maybes
    , catMaybes
    , mapMaybe

    -- * Pair manipulation
    , lazily
    , strictly
    , fst'
    , snd'
    , mapOf
    , _first
    , _second

    -- * Interoperation
    , reread

    -- * Basic Type
    , Stream
  ) where

import Streaming.Internal

import Control.Applicative (Applicative (..))
import Control.Concurrent (threadDelay)
import Control.Exception (throwIO, try)
import Control.Monad hiding (filterM, mapM, mapM_, foldM, foldM_, replicateM, sequence)
import Control.Monad.Trans
import Data.Functor (Functor (..), (<$))
import Data.Functor.Compose
import Data.Functor.Identity
import Data.Functor.Of
import Data.Functor.Sum
import Data.Monoid (Monoid (mappend, mempty))
import Data.Ord (Ordering (..), comparing)
import Foreign.C.Error (Errno(Errno), ePIPE)
import Text.Read (readMaybe)
import qualified Data.Foldable as Foldable
import qualified Data.IntSet as IntSet
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.Word (Word64)
import qualified GHC.IO.Exception as G
import qualified Prelude
import qualified System.IO as IO

import Prelude hiding (map, mapM, mapM_, filter, drop, dropWhile, take, mconcat
                      , sum, product, iterate, repeat, cycle, replicate, splitAt
                      , takeWhile, enumFrom, enumFromTo, enumFromThen, length
                      , print, zipWith, zip, zipWith3, zip3, unzip, seq, show, read
                      , readLn, sequence, concat, span, break, readFile, writeFile
                      , minimum, maximum, elem, notElem, all, any, head
                      , last, foldMap)



-- $setup
-- >>> import Control.Applicative
-- >>> import qualified Control.Foldl as L
-- >>> import Data.Bifunctor (first)
-- >>> import Data.Function ((&))
-- >>> import Data.IORef
-- >>> import Data.Vector (Vector)
-- >>> import qualified Streaming.Prelude as S
-- >>> import qualified System.IO
-- >>> import Text.Read (readEither)


-- instance (Eq a) => Eq1 (Of a) where eq1 = (==)
-- instance (Ord a) => Ord1 (Of a) where compare1 = compare
-- instance (Read a) => Read1 (Of a) where readsPrec1 = readsPrec
-- instance (Show a) => Show1 (Of a) where showsPrec1 = showsPrec

{-| Note that 'lazily', 'strictly', 'fst'', and 'mapOf' are all so-called /natural transformations/ on the primitive @Of a@ functor.
    If we write

>  type f ~~> g = forall x . f x -> g x

   then we can restate some types as follows:

>  mapOf            :: (a -> b) -> Of a ~~> Of b   -- Bifunctor first
>  lazily           ::             Of a ~~> (,) a
>  Identity . fst'  ::             Of a ~~> Identity a

   Manipulation of a @Stream f m r@ by mapping often turns on recognizing natural transformations of @f@.
   Thus @maps@ is far more general the the @map@ of the @Streaming.Prelude@, which can be
   defined thus:

>  S.map :: (a -> b) -> Stream (Of a) m r -> Stream (Of b) m r
>  S.map f = maps (mapOf f)

  i.e.

>  S.map f = maps (\(a :> x) -> (f a :> x))

  This rests on recognizing that @mapOf@ is a natural transformation; note though
  that it results in such a transformation as well:

>  S.map :: (a -> b) -> Stream (Of a) m ~~> Stream (Of b) m

  Thus we can @maps@ it in turn.


 -}
lazily :: Of a b -> (a,b)
lazily :: Of a b -> (a, b)
lazily = \(a
a:>b
b) -> (a
a,b
b)
{-# INLINE lazily #-}

{-| Convert a standard Haskell pair into a left-strict pair  -}
strictly :: (a,b) -> Of a b
strictly :: (a, b) -> Of a b
strictly = \(a
a,b
b) -> a
a a -> b -> Of a b
forall a b. a -> b -> Of a b
:> b
b
{-# INLINE strictly #-}

{-| @fst'@ and @snd'@ extract the first and second element of a pair

>>> S.fst' (1:>"hi")
1
>>> S.snd' (1:>"hi")
"hi"


     They are contained in the @_first@ and @_second@ lenses,
     if any lens library is in scope

>>> import Lens.Micro
>>> (1:>"hi") ^. S._first
1
>>> (1:>"hi") ^. S._second
"hi"

 -}

fst' :: Of a b -> a
fst' :: Of a b -> a
fst' (a
a :> b
_) = a
a
{-# INLINE fst' #-}
snd' :: Of a b -> b
snd' :: Of a b -> b
snd' (a
_ :> b
b) = b
b
{-# INLINE snd' #-}

{-| Map a function over the first element of an @Of@ pair

>>> S.mapOf even (1:>"hi")
False :> "hi"

     @mapOf@ is just @first@ from the @Bifunctor@ instance

>>> first even (1:>"hi")
False :> "hi"

     and is contained in the @_first@ lens

>>> import Lens.Micro
>>> over S._first even (1:>"hi")
False :> "hi"

 -}

mapOf :: (a -> b) -> Of a r -> Of b r
mapOf :: (a -> b) -> Of a r -> Of b r
mapOf a -> b
f (a
a :> r
b) = a -> b
f a
a b -> r -> Of b r
forall a b. a -> b -> Of a b
:> r
b
{-# INLINE mapOf #-}

{-| A lens into the first element of a left-strict pair -}
_first :: Functor f => (a -> f a') -> Of a b -> f (Of a' b)
_first :: (a -> f a') -> Of a b -> f (Of a' b)
_first a -> f a'
afb (a
a :> b
b) = (a' -> Of a' b) -> f a' -> f (Of a' b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a'
c -> a'
c a' -> b -> Of a' b
forall a b. a -> b -> Of a b
:> b
b) (a -> f a'
afb a
a)
{-# INLINE _first #-}

{-| A lens into the second element of a left-strict pair -}
_second :: Functor f => (b -> f b') -> Of a b -> f (Of a b')
_second :: (b -> f b') -> Of a b -> f (Of a b')
_second b -> f b'
afb (a
a :> b
b) = (b' -> Of a b') -> f b' -> f (Of a b')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b'
c -> a
a a -> b' -> Of a b'
forall a b. a -> b -> Of a b
:> b'
c) (b -> f b'
afb b
b)
{-# INLINABLE _second #-}

all :: Monad m => (a -> Bool) -> Stream (Of a) m r -> m (Of Bool r)
all :: (a -> Bool) -> Stream (Of a) m r -> m (Of Bool r)
all a -> Bool
thus = Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
True where
  loop :: Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
b Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r -> Of Bool r -> m (Of Bool r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
b Bool -> r -> Of Bool r
forall a b. a -> b -> Of a b
:> r
r)
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
-> (Stream (Of a) m r -> m (Of Bool r)) -> m (Of Bool r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
b
    Step (a
a :> Stream (Of a) m r
rest) -> if a -> Bool
thus a
a
      then Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
True Stream (Of a) m r
rest
      else do
        r
r <- Stream (Of a) m r -> m r
forall (m :: * -> *) a r. Monad m => Stream (Of a) m r -> m r
effects Stream (Of a) m r
rest
        Of Bool r -> m (Of Bool r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False Bool -> r -> Of Bool r
forall a b. a -> b -> Of a b
:> r
r)
{-# INLINABLE all #-}

all_ :: Monad m => (a -> Bool) -> Stream (Of a) m r -> m Bool
all_ :: (a -> Bool) -> Stream (Of a) m r -> m Bool
all_ a -> Bool
thus = Bool -> Stream (Of a) m r -> m Bool
loop Bool
True where
  loop :: Bool -> Stream (Of a) m r -> m Bool
loop Bool
b Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r) -> (Stream (Of a) m r -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream (Of a) m r -> m Bool
loop Bool
b
    Step (a
a :> Stream (Of a) m r
rest) -> if a -> Bool
thus a
a
      then Bool -> Stream (Of a) m r -> m Bool
loop Bool
True Stream (Of a) m r
rest
      else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
{-# INLINABLE all_ #-}


any :: Monad m => (a -> Bool) -> Stream (Of a) m r -> m (Of Bool r)
any :: (a -> Bool) -> Stream (Of a) m r -> m (Of Bool r)
any a -> Bool
thus = Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
False where
  loop :: Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
b Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r -> Of Bool r -> m (Of Bool r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
b Bool -> r -> Of Bool r
forall a b. a -> b -> Of a b
:> r
r)
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
-> (Stream (Of a) m r -> m (Of Bool r)) -> m (Of Bool r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
b
    Step (a
a :> Stream (Of a) m r
rest) -> if a -> Bool
thus a
a
      then do
        r
r <- Stream (Of a) m r -> m r
forall (m :: * -> *) a r. Monad m => Stream (Of a) m r -> m r
effects Stream (Of a) m r
rest
        Of Bool r -> m (Of Bool r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True Bool -> r -> Of Bool r
forall a b. a -> b -> Of a b
:> r
r)
      else Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
False Stream (Of a) m r
rest
{-# INLINABLE any #-}

any_ :: Monad m => (a -> Bool) -> Stream (Of a) m r -> m Bool
any_ :: (a -> Bool) -> Stream (Of a) m r -> m Bool
any_ a -> Bool
thus = Bool -> Stream (Of a) m r -> m Bool
loop Bool
False where
  loop :: Bool -> Stream (Of a) m r -> m Bool
loop Bool
b Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r) -> (Stream (Of a) m r -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream (Of a) m r -> m Bool
loop Bool
b
    Step (a
a :> Stream (Of a) m r
rest) -> if a -> Bool
thus a
a
      then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      else Bool -> Stream (Of a) m r -> m Bool
loop Bool
False Stream (Of a) m r
rest
{-# INLINABLE any_ #-}

{-| Break a sequence upon meeting element falls under a predicate,
    keeping it and the rest of the stream as the return value.

>>> rest <- S.print $ S.break even $ each [1,1,2,3]
1
1
>>> S.print rest
2
3

-}

break :: Monad m => (a -> Bool) -> Stream (Of a) m r
      -> Stream (Of a) m (Stream (Of a) m r)
break :: (a -> Bool)
-> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
break a -> Bool
thePred = Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop where
  loop :: Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r         -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r)
    Effect m (Stream (Of a) m r)
m         -> m (Stream (Of a) m (Stream (Of a) m r))
-> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m (Stream (Of a) m r))
 -> Stream (Of a) m (Stream (Of a) m r))
-> m (Stream (Of a) m (Stream (Of a) m r))
-> Stream (Of a) m (Stream (Of a) m r)
forall a b. (a -> b) -> a -> b
$ (Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r))
-> m (Stream (Of a) m r) -> m (Stream (Of a) m (Stream (Of a) m r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop m (Stream (Of a) m r)
m
    Step (a
a :> Stream (Of a) m r
rest) -> if a -> Bool
thePred a
a
      then Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
rest))
      else Of a (Stream (Of a) m (Stream (Of a) m r))
-> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) m (Stream (Of a) m r)
-> Of a (Stream (Of a) m (Stream (Of a) m r))
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop Stream (Of a) m r
rest)
{-# INLINABLE break #-}

{-| Yield elements, using a fold to maintain state, until the accumulated
   value satifies the supplied predicate. The fold will then be short-circuited
   and the element that breaks it will be put after the break.
   This function is easiest to use with 'Control.Foldl.purely'

>>> rest <- each [1..10] & L.purely S.breakWhen L.sum (>10) & S.print
1
2
3
4
>>> S.print rest
5
6
7
8
9
10

-}
breakWhen :: Monad m => (x -> a -> x) -> x -> (x -> b) -> (b -> Bool) -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
breakWhen :: (x -> a -> x)
-> x
-> (x -> b)
-> (b -> Bool)
-> Stream (Of a) m r
-> Stream (Of a) m (Stream (Of a) m r)
breakWhen x -> a -> x
step x
begin x -> b
done b -> Bool
thePred = x -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop0 x
begin
  where
    loop0 :: x -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop0 x
x Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
        Return r
r -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Stream (Of a) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
        Effect m (Stream (Of a) m r)
mn  -> m (Stream (Of a) m (Stream (Of a) m r))
-> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m (Stream (Of a) m r))
 -> Stream (Of a) m (Stream (Of a) m r))
-> m (Stream (Of a) m (Stream (Of a) m r))
-> Stream (Of a) m (Stream (Of a) m r)
forall a b. (a -> b) -> a -> b
$ (Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r))
-> m (Stream (Of a) m r) -> m (Stream (Of a) m (Stream (Of a) m r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop0 x
x) m (Stream (Of a) m r)
mn
        Step (a
a :> Stream (Of a) m r
rest) -> a -> x -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop a
a (x -> a -> x
step x
x a
a) Stream (Of a) m r
rest
    loop :: a -> x -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop a
a !x
x Stream (Of a) m r
stream =
      if b -> Bool
thePred (x -> b
done x
x)
        then Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a Stream (Of a) m () -> Stream (Of a) m r -> Stream (Of a) m r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream (Of a) m r
stream)
        else case Stream (Of a) m r
stream of
          Return r
r -> a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a Stream (Of a) m ()
-> Stream (Of a) m (Stream (Of a) m r)
-> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Stream (Of a) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
          Effect m (Stream (Of a) m r)
mn  -> m (Stream (Of a) m (Stream (Of a) m r))
-> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m (Stream (Of a) m r))
 -> Stream (Of a) m (Stream (Of a) m r))
-> m (Stream (Of a) m (Stream (Of a) m r))
-> Stream (Of a) m (Stream (Of a) m r)
forall a b. (a -> b) -> a -> b
$ (Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r))
-> m (Stream (Of a) m r) -> m (Stream (Of a) m (Stream (Of a) m r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> x -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop a
a x
x) m (Stream (Of a) m r)
mn
          Step (a
a' :> Stream (Of a) m r
rest) -> do
            a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a
            a -> x -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop a
a' (x -> a -> x
step x
x a
a') Stream (Of a) m r
rest
{-# INLINABLE breakWhen #-}

{-| Break during periods where the predicate is not satisfied, grouping the periods when it is.

>>> S.print $ mapped S.toList $ S.breaks not $ S.each [False,True,True,False,True,True,False]
[True,True]
[True,True]
>>> S.print $ mapped S.toList $ S.breaks id $ S.each [False,True,True,False,True,True,False]
[False]
[False]
[False]

-}
breaks
  :: Monad m =>
     (a -> Bool) -> Stream (Of a) m r -> Stream (Stream (Of a) m) m r
breaks :: (a -> Bool) -> Stream (Of a) m r -> Stream (Stream (Of a) m) m r
breaks a -> Bool
thus  = Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop  where
  loop :: Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
stream = m (Stream (Stream (Of a) m) m r) -> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Stream (Of a) m) m r) -> Stream (Stream (Of a) m) m r)
-> m (Stream (Stream (Of a) m) m r) -> Stream (Stream (Of a) m) m r
forall a b. (a -> b) -> a -> b
$ do
    Either r (a, Stream (Of a) m r)
e <- Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next Stream (Of a) m r
stream
    Stream (Stream (Of a) m) m r -> m (Stream (Stream (Of a) m) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream (Stream (Of a) m) m r -> m (Stream (Stream (Of a) m) m r))
-> Stream (Stream (Of a) m) m r -> m (Stream (Stream (Of a) m) m r)
forall a b. (a -> b) -> a -> b
$ case Either r (a, Stream (Of a) m r)
e of
      Left   r
r      -> r -> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
      Right (a
a, Stream (Of a) m r
p') ->
       if Bool -> Bool
not (a -> Bool
thus a
a)
          then Stream (Of a) m (Stream (Stream (Of a) m) m r)
-> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Stream (Of a) m (Stream (Stream (Of a) m) m r)
 -> Stream (Stream (Of a) m) m r)
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
-> Stream (Stream (Of a) m) m r
forall a b. (a -> b) -> a -> b
$ (Stream (Of a) m r -> Stream (Stream (Of a) m) m r)
-> Stream (Of a) m (Stream (Of a) m r)
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop (a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a Stream (Of a) m ()
-> Stream (Of a) m (Stream (Of a) m r)
-> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> Bool)
-> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
break a -> Bool
thus Stream (Of a) m r
p')
          else Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
p'
{-# INLINABLE breaks #-}

{-| Apply an action to all values, re-yielding each.
    The return value (@y@) of the function is ignored.

>>> S.product $ S.chain Prelude.print $ S.each [1..5]
1
2
3
4
5
120 :> ()

See also 'mapM' for a variant of this which uses the return value of the function to transorm the values in the stream.
-}

chain :: Monad m => (a -> m y) -> Stream (Of a) m r -> Stream (Of a) m r
chain :: (a -> m y) -> Stream (Of a) m r -> Stream (Of a) m r
chain a -> m y
f = Stream (Of a) m r -> Stream (Of a) m r
loop where
  loop :: Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r -> r -> Stream (Of a) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
    Effect m (Stream (Of a) m r)
mn  -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of a) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of a) m r
loop m (Stream (Of a) m r)
mn)
    Step (a
a :> Stream (Of a) m r
rest) -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> Stream (Of a) m r
forall a b. (a -> b) -> a -> b
$ do
      y
_ <- a -> m y
f a
a
      Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
rest))
{-# INLINABLE chain #-}

{-| Make a stream of foldable containers into a stream of their separate elements.
    This is just

> concat str = for str each

>>> S.print $ S.concat (each ["xy","z"])
'x'
'y'
'z'

    Note that it also has the effect of 'Data.Maybe.catMaybes', 'Data.Either.rights'
    @map snd@ and such-like operations.

>>> S.print $ S.concat $ S.each [Just 1, Nothing, Just 2]
1
2
>>> S.print $  S.concat $ S.each [Right 1, Left "Error!", Right 2]
1
2
>>> S.print $ S.concat $ S.each [('A',1), ('B',2)]
1
2

-}

concat :: (Monad m, Foldable.Foldable f) => Stream (Of (f a)) m r -> Stream (Of a) m r
concat :: Stream (Of (f a)) m r -> Stream (Of a) m r
concat = Stream (Of (f a)) m r -> Stream (Of a) m r
forall (m :: * -> *) (t :: * -> *) a r.
(Functor m, Foldable t) =>
Stream (Of (t a)) m r -> Stream (Of a) m r
loop
  where
    loop :: Stream (Of (t a)) m r -> Stream (Of a) m r
loop Stream (Of (t a)) m r
str = case Stream (Of (t a)) m r
str of
        Return r
r -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
        Effect m (Stream (Of (t a)) m r)
m -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of (t a)) m r -> Stream (Of a) m r)
-> m (Stream (Of (t a)) m r) -> m (Stream (Of a) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of (t a)) m r -> Stream (Of a) m r
loop m (Stream (Of (t a)) m r)
m)
        Step (t a
lst :> Stream (Of (t a)) m r
as) ->
          let inner :: [a] -> Stream (Of a) m r
inner [] = Stream (Of (t a)) m r -> Stream (Of a) m r
loop Stream (Of (t a)) m r
as
              inner (a
x:[a]
rest) = Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
x a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> [a] -> Stream (Of a) m r
inner [a]
rest)
          in [a] -> Stream (Of a) m r
inner (t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList t a
lst)
{-# INLINABLE concat #-}
-- The above hand-written loop is ~20% faster than the 'for' implementation
-- concat str = for str each

{-| The natural @cons@ for a @Stream (Of a)@.

> cons a stream = yield a >> stream

   Useful for interoperation:

> Data.Text.foldr S.cons (return ()) :: Text -> Stream (Of Char) m ()
> Lazy.foldrChunks S.cons (return ()) :: Lazy.ByteString -> Stream (Of Strict.ByteString) m ()

    and so on.
-}

cons :: (Monad m) => a -> Stream (Of a) m r -> Stream (Of a) m r
cons :: a -> Stream (Of a) m r -> Stream (Of a) m r
cons a
a Stream (Of a) m r
str = Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
str)
{-# INLINE cons #-}

{- | Cycle repeatedly through the layers of a stream, /ad inf./ This
     function is functor-general

> cycle = forever

>>> rest <- S.print $ S.splitAt 3 $ S.cycle (yield True >> yield False)
True
False
True
>>> S.print $ S.take 3 rest
False
True
False

-}

cycle :: (Monad m, Functor f) => Stream f m r -> Stream f m s
cycle :: Stream f m r -> Stream f m s
cycle Stream f m r
str = Stream f m s
loop where loop :: Stream f m s
loop = Stream f m r
str Stream f m r -> Stream f m s -> Stream f m s
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream f m s
loop
{-# INLINABLE cycle #-}


{-| Interpolate a delay of n seconds between yields.
-}
delay :: MonadIO m => Double -> Stream (Of a) m r -> Stream (Of a) m r
delay :: Double -> Stream (Of a) m r -> Stream (Of a) m r
delay Double
seconds = Stream (Of a) m r -> Stream (Of a) m r
loop where
  pico :: Int
pico = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
seconds Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000000)
  loop :: Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
str = do
    Either r (a, Stream (Of a) m r)
e <- m (Either r (a, Stream (Of a) m r))
-> Stream (Of a) m (Either r (a, Stream (Of a) m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (a, Stream (Of a) m r))
 -> Stream (Of a) m (Either r (a, Stream (Of a) m r)))
-> m (Either r (a, Stream (Of a) m r))
-> Stream (Of a) m (Either r (a, Stream (Of a) m r))
forall a b. (a -> b) -> a -> b
$ Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next Stream (Of a) m r
str
    case Either r (a, Stream (Of a) m r)
e of
      Left r
r -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
      Right (a
a,Stream (Of a) m r
rest) -> do
        a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a
        IO () -> Stream (Of a) m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Stream (Of a) m ()) -> IO () -> Stream (Of a) m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
pico
        Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
rest
{-# INLINABLE delay #-}



{-| Where a transformer returns a stream, run the effects of the stream, keeping
   the return value. This is usually used at the type

> drained :: Monad m => Stream (Of a) m (Stream (Of b) m r) -> Stream (Of a) m r
> drained = join . fmap (lift . effects)

   Here, for example, we split a stream in two places and throw out the middle segment:

>>> rest <- S.print $ S.drained $ S.splitAt 2 $ S.splitAt 5 $ each [1..7]
1
2
>>> S.print rest
6
7

   In particular, we can define versions  of @take@ and @takeWhile@ which
   retrieve the return value of the rest of the stream - and which can
   thus be used with 'maps':

> take' n = S.drained . S.splitAt n
> takeWhile' thus = S.drained . S.span thus

-}
drained :: (Monad m, Monad (t m), MonadTrans t) => t m (Stream (Of a) m r) -> t m r
drained :: t m (Stream (Of a) m r) -> t m r
drained t m (Stream (Of a) m r)
tms = t m (Stream (Of a) m r)
tms t m (Stream (Of a) m r) -> (Stream (Of a) m r -> t m r) -> t m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m r -> t m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m r -> t m r)
-> (Stream (Of a) m r -> m r) -> Stream (Of a) m r -> t m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream (Of a) m r -> m r
forall (m :: * -> *) a r. Monad m => Stream (Of a) m r -> m r
effects
{-# INLINE drained #-}

-- ---------------
-- drop
-- ---------------
{-|  Ignore the first n elements of a stream, but carry out the actions

>>> S.toList $ S.drop 2 $ S.replicateM 5 getLine
a<Enter>
b<Enter>
c<Enter>
d<Enter>
e<Enter>
["c","d","e"] :> ()

     Because it retains the final return value, @drop n@  is a suitable argument
     for @maps@:

>>> S.toList $ concats $ maps (S.drop 4) $ chunksOf 5 $ each [1..20]
[5,10,15,20] :> ()
  -}

drop :: (Monad m) => Int -> Stream (Of a) m r -> Stream (Of a) m r
drop :: Int -> Stream (Of a) m r -> Stream (Of a) m r
drop Int
n Stream (Of a) m r
str | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Stream (Of a) m r
str
drop Int
n Stream (Of a) m r
str = Int -> Stream (Of a) m r -> Stream (Of a) m r
forall a (m :: * -> *) a r.
(Eq a, Num a, Functor m) =>
a -> Stream (Of a) m r -> Stream (Of a) m r
loop Int
n Stream (Of a) m r
str where
  loop :: a -> Stream (Of a) m r -> Stream (Of a) m r
loop a
0 Stream (Of a) m r
stream = Stream (Of a) m r
stream
  loop a
m Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
      Return r
r       -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
ma      -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of a) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Stream (Of a) m r -> Stream (Of a) m r
loop a
m) m (Stream (Of a) m r)
ma)
      Step (a
_ :> Stream (Of a) m r
as) -> a -> Stream (Of a) m r -> Stream (Of a) m r
loop (a
ma -> a -> a
forall a. Num a => a -> a -> a
-a
1) Stream (Of a) m r
as
{-# INLINABLE drop #-}

-- ---------------
-- dropWhile
-- ---------------

{- | Ignore elements of a stream until a test succeeds, retaining the rest.

>>> S.print $ S.dropWhile ((< 5) . length) S.stdinLn
one<Enter>
two<Enter>
three<Enter>
"three"
four<Enter>
"four"
^CInterrupted.


-}
dropWhile :: Monad m => (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m r
dropWhile :: (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m r
dropWhile a -> Bool
thePred = Stream (Of a) m r -> Stream (Of a) m r
loop where
  loop :: Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
    Return r
r       -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
ma       -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of a) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of a) m r
loop m (Stream (Of a) m r)
ma)
    Step (a
a :> Stream (Of a) m r
as) -> if a -> Bool
thePred a
a
      then Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
as
      else Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
as)
{-# INLINABLE dropWhile #-}

-- ---------------
-- each
-- ---------------

{- | Stream the elements of a pure, foldable container.

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


-}
each :: (Monad m, Foldable.Foldable f) => f a -> Stream (Of a) m ()
each :: f a -> Stream (Of a) m ()
each = (a -> Stream (Of a) m () -> Stream (Of a) m ())
-> Stream (Of a) m () -> f a -> Stream (Of a) m ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr (\a
a Stream (Of a) m ()
p -> Of a (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m () -> Of a (Stream (Of a) m ())
forall a b. a -> b -> Of a b
:> Stream (Of a) m ()
p)) (() -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return ())
{-# INLINABLE each #-}


-- ---------------
-- effects
-- ---------------

{- | Reduce a stream, performing its actions but ignoring its elements.

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

    'effects' should be understood together with 'copy' and is subject to the rules

> S.effects . S.copy       = id
> hoist S.effects . S.copy = id

    The similar @effects@ and @copy@ operations in @Data.ByteString.Streaming@ obey the same rules.

-}
effects :: Monad m => Stream (Of a) m r -> m r
effects :: Stream (Of a) m r -> m r
effects = Stream (Of a) m r -> m r
forall (m :: * -> *) a r. Monad m => Stream (Of a) m r -> m r
loop where
  loop :: Stream (Of a) m a -> m a
loop Stream (Of a) m a
stream = case Stream (Of a) m a
stream of
    Return a
r         -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
    Effect m (Stream (Of a) m a)
m         -> m (Stream (Of a) m a)
m m (Stream (Of a) m a) -> (Stream (Of a) m a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of a) m a -> m a
loop
    Step (a
_ :> Stream (Of a) m a
rest) -> Stream (Of a) m a -> m a
loop Stream (Of a) m a
rest
{-# INLINABLE effects #-}

{-| Before evaluating the monadic action returning the next step in the 'Stream', @wrapEffect@
    extracts the value in a monadic computation @m a@ and passes it to a computation @a -> m y@.

-}
wrapEffect :: (Monad m, Functor f) => m a -> (a -> m y) -> Stream f m r -> Stream f m r
wrapEffect :: m a -> (a -> m y) -> Stream f m r -> Stream f m r
wrapEffect m a
m a -> m y
f = Stream f m r -> Stream f m r
loop where
  loop :: Stream f m r -> Stream f m r
loop Stream f m r
stream = do
    a
x <- m a -> Stream f m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m
    Either r (f (Stream f m r))
step <- m (Either r (f (Stream f m r)))
-> Stream f m (Either r (f (Stream f m r)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (f (Stream f m r)))
 -> Stream f m (Either r (f (Stream f m r))))
-> m (Either r (f (Stream f m r)))
-> Stream f m (Either r (f (Stream f m r)))
forall a b. (a -> b) -> a -> b
$ 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
    y
_ <- m y -> Stream f m y
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m y -> Stream f m y) -> m y -> Stream f m y
forall a b. (a -> b) -> a -> b
$ a -> m y
f a
x
    (r -> Stream f m r)
-> (f (Stream f m r) -> Stream f m r)
-> Either r (f (Stream f m r))
-> Stream f m r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either r -> Stream f m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure f (Stream f m r) -> Stream f m r
loop' Either r (f (Stream f m r))
step
  loop' :: f (Stream f m r) -> Stream f m r
loop' f (Stream f m r)
stream = f (Stream f m r) -> Stream f m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap ((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 Stream f m r -> Stream f m r
loop f (Stream f m r)
stream)

{-| Exhaust a stream remembering only whether @a@ was an element.

-}

elem :: (Monad m, Eq a) => a -> Stream (Of a) m r -> m (Of Bool r)
elem :: a -> Stream (Of a) m r -> m (Of Bool r)
elem a
a' = Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
False where
  loop :: Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
True Stream (Of a) m r
str = (r -> Of Bool r) -> m r -> m (Of Bool r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
True Bool -> r -> Of Bool r
forall a b. a -> b -> Of a b
:>) (Stream (Of a) m r -> m r
forall (m :: * -> *) a r. Monad m => Stream (Of a) m r -> m r
effects Stream (Of a) m r
str)
  loop Bool
False Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r -> Of Bool r -> m (Of Bool r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False Bool -> r -> Of Bool r
forall a b. a -> b -> Of a b
:> r
r)
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
-> (Stream (Of a) m r -> m (Of Bool r)) -> m (Of Bool r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
False
    Step (a
a:> Stream (Of a) m r
rest) ->
      if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
        then (r -> Of Bool r) -> m r -> m (Of Bool r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
True Bool -> r -> Of Bool r
forall a b. a -> b -> Of a b
:>) (Stream (Of a) m r -> m r
forall (m :: * -> *) a r. Monad m => Stream (Of a) m r -> m r
effects Stream (Of a) m r
rest)
        else Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
False Stream (Of a) m r
rest
{-# INLINABLE elem #-}

elem_ :: (Monad m, Eq a) => a -> Stream (Of a) m r -> m Bool
elem_ :: a -> Stream (Of a) m r -> m Bool
elem_ a
a' = Bool -> Stream (Of a) m r -> m Bool
loop Bool
False where
  loop :: Bool -> Stream (Of a) m r -> m Bool
loop Bool
True Stream (Of a) m r
_ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  loop Bool
False Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r) -> (Stream (Of a) m r -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream (Of a) m r -> m Bool
loop Bool
False
    Step (a
a:> Stream (Of a) m r
rest) ->
      if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
        then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else Bool -> Stream (Of a) m r -> m Bool
loop Bool
False Stream (Of a) m r
rest
{-# INLINABLE elem_ #-}

-- -----
-- enumFrom
-- ------

{-| An infinite stream of enumerable values, starting from a given value.
    It is the same as @S.iterate succ@.
    Because their return type is polymorphic, @enumFrom@, @enumFromThen@
    and @iterate@ are useful with functions like @zip@ and @zipWith@, which
    require the zipped streams to have the same return type. 

    For example, with
    @each [1..]@ the following bit of connect-and-resume would not compile:

>>> rest <- S.print $ S.zip (S.enumFrom 1) $ S.splitAt 3 $ S.each ['a'..'z']
(1,'a')
(2,'b')
(3,'c')
>>>  S.print $ S.take 3 rest
'd'
'e'
'f'

-}
enumFrom :: (Monad m, Enum n) => n -> Stream (Of n) m r
enumFrom :: n -> Stream (Of n) m r
enumFrom = n -> Stream (Of n) m r
forall (m :: * -> *) t r.
(Monad m, Enum t) =>
t -> Stream (Of t) m r
loop where
  loop :: t -> Stream (Of t) m r
loop !t
n = m (Stream (Of t) m r) -> Stream (Of t) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of t) m r -> m (Stream (Of t) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of t (Stream (Of t) m r) -> Stream (Of t) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (t
n t -> Stream (Of t) m r -> Of t (Stream (Of t) m r)
forall a b. a -> b -> Of a b
:> t -> Stream (Of t) m r
loop (t -> t
forall a. Enum a => a -> a
succ t
n))))
{-# INLINABLE enumFrom #-}


{-| An infinite sequence of enumerable values at a fixed distance, determined
   by the first and second values. See the discussion of 'Streaming.enumFrom'

>>> S.print $ S.take 3 $ S.enumFromThen 100 200
100
200
300

-}
enumFromThen:: (Monad m, Enum a) => a -> a -> Stream (Of a) m r
enumFromThen :: a -> a -> Stream (Of a) m r
enumFromThen a
first a
second = (Int -> a) -> Stream (Of Int) m r -> Stream (Of a) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r -> Stream (Of b) m r
Streaming.Prelude.map Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> Stream (Of Int) m r
loop Int
_first)
  where
    _first :: Int
_first = a -> Int
forall a. Enum a => a -> Int
fromEnum a
first
    _second :: Int
_second = a -> Int
forall a. Enum a => a -> Int
fromEnum a
second
    diff :: Int
diff = Int
_second Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
_first
    loop :: Int -> Stream (Of Int) m r
loop !Int
s =  Of Int (Stream (Of Int) m r) -> Stream (Of Int) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Int
s Int -> Stream (Of Int) m r -> Of Int (Stream (Of Int) m r)
forall a b. a -> b -> Of a b
:> Int -> Stream (Of Int) m r
loop (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
diff))
{-# INLINABLE enumFromThen #-}

-- ---------------
-- erase
-- ---------------
{- | Remove the elements from a stream of values, retaining the structure of layers.
-}
erase :: Monad m => Stream (Of a) m r -> Stream Identity m r
erase :: Stream (Of a) m r -> Stream Identity m r
erase = Stream (Of a) m r -> Stream Identity m r
forall (m :: * -> *) a r.
Functor m =>
Stream (Of a) m r -> Stream Identity m r
loop where
  loop :: Stream (Of a) m r -> Stream Identity m r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r -> r -> Stream Identity m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m -> m (Stream Identity m r) -> Stream Identity m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream Identity m r)
-> m (Stream (Of a) m r) -> m (Stream Identity m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream Identity m r
loop m (Stream (Of a) m r)
m)
    Step (a
_:>Stream (Of a) m r
rest) -> Identity (Stream Identity m r) -> Stream Identity m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Stream Identity m r -> Identity (Stream Identity m r)
forall a. a -> Identity a
Identity (Stream (Of a) m r -> Stream Identity m r
loop Stream (Of a) m r
rest))
{-# INLINABLE erase #-}

-- ---------------
-- filter
-- ---------------

-- | Skip elements of a stream that fail a predicate
filter  :: (Monad m) => (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m r
filter :: (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m r
filter a -> Bool
thePred = Stream (Of a) m r -> Stream (Of a) m r
loop where
  loop :: Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r       -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m       -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of a) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of a) m r
loop m (Stream (Of a) m r)
m)
    Step (a
a :> Stream (Of a) m r
as) -> if a -> Bool
thePred a
a
      then Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
as)
      else Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
as
{-# INLINE filter #-}  -- ~ 10% faster than INLINABLE in simple bench


-- ---------------
-- filterM
-- ---------------

-- | Skip elements of a stream that fail a monadic test
filterM  :: (Monad m) => (a -> m Bool) -> Stream (Of a) m r -> Stream (Of a) m r
filterM :: (a -> m Bool) -> Stream (Of a) m r -> Stream (Of a) m r
filterM a -> m Bool
thePred = Stream (Of a) m r -> Stream (Of a) m r
loop where
  loop :: Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r       -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m       -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> Stream (Of a) m r
forall a b. (a -> b) -> a -> b
$ (Stream (Of a) m r -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of a) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of a) m r
loop m (Stream (Of a) m r)
m
    Step (a
a :> Stream (Of a) m r
as) -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> Stream (Of a) m r
forall a b. (a -> b) -> a -> b
$ do
      Bool
bool <- a -> m Bool
thePred a
a
      if Bool
bool
        then Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream (Of a) m r -> m (Stream (Of a) m r))
-> Stream (Of a) m r -> m (Stream (Of a) m r)
forall a b. (a -> b) -> a -> b
$ Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
as)
        else Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream (Of a) m r -> m (Stream (Of a) m r))
-> Stream (Of a) m r -> m (Stream (Of a) m r)
forall a b. (a -> b) -> a -> b
$ Stream (Of a) m r -> Stream (Of a) m r
loop Stream (Of a) m r
as
{-# INLINE filterM #-}  -- ~ 10% faster than INLINABLE in simple bench

-- -- ---------------
-- -- first
-- -- ---------------
-- {- | Take either the first item in a stream or the return value, if it is empty.
--      The typical mark of an infinite stream is a polymorphic return value; in
--      that case, 'first' is a sort of @safeHead@
--
--      To iterate an action returning a 'Maybe', until it succeeds.
--
-- -}
-- first :: Monad m => Stream (Of r) m r -> m r
-- first = loop where
--   loop str = case str of
--     Return r -> return r
--     Effect m -> m >>= loop
--     Step (r :> rest) -> return r
-- {-# INLINABLE first #-}

-- ---------------
-- fold
-- ---------------

{- $folds
    Use these to fold the elements of a 'Stream'.

>>> S.fold_ (+) 0 id $ S.each [1..10]
55

    The general folds 'fold', 'fold_', 'foldM' and 'foldM_' are arranged
    for use with @Control.Foldl@ 'Control.Foldl.purely' and 'Control.Foldl.impurely'

>>> L.purely fold_ L.sum $ each [1..10]
55
>>> L.purely fold_ (liftA3 (,,) L.sum L.product L.list) $ each [1..10]
(55,3628800,[1,2,3,4,5,6,7,8,9,10])

    All functions marked with an underscore
    (e.g. @fold_@, @sum_@) omit the stream's return value in a left-strict pair.
    They are good for exiting streaming completely,
    but when you are, e.g. @mapped@-ing over a @Stream (Stream (Of a) m) m r@,
    which is to be compared with @[[a]]@. Specializing, we have e.g.

>  mapped sum :: (Monad m, Num n) => Stream (Stream (Of Int)) IO () -> Stream (Of n) IO ()
>  mapped (fold mappend mempty id) :: Stream (Stream (Of Int)) IO () -> Stream (Of Int) IO ()

>>> S.print $ mapped S.sum $ chunksOf 3 $ S.each [1..10]
6
15
24
10

>>> let three_folds = L.purely S.fold (liftA3 (,,) L.sum L.product L.list)
>>> S.print $ mapped three_folds $ chunksOf 3 (each [1..10])
(6,6,[1,2,3])
(15,120,[4,5,6])
(24,504,[7,8,9])
(10,10,[10])
-}

{-| Strict fold of a 'Stream' of elements, preserving only the result of the fold, not
    the return value of the stream.  The third parameter will often be 'id' where a fold
    is written by hand:

>>> S.fold_ (+) 0 id $ each [1..10]
55

    It can be used to replace a standard Haskell type with one more suited to
    writing a strict accumulation function. It is also crucial to the
    Applicative instance for @Control.Foldl.Fold@

> Control.Foldl.purely fold :: Monad m => Fold a b -> Stream (Of a) m () -> m b
-}
fold_ :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m b
fold_ :: (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m b
fold_ x -> a -> x
step x
begin x -> b
done = (Of b r -> b) -> m (Of b r) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
a :> r
_) -> b
a) (m (Of b r) -> m b)
-> (Stream (Of a) m r -> m (Of b r)) -> Stream (Of a) m r -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold x -> a -> x
step x
begin x -> b
done
{-# INLINE fold_ #-}

{-| Strict fold of a 'Stream' of elements that preserves the return value.
    The third parameter will often be 'id' where a fold is written by hand:

>>> S.fold (+) 0 id $ each [1..10]
55 :> ()

>>> S.fold (*) 1 id $ S.fold (+) 0 id $ S.copy $ each [1..10]
3628800 :> (55 :> ())

    It can be used to replace a standard Haskell type with one more suited to
    writing a strict accumulation function. It is also crucial to the
    Applicative instance for @Control.Foldl.Fold@  We can apply such a fold
    @purely@

> Control.Foldl.purely S.fold :: Monad m => Fold a b -> Stream (Of a) m r -> m (Of b r)

    Thus, specializing a bit:

> L.purely S.fold L.sum :: Stream (Of Int) Int r -> m (Of Int r)
> mapped (L.purely S.fold L.sum) :: Stream (Stream (Of Int)) IO r -> Stream (Of Int) IO r

    Here we use the Applicative instance for @Control.Foldl.Fold@ to
    stream three-item segments of a stream together with their sums and products.

>>> S.print $ mapped (L.purely S.fold (liftA3 (,,) L.list L.product L.sum)) $ chunksOf 3 $ each [1..10]
([1,2,3],6,6)
([4,5,6],120,15)
([7,8,9],504,24)
([10],10,10)

-}

fold :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold :: (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold x -> a -> x
step x
begin x -> b
done Stream (Of a) m r
str =  Stream (Of a) m r -> x -> m (Of b r)
fold_loop Stream (Of a) m r
str x
begin
  where
    fold_loop :: Stream (Of a) m r -> x -> m (Of b r)
fold_loop Stream (Of a) m r
stream !x
x = case Stream (Of a) m r
stream of
      Return r
r         -> Of b r -> m (Of b r)
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> b
done x
x b -> r -> Of b r
forall a b. a -> b -> Of a b
:> r
r)
      Effect m (Stream (Of a) m r)
m         -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
-> (Stream (Of a) m r -> m (Of b r)) -> m (Of b r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Stream (Of a) m r
str' -> Stream (Of a) m r -> x -> m (Of b r)
fold_loop Stream (Of a) m r
str' x
x
      Step (a
a :> Stream (Of a) m r
rest) -> Stream (Of a) m r -> x -> m (Of b r)
fold_loop Stream (Of a) m r
rest (x -> m (Of b r)) -> x -> m (Of b r)
forall a b. (a -> b) -> a -> b
$! x -> a -> x
step x
x a
a
{-# INLINE fold #-}


{-| Strict, monadic fold of the elements of a @Stream (Of a)@

> Control.Foldl.impurely foldM :: Monad m => FoldM a b -> Stream (Of a) m () -> m b
-}
foldM_
    :: Monad m
    => (x -> a -> m x) -> m x -> (x -> m b) -> Stream (Of a) m r -> m b
foldM_ :: (x -> a -> m x) -> m x -> (x -> m b) -> Stream (Of a) m r -> m b
foldM_ x -> a -> m x
step m x
begin x -> m b
done = (Of b r -> b) -> m (Of b r) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
a :> r
_) -> b
a) (m (Of b r) -> m b)
-> (Stream (Of a) m r -> m (Of b r)) -> Stream (Of a) m r -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> a -> m x)
-> m x -> (x -> m b) -> Stream (Of a) m r -> m (Of b r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> m x)
-> m x -> (x -> m b) -> Stream (Of a) m r -> m (Of b r)
foldM x -> a -> m x
step m x
begin x -> m b
done
{-# INLINE foldM_ #-}

{-| Strict, monadic fold of the elements of a @Stream (Of a)@

> Control.Foldl.impurely foldM' :: Monad m => FoldM a b -> Stream (Of a) m r -> m (b, r)

   Thus to accumulate the elements of a stream as a vector, together with a random
   element we might write:

>>> L.impurely S.foldM (liftA2 (,) L.vectorM L.random) $ each [1..10::Int] :: IO (Of (Vector Int, Maybe Int) ())
([1,2,3,4,5,6,7,8,9,10],Just 9) :> ()

-}
foldM
    :: Monad m
    => (x -> a -> m x) -> m x -> (x -> m b) -> Stream (Of a) m r ->m (Of b r)

foldM :: (x -> a -> m x)
-> m x -> (x -> m b) -> Stream (Of a) m r -> m (Of b r)
foldM x -> a -> m x
step m x
begin x -> m b
done Stream (Of a) m r
str = do
    x
x0 <- m x
begin
    Stream (Of a) m r -> x -> m (Of b r)
loop Stream (Of a) m r
str x
x0
  where
    loop :: Stream (Of a) m r -> x -> m (Of b r)
loop Stream (Of a) m r
stream !x
x = case Stream (Of a) m r
stream of
      Return r
r         -> x -> m b
done x
x m b -> (b -> m (Of b r)) -> m (Of b r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
b -> Of b r -> m (Of b r)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b b -> r -> Of b r
forall a b. a -> b -> Of a b
:> r
r)
      Effect m (Stream (Of a) m r)
m          -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
-> (Stream (Of a) m r -> m (Of b r)) -> m (Of b r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Stream (Of a) m r
s -> Stream (Of a) m r -> x -> m (Of b r)
loop Stream (Of a) m r
s x
x
      Step (a
a :> Stream (Of a) m r
rest) -> do
        x
x' <- x -> a -> m x
step x
x a
a
        Stream (Of a) m r -> x -> m (Of b r)
loop Stream (Of a) m r
rest x
x'
{-# INLINABLE foldM #-}

-- the following requires GHC.Magic.oneShot:
-- foldM step begin done str = do
--       x <- begin
--       (x' :> r) <- streamFold
--         (\r x -> return (x :> r))
--         (\mx2mx -> oneShot (\x -> x `seq` mx2mx >>= ($ x) ))
--         (\(a :> x2mx') -> oneShot (\x -> x `seq` (step x a >>= x2mx')) )
--         ( str)
--         x
--       b <- done x'
--       return (b :> r)
--   where seq = Prelude.seq
-- {-# INLINE foldM #-}

{-| A natural right fold for consuming a stream of elements.
    See also the more general 'iterTM' in the 'Streaming' module
    and the still more general 'destroy'

> foldrT (\a p -> Streaming.yield a >> p) = id
> foldrT (\a p -> Pipes.yield a     >> p) :: Monad m => Stream (Of a) m r -> Producer a m r
> foldrT (\a p -> Conduit.yield a   >> p) :: Monad m => Stream (Of a) m r -> Conduit a m r

-}

foldrT :: (Monad m, MonadTrans t, Monad (t m))
       => (a -> t m r -> t m r) -> Stream (Of a) m r -> t m r
foldrT :: (a -> t m r -> t m r) -> Stream (Of a) m r -> t m r
foldrT a -> t m r -> t m r
step = Stream (Of a) m r -> t m r
loop where
  loop :: Stream (Of a) m r -> t m r
loop Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
    Return r
r       -> r -> t m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
    Effect m (Stream (Of a) m r)
m       -> m (Stream (Of a) m r) -> t m (Stream (Of a) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Stream (Of a) m r)
m t m (Stream (Of a) m r) -> (Stream (Of a) m r -> t m r) -> t m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of a) m r -> t m r
loop
    Step (a
a :> Stream (Of a) m r
as) -> a -> t m r -> t m r
step a
a (Stream (Of a) m r -> t m r
loop Stream (Of a) m r
as)
{-# INLINABLE foldrT #-}

{-| A natural right fold for consuming a stream of elements.
    See also the more general 'iterT' in the 'Streaming' module and the
    still more general 'destroy'
-}
foldrM :: Monad m
       => (a -> m r -> m r) -> Stream (Of a) m r -> m r
foldrM :: (a -> m r -> m r) -> Stream (Of a) m r -> m r
foldrM a -> m r -> m r
step = Stream (Of a) m r -> m r
loop where
  loop :: Stream (Of a) m r -> m r
loop Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
    Return r
r       -> r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
    Effect m (Stream (Of a) m r)
m       -> m (Stream (Of a) m r)
m m (Stream (Of a) m r) -> (Stream (Of a) m r -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of a) m r -> m r
loop
    Step (a
a :> Stream (Of a) m r
as) -> a -> m r -> m r
step a
a (Stream (Of a) m r -> m r
loop Stream (Of a) m r
as)
{-# INLINABLE foldrM #-}

-- ---------------
-- for
-- ---------------

-- | @for@ replaces each element of a stream with an associated stream. Note that the
-- associated stream may layer any functor.
for :: (Monad m, Functor f) => Stream (Of a) m r -> (a -> Stream f m x) -> Stream f m r
for :: Stream (Of a) m r -> (a -> Stream f m x) -> Stream f m r
for Stream (Of a) m r
str0 a -> Stream f m x
f = Stream (Of a) m r -> Stream f m r
loop Stream (Of a) m r
str0 where
  loop :: Stream (Of a) m r -> Stream f m r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r         -> r -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) 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 (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
$ (Stream (Of a) m r -> Stream f m r)
-> m (Stream (Of a) m r) -> m (Stream f m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream f m r
loop m (Stream (Of a) m r)
m
    Step (a
a :> Stream (Of a) m r
as) -> a -> Stream f m x
f a
a Stream f m x -> Stream f m r -> Stream f m r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Stream (Of a) m r -> Stream f m r
loop Stream (Of a) m r
as
{-# INLINABLE for #-}

-- -| Group layers of any functor by comparisons on a preliminary annotation

-- groupedBy
--   :: (Monad m, Functor f) =>
--      (a -> a -> Bool)
--      -> Stream (Compose (Of a) f) m r
--      -> Stream (Stream (Compose (Of a) f) m) m r
-- groupedBy equals = loop  where
--   loop stream = Effect $ do
--         e <- inspect stream
--         return $ case e of
--             Left   r      -> Return r
--             Right s@(Compose (a :> p')) -> Step $
--                 fmap loop (Step $ Compose (a :> fmap (span' (equals a)) p'))
--   span' :: (Monad m, Functor f) => (a -> Bool) -> Stream (Compose (Of a) f) m r
--         -> Stream (Compose (Of a) f) m (Stream (Compose (Of a) f) m r)
--   span' thePred = loop where
--     loop str = case str of
--       Return r         -> Return (Return r)
--       Effect m          -> Effect $ fmap loop m
--       Step s@(Compose (a :> rest)) -> case thePred a  of
--         True  -> Step (Compose (a :> fmap loop rest))
--         False -> Return (Step s)
-- {-# INLINABLE groupedBy #-}

{-| Group elements of a stream in accordance with the supplied comparison.


>>> S.print $ mapped S.toList $ S.groupBy (>=) $ each [1,2,3,1,2,3,4,3,2,4,5,6,7,6,5]
[1]
[2]
[3,1,2,3]
[4,3,2,4]
[5]
[6]
[7,6,5]

-}
groupBy :: Monad m
  => (a -> a -> Bool)
  -> Stream (Of a) m r
  -> Stream (Stream (Of a) m) m r
groupBy :: (a -> a -> Bool)
-> Stream (Of a) m r -> Stream (Stream (Of a) m) m r
groupBy a -> a -> Bool
equals = Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop  where
  loop :: Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
stream = m (Stream (Stream (Of a) m) m r) -> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Stream (Of a) m) m r) -> Stream (Stream (Of a) m) m r)
-> m (Stream (Stream (Of a) m) m r) -> Stream (Stream (Of a) m) m r
forall a b. (a -> b) -> a -> b
$ do
        Either r (a, Stream (Of a) m r)
e <- Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next Stream (Of a) m r
stream
        Stream (Stream (Of a) m) m r -> m (Stream (Stream (Of a) m) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream (Stream (Of a) m) m r -> m (Stream (Stream (Of a) m) m r))
-> Stream (Stream (Of a) m) m r -> m (Stream (Stream (Of a) m) m r)
forall a b. (a -> b) -> a -> b
$ case Either r (a, Stream (Of a) m r)
e of
            Left   r
r      -> r -> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
            Right (a
a, Stream (Of a) m r
p') -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
-> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Stream (Of a) m (Stream (Stream (Of a) m) m r)
 -> Stream (Stream (Of a) m) m r)
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
-> Stream (Stream (Of a) m) m r
forall a b. (a -> b) -> a -> b
$
                (Stream (Of a) m r -> Stream (Stream (Of a) m) m r)
-> Stream (Of a) m (Stream (Of a) m r)
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop (a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a Stream (Of a) m ()
-> Stream (Of a) m (Stream (Of a) m r)
-> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> Bool)
-> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
span (a -> a -> Bool
equals a
a) Stream (Of a) m r
p')
{-# INLINABLE groupBy #-}


{-| Group successive equal items together

>>> S.toList $ mapped S.toList $ S.group $ each "baaaaad"
["b","aaaaa","d"] :> ()

>>> S.toList $ concats $ maps (S.drained . S.splitAt 1) $ S.group $ each "baaaaaaad"
"bad" :> ()

-}
group :: (Monad m, Eq a) => Stream (Of a) m r -> Stream (Stream (Of a) m) m r
group :: Stream (Of a) m r -> Stream (Stream (Of a) m) m r
group = (a -> a -> Bool)
-> Stream (Of a) m r -> Stream (Stream (Of a) m) m r
forall (m :: * -> *) a r.
Monad m =>
(a -> a -> Bool)
-> Stream (Of a) m r -> Stream (Stream (Of a) m) m r
groupBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINE group #-}


head :: Monad m => Stream (Of a) m r -> m (Of (Maybe a) r)
head :: Stream (Of a) m r -> m (Of (Maybe a) r)
head Stream (Of a) m r
str = case Stream (Of a) m r
str of
  Return r
r            -> Of (Maybe a) r -> m (Of (Maybe a) r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing Maybe a -> r -> Of (Maybe a) r
forall a b. a -> b -> Of a b
:> r
r)
  Effect m (Stream (Of a) m r)
m            -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
-> (Stream (Of a) m r -> m (Of (Maybe a) r)) -> m (Of (Maybe a) r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of a) m r -> m (Of (Maybe a) r)
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Of (Maybe a) r)
head
  Step (a
a :> Stream (Of a) m r
rest)    -> Stream (Of a) m r -> m r
forall (m :: * -> *) a r. Monad m => Stream (Of a) m r -> m r
effects Stream (Of a) m r
rest m r -> (r -> m (Of (Maybe a) r)) -> m (Of (Maybe a) r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r
r -> Of (Maybe a) r -> m (Of (Maybe a) r)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a Maybe a -> r -> Of (Maybe a) r
forall a b. a -> b -> Of a b
:> r
r)
{-# INLINABLE head #-}

head_ :: Monad m => Stream (Of a) m r -> m (Maybe a)
head_ :: Stream (Of a) m r -> m (Maybe a)
head_ Stream (Of a) m r
str = case Stream (Of a) m r
str of
  Return r
_ -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
-> (Stream (Of a) m r -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of a) m r -> m (Maybe a)
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Maybe a)
head_
  Step (a
a :> Stream (Of a) m r
_) -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
{-# INLINABLE head_ #-}


{-| Intersperse given value between each element of the stream.

>>> S.print $ S.intersperse 0 $ each [1,2,3]
1
0
2
0
3

-}
intersperse :: Monad m => a -> Stream (Of a) m r -> Stream (Of a) m r
intersperse :: a -> Stream (Of a) m r -> Stream (Of a) m r
intersperse a
x Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of a) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Stream (Of a) m r -> Stream (Of a) m r
forall (m :: * -> *) a r.
Monad m =>
a -> Stream (Of a) m r -> Stream (Of a) m r
intersperse a
x) m (Stream (Of a) m r)
m)
    Step (a
a :> Stream (Of a) m r
rest) -> a -> Stream (Of a) m r -> Stream (Of a) m r
loop a
a Stream (Of a) m r
rest
  where
  loop :: a -> Stream (Of a) m r -> Stream (Of a) m r
loop !a
a Stream (Of a) m r
theStr = case Stream (Of a) m r
theStr of
    Return r
r -> Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r)
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of a) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Stream (Of a) m r -> Stream (Of a) m r
loop a
a) m (Stream (Of a) m r)
m)
    Step (a
b :> Stream (Of a) m r
rest) -> Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
x a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> a -> Stream (Of a) m r -> Stream (Of a) m r
loop a
b Stream (Of a) m r
rest))
{-# INLINABLE intersperse #-}




-- ---------------
-- iterate
-- ---------------

{-| Iterate a pure function from a seed value, streaming the results forever



-}
iterate :: Monad m => (a -> a) -> a -> Stream (Of a) m r
iterate :: (a -> a) -> a -> Stream (Of a) m r
iterate a -> a
f = a -> Stream (Of a) m r
loop where
  loop :: a -> Stream (Of a) m r
loop a
a' = m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a' a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> a -> Stream (Of a) m r
loop (a -> a
f a
a'))))
{-# INLINABLE iterate #-}

-- | Iterate a monadic function from a seed value, streaming the results forever
iterateM :: Monad m => (a -> m a) -> m a -> Stream (Of a) m r
iterateM :: (a -> m a) -> m a -> Stream (Of a) m r
iterateM a -> m a
f = m a -> Stream (Of a) m r
loop where
  loop :: m a -> Stream (Of a) m r
loop m a
ma  = m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> Stream (Of a) m r
forall a b. (a -> b) -> a -> b
$ do
    a
a <- m a
ma
    Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> m a -> Stream (Of a) m r
loop (a -> m a
f a
a)))
{-# INLINABLE iterateM #-}



last :: Monad m => Stream (Of a) m r -> m (Of (Maybe a) r)
last :: Stream (Of a) m r -> m (Of (Maybe a) r)
last = Maybe_ a -> Stream (Of a) m r -> m (Of (Maybe a) r)
forall (m :: * -> *) a b.
Monad m =>
Maybe_ a -> Stream (Of a) m b -> m (Of (Maybe a) b)
loop Maybe_ a
forall a. Maybe_ a
Nothing_ where
  loop :: Maybe_ a -> Stream (Of a) m b -> m (Of (Maybe a) b)
loop Maybe_ a
mb Stream (Of a) m b
str = case Stream (Of a) m b
str of
    Return b
r            -> case Maybe_ a
mb of
      Maybe_ a
Nothing_ -> Of (Maybe a) b -> m (Of (Maybe a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing Maybe a -> b -> Of (Maybe a) b
forall a b. a -> b -> Of a b
:> b
r)
      Just_ a
a  -> Of (Maybe a) b -> m (Of (Maybe a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a Maybe a -> b -> Of (Maybe a) b
forall a b. a -> b -> Of a b
:> b
r)
    Effect m (Stream (Of a) m b)
m            -> m (Stream (Of a) m b)
m m (Stream (Of a) m b)
-> (Stream (Of a) m b -> m (Of (Maybe a) b)) -> m (Of (Maybe a) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe_ a -> Stream (Of a) m b -> m (Of (Maybe a) b)
loop Maybe_ a
mb
    Step (a
a :> Stream (Of a) m b
rest)  -> Maybe_ a -> Stream (Of a) m b -> m (Of (Maybe a) b)
loop (a -> Maybe_ a
forall a. a -> Maybe_ a
Just_ a
a) Stream (Of a) m b
rest
{-# INLINABLE last #-}



last_ :: Monad m => Stream (Of a) m r -> m (Maybe a)
last_ :: Stream (Of a) m r -> m (Maybe a)
last_ = Maybe_ a -> Stream (Of a) m r -> m (Maybe a)
forall (m :: * -> *) a r.
Monad m =>
Maybe_ a -> Stream (Of a) m r -> m (Maybe a)
loop Maybe_ a
forall a. Maybe_ a
Nothing_ where
  loop :: Maybe_ a -> Stream (Of a) m r -> m (Maybe a)
loop Maybe_ a
mb Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
_ -> case Maybe_ a
mb of
      Maybe_ a
Nothing_ -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
      Just_ a
a  -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
-> (Stream (Of a) m r -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe_ a -> Stream (Of a) m r -> m (Maybe a)
loop Maybe_ a
mb
    Step (a
a :> Stream (Of a) m r
rest) -> Maybe_ a -> Stream (Of a) m r -> m (Maybe a)
loop (a -> Maybe_ a
forall a. a -> Maybe_ a
Just_ a
a) Stream (Of a) m r
rest
{-# INLINABLE last_ #-}


-- ---------------
-- length
-- ---------------

{-| Run a stream, remembering only its length:

>>> runIdentity $ S.length_ (S.each [1..10] :: Stream (Of Int) Identity ())
10

-}
length_ :: Monad m => Stream (Of a) m r -> m Int
length_ :: Stream (Of a) m r -> m Int
length_ = (Int -> a -> Int)
-> Int -> (Int -> Int) -> Stream (Of a) m r -> m Int
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m b
fold_ (\Int
n a
_ -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 Int -> Int
forall a. a -> a
id
{-# INLINE length_ #-}

{-| Run a stream, keeping its length and its return value.

>>> S.print $ mapped S.length $ chunksOf 3 $ S.each [1..10]
3
3
3
1

-}

length :: Monad m => Stream (Of a) m r -> m (Of Int r)
length :: Stream (Of a) m r -> m (Of Int r)
length = (Int -> a -> Int)
-> Int -> (Int -> Int) -> Stream (Of a) m r -> m (Of Int r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold (\Int
n a
_ -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 Int -> Int
forall a. a -> a
id
{-# INLINE length #-}
-- ---------------
-- map
-- ---------------

{-| Standard map on the elements of a stream.

>>> S.stdoutLn $ S.map reverse $ each (words "alpha beta")
ahpla
ateb
-}

map :: Monad m => (a -> b) -> Stream (Of a) m r -> Stream (Of b) m r
map :: (a -> b) -> Stream (Of a) m r -> Stream (Of b) m r
map a -> b
f = (forall x. Of a x -> Of b x)
-> Stream (Of a) m r -> Stream (Of b) 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 (\(x :> rest) -> a -> b
f a
x b -> x -> Of b x
forall a b. a -> b -> Of a b
:> x
rest)
-- loop where  --
  -- loop stream = case stream of
  --   Return r -> Return r
  --   Effect m -> Effect (fmap loop m)
  --   Step (a :> as) -> Step (f a :> loop as)
{-# INLINABLE map #-}
-- {-# NOINLINE [1] map #-}
-- {-# RULES
-- "map/map"  [~1] forall f g bs . map f (map g bs) =
--   map (f . g) bs
-- #-}

{-| Replace each element of a stream with the result of a monadic action

>>> S.print $ S.mapM readIORef $ S.chain (\ior -> modifyIORef ior (*100)) $ S.mapM newIORef $ each [1..6]
100
200
300
400
500
600

See also 'chain' for a variant of this which ignores the return value of the function and just uses the side effects.
-}
mapM :: Monad m => (a -> m b) -> Stream (Of a) m r -> Stream (Of b) m r
mapM :: (a -> m b) -> Stream (Of a) m r -> Stream (Of b) m r
mapM a -> m b
f = Stream (Of a) m r -> Stream (Of b) m r
loop where
  loop :: Stream (Of a) m r -> Stream (Of b) m r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r       -> r -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m       -> m (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of b) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of b) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of b) m r
loop m (Stream (Of a) m r)
m)
    Step (a
a :> Stream (Of a) m r
as) -> m (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) -> Stream (Of b) m r)
-> m (Stream (Of b) m r) -> Stream (Of b) m r
forall a b. (a -> b) -> a -> b
$ do
      b
a' <- a -> m b
f a
a
      Stream (Of b) m r -> m (Stream (Of b) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of b (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (b
a' b -> Stream (Of b) m r -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of b) m r
loop Stream (Of a) m r
as) )
{-# INLINABLE mapM #-}



{-| Reduce a stream to its return value with a monadic action.

>>> S.mapM_ Prelude.print $ each [1..3]
1
2
3


>>> rest <- S.mapM_ Prelude.print $ S.splitAt 3 $ each [1..10]
1
2
3
>>> S.sum rest
49 :> ()

-}
mapM_ :: Monad m => (a -> m x) -> Stream (Of a) m r -> m r
mapM_ :: (a -> m x) -> Stream (Of a) m r -> m r
mapM_ a -> m x
f = Stream (Of a) m r -> m r
loop where
  loop :: Stream (Of a) m r -> m r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r -> r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r) -> (Stream (Of a) m r -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of a) m r -> m r
loop
    Step (a
a :> Stream (Of a) m r
as) -> a -> m x
f a
a m x -> m r -> m r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Stream (Of a) m r -> m r
loop Stream (Of a) m r
as
{-# INLINABLE mapM_ #-}



{- | Map layers of one functor to another with a transformation involving the base monad.
 
     This function is completely functor-general. It is often useful with the more concrete type

@
mapped :: (forall x. Stream (Of a) IO x -> IO (Of b x)) -> Stream (Stream (Of a) IO) IO r -> Stream (Of b) IO r
@

     to process groups which have been demarcated in an effectful, @IO@-based
     stream by grouping functions like 'Streaming.Prelude.group',
     'Streaming.Prelude.split' or 'Streaming.Prelude.breaks'. Summary functions
     like 'Streaming.Prelude.fold', 'Streaming.Prelude.foldM',
     'Streaming.Prelude.mconcat' or 'Streaming.Prelude.toList' are often used
     to define the transformation argument. For example:

>>> S.toList_ $ S.mapped S.toList $ S.split 'c' (S.each "abcde")
["ab","de"]

     'Streaming.Prelude.maps' and 'Streaming.Prelude.mapped' obey these rules:

> maps id              = id
> mapped return        = id
> maps f . maps g      = maps (f . g)
> mapped f . mapped g  = mapped (f <=< g)
> maps f . mapped g    = mapped (fmap f . g)
> mapped f . maps g    = mapped (f <=< fmap g)

     'Streaming.Prelude.maps' is more fundamental than
     'Streaming.Prelude.mapped', which is best understood as a convenience for
     effecting this frequent composition:

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


-}

mapped :: (Monad m, Functor f) => (forall x . f x -> m (g x)) -> Stream f m r -> Stream g m r
mapped :: (forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r
mapped = (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
{-# INLINE mapped #-}

{-| A version of 'mapped' that imposes a 'Functor' constraint on the target functor rather
    than the source functor. This version should be preferred if 'fmap' on the target
    functor is cheaper.

-}
mappedPost :: (Monad m, Functor g) => (forall x . f x -> m (g x)) -> Stream f m r -> Stream g m r
mappedPost :: (forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r
mappedPost = (forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r
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
{-# INLINE mappedPost #-}

{-| Map each element of the stream to a monoid, and take the monoidal sum of the results.

>>> S.foldMap Sum $ S.take 2 (S.stdinLn)
1<Enter>
2<Enter>
3<Enter>
Sum {getSum = 6} :> ()

 -}
foldMap :: (Monad m, Monoid w) => (a -> w) -> Stream (Of a) m r -> m (Of w r)
foldMap :: (a -> w) -> Stream (Of a) m r -> m (Of w r)
foldMap a -> w
f = (w -> a -> w) -> w -> (w -> w) -> Stream (Of a) m r -> m (Of w r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold (\ !w
acc a
a -> w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
acc (a -> w
f a
a)) w
forall a. Monoid a => a
mempty w -> w
forall a. a -> a
id
{-# INLINE foldMap #-}

foldMap_ :: (Monad m, Monoid w) => (a -> w) -> Stream (Of a) m r -> m w
foldMap_ :: (a -> w) -> Stream (Of a) m r -> m w
foldMap_ a -> w
f = (w -> a -> w) -> w -> (w -> w) -> Stream (Of a) m r -> m w
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m b
fold_ (\ !w
acc a
a -> w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
acc (a -> w
f a
a)) w
forall a. Monoid a => a
mempty w -> w
forall a. a -> a
id
{-# INLINE foldMap_ #-}

{-| Fold streamed items into their monoidal sum

>>> S.mconcat $ S.take 2 $ S.map (Data.Monoid.Last . Just) S.stdinLn
first<Enter>
last<Enter>
Last {getLast = Just "last"} :> ()

 -}
mconcat :: (Monad m, Monoid w) => Stream (Of w) m r -> m (Of w r)
mconcat :: Stream (Of w) m r -> m (Of w r)
mconcat = (w -> w -> w) -> w -> (w -> w) -> Stream (Of w) m r -> m (Of w r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
forall a. Monoid a => a
mempty w -> w
forall a. a -> a
id
{-# INLINE mconcat #-}

data Maybe_ a = Just_ !a | Nothing_
mconcat_ :: (Monad m, Monoid w) => Stream (Of w) m r -> m w
mconcat_ :: Stream (Of w) m r -> m w
mconcat_ = (w -> w -> w) -> w -> (w -> w) -> Stream (Of w) m r -> m w
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m b
fold_ w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
forall a. Monoid a => a
mempty w -> w
forall a. a -> a
id

minimum :: (Monad m, Ord a) => Stream (Of a) m r -> m (Of (Maybe a) r)
minimum :: Stream (Of a) m r -> m (Of (Maybe a) r)
minimum = (Maybe_ a -> a -> Maybe_ a)
-> Maybe_ a
-> (Maybe_ a -> Maybe a)
-> Stream (Of a) m r
-> m (Of (Maybe a) r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold (\Maybe_ a
m a
a -> case Maybe_ a
m of Maybe_ a
Nothing_ -> a -> Maybe_ a
forall a. a -> Maybe_ a
Just_ a
a ; Just_ a
a' -> a -> Maybe_ a
forall a. a -> Maybe_ a
Just_ (a -> a -> a
forall a. Ord a => a -> a -> a
min a
a a
a'))
               Maybe_ a
forall a. Maybe_ a
Nothing_
               (\Maybe_ a
m -> case Maybe_ a
m of Maybe_ a
Nothing_ -> Maybe a
forall a. Maybe a
Nothing; Just_ a
r -> a -> Maybe a
forall a. a -> Maybe a
Just a
r)
{-# INLINE minimum #-}

minimum_ :: (Monad m, Ord a) => Stream (Of a) m r -> m (Maybe a)
minimum_ :: Stream (Of a) m r -> m (Maybe a)
minimum_ = (Maybe_ a -> a -> Maybe_ a)
-> Maybe_ a
-> (Maybe_ a -> Maybe a)
-> Stream (Of a) m r
-> m (Maybe a)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m b
fold_ (\Maybe_ a
m a
a -> case Maybe_ a
m of Maybe_ a
Nothing_ -> a -> Maybe_ a
forall a. a -> Maybe_ a
Just_ a
a ; Just_ a
a' -> a -> Maybe_ a
forall a. a -> Maybe_ a
Just_ (a -> a -> a
forall a. Ord a => a -> a -> a
min a
a a
a'))
                 Maybe_ a
forall a. Maybe_ a
Nothing_
                 (\Maybe_ a
m -> case Maybe_ a
m of Maybe_ a
Nothing_ -> Maybe a
forall a. Maybe a
Nothing; Just_ a
r -> a -> Maybe a
forall a. a -> Maybe a
Just a
r)
{-# INLINE minimum_ #-}

maximum :: (Monad m, Ord a) => Stream (Of a) m r -> m (Of (Maybe a) r)
maximum :: Stream (Of a) m r -> m (Of (Maybe a) r)
maximum = (Maybe_ a -> a -> Maybe_ a)
-> Maybe_ a
-> (Maybe_ a -> Maybe a)
-> Stream (Of a) m r
-> m (Of (Maybe a) r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold (\Maybe_ a
m a
a -> case Maybe_ a
m of Maybe_ a
Nothing_ -> a -> Maybe_ a
forall a. a -> Maybe_ a
Just_ a
a ; Just_ a
a' -> a -> Maybe_ a
forall a. a -> Maybe_ a
Just_ (a -> a -> a
forall a. Ord a => a -> a -> a
max a
a a
a'))
               Maybe_ a
forall a. Maybe_ a
Nothing_
               (\Maybe_ a
m -> case Maybe_ a
m of Maybe_ a
Nothing_ -> Maybe a
forall a. Maybe a
Nothing; Just_ a
r -> a -> Maybe a
forall a. a -> Maybe a
Just a
r)
{-# INLINE maximum #-}

maximum_ :: (Monad m, Ord a) => Stream (Of a) m r -> m (Maybe a)
maximum_ :: Stream (Of a) m r -> m (Maybe a)
maximum_ = (Maybe_ a -> a -> Maybe_ a)
-> Maybe_ a
-> (Maybe_ a -> Maybe a)
-> Stream (Of a) m r
-> m (Maybe a)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m b
fold_ (\Maybe_ a
m a
a -> case Maybe_ a
m of Maybe_ a
Nothing_ -> a -> Maybe_ a
forall a. a -> Maybe_ a
Just_ a
a ; Just_ a
a' -> a -> Maybe_ a
forall a. a -> Maybe_ a
Just_ (a -> a -> a
forall a. Ord a => a -> a -> a
max a
a a
a'))
                 Maybe_ a
forall a. Maybe_ a
Nothing_
                 (\Maybe_ a
m -> case Maybe_ a
m of Maybe_ a
Nothing_ -> Maybe a
forall a. Maybe a
Nothing; Just_ a
r -> a -> Maybe a
forall a. a -> Maybe a
Just a
r)
{-# INLINE maximum_ #-}

{-| The standard way of inspecting the first item in a stream of elements, if the
     stream is still \'running\'. The @Right@ case contains a
     Haskell pair, where the more general @inspect@ would return a left-strict pair.
     There is no reason to prefer @inspect@ since, if the @Right@ case is exposed,
     the first element in the pair will have been evaluated to whnf.

> next    :: Monad m => Stream (Of a) m r -> m (Either r    (a, Stream (Of a) m r))
> inspect :: Monad m => Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r)))

     Interoperate with @pipes@ producers thus:

> Pipes.unfoldr Stream.next :: Stream (Of a) m r -> Producer a m r
> Stream.unfoldr Pipes.next :: Producer a m r -> Stream (Of a) m r

     Similarly:

> IOStreams.unfoldM (fmap (either (const Nothing) Just) . next) :: Stream (Of a) IO b -> IO (InputStream a)
> Conduit.unfoldM   (fmap (either (const Nothing) Just) . next) :: Stream (Of a) m r -> Source a m r

     But see 'uncons', which is better fitted to these @unfoldM@s
-}
next :: Monad m => Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next :: Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next = Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
loop where
  loop :: Stream (Of a) m a -> m (Either a (a, Stream (Of a) m a))
loop Stream (Of a) m a
stream = case Stream (Of a) m a
stream of
    Return a
r         -> Either a (a, Stream (Of a) m a)
-> m (Either a (a, Stream (Of a) m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either a (a, Stream (Of a) m a)
forall a b. a -> Either a b
Left a
r)
    Effect m (Stream (Of a) m a)
m          -> m (Stream (Of a) m a)
m m (Stream (Of a) m a)
-> (Stream (Of a) m a -> m (Either a (a, Stream (Of a) m a)))
-> m (Either a (a, Stream (Of a) m a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of a) m a -> m (Either a (a, Stream (Of a) m a))
loop
    Step (a
a :> Stream (Of a) m a
rest) -> Either a (a, Stream (Of a) m a)
-> m (Either a (a, Stream (Of a) m a))
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, Stream (Of a) m a) -> Either a (a, Stream (Of a) m a)
forall a b. b -> Either a b
Right (a
a,Stream (Of a) m a
rest))
{-# INLINABLE next #-}


{-| Exhaust a stream deciding whether @a@ was an element.

-}

notElem :: (Monad m, Eq a) => a -> Stream (Of a) m r -> m (Of Bool r)
notElem :: a -> Stream (Of a) m r -> m (Of Bool r)
notElem a
a' = Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
True where
  loop :: Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
False Stream (Of a) m r
str = (r -> Of Bool r) -> m r -> m (Of Bool r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
False Bool -> r -> Of Bool r
forall a b. a -> b -> Of a b
:>) (Stream (Of a) m r -> m r
forall (m :: * -> *) a r. Monad m => Stream (Of a) m r -> m r
effects Stream (Of a) m r
str)
  loop Bool
True Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r -> Of Bool r -> m (Of Bool r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
TrueBool -> r -> Of Bool r
forall a b. a -> b -> Of a b
:> r
r)
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
-> (Stream (Of a) m r -> m (Of Bool r)) -> m (Of Bool r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
True
    Step (a
a:> Stream (Of a) m r
rest) ->
      if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
        then (r -> Of Bool r) -> m r -> m (Of Bool r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
False Bool -> r -> Of Bool r
forall a b. a -> b -> Of a b
:>) (Stream (Of a) m r -> m r
forall (m :: * -> *) a r. Monad m => Stream (Of a) m r -> m r
effects Stream (Of a) m r
rest)
        else Bool -> Stream (Of a) m r -> m (Of Bool r)
loop Bool
True Stream (Of a) m r
rest
{-# INLINABLE notElem #-}

notElem_ :: (Monad m, Eq a) => a -> Stream (Of a) m r -> m Bool
notElem_ :: a -> Stream (Of a) m r -> m Bool
notElem_ a
a' = Bool -> Stream (Of a) m r -> m Bool
loop Bool
True where
  loop :: Bool -> Stream (Of a) m r -> m Bool
loop Bool
False Stream (Of a) m r
_ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  loop Bool
True Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r) -> (Stream (Of a) m r -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream (Of a) m r -> m Bool
loop Bool
True
    Step (a
a:> Stream (Of a) m r
rest) ->
      if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
        then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        else Bool -> Stream (Of a) m r -> m Bool
loop Bool
True Stream (Of a) m r
rest
{-# INLINABLE notElem_ #-}


{-| Remove repeated elements from a Stream. 'nubOrd' of course accumulates a 'Data.Set.Set' of
    elements that have already been seen and should thus be used with care.

>>> S.toList_ $ S.nubOrd $ S.take 5 S.readLn :: IO [Int]
1<Enter>
2<Enter>
3<Enter>
1<Enter>
2<Enter>
[1,2,3]

-}

nubOrd :: (Monad m, Ord a) => Stream (Of a) m r -> Stream (Of a) m r
nubOrd :: Stream (Of a) m r -> Stream (Of a) m r
nubOrd = (a -> a) -> Stream (Of a) m r -> Stream (Of a) m r
forall (m :: * -> *) b a r.
(Monad m, Ord b) =>
(a -> b) -> Stream (Of a) m r -> Stream (Of a) m r
nubOrdOn a -> a
forall a. a -> a
id
{-# INLINE nubOrd #-}

{-|  Use 'nubOrdOn' to have a custom ordering function for your elements. -}
nubOrdOn :: (Monad m, Ord b) => (a -> b) -> Stream (Of a) m r -> Stream (Of a) m r
nubOrdOn :: (a -> b) -> Stream (Of a) m r -> Stream (Of a) m r
nubOrdOn a -> b
f Stream (Of a) m r
xs = Set b -> Stream (Of a) m r -> Stream (Of a) m r
loop Set b
forall a. Monoid a => a
mempty Stream (Of a) m r
xs where
  loop :: Set b -> Stream (Of a) m r -> Stream (Of a) m r
loop !Set b
set Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
    Return r
r         -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m         -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of a) m r)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Set b -> Stream (Of a) m r -> Stream (Of a) m r
loop Set b
set) m (Stream (Of a) m r)
m)
    Step (a
a :> Stream (Of a) m r
rest) -> let !fa :: b
fa = a -> b
f a
a in
      if b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member b
fa Set b
set
         then Set b -> Stream (Of a) m r -> Stream (Of a) m r
loop Set b
set Stream (Of a) m r
rest
         else Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Set b -> Stream (Of a) m r -> Stream (Of a) m r
loop (b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert b
fa Set b
set) Stream (Of a) m r
rest)

{-| More efficient versions of above when working with 'Int's that use 'Data.IntSet.IntSet'. -}

nubInt :: Monad m => Stream (Of Int) m r -> Stream (Of Int) m r
nubInt :: Stream (Of Int) m r -> Stream (Of Int) m r
nubInt = (Int -> Int) -> Stream (Of Int) m r -> Stream (Of Int) m r
forall (m :: * -> *) a r.
Monad m =>
(a -> Int) -> Stream (Of a) m r -> Stream (Of a) m r
nubIntOn Int -> Int
forall a. a -> a
id
{-# INLINE nubInt #-}

nubIntOn :: Monad m => (a -> Int) -> Stream (Of a) m r -> Stream (Of a) m r
nubIntOn :: (a -> Int) -> Stream (Of a) m r -> Stream (Of a) m r
nubIntOn a -> Int
f Stream (Of a) m r
xs = IntSet -> Stream (Of a) m r -> Stream (Of a) m r
loop IntSet
forall a. Monoid a => a
mempty Stream (Of a) m r
xs where
  loop :: IntSet -> Stream (Of a) m r -> Stream (Of a) m r
loop !IntSet
set Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
    Return r
r         -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m         -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of a) m r)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (IntSet -> Stream (Of a) m r -> Stream (Of a) m r
loop IntSet
set) m (Stream (Of a) m r)
m)
    Step (a
a :> Stream (Of a) m r
rest) -> let !fa :: Int
fa = a -> Int
f a
a in
      if Int -> IntSet -> Bool
IntSet.member Int
fa IntSet
set
         then IntSet -> Stream (Of a) m r -> Stream (Of a) m r
loop IntSet
set Stream (Of a) m r
rest
         else Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> IntSet -> Stream (Of a) m r -> Stream (Of a) m r
loop (Int -> IntSet -> IntSet
IntSet.insert Int
fa IntSet
set) Stream (Of a) m r
rest)


{-|
> filter p = hoist effects (partition p)

 -}
partition :: Monad m => (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
partition :: (a -> Bool)
-> Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
partition a -> Bool
thus = Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
loop where
   loop :: Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
     Return r
r -> r -> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
     Effect m (Stream (Of a) m r)
m -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) m (Stream (Of a) m r)
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
loop (m (Stream (Of a) m r) -> Stream (Of a) m (Stream (Of a) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Stream (Of a) m r)
m))
     Step (a
a :> Stream (Of a) m r
rest) -> if a -> Bool
thus a
a
       then Of a (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) (Stream (Of a) m) r
-> Of a (Stream (Of a) (Stream (Of a) m) r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of a) m r
rest)
       else Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
 -> Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall a b. (a -> b) -> a -> b
$ do
               a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a
               Stream (Of a) (Stream (Of a) m) r
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of a) m r
rest)


{-| Separate left and right values in distinct streams. ('separate' is
    a more powerful, functor-general, equivalent using 'Sum' in place of 'Either').
    So, for example, to permit unlimited user
    input of @Int@s on condition of only two errors, we might write:

>>> S.toList $ S.print $ S.take 2 $ partitionEithers $ S.map readEither $ S.stdinLn  :: IO (Of [Int] ())
1<Enter>
2<Enter>
qqqqqqqqqq<Enter>
"Prelude.read: no parse"
3<Enter>
rrrrrrrrrr<Enter>
"Prelude.read: no parse"
[1,2,3] :> ()

> partitionEithers = separate . maps S.eitherToSum
> lefts  = hoist S.effects . partitionEithers
> rights = S.effects . partitionEithers
> rights = S.concat
-}
partitionEithers :: Monad m => Stream (Of (Either a b)) m r -> Stream (Of a) (Stream (Of b) m) r
partitionEithers :: Stream (Of (Either a b)) m r -> Stream (Of a) (Stream (Of b) m) r
partitionEithers =  Stream (Of (Either a b)) m r -> Stream (Of a) (Stream (Of b) m) r
forall (m :: * -> *) a a r.
Monad m =>
Stream (Of (Either a a)) m r -> Stream (Of a) (Stream (Of a) m) r
loop where
   loop :: Stream (Of (Either a a)) m r -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of (Either a a)) m r
str = case Stream (Of (Either a a)) m r
str of
     Return r
r -> r -> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
     Effect m (Stream (Of (Either a a)) m r)
m -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of (Either a a)) m r -> Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) m (Stream (Of (Either a a)) m r)
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of (Either a a)) m r -> Stream (Of a) (Stream (Of a) m) r
loop (m (Stream (Of (Either a a)) m r)
-> Stream (Of a) m (Stream (Of (Either a a)) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Stream (Of (Either a a)) m r)
m))
     Step (Left a
a :> Stream (Of (Either a a)) m r
rest) -> Of a (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) (Stream (Of a) m) r
-> Of a (Stream (Of a) (Stream (Of a) m) r)
forall a b. a -> b -> Of a b
:> Stream (Of (Either a a)) m r -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of (Either a a)) m r
rest)
     Step (Right a
b :> Stream (Of (Either a a)) m r
rest) -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
 -> Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall a b. (a -> b) -> a -> b
$ do
       a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
b
       Stream (Of a) (Stream (Of a) m) r
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream (Of (Either a a)) m r -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of (Either a a)) m r
rest)


-- | Fold a 'Stream' of numbers into their product
product_ :: (Monad m, Num a) => Stream (Of a) m () -> m a
product_ :: Stream (Of a) m () -> m a
product_ = (a -> a -> a) -> a -> (a -> a) -> Stream (Of a) m () -> m a
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m b
fold_ a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1 a -> a
forall a. a -> a
id
{-# INLINE product_ #-}

{-| Fold a 'Stream' of numbers into their product with the return value

>  mapped product :: Stream (Stream (Of Int)) m r -> Stream (Of Int) m r
-}
product :: (Monad m, Num a) => Stream (Of a) m r -> m (Of a r)
product :: Stream (Of a) m r -> m (Of a r)
product = (a -> a -> a) -> a -> (a -> a) -> Stream (Of a) m r -> m (Of a r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1 a -> a
forall a. a -> a
id
{-# INLINE product #-}


-- ---------------
-- read
-- ---------------

{- | Make a stream of strings into a stream of parsed values, skipping bad cases

>>> S.sum_ $ S.read $ S.takeWhile (/= "total") S.stdinLn :: IO Int
1000<Enter>
2000<Enter>
total<Enter>
3000


-}
read :: (Monad m, Read a) => Stream (Of String) m r -> Stream (Of a) m r
read :: Stream (Of String) m r -> Stream (Of a) m r
read Stream (Of String) m r
stream = Stream (Of String) m r
-> (String -> Stream (Of a) m ()) -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) a r x.
(Monad m, Functor f) =>
Stream (Of a) m r -> (a -> Stream f m x) -> Stream f m r
for Stream (Of String) m r
stream ((String -> Stream (Of a) m ()) -> Stream (Of a) m r)
-> (String -> Stream (Of a) m ()) -> Stream (Of a) m r
forall a b. (a -> b) -> a -> b
$ \String
str -> case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
str of
  Maybe a
Nothing -> () -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Just a
r  -> a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
r
{-# INLINE read #-}

-- ---------------
-- repeat
-- ---------------
{-| Repeat an element /ad inf./ .

>>> S.print $ S.take 3 $ S.repeat 1
1
1
1
-}

repeat :: Monad m => a -> Stream (Of a) m r
repeat :: a -> Stream (Of a) m r
repeat a
a = Stream (Of a) m r
loop where loop :: Stream (Of a) m r
loop = m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
loop)))
{-# INLINE repeat #-}


{-| Repeat a monadic action /ad inf./, streaming its results.

>>> S.toList $ S.take 2 $ repeatM getLine
one<Enter>
two<Enter>
["one","two"]

-}

repeatM :: Monad m => m a -> Stream (Of a) m r
repeatM :: m a -> Stream (Of a) m r
repeatM m a
ma = Stream (Of a) m r
loop where
  loop :: Stream (Of a) m r
loop = do
    a
a <- m a -> Stream (Of a) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
ma
    a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a
    Stream (Of a) m r
loop
{-# INLINABLE repeatM #-}

-- ---------------
-- replicate
-- ---------------

-- | Repeat an element several times.
replicate :: Monad m => Int -> a -> Stream (Of a) m ()
replicate :: Int -> a -> Stream (Of a) m ()
replicate Int
n a
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = () -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
replicate Int
n a
a = Int -> Stream (Of a) m ()
loop Int
n where
  loop :: Int -> Stream (Of a) m ()
loop Int
0 = () -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return ()
  loop Int
m = m (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of a) m () -> m (Stream (Of a) m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Of a (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m () -> Of a (Stream (Of a) m ())
forall a b. a -> b -> Of a b
:> Int -> Stream (Of a) m ()
loop (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))))
{-# INLINABLE replicate #-}

{-| Repeat an action several times, streaming its results.

>>> S.print $ S.replicateM 2 getCurrentTime
2015-08-18 00:57:36.124508 UTC
2015-08-18 00:57:36.124785 UTC

-}
replicateM :: Monad m => Int -> m a -> Stream (Of a) m ()
replicateM :: Int -> m a -> Stream (Of a) m ()
replicateM Int
n m a
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = () -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
replicateM Int
n m a
ma = Int -> Stream (Of a) m ()
loop Int
n where
  loop :: Int -> Stream (Of a) m ()
loop Int
0 = () -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return ()
  loop Int
m = m (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m ()) -> Stream (Of a) m ())
-> m (Stream (Of a) m ()) -> Stream (Of a) m ()
forall a b. (a -> b) -> a -> b
$ do
    a
a <- m a
ma
    Stream (Of a) m () -> m (Stream (Of a) m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Of a (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m () -> Of a (Stream (Of a) m ())
forall a b. a -> b -> Of a b
:> Int -> Stream (Of a) m ()
loop (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)))
{-# INLINABLE replicateM #-}

{-| Read an @IORef (Maybe a)@ or a similar device until it reads @Nothing@.
    @reread@ provides convenient exit from the @io-streams@ library

> reread readIORef    :: IORef (Maybe a) -> Stream (Of a) IO ()
> reread Streams.read :: System.IO.Streams.InputStream a -> Stream (Of a) IO ()
-}
reread :: Monad m => (s -> m (Maybe a)) -> s -> Stream (Of a) m ()
reread :: (s -> m (Maybe a)) -> s -> Stream (Of a) m ()
reread s -> m (Maybe a)
step s
s = Stream (Of a) m ()
loop where
  loop :: Stream (Of a) m ()
loop = m (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m ()) -> Stream (Of a) m ())
-> m (Stream (Of a) m ()) -> Stream (Of a) m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe a
m <- s -> m (Maybe a)
step s
s
    case Maybe a
m of
      Maybe a
Nothing -> Stream (Of a) m () -> m (Stream (Of a) m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return ())
      Just a
a  -> Stream (Of a) m () -> m (Stream (Of a) m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Of a (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m () -> Of a (Stream (Of a) m ())
forall a b. a -> b -> Of a b
:> Stream (Of a) m ()
loop))
{-# INLINABLE reread #-}

{-| Strict left scan, streaming, e.g. successive partial results. The seed
    is yielded first, before any action of finding the next element is performed.


>>> S.print $ S.scan (++) "" id $ each (words "a b c d")
""
"a"
"ab"
"abc"
"abcd"

    'scan' is fitted for use with @Control.Foldl@, thus:

>>> S.print $ L.purely S.scan L.list $ each [3..5]
[]
[3]
[3,4]
[3,4,5]

-}
scan :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> Stream (Of b) m r
scan :: (x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r -> Stream (Of b) m r
scan x -> a -> x
step x
begin x -> b
done Stream (Of a) m r
str = Of b (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (x -> b
done x
begin b -> Stream (Of b) m r -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> x -> Stream (Of a) m r -> Stream (Of b) m r
loop x
begin Stream (Of a) m r
str)
  where
  loop :: x -> Stream (Of a) m r -> Stream (Of b) m r
loop !x
acc Stream (Of a) m r
stream =
    case Stream (Of a) m r
stream of
      Return r
r -> r -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of b) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of b) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x -> Stream (Of a) m r -> Stream (Of b) m r
loop x
acc) m (Stream (Of a) m r)
m)
      Step (a
a :> Stream (Of a) m r
rest) ->
        let !acc' :: x
acc' = x -> a -> x
step x
acc a
a
        in Of b (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (x -> b
done x
acc' b -> Stream (Of b) m r -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> x -> Stream (Of a) m r -> Stream (Of b) m r
loop x
acc' Stream (Of a) m r
rest)
{-# INLINABLE scan #-}

{-| Strict left scan, accepting a monadic function. It can be used with
    'FoldM's from @Control.Foldl@ using 'impurely'. Here we yield
    a succession of vectors each recording

>>> let v = L.impurely scanM L.vectorM $ each [1..4::Int] :: Stream (Of (Vector Int)) IO ()
>>> S.print v
[]
[1]
[1,2]
[1,2,3]
[1,2,3,4]

-}
scanM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream (Of a) m r -> Stream (Of b) m r
scanM :: (x -> a -> m x)
-> m x -> (x -> m b) -> Stream (Of a) m r -> Stream (Of b) m r
scanM x -> a -> m x
step m x
begin x -> m b
done Stream (Of a) m r
str = m (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) -> Stream (Of b) m r)
-> m (Stream (Of b) m r) -> Stream (Of b) m r
forall a b. (a -> b) -> a -> b
$ do
    x
x <- m x
begin
    b
b <- x -> m b
done x
x
    Stream (Of b) m r -> m (Stream (Of b) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of b (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (b
b b -> Stream (Of b) m r -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> x -> Stream (Of a) m r -> Stream (Of b) m r
loop x
x Stream (Of a) m r
str))
  where
    loop :: x -> Stream (Of a) m r -> Stream (Of b) m r
loop !x
x Stream (Of a) m r
stream = case Stream (Of a) m r
stream of -- note we have already yielded from x
      Return r
r -> r -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m  -> m (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (do
        Stream (Of a) m r
stream' <- m (Stream (Of a) m r)
m
        Stream (Of b) m r -> m (Stream (Of b) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> Stream (Of a) m r -> Stream (Of b) m r
loop x
x Stream (Of a) m r
stream')
        )
      Step (a
a :> Stream (Of a) m r
rest) -> m (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (do
        x
x' <- x -> a -> m x
step x
x a
a
        b
b   <- x -> m b
done x
x'
        Stream (Of b) m r -> m (Stream (Of b) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of b (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (b
b b -> Stream (Of b) m r -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> x -> Stream (Of a) m r -> Stream (Of b) m r
loop x
x' Stream (Of a) m r
rest))
        )
{-# INLINABLE scanM #-}

{-| Label each element in a stream with a value accumulated according to a fold.

>>> S.print $ S.scanned (*) 1 id $ S.each [100,200,300]
(100,100)
(200,20000)
(300,6000000)

>>> S.print $ L.purely S.scanned L.product $ S.each [100,200,300]
(100,100)
(200,20000)
(300,6000000)

-}

scanned :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> Stream (Of (a,b)) m r
scanned :: (x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r -> Stream (Of (a, b)) m r
scanned x -> a -> x
step x
begin x -> b
done = Maybe' a -> x -> Stream (Of a) m r -> Stream (Of (a, b)) m r
loop Maybe' a
forall a. Maybe' a
Nothing' x
begin
  where
    loop :: Maybe' a -> x -> Stream (Of a) m r -> Stream (Of (a, b)) m r
loop !Maybe' a
m !x
x Stream (Of a) m r
stream =
      case Stream (Of a) m r
stream of
        Return r
r -> r -> Stream (Of (a, b)) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
        Effect m (Stream (Of a) m r)
mn  -> m (Stream (Of (a, b)) m r) -> Stream (Of (a, b)) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of (a, b)) m r) -> Stream (Of (a, b)) m r)
-> m (Stream (Of (a, b)) m r) -> Stream (Of (a, b)) m r
forall a b. (a -> b) -> a -> b
$ (Stream (Of a) m r -> Stream (Of (a, b)) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of (a, b)) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe' a -> x -> Stream (Of a) m r -> Stream (Of (a, b)) m r
loop Maybe' a
m x
x) m (Stream (Of a) m r)
mn
        Step (a
a :> Stream (Of a) m r
rest) ->
          case Maybe' a
m of
            Maybe' a
Nothing' -> do
              let !acc :: x
acc = x -> a -> x
step x
x a
a
              (a, b) -> Stream (Of (a, b)) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield (a
a, x -> b
done x
acc)
              Maybe' a -> x -> Stream (Of a) m r -> Stream (Of (a, b)) m r
loop (a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a) x
acc Stream (Of a) m r
rest
            Just' a
_ -> do
              let !acc :: b
acc = x -> b
done (x -> a -> x
step x
x a
a)
              (a, b) -> Stream (Of (a, b)) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield (a
a, b
acc)
              Maybe' a -> x -> Stream (Of a) m r -> Stream (Of (a, b)) m r
loop (a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a) (x -> a -> x
step x
x a
a) Stream (Of a) m r
rest
{-# INLINABLE scanned #-}

data Maybe' a = Just' a | Nothing'

-- ---------------
-- sequence
-- ---------------

{-| Like the 'Data.List.sequence' but streaming. The result type is a
    stream of a\'s, /but is not accumulated/; the effects of the elements
    of the original stream are interleaved in the resulting stream. Compare:

> sequence :: Monad m =>       [m a]           -> m [a]
> sequence :: Monad m => Stream (Of (m a)) m r -> Stream (Of a) m r

   This obeys the rule

-}
sequence :: Monad m => Stream (Of (m a)) m r -> Stream (Of a) m r
sequence :: Stream (Of (m a)) m r -> Stream (Of a) m r
sequence = Stream (Of (m a)) m r -> Stream (Of a) m r
forall (m :: * -> *) a r.
Monad m =>
Stream (Of (m a)) m r -> Stream (Of a) m r
loop where
  loop :: Stream (Of (m a)) m r -> Stream (Of a) m r
loop Stream (Of (m a)) m r
stream = case Stream (Of (m a)) m r
stream of
    Return r
r          -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of (m a)) m r)
m           -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> Stream (Of a) m r
forall a b. (a -> b) -> a -> b
$ (Stream (Of (m a)) m r -> Stream (Of a) m r)
-> m (Stream (Of (m a)) m r) -> m (Stream (Of a) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of (m a)) m r -> Stream (Of a) m r
loop m (Stream (Of (m a)) m r)
m
    Step (m a
ma :> Stream (Of (m a)) m r
rest) -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) -> Stream (Of a) m r)
-> m (Stream (Of a) m r) -> Stream (Of a) m r
forall a b. (a -> b) -> a -> b
$ do
      a
a <- m a
ma
      Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of (m a)) m r -> Stream (Of a) m r
loop Stream (Of (m a)) m r
rest))
{-# INLINABLE sequence #-}

-- ---------------
-- show
-- ---------------

show :: (Monad m, Show a) => Stream (Of a) m r -> Stream (Of String) m r
show :: Stream (Of a) m r -> Stream (Of String) m r
show = (a -> String) -> Stream (Of a) m r -> Stream (Of String) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r -> Stream (Of b) m r
map a -> String
forall a. Show a => a -> String
Prelude.show
{-# INLINE show #-}
-- ---------------
-- sum
-- ---------------

-- | Fold a 'Stream' of numbers into their sum
sum_ :: (Monad m, Num a) => Stream (Of a) m () -> m a
sum_ :: Stream (Of a) m () -> m a
sum_ = (a -> a -> a) -> a -> (a -> a) -> Stream (Of a) m () -> m a
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m b
fold_ a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 a -> a
forall a. a -> a
id
{-# INLINE sum_ #-}

{-| Fold a 'Stream' of numbers into their sum with the return value

>  mapped S.sum :: Stream (Stream (Of Int)) m r -> Stream (Of Int) m r


>>> S.sum $ each [1..10]
55 :> ()

>>> (n :> rest)  <- S.sum $ S.splitAt 3 $ each [1..10]
>>> System.IO.print n
6
>>> (m :> rest') <- S.sum $ S.splitAt 3 rest
>>> System.IO.print m
15
>>> S.print rest'
7
8
9
10

-}
sum :: (Monad m, Num a) => Stream (Of a) m r -> m (Of a r)
sum :: Stream (Of a) m r -> m (Of a r)
sum = (a -> a -> a) -> a -> (a -> a) -> Stream (Of a) m r -> m (Of a r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 a -> a
forall a. a -> a
id
{-# INLINABLE sum #-}

-- ---------------
-- span
-- ---------------

-- | Stream elements until one fails the condition, return the rest.
span :: Monad m => (a -> Bool) -> Stream (Of a) m r
      -> Stream (Of a) m (Stream (Of a) m r)
span :: (a -> Bool)
-> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
span a -> Bool
thePred = Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop where
  loop :: Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r         -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r)
    Effect m (Stream (Of a) m r)
m          -> m (Stream (Of a) m (Stream (Of a) m r))
-> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m (Stream (Of a) m r))
 -> Stream (Of a) m (Stream (Of a) m r))
-> m (Stream (Of a) m (Stream (Of a) m r))
-> Stream (Of a) m (Stream (Of a) m r)
forall a b. (a -> b) -> a -> b
$ (Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r))
-> m (Stream (Of a) m r) -> m (Stream (Of a) m (Stream (Of a) m r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop m (Stream (Of a) m r)
m
    Step (a
a :> Stream (Of a) m r
rest) -> if a -> Bool
thePred a
a
      then Of a (Stream (Of a) m (Stream (Of a) m r))
-> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) m (Stream (Of a) m r)
-> Of a (Stream (Of a) m (Stream (Of a) m r))
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
loop Stream (Of a) m r
rest)
      else Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
rest))
{-# INLINABLE span #-}


{-| Split a stream of elements wherever a given element arises.
    The action is like that of 'Prelude.words'.

>>> S.stdoutLn $ mapped S.toList $ S.split ' ' $ each "hello world  "
hello
world

-}

split :: (Eq a, Monad m) =>
      a -> Stream (Of a) m r -> Stream (Stream (Of a) m) m r
split :: a -> Stream (Of a) m r -> Stream (Stream (Of a) m) m r
split a
t  = Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop  where
  loop :: Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
    Return r
r -> r -> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m -> m (Stream (Stream (Of a) m) m r) -> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Stream (Of a) m) m r)
-> m (Stream (Of a) m r) -> m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop m (Stream (Of a) m r)
m)
    Step (a
a :> Stream (Of a) m r
rest) ->
         if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
t
            then Stream (Of a) m (Stream (Stream (Of a) m) m r)
-> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream (Of a) m r -> Stream (Stream (Of a) m) m r)
-> Stream (Of a) m (Stream (Of a) m r)
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop (a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a Stream (Of a) m ()
-> Stream (Of a) m (Stream (Of a) m r)
-> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> Bool)
-> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t) Stream (Of a) m r
rest))
            else Stream (Of a) m r -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
rest
{-# INLINABLE split #-}

{-| Split a succession of layers after some number, returning a streaming or
    effectful pair. This function is the same as the 'splitsAt' exported by the
    @Streaming@ module, but since this module is imported qualified, it can
    usurp a Prelude name. It specializes to:

>  splitAt :: (Monad m) => Int -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)

-}
splitAt :: (Monad m, Functor f) => Int -> Stream f m r -> Stream f m (Stream f m r)
splitAt :: Int -> Stream f m r -> Stream f m (Stream f m r)
splitAt = 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
{-# INLINE splitAt #-}

-- -------
-- subst
-- -------
{-| Replace each element in a stream of individual values with a functorial
    layer of any sort. @subst = flip with@ and is more convenient in
    a sequence of compositions that transform a stream.

> with = flip subst
> for str f = concats $ subst f str
> subst f = maps (\(a:>r) -> r <$ f a)
> S.concat = concats . subst each
-}
subst :: (Monad m, Functor f) =>  (a -> f x) -> Stream (Of a) m r -> Stream f m r
subst :: (a -> f x) -> Stream (Of a) m r -> Stream f m r
subst a -> f x
f Stream (Of a) m r
s = Stream (Of a) m r -> Stream f m r
loop Stream (Of a) m r
s where
  loop :: Stream (Of a) m r -> Stream f m r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r         -> r -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) 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 (Of a) m r -> Stream f m r)
-> m (Stream (Of a) m r) -> m (Stream f m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream f m r
loop m (Stream (Of a) m r)
m)
    Step (a
a :> Stream (Of a) m r
rest) -> f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Stream (Of a) m r -> Stream f m r
loop Stream (Of a) m r
rest Stream f m r -> f x -> f (Stream f m r)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ a -> f x
f a
a)
{-# INLINABLE subst #-}
-- ---------------
-- take
-- ---------------

{-| End a stream after n elements; the original return value is thus lost.
    'splitAt' preserves this information. Note that, like @splitAt@, this
    function is functor-general, so that, for example, you can @take@ not
    just a number of items from a stream of elements, but a number
    of substreams and the like.

>>> S.toList $ S.take 3 $ each "with"
"wit" :> ()

>>> S.readFile "stream.hs" (S.stdoutLn . S.take 3)
import Streaming
import qualified Streaming.Prelude as S
import Streaming.Prelude (each, next, yield)


-}

take :: (Monad m, Functor f) => Int -> Stream f m r -> Stream f m ()
take :: Int -> Stream f m r -> Stream f m ()
take Int
n0 Stream f m r
_ | Int
n0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = () -> Stream f m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
take Int
n0 Stream f m r
str = Int -> Stream f m r -> Stream f m ()
forall t (m :: * -> *) (f :: * -> *) r.
(Eq t, Num t, Monad m, Functor f) =>
t -> Stream f m r -> Stream f m ()
loop Int
n0 Stream f m r
str where
  loop :: t -> Stream f m r -> Stream f m ()
loop t
0 Stream f m r
_ = () -> Stream f m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  loop t
n Stream f m r
p =
    case Stream f m r
p of
      Step f (Stream f m r)
fas -> f (Stream f m ()) -> Stream f m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step ((Stream f m r -> Stream f m ())
-> f (Stream f m r) -> f (Stream f m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t -> Stream f m r -> Stream f m ()
loop (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)) f (Stream f m r)
fas)
      Effect m (Stream f m r)
m -> m (Stream f m ()) -> Stream f m ()
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream f m r -> Stream f m ())
-> m (Stream f m r) -> m (Stream f m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t -> Stream f m r -> Stream f m ()
loop t
n) m (Stream f m r)
m)
      Return r
_ -> () -> Stream f m ()
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return ()
{-# INLINABLE take #-}

-- ---------------
-- takeWhile
-- ---------------

{-| End stream when an element fails a condition; the original return value is lost.
    By contrast 'span' preserves this information, and is generally more desirable.

> S.takeWhile thus = void . S.span thus

    To preserve the information - but thus also force the rest of the stream to be
    developed - write

> S.drained . S.span thus

    as @dropWhile thus@ is

> S.effects . S.span thus

-}
takeWhile :: Monad m => (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m ()
takeWhile :: (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m ()
takeWhile a -> Bool
thePred = Stream (Of a) m r -> Stream (Of a) m ()
loop where
  loop :: Stream (Of a) m r -> Stream (Of a) m ()
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Step (a
a :> Stream (Of a) m r
as) -> Bool -> Stream (Of a) m () -> Stream (Of a) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
thePred a
a) (Of a (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m () -> Of a (Stream (Of a) m ())
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) m ()
loop Stream (Of a) m r
as))
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) m ())
-> m (Stream (Of a) m r) -> m (Stream (Of a) m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of a) m ()
loop m (Stream (Of a) m r)
m)
    Return r
_ -> () -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return ()
{-# INLINE takeWhile #-}

{-| Like 'takeWhile', but takes a monadic predicate. -}
takeWhileM :: Monad m => (a -> m Bool) -> Stream (Of a) m r -> Stream (Of a) m ()
takeWhileM :: (a -> m Bool) -> Stream (Of a) m r -> Stream (Of a) m ()
takeWhileM a -> m Bool
thePred = Stream (Of a) m r -> Stream (Of a) m ()
loop where
  loop :: Stream (Of a) m r -> Stream (Of a) m ()
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Step (a
a :> Stream (Of a) m r
as) -> do
      Bool
b <- m Bool -> Stream (Of a) m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m Bool
thePred a
a)
      Bool -> Stream (Of a) m () -> Stream (Of a) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (Of a (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m () -> Of a (Stream (Of a) m ())
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) m ()
loop Stream (Of a) m r
as))
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) m ())
-> m (Stream (Of a) m r) -> m (Stream (Of a) m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of a) m ()
loop m (Stream (Of a) m r)
m)
    Return r
_ -> () -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return ()
{-# INLINE takeWhileM #-}


{-| Convert an effectful @Stream (Of a)@ into a list of @as@

    Note: Needless to say, this function does not stream properly.
    It is basically the same as Prelude 'mapM' which, like 'replicateM',
    'sequence' and similar operations on traversable containers
    is a leading cause of space leaks.

-}
toList_ :: Monad m => Stream (Of a) m r -> m [a]
toList_ :: Stream (Of a) m r -> m [a]
toList_ = (([a] -> [a]) -> a -> [a] -> [a])
-> ([a] -> [a])
-> (([a] -> [a]) -> [a])
-> Stream (Of a) m r
-> m [a]
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m b
fold_ (\[a] -> [a]
diff a
a [a]
ls -> [a] -> [a]
diff (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ls)) [a] -> [a]
forall a. a -> a
id (\[a] -> [a]
diff -> [a] -> [a]
diff [])
{-# INLINE toList_ #-}


{-| Convert an effectful 'Stream' into a list alongside the return value

>  mapped toList :: Stream (Stream (Of a) m) m r -> Stream (Of [a]) m r

    Like 'toList_', 'toList' breaks streaming; unlike 'toList_' it /preserves the return value/
    and thus is frequently useful with e.g. 'mapped'

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

>>> S.print $ mapped S.toList $ chunksOf 2 $ S.replicateM 4 getLine
s<Enter>
t<Enter>
["s","t"]
u<Enter>
v<Enter>
["u","v"]
-}
toList :: Monad m => Stream (Of a) m r -> m (Of [a] r)
toList :: Stream (Of a) m r -> m (Of [a] r)
toList = (([a] -> [a]) -> a -> [a] -> [a])
-> ([a] -> [a])
-> (([a] -> [a]) -> [a])
-> Stream (Of a) m r
-> m (Of [a] r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (Of b r)
fold (\[a] -> [a]
diff a
a [a]
ls -> [a] -> [a]
diff (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ls)) [a] -> [a]
forall a. a -> a
id (\[a] -> [a]
diff -> [a] -> [a]
diff [])
{-# INLINE toList #-}


{-| Inspect the first item in a stream of elements, without a return value.
    @uncons@ provides convenient exit into another streaming type:

> IOStreams.unfoldM uncons :: Stream (Of a) IO b -> IO (InputStream a)
> Conduit.unfoldM uncons   :: Stream (Of a) m r -> Conduit.Source m a

-}
uncons :: Monad m => Stream (Of a) m r -> m (Maybe (a, Stream (Of a) m r))
uncons :: Stream (Of a) m r -> m (Maybe (a, Stream (Of a) m r))
uncons = Stream (Of a) m r -> m (Maybe (a, Stream (Of a) m r))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Maybe (a, Stream (Of a) m r))
loop where
  loop :: Stream (Of a) m r -> m (Maybe (a, Stream (Of a) m r))
loop Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
    Return r
_         -> Maybe (a, Stream (Of a) m r) -> m (Maybe (a, Stream (Of a) m r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, Stream (Of a) m r)
forall a. Maybe a
Nothing
    Effect m (Stream (Of a) m r)
m          -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
-> (Stream (Of a) m r -> m (Maybe (a, Stream (Of a) m r)))
-> m (Maybe (a, Stream (Of a) m r))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of a) m r -> m (Maybe (a, Stream (Of a) m r))
loop
    Step (a
a :> Stream (Of a) m r
rest) -> Maybe (a, Stream (Of a) m r) -> m (Maybe (a, Stream (Of a) m r))
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, Stream (Of a) m r) -> Maybe (a, Stream (Of a) m r)
forall a. a -> Maybe a
Just (a
a,Stream (Of a) m r
rest))
{-# INLINABLE uncons #-}


{-| Build a @Stream@ by unfolding steps starting from a seed. In particular note
    that @S.unfoldr S.next = id@.

    The seed can of course be anything, but this is one natural way
    to consume a @pipes@ 'Pipes.Producer'. Consider:

>>> S.stdoutLn $ S.take 2 $ S.unfoldr Pipes.next Pipes.stdinLn
hello<Enter>
hello
goodbye<Enter>
goodbye

>>> S.stdoutLn $ S.unfoldr Pipes.next (Pipes.stdinLn >-> Pipes.take 2)
hello<Enter>
hello
goodbye<Enter>
goodbye

>>> S.effects $ S.unfoldr Pipes.next (Pipes.stdinLn >-> Pipes.take 2 >-> Pipes.stdoutLn)
hello<Enter>
hello
goodbye<Enter>
goodbye

    @Pipes.unfoldr S.next@ similarly unfolds a @Pipes.Producer@ from a stream.

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

-- ---------------------------------------
-- untilLeft
-- ---------------------------------------
untilLeft :: Monad m => m (Either r a) -> Stream (Of a) m r
untilLeft :: m (Either r a) -> Stream (Of a) m r
untilLeft m (Either r a)
act = m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect m (Stream (Of a) m r)
loop where
  loop :: m (Stream (Of a) m r)
loop = do
    Either r a
e <- m (Either r a)
act
    case Either r a
e of
      Right a
a -> Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect m (Stream (Of a) m r)
loop))
      Left r
r -> Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r)
{-# INLINABLE untilLeft #-}

-- ---------------------------------------
-- untilRight
-- ---------------------------------------
untilRight :: Monad m => m (Either a r) -> Stream (Of a) m r
untilRight :: m (Either a r) -> Stream (Of a) m r
untilRight m (Either a r)
act = m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect m (Stream (Of a) m r)
loop where
  loop :: m (Stream (Of a) m r)
loop = do
    Either a r
e <- m (Either a r)
act
    case Either a r
e of
      Right r
r -> Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r)
      Left a
a -> Stream (Of a) m r -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect m (Stream (Of a) m r)
loop))
{-# INLINABLE untilRight #-}

-- ---------------------------------------
-- with
-- ---------------------------------------

{-| Replace each element in a stream of individual Haskell values (a @Stream (Of a) m r@) with an associated 'functorial' step.

> for str f  = concats (with str f)
> with str f = for str (yields . f)
> with str f = maps (\(a:>r) -> r <$ f a) str
> with = flip subst
> subst = flip with

>>> with (each [1..3]) (yield . Prelude.show) & intercalates (yield "--") & S.stdoutLn
1
--
2
--
3
 -}
with :: (Monad m, Functor f) => Stream (Of a) m r -> (a -> f x) -> Stream f m r
with :: Stream (Of a) m r -> (a -> f x) -> Stream f m r
with Stream (Of a) m r
s a -> f x
f = Stream (Of a) m r -> Stream f m r
loop Stream (Of a) m r
s where
  loop :: Stream (Of a) m r -> Stream f m r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r         -> r -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) 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 (Of a) m r -> Stream f m r)
-> m (Stream (Of a) m r) -> m (Stream f m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream f m r
loop m (Stream (Of a) m r)
m)
    Step (a
a :> Stream (Of a) m r
rest) -> f (Stream f m r) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Stream (Of a) m r -> Stream f m r
loop Stream (Of a) m r
rest Stream f m r -> f x -> f (Stream f m r)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ a -> f x
f a
a)
{-# INLINABLE with #-}

-- ---------------------------------------
-- yield
-- ---------------------------------------

{-| A singleton stream

>>> stdoutLn $ yield "hello"
hello

>>> S.sum $ do {yield 1; yield 2; yield 3}
6 :> ()

>>> let number = lift (putStrLn "Enter a number:") >> lift readLn >>= yield :: Stream (Of Int) IO ()
>>> S.toList $ do {number; number; number}
Enter a number:
1<Enter>
Enter a number:
2<Enter>
Enter a number:
3<Enter>
[1,2,3] :> ()

-}

yield :: Monad m => a -> Stream (Of a) m ()
yield :: a -> Stream (Of a) m ()
yield a
a = Of a (Stream (Of a) m ()) -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m () -> Of a (Stream (Of a) m ())
forall a b. a -> b -> Of a b
:> () -> Stream (Of a) m ()
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return ())
{-# INLINE yield #-}

-- | Zip two 'Stream's
zip :: Monad m
    => Stream (Of a) m r
    -> Stream (Of b) m r
    -> Stream (Of (a,b)) m r
zip :: Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of (a, b)) m r
zip = (a -> b -> (a, b))
-> Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of (a, b)) m r
forall (m :: * -> *) a b c r.
Monad m =>
(a -> b -> c)
-> Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of c) m r
zipWith (,)
{-# INLINE zip #-}

-- | Zip two 'Stream's using the provided combining function
zipWith :: Monad m
    => (a -> b -> c)
    -> Stream (Of a) m r
    -> Stream (Of b) m r
    -> Stream (Of c) m r
zipWith :: (a -> b -> c)
-> Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of c) m r
zipWith a -> b -> c
f = Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of c) m r
loop
  where
    loop :: Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of c) m r
loop Stream (Of a) m r
str0 Stream (Of b) m r
str1 = case Stream (Of a) m r
str0 of
      Return r
r          -> r -> Stream (Of c) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m           -> m (Stream (Of c) m r) -> Stream (Of c) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of c) m r) -> Stream (Of c) m r)
-> m (Stream (Of c) m r) -> Stream (Of c) m r
forall a b. (a -> b) -> a -> b
$ (Stream (Of a) m r -> Stream (Of c) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of c) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Stream (Of a) m r
str -> Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of c) m r
loop Stream (Of a) m r
str Stream (Of b) m r
str1) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
rest0) -> case Stream (Of b) m r
str1 of
        Return r
r          -> r -> Stream (Of c) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
        Effect m (Stream (Of b) m r)
m           -> m (Stream (Of c) m r) -> Stream (Of c) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of c) m r) -> Stream (Of c) m r)
-> m (Stream (Of c) m r) -> Stream (Of c) m r
forall a b. (a -> b) -> a -> b
$ (Stream (Of b) m r -> Stream (Of c) m r)
-> m (Stream (Of b) m r) -> m (Stream (Of c) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of c) m r
loop Stream (Of a) m r
str0) m (Stream (Of b) m r)
m
        Step (b
b :> Stream (Of b) m r
rest1) -> Of c (Stream (Of c) m r) -> Stream (Of c) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a -> b -> c
f a
a b
b c -> Stream (Of c) m r -> Of c (Stream (Of c) m r)
forall a b. a -> b -> Of a b
:>Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of c) m r
loop Stream (Of a) m r
rest0 Stream (Of b) m r
rest1)
{-# INLINABLE zipWith #-}


-- | Zip three 'Stream's with a combining function
zipWith3 :: Monad m =>
       (a -> b -> c -> d)
       -> Stream (Of a) m r
       -> Stream (Of b) m r
       -> Stream (Of c) m r
       -> Stream (Of d) m r
zipWith3 :: (a -> b -> c -> d)
-> Stream (Of a) m r
-> Stream (Of b) m r
-> Stream (Of c) m r
-> Stream (Of d) m r
zipWith3 a -> b -> c -> d
op = Stream (Of a) m r
-> Stream (Of b) m r -> Stream (Of c) m r -> Stream (Of d) m r
loop where
  loop :: Stream (Of a) m r
-> Stream (Of b) m r -> Stream (Of c) m r -> Stream (Of d) m r
loop Stream (Of a) m r
str0 Stream (Of b) m r
str1 Stream (Of c) m r
str2 = do
    Either r (a, Stream (Of a) m r)
e0 <- m (Either r (a, Stream (Of a) m r))
-> Stream (Of d) m (Either r (a, Stream (Of a) m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next Stream (Of a) m r
str0)
    case Either r (a, Stream (Of a) m r)
e0 of
      Left r
r0 -> r -> Stream (Of d) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r0
      Right (a
a0,Stream (Of a) m r
rest0) -> do
        Either r (b, Stream (Of b) m r)
e1 <- m (Either r (b, Stream (Of b) m r))
-> Stream (Of d) m (Either r (b, Stream (Of b) m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream (Of b) m r -> m (Either r (b, Stream (Of b) m r))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next Stream (Of b) m r
str1)
        case Either r (b, Stream (Of b) m r)
e1 of
          Left r
r1 -> r -> Stream (Of d) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r1
          Right (b
a1,Stream (Of b) m r
rest1) -> do
            Either r (c, Stream (Of c) m r)
e2 <- m (Either r (c, Stream (Of c) m r))
-> Stream (Of d) m (Either r (c, Stream (Of c) m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream (Of c) m r -> m (Either r (c, Stream (Of c) m r))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next Stream (Of c) m r
str2)
            case Either r (c, Stream (Of c) m r)
e2 of
              Left r
r2 -> r -> Stream (Of d) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r2
              Right (c
a2,Stream (Of c) m r
rest2) -> do
                d -> Stream (Of d) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield (a -> b -> c -> d
op a
a0 b
a1 c
a2)
                Stream (Of a) m r
-> Stream (Of b) m r -> Stream (Of c) m r -> Stream (Of d) m r
loop Stream (Of a) m r
rest0 Stream (Of b) m r
rest1 Stream (Of c) m r
rest2
{-# INLINABLE zipWith3 #-}


-- | Zip three 'Stream's together
zip3 :: Monad m
     => Stream (Of a) m r
     -> Stream (Of b) m r
     -> Stream (Of c) m r
     -> Stream (Of (a,b,c)) m r
zip3 :: Stream (Of a) m r
-> Stream (Of b) m r
-> Stream (Of c) m r
-> Stream (Of (a, b, c)) m r
zip3 = (a -> b -> c -> (a, b, c))
-> Stream (Of a) m r
-> Stream (Of b) m r
-> Stream (Of c) m r
-> Stream (Of (a, b, c)) m r
forall (m :: * -> *) a b c d r.
Monad m =>
(a -> b -> c -> d)
-> Stream (Of a) m r
-> Stream (Of b) m r
-> Stream (Of c) m r
-> Stream (Of d) m r
zipWith3 (,,)
{-# INLINABLE zip3 #-}

-- --------------
-- IO fripperies
-- --------------

{-| View standard input as a @Stream (Of String) m r@. By contrast, 'stdoutLn' renders a @Stream (Of String) m r@ to standard output. The names
    follow @Pipes.Prelude@

>>> stdoutLn stdinLn
hello<Enter>
hello
world<Enter>
world
^CInterrupted.


>>> stdoutLn $ S.map reverse stdinLn
hello<Enter>
olleh
world<Enter>
dlrow
^CInterrupted.

-}
stdinLn :: MonadIO m => Stream (Of String) m ()
stdinLn :: Stream (Of String) m ()
stdinLn = Handle -> Stream (Of String) m ()
forall (m :: * -> *).
MonadIO m =>
Handle -> Stream (Of String) m ()
fromHandle Handle
IO.stdin
{-# INLINABLE stdinLn #-}

{-| Read values from 'IO.stdin', ignoring failed parses.

>>> :set -XTypeApplications
>>> S.sum $ S.take 2 (S.readLn @IO @Int)
10<Enter>
12<Enter>
22 :> ()

>>> S.toList $ S.take 2 (S.readLn @IO @Int)
10<Enter>
1@#$%^&*\<Enter>
12<Enter>
[10,12] :> ()

-}

readLn :: (MonadIO m, Read a) => Stream (Of a) m ()
readLn :: Stream (Of a) m ()
readLn = Stream (Of a) m ()
loop where
  loop :: Stream (Of a) m ()
loop = do
    Bool
eof <- IO Bool -> Stream (Of a) m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
IO.isEOF
    Bool -> Stream (Of a) m () -> Stream (Of a) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
eof (Stream (Of a) m () -> Stream (Of a) m ())
-> Stream (Of a) m () -> Stream (Of a) m ()
forall a b. (a -> b) -> a -> b
$ do
      String
str <- IO String -> Stream (Of a) m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getLine
      case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
str of
        Maybe a
Nothing -> Stream (Of a) m ()
forall (m :: * -> *) a. (MonadIO m, Read a) => Stream (Of a) m ()
readLn
        Just a
n  -> a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
n Stream (Of a) m () -> Stream (Of a) m () -> Stream (Of a) m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream (Of a) m ()
loop
{-# INLINABLE readLn #-}


{-| Read 'String's from a 'IO.Handle' using 'IO.hGetLine'

    Terminates on end of input

>>> IO.withFile "/usr/share/dict/words" IO.ReadMode $ S.stdoutLn . S.take 3 . S.drop 50000 . S.fromHandle
deflagrator
deflate
deflation

-}
fromHandle :: MonadIO m => IO.Handle -> Stream (Of String) m ()
fromHandle :: Handle -> Stream (Of String) m ()
fromHandle Handle
h = Stream (Of String) m ()
go
  where
    go :: Stream (Of String) m ()
go = do
        Bool
eof <- IO Bool -> Stream (Of String) m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Stream (Of String) m Bool)
-> IO Bool -> Stream (Of String) m Bool
forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
IO.hIsEOF Handle
h
        Bool -> Stream (Of String) m () -> Stream (Of String) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
eof (Stream (Of String) m () -> Stream (Of String) m ())
-> Stream (Of String) m () -> Stream (Of String) m ()
forall a b. (a -> b) -> a -> b
$ do
            String
str <- IO String -> Stream (Of String) m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Stream (Of String) m String)
-> IO String -> Stream (Of String) m String
forall a b. (a -> b) -> a -> b
$ Handle -> IO String
IO.hGetLine Handle
h
            String -> Stream (Of String) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield String
str
            Stream (Of String) m ()
go
{-# INLINABLE fromHandle #-}

{-| Write a succession of strings to a handle as separate lines.

>>> S.toHandle IO.stdout $ each (words "one two three")
one
two
three
-}
toHandle :: MonadIO m => IO.Handle -> Stream (Of String) m r -> m r
toHandle :: Handle -> Stream (Of String) m r -> m r
toHandle Handle
handle = Stream (Of String) m r -> m r
loop where
  loop :: Stream (Of String) m r -> m r
loop Stream (Of String) m r
str = case Stream (Of String) m r
str of
    Return r
r         -> r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
    Effect m (Stream (Of String) m r)
m          -> m (Stream (Of String) m r)
m m (Stream (Of String) m r)
-> (Stream (Of String) m r -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of String) m r -> m r
loop
    Step (String
s :> Stream (Of String) m r
rest) -> do
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
IO.hPutStrLn Handle
handle String
s)
      Stream (Of String) m r -> m r
loop Stream (Of String) m r
rest
{-# INLINABLE toHandle #-}

{-| Print the elements of a stream as they arise.

>>> S.print $ S.take 2 S.stdinLn
hello<Enter>
"hello"
world<Enter>
"world"

-}
print :: (MonadIO m, Show a) => Stream (Of a) m r -> m r
print :: Stream (Of a) m r -> m r
print = Stream (Of a) m r -> m r
forall (m :: * -> *) a a.
(MonadIO m, Show a) =>
Stream (Of a) m a -> m a
loop where
  loop :: Stream (Of a) m a -> m a
loop Stream (Of a) m a
stream = case Stream (Of a) m a
stream of
    Return a
r         -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
    Effect m (Stream (Of a) m a)
m         -> m (Stream (Of a) m a)
m m (Stream (Of a) m a) -> (Stream (Of a) m a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of a) m a -> m a
loop
    Step (a
a :> Stream (Of a) m a
rest) -> do
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO ()
forall a. Show a => a -> IO ()
Prelude.print a
a)
      Stream (Of a) m a -> m a
loop Stream (Of a) m a
rest


{-| Write 'String's to 'IO.stdout' using 'putStrLn'; terminates on a broken output pipe
    (The name and implementation are modelled on the @Pipes.Prelude@ @stdoutLn@).

>>> S.stdoutLn $ S.take 3 $ S.each $ words "one two three four five"
one
two
three
-}
stdoutLn :: MonadIO m => Stream (Of String) m () -> m ()
stdoutLn :: Stream (Of String) m () -> m ()
stdoutLn = Stream (Of String) m () -> m ()
forall (m :: * -> *) r. MonadIO m => Stream (Of String) m r -> m ()
loop
  where
    loop :: Stream (Of String) m r -> m ()
loop Stream (Of String) m r
stream = case Stream (Of String) m r
stream of
      Return r
_         -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Effect m (Stream (Of String) m r)
m          -> m (Stream (Of String) m r)
m m (Stream (Of String) m r)
-> (Stream (Of String) m r -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream (Of String) m r -> m ()
loop
      Step (String
s :> Stream (Of String) m r
rest) -> do
        Either IOException ()
x   <- IO (Either IOException ()) -> m (Either IOException ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ()) -> m (Either IOException ()))
-> IO (Either IOException ()) -> m (Either IOException ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO ()
putStrLn String
s)
        case Either IOException ()
x of
           Left (G.IOError { ioe_type :: IOException -> IOErrorType
G.ioe_type  = IOErrorType
G.ResourceVanished
                           , ioe_errno :: IOException -> Maybe CInt
G.ioe_errno = Just CInt
ioe })
                | CInt -> Errno
Errno CInt
ioe Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
ePIPE
                    -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           Left  IOException
e  -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e)
           Right () -> Stream (Of String) m r -> m ()
loop Stream (Of String) m r
rest
{-# INLINABLE stdoutLn #-}

{-| Read the lines of a file, using a function of the type: \'@'Stream' ('Of' 'String') 'IO' () -> 'IO' a@\'
    to turn the stream into a value of type \''IO' a\'.

>>> S.writeFile "lines.txt" $ S.take 2 S.stdinLn
hello<Enter>
world<Enter>
>>> S.readFile "lines.txt" S.print
"hello"
"world"

-}
readFile :: FilePath -> (Stream (Of String) IO () -> IO a) -> IO a
readFile :: String -> (Stream (Of String) IO () -> IO a) -> IO a
readFile String
f Stream (Of String) IO () -> IO a
s = String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile String
f IOMode
IO.ReadMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Stream (Of String) IO () -> IO a
s (Handle -> Stream (Of String) IO ()
forall (m :: * -> *).
MonadIO m =>
Handle -> Stream (Of String) m ()
fromHandle Handle
h)

{-| Write a series of 'String's as lines to a file.

>>> S.writeFile "lines.txt" $ S.take 2 S.stdinLn
hello<Enter>
world<Enter>

>>> S.readFile "lines.txt" S.stdoutLn
hello
world

-}
writeFile :: FilePath -> Stream (Of String) IO r -> IO r
writeFile :: String -> Stream (Of String) IO r -> IO r
writeFile String
f = String -> IOMode -> (Handle -> IO r) -> IO r
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile String
f IOMode
IO.WriteMode ((Handle -> IO r) -> IO r)
-> (Stream (Of String) IO r -> Handle -> IO r)
-> Stream (Of String) IO r
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> Stream (Of String) IO r -> IO r)
-> Stream (Of String) IO r -> Handle -> IO r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> Stream (Of String) IO r -> IO r
forall (m :: * -> *) r.
MonadIO m =>
Handle -> Stream (Of String) m r -> m r
toHandle

{-| Write 'String's to 'IO.stdout' using 'putStrLn'

    Unlike @stdoutLn@, @stdoutLn'@ does not handle a broken output pipe. Thus it can have a polymorphic return
    value, rather than @()@, and this kind of \"connect and resume\" is possible:

>>> rest <- S.stdoutLn' $ S.show $ S.splitAt 3 (each [1..5])
1
2
3
>>> S.toList rest
[4,5] :> ()

-}

stdoutLn' :: MonadIO m => Stream (Of String) m r -> m r
stdoutLn' :: Stream (Of String) m r -> m r
stdoutLn' = Handle -> Stream (Of String) m r -> m r
forall (m :: * -> *) r.
MonadIO m =>
Handle -> Stream (Of String) m r -> m r
toHandle Handle
IO.stdout

distinguish :: (a -> Bool) -> Of a r -> Sum (Of a) (Of a) r
distinguish :: (a -> Bool) -> Of a r -> Sum (Of a) (Of a) r
distinguish a -> Bool
predicate (a
a :> r
b) = if a -> Bool
predicate a
a then Of a r -> Sum (Of a) (Of a) r
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (a
a a -> r -> Of a r
forall a b. a -> b -> Of a b
:> r
b) else Of a r -> Sum (Of a) (Of a) r
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (a
a a -> r -> Of a r
forall a b. a -> b -> Of a b
:> r
b)
{-# INLINE distinguish #-}

sumToEither ::Sum (Of a) (Of b) r ->  Of (Either a b) r
sumToEither :: Sum (Of a) (Of b) r -> Of (Either a b) r
sumToEither Sum (Of a) (Of b) r
s = case Sum (Of a) (Of b) r
s of
  InL (a
a :> r
r) -> a -> Either a b
forall a b. a -> Either a b
Left a
a Either a b -> r -> Of (Either a b) r
forall a b. a -> b -> Of a b
:> r
r
  InR (b
b :> r
r) -> b -> Either a b
forall a b. b -> Either a b
Right b
b Either a b -> r -> Of (Either a b) r
forall a b. a -> b -> Of a b
:> r
r
{-# INLINE sumToEither #-}

eitherToSum :: Of (Either a b) r -> Sum (Of a) (Of b) r
eitherToSum :: Of (Either a b) r -> Sum (Of a) (Of b) r
eitherToSum Of (Either a b) r
s = case Of (Either a b) r
s of
  Left a
a :> r
r  -> Of a r -> Sum (Of a) (Of b) r
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (a
a a -> r -> Of a r
forall a b. a -> b -> Of a b
:> r
r)
  Right b
b :> r
r -> Of b r -> Sum (Of a) (Of b) r
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (b
b b -> r -> Of b r
forall a b. a -> b -> Of a b
:> r
r)
{-# INLINE eitherToSum #-}

composeToSum ::  Compose (Of Bool) f r -> Sum f f r
composeToSum :: Compose (Of Bool) f r -> Sum f f r
composeToSum Compose (Of Bool) f r
x = case Compose (Of Bool) f r
x of
  Compose (Bool
True :> f r
f) -> f r -> Sum f f r
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR f r
f
  Compose (Bool
False :> f r
f) -> f r -> Sum f f r
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL f r
f
{-# INLINE composeToSum #-}

sumToCompose :: Sum f f r -> Compose (Of Bool) f r
sumToCompose :: Sum f f r -> Compose (Of Bool) f r
sumToCompose Sum f f r
x = case Sum f f r
x of
  InR f r
f -> Of Bool (f r) -> Compose (Of Bool) f r
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Bool
True Bool -> f r -> Of Bool (f r)
forall a b. a -> b -> Of a b
:> f r
f)
  InL f r
f -> Of Bool (f r) -> Compose (Of Bool) f r
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Bool
False Bool -> f r -> Of Bool (f r)
forall a b. a -> b -> Of a b
:> f r
f)
{-# INLINE sumToCompose #-}

{-| Store the result of any suitable fold over a stream, keeping the stream for
    further manipulation. @store f = f . copy@ :

>>> S.print $ S.store S.product $ each [1..4]
1
2
3
4
24 :> ()

>>> S.print $ S.store S.sum $ S.store S.product $ each [1..4]
1
2
3
4
10 :> (24 :> ())

   Here the sum (10) and the product (24) have been \'stored\' for use when
   finally we have traversed the stream with 'print' . Needless to say,
   a second 'pass' is excluded conceptually, so the
   folds that you apply successively with @store@ are performed
   simultaneously, and in constant memory -- as they would be if,
   say, you linked them together with @Control.Fold@:

>>> L.impurely S.foldM (liftA3 (\a b c -> (b, c)) (L.sink Prelude.print) (L.generalize L.sum) (L.generalize L.product)) $ each [1..4]
1
2
3
4
(10,24) :> ()

   Fusing folds after the fashion of @Control.Foldl@ will generally be a bit faster
   than the corresponding succession of uses of 'store', but by
   constant factor that will be completely dwarfed when any IO is at issue.

   But 'store' \/ 'copy' is /much/ more powerful, as you can see by reflecting on
   uses like this:

>>> S.sum $ S.store (S.sum . mapped S.product . chunksOf 2) $ S.store (S.product . mapped S.sum . chunksOf 2) $ each [1..6]
21 :> (44 :> (231 :> ()))

   It will be clear that this cannot be reproduced with any combination of lenses,
   @Control.Fold@ folds, or the like.  (See also the discussion of 'copy'.)

   It would conceivably be clearer to import a series of specializations of 'store'.
   It is intended to be used at types like these:

> storeM ::  (forall s m . Monad m => Stream (Of a) m s -> m (Of b s))
>         -> (Monad n => Stream (Of a) n r -> Stream (Of a) n (Of b r))
> storeM = store
>
> storeMIO :: (forall s m . MonadIO m => Stream (Of a) m s -> m (Of b s))
>          -> (MonadIO n => Stream (Of a) n r -> Stream (Of a) n (Of b r)
> storeMIO = store

    It is clear from these types that we are just using the general instances:

> instance (Functor f, Monad m)   => Monad (Stream f m)
> instance (Functor f, MonadIO m) => MonadIO (Stream f m)

    We thus can't be touching the elements of the stream, or the final return value.
    It is the same with other constraints that @Stream (Of a)@ inherits from the underlying monad,
    like 'MonadResource'.  Thus I can independently filter and write to one file, but
    nub and write to another, or interact with a database and a logfile and the like:

>>> (S.writeFile "hello2.txt" . S.nubOrd) $ store (S.writeFile "hello.txt" . S.filter (/= "world")) $ each ["hello", "world", "goodbye", "world"]
>>> :! cat hello.txt
hello
goodbye
>>> :! cat hello2.txt
hello
world
goodbye


-}
store
  :: Monad m =>
     (Stream (Of a) (Stream (Of a) m) r -> t) -> Stream (Of a) m r -> t
store :: (Stream (Of a) (Stream (Of a) m) r -> t) -> Stream (Of a) m r -> t
store Stream (Of a) (Stream (Of a) m) r -> t
f Stream (Of a) m r
x = Stream (Of a) (Stream (Of a) m) r -> t
f (Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
copy Stream (Of a) m r
x)
{-# INLINE store #-}

{-| Duplicate the content of stream, so that it can be acted on twice in different ways,
    but without breaking streaming. Thus, with @each [1,2]@ I might do:

>>> S.print $ each ["one","two"]
"one"
"two"
>>> S.stdoutLn $ each ["one","two"]
one
two

    With copy, I can do these simultaneously:

>>> S.print $ S.stdoutLn $ S.copy $ each ["one","two"]
"one"
one
"two"
two

    'copy' should be understood together with 'effects' and is subject to the rules

> S.effects . S.copy       = id
> hoist S.effects . S.copy = id

    The similar operations in 'Data.ByteString.Streaming' obey the same rules.

    Where the actions you are contemplating are each simple folds over
    the elements, or a selection of elements, then the coupling of the
    folds is often more straightforwardly effected with `Control.Foldl`,
    e.g.

>>> L.purely S.fold (liftA2 (,) L.sum L.product) $ each [1..10]
(55,3628800) :> ()

    rather than

>>> S.sum $ S.product . S.copy $ each [1..10]
55 :> (3628800 :> ())

    A @Control.Foldl@ fold can be altered to act on a selection of elements by
    using 'Control.Foldl.handles' on an appropriate lens. Some such
    manipulations are simpler and more 'Data.List'-like, using 'copy':

>>> L.purely S.fold (liftA2 (,) (L.handles (L.filtered odd) L.sum) (L.handles (L.filtered even) L.product)) $ each [1..10]
(25,3840) :> ()

     becomes

>>> S.sum $ S.filter odd $ S.product $ S.filter even $ S.copy $ each [1..10]
25 :> (3840 :> ())

    or using 'store'

>>> S.sum $ S.filter odd $ S.store (S.product . S.filter even) $ each [1..10]
25 :> (3840 :> ())

    But anything that fold of a @Stream (Of a) m r@ into e.g. an @m (Of b r)@
    that has a constraint on @m@ that is carried over into @Stream f m@ -
    e.g. @Monad@, @MonadIO@, @MonadResource@, etc. can be used on the stream.
    Thus, I can fold over different groupings of the original stream:

>>>  (S.toList . mapped S.toList . chunksOf 5) $  (S.toList . mapped S.toList . chunksOf 3) $ S.copy $ each [1..10]
[[1,2,3,4,5],[6,7,8,9,10]] :> ([[1,2,3],[4,5,6],[7,8,9],[10]] :> ())

    The procedure can be iterated as one pleases, as one can see from this (otherwise unadvisable!) example:

>>>  (S.toList . mapped S.toList . chunksOf 4) $ (S.toList . mapped S.toList . chunksOf 3) $ S.copy $ (S.toList . mapped S.toList . chunksOf 2) $ S.copy $ each [1..12]
[[1,2,3,4],[5,6,7,8],[9,10,11,12]] :> ([[1,2,3],[4,5,6],[7,8,9],[10,11,12]] :> ([[1,2],[3,4],[5,6],[7,8],[9,10],[11,12]] :> ()))


@copy@ can be considered a special case of 'expand':

@
  copy = 'expand' $ \\p (a :> as) -> a :> p (a :> as)
@

If 'Of' were an instance of 'Control.Comonad.Comonad', then one could write

@
  copy = 'expand' extend
@
-}
copy
  :: Monad m =>
     Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
copy :: Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
copy = Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
 -> Stream (Of a) (Stream (Of a) m) r)
-> (Stream (Of a) m r
    -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
-> Stream (Of a) m r
-> Stream (Of a) (Stream (Of a) m) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream (Of a) (Stream (Of a) m) r
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream (Of a) (Stream (Of a) m) r
 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
-> (Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) m r
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
loop where
  loop :: Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of a) m r
str = case Stream (Of a) m r
str of
    Return r
r         -> r -> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m         -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) m (Stream (Of a) m r)
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
loop (m (Stream (Of a) m r) -> Stream (Of a) m (Stream (Of a) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Stream (Of a) m r)
m))
    Step (a
a :> Stream (Of a) m r
rest) -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Of a (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Of a (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
forall a b. a -> b -> Of a b
:> Stream (Of a) (Stream (Of a) m) r
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (Of a (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) (Stream (Of a) m) r
-> Of a (Stream (Of a) (Stream (Of a) m) r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of a) m r
rest))))
{-# INLINABLE copy#-}

{-| An alias for @copy@.
-}
duplicate
  :: Monad m =>
     Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
duplicate :: Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
duplicate = Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r
copy
{-# INLINE duplicate #-}

{-| The type

> Data.List.unzip     :: [(a,b)] -> ([a],[b])

   might lead us to expect

> Streaming.unzip :: Stream (Of (a,b)) m r -> Stream (Of a) m (Stream (Of b) m r)

   which would not stream, since it would have to accumulate the second stream (of @b@s).
   Of course, @Data.List@ 'Data.List.unzip' doesn't stream either.

   This @unzip@ does
   stream, though of course you can spoil this by using e.g. 'toList':

>>> let xs = Prelude.map (\x -> (x, Prelude.show x)) [1..5 :: Int]

>>> S.toList $ S.toList $ S.unzip (S.each xs)
["1","2","3","4","5"] :> ([1,2,3,4,5] :> ())

>>> Prelude.unzip xs
([1,2,3,4,5],["1","2","3","4","5"])

    Note the difference of order in the results. It may be of some use to think why.
    The first application of 'toList' was applied to a stream of integers:

>>> :t S.unzip $ S.each xs
S.unzip $ S.each xs :: Monad m => Stream (Of Int) (Stream (Of String) m) ()

    Like any fold, 'toList' takes no notice of the monad of effects.

> toList :: Monad m => Stream (Of a) m r -> m (Of [a] r)

    In the case at hand (since I am in @ghci@) @m = Stream (Of String) IO@.
    So when I apply 'toList', I exhaust that stream of integers, folding
    it into a list:

>>> :t S.toList $ S.unzip $ S.each xs
S.toList $ S.unzip $ S.each xs
  :: Monad m => Stream (Of String) m (Of [Int] ())

    When I apply 'toList' to /this/, I reduce everything to an ordinary action in @IO@,
    and return a list of strings:

>>> S.toList $ S.toList $ S.unzip (S.each xs)
["1","2","3","4","5"] :> ([1,2,3,4,5] :> ())

'unzip' can be considered a special case of either 'unzips' or 'expand':

@
  unzip = 'unzips' . 'maps' (\\((a,b) :> x) -> Compose (a :> b :> x))
  unzip = 'expand' $ \\p ((a,b) :> abs) -> b :> p (a :> abs)
@
-}
unzip :: Monad m =>  Stream (Of (a,b)) m r -> Stream (Of a) (Stream (Of b) m) r
unzip :: Stream (Of (a, b)) m r -> Stream (Of a) (Stream (Of b) m) r
unzip = Stream (Of (a, b)) m r -> Stream (Of a) (Stream (Of b) m) r
forall (m :: * -> *) a a r.
Monad m =>
Stream (Of (a, a)) m r -> Stream (Of a) (Stream (Of a) m) r
loop where
 loop :: Stream (Of (a, a)) m r -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of (a, a)) m r
str = case Stream (Of (a, a)) m r
str of
   Return r
r -> r -> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
   Effect m (Stream (Of (a, a)) m r)
m -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of (a, a)) m r -> Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) m (Stream (Of (a, a)) m r)
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of (a, a)) m r -> Stream (Of a) (Stream (Of a) m) r
loop (m (Stream (Of (a, a)) m r)
-> Stream (Of a) m (Stream (Of (a, a)) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Stream (Of (a, a)) m r)
m))
   Step ((a
a,a
b):> Stream (Of (a, a)) m r
rest) -> Of a (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) (Stream (Of a) m) r
-> Of a (Stream (Of a) (Stream (Of a) m) r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Stream (Of a) (Stream (Of a) m) r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Of a (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
b a
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
-> Of a (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
forall a b. a -> b -> Of a b
:> Stream (Of a) (Stream (Of a) m) r
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (Stream (Of (a, a)) m r -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of (a, a)) m r
rest))))
{-# INLINABLE unzip #-}



{- $merging
   These functions combine two sorted streams of orderable elements
   into one sorted stream. The elements of the merged stream are
   guaranteed to be in a sorted order if the two input streams are
   also sorted.

   The merge operation is /left-biased/: when merging two elements
   that compare as equal, the left element is chosen first.
-}

{- | Merge two streams of elements ordered with their 'Ord' instance.

   The return values of both streams are returned.

>>> S.print $ merge (each [1,3,5]) (each [2,4])
1
2
3
4
5
((), ())

-}
merge :: (Monad m, Ord a)
  => Stream (Of a) m r
  -> Stream (Of a) m s
  -> Stream (Of a) m (r, s)
merge :: Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
merge = (a -> a -> Ordering)
-> Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
forall (m :: * -> *) a r s.
Monad m =>
(a -> a -> Ordering)
-> Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
mergeBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE merge #-}

{- | Merge two streams, ordering them by applying the given function to
   each element before comparing.

   The return values of both streams are returned.
-}
mergeOn :: (Monad m, Ord b)
  => (a -> b)
  -> Stream (Of a) m r
  -> Stream (Of a) m s
  -> Stream (Of a) m (r, s)
mergeOn :: (a -> b)
-> Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
mergeOn a -> b
f = (a -> a -> Ordering)
-> Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
forall (m :: * -> *) a r s.
Monad m =>
(a -> a -> Ordering)
-> Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
mergeBy ((a -> b) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> b
f)
{-# INLINE mergeOn #-}

{- | Merge two streams, ordering the elements using the given comparison function.

   The return values of both streams are returned.
-}
mergeBy :: Monad m
  => (a -> a -> Ordering)
  -> Stream (Of a) m r
  -> Stream (Of a) m s
  -> Stream (Of a) m (r, s)
mergeBy :: (a -> a -> Ordering)
-> Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
mergeBy a -> a -> Ordering
cmp = Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
loop
  where
    loop :: Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
loop Stream (Of a) m r
str0 Stream (Of a) m s
str1 = case Stream (Of a) m r
str0 of
      Return r
r0         -> (\ s
r1 -> (r
r0, s
r1)) (s -> (r, s)) -> Stream (Of a) m s -> Stream (Of a) m (r, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream (Of a) m s
str1
      Effect m (Stream (Of a) m r)
m          -> m (Stream (Of a) m (r, s)) -> Stream (Of a) m (r, s)
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m (r, s)) -> Stream (Of a) m (r, s))
-> m (Stream (Of a) m (r, s)) -> Stream (Of a) m (r, s)
forall a b. (a -> b) -> a -> b
$ (Stream (Of a) m r -> Stream (Of a) m (r, s))
-> m (Stream (Of a) m r) -> m (Stream (Of a) m (r, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Stream (Of a) m r
str -> Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
loop Stream (Of a) m r
str Stream (Of a) m s
str1) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
rest0) -> case Stream (Of a) m s
str1 of
        Return s
r1         -> (\ r
r0 -> (r
r0, s
r1)) (r -> (r, s)) -> Stream (Of a) m r -> Stream (Of a) m (r, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream (Of a) m r
str0
        Effect m (Stream (Of a) m s)
m          -> m (Stream (Of a) m (r, s)) -> Stream (Of a) m (r, s)
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m (r, s)) -> Stream (Of a) m (r, s))
-> m (Stream (Of a) m (r, s)) -> Stream (Of a) m (r, s)
forall a b. (a -> b) -> a -> b
$ (Stream (Of a) m s -> Stream (Of a) m (r, s))
-> m (Stream (Of a) m s) -> m (Stream (Of a) m (r, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
loop Stream (Of a) m r
str0) m (Stream (Of a) m s)
m
        Step (a
b :> Stream (Of a) m s
rest1) -> case a -> a -> Ordering
cmp a
a a
b of
          Ordering
LT -> Of a (Stream (Of a) m (r, s)) -> Stream (Of a) m (r, s)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m (r, s) -> Of a (Stream (Of a) m (r, s))
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
loop Stream (Of a) m r
rest0 Stream (Of a) m s
str1)
          Ordering
EQ -> Of a (Stream (Of a) m (r, s)) -> Stream (Of a) m (r, s)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m (r, s) -> Of a (Stream (Of a) m (r, s))
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
loop Stream (Of a) m r
rest0 Stream (Of a) m s
str1) -- left-biased
          Ordering
GT -> Of a (Stream (Of a) m (r, s)) -> Stream (Of a) m (r, s)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
b a -> Stream (Of a) m (r, s) -> Of a (Stream (Of a) m (r, s))
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of a) m s -> Stream (Of a) m (r, s)
loop Stream (Of a) m r
str0 Stream (Of a) m s
rest1)
{-# INLINABLE mergeBy #-}

{- $maybes
    These functions discard the 'Nothing's that they encounter. They are analogous
    to the functions from @Data.Maybe@ that share their names.
-}

{-| The 'catMaybes' function takes a 'Stream' of 'Maybe's and returns
    a 'Stream' of all of the 'Just' values. 'concat' has the same behavior,
    but is more general; it works for any foldable container type.
-}
catMaybes :: Monad m => Stream (Of (Maybe a)) m r -> Stream (Of a) m r
catMaybes :: Stream (Of (Maybe a)) m r -> Stream (Of a) m r
catMaybes = Stream (Of (Maybe a)) m r -> Stream (Of a) m r
forall (m :: * -> *) a r.
Functor m =>
Stream (Of (Maybe a)) m r -> Stream (Of a) m r
loop where
  loop :: Stream (Of (Maybe a)) m r -> Stream (Of a) m r
loop Stream (Of (Maybe a)) m r
stream = case Stream (Of (Maybe a)) m r
stream of
    Return r
r -> r -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of (Maybe a)) m r)
m -> m (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of (Maybe a)) m r -> Stream (Of a) m r)
-> m (Stream (Of (Maybe a)) m r) -> m (Stream (Of a) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of (Maybe a)) m r -> Stream (Of a) m r
loop m (Stream (Of (Maybe a)) m r)
m)
    Step (Maybe a
ma :> Stream (Of (Maybe a)) m r
snext) -> case Maybe a
ma of
      Maybe a
Nothing -> Stream (Of (Maybe a)) m r -> Stream (Of a) m r
loop Stream (Of (Maybe a)) m r
snext
      Just a
a -> Of a (Stream (Of a) m r) -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) m r -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of (Maybe a)) m r -> Stream (Of a) m r
loop Stream (Of (Maybe a)) m r
snext)
{-# INLINABLE catMaybes #-}

{-| The 'mapMaybe' function is a version of 'map' which can throw out elements. In particular,
    the functional argument returns something of type @'Maybe' b@. If this is 'Nothing', no element
    is added on to the result 'Stream'. If it is @'Just' b@, then @b@ is included in the result 'Stream'.

-}
mapMaybe :: Monad m => (a -> Maybe b) -> Stream (Of a) m r -> Stream (Of b) m r
mapMaybe :: (a -> Maybe b) -> Stream (Of a) m r -> Stream (Of b) m r
mapMaybe a -> Maybe b
phi = Stream (Of a) m r -> Stream (Of b) m r
loop where
  loop :: Stream (Of a) m r -> Stream (Of b) m r
loop Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
    Return r
r -> r -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of b) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of b) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of b) m r
loop m (Stream (Of a) m r)
m)
    Step (a
a :> Stream (Of a) m r
snext) -> case a -> Maybe b
phi a
a of
      Maybe b
Nothing -> Stream (Of a) m r -> Stream (Of b) m r
loop Stream (Of a) m r
snext
      Just b
b -> Of b (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (b
b b -> Stream (Of b) m r -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of b) m r
loop Stream (Of a) m r
snext)
{-# INLINABLE mapMaybe #-}

{-| 'slidingWindow' accumulates the first @n@ elements of a stream,
     update thereafter to form a sliding window of length @n@.
     It follows the behavior of the slidingWindow function in
     <https://hackage.haskell.org/package/conduit-combinators-1.0.4/docs/Data-Conduit-Combinators.html#v:slidingWindow conduit-combinators>.

>>> S.print $ S.slidingWindow 4 $ S.each "123456"
fromList "1234"
fromList "2345"
fromList "3456"

-}

slidingWindow :: Monad m
  => Int
  -> Stream (Of a) m b
  -> Stream (Of (Seq.Seq a)) m b
slidingWindow :: Int -> Stream (Of a) m b -> Stream (Of (Seq a)) m b
slidingWindow Int
n = Int -> Seq a -> Stream (Of a) m b -> Stream (Of (Seq a)) m b
forall t (m :: * -> *) a b.
(Eq t, Num t, Monad m) =>
t -> Seq a -> Stream (Of a) m b -> Stream (Of (Seq a)) m b
setup (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n :: Int) Seq a
forall a. Monoid a => a
mempty
  where
    window :: Seq a -> Stream (Of a) m b -> Stream (Of (Seq a)) m b
window !Seq a
sequ Stream (Of a) m b
str = do
      Either b (a, Stream (Of a) m b)
e <- m (Either b (a, Stream (Of a) m b))
-> Stream (Of (Seq a)) m (Either b (a, Stream (Of a) m b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream (Of a) m b -> m (Either b (a, Stream (Of a) m b))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next Stream (Of a) m b
str)
      case Either b (a, Stream (Of a) m b)
e of
        Left b
r -> b -> Stream (Of (Seq a)) m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
        Right (a
a,Stream (Of a) m b
rest) -> do
          Seq a -> Stream (Of (Seq a)) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield (Seq a
sequ Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
a)
          Seq a -> Stream (Of a) m b -> Stream (Of (Seq a)) m b
window (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ Seq a
sequ Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
a) Stream (Of a) m b
rest
    setup :: t -> Seq a -> Stream (Of a) m b -> Stream (Of (Seq a)) m b
setup t
0 !Seq a
sequ Stream (Of a) m b
str = do
       Seq a -> Stream (Of (Seq a)) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield Seq a
sequ
       Seq a -> Stream (Of a) m b -> Stream (Of (Seq a)) m b
forall (m :: * -> *) a b.
Monad m =>
Seq a -> Stream (Of a) m b -> Stream (Of (Seq a)) m b
window (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq a
sequ) Stream (Of a) m b
str
    setup t
m Seq a
sequ Stream (Of a) m b
str = do
      Either b (a, Stream (Of a) m b)
e <- m (Either b (a, Stream (Of a) m b))
-> Stream (Of (Seq a)) m (Either b (a, Stream (Of a) m b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either b (a, Stream (Of a) m b))
 -> Stream (Of (Seq a)) m (Either b (a, Stream (Of a) m b)))
-> m (Either b (a, Stream (Of a) m b))
-> Stream (Of (Seq a)) m (Either b (a, Stream (Of a) m b))
forall a b. (a -> b) -> a -> b
$ Stream (Of a) m b -> m (Either b (a, Stream (Of a) m b))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next Stream (Of a) m b
str
      case Either b (a, Stream (Of a) m b)
e of
        Left b
r ->  Seq a -> Stream (Of (Seq a)) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield Seq a
sequ Stream (Of (Seq a)) m ()
-> Stream (Of (Seq a)) m b -> Stream (Of (Seq a)) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Stream (Of (Seq a)) m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
        Right (a
x,Stream (Of a) m b
rest) -> t -> Seq a -> Stream (Of a) m b -> Stream (Of (Seq a)) m b
setup (t
mt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (Seq a
sequ Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
x) Stream (Of a) m b
rest
{-# INLINABLE slidingWindow #-}

-- | 'slidingWindowMin' finds the minimum in every sliding window of @n@
-- elements of a stream. If within a window there are multiple elements that are
-- the least, it prefers the first occurrence (if you prefer to have the last
-- occurrence, use the max version and flip your comparator). It satisfies:
--
-- @
-- 'slidingWindowMin' n s = 'map' 'Foldable.minimum' ('slidingWindow' n s)
-- @
--
-- Except that it is far more efficient, especially when the window size is
-- large: it calls 'compare' /O(m)/ times overall where /m/ is the total number
-- of elements in the stream.
slidingWindowMin :: (Monad m, Ord a) => Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMin :: Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMin = (a -> a -> Ordering)
-> Int -> Stream (Of a) m b -> Stream (Of a) m b
forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Ordering)
-> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMinBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE slidingWindowMin #-}

-- | 'slidingWindowMax' finds the maximum in every sliding window of @n@
-- elements of a stream. If within a window there are multiple elements that are
-- the largest, it prefers the last occurrence (if you prefer to have the first
-- occurrence, use the min version and flip your comparator). It satisfies:
--
-- @
-- 'slidingWindowMax' n s = 'map' 'Foldable.maximum' ('slidingWindow' n s)
-- @
--
-- Except that it is far more efficient, especially when the window size is
-- large: it calls 'compare' /O(m)/ times overall where /m/ is the total number
-- of elements in the stream.
slidingWindowMax :: (Monad m, Ord a) => Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMax :: Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMax = (a -> a -> Ordering)
-> Int -> Stream (Of a) m b -> Stream (Of a) m b
forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Ordering)
-> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMaxBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE slidingWindowMax #-}

-- | 'slidingWindowMinBy' finds the minimum in every sliding window of @n@
-- elements of a stream according to the given comparison function (which should
-- define a total ordering). See notes above about elements that are equal. It
-- satisfies:
--
-- @
-- 'slidingWindowMinBy' f n s = 'map' ('Foldable.minimumBy' f) ('slidingWindow' n s)
-- @
--
-- Except that it is far more efficient, especially when the window size is
-- large: it calls the comparison function /O(m)/ times overall where /m/ is the
-- total number of elements in the stream.
slidingWindowMinBy :: Monad m => (a -> a -> Ordering) -> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMinBy :: (a -> a -> Ordering)
-> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMinBy a -> a -> Ordering
cmp = (a -> a)
-> (a -> a -> Bool)
-> Int
-> Stream (Of a) m b
-> Stream (Of a) m b
forall (m :: * -> *) a p b.
Monad m =>
(a -> p)
-> (p -> p -> Bool)
-> Int
-> Stream (Of a) m b
-> Stream (Of a) m b
slidingWindowOrd a -> a
forall a. a -> a
id (\a
a a
b -> a -> a -> Ordering
cmp a
a a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT)
{-# INLINE slidingWindowMinBy #-}

-- | 'slidingWindowMaxBy' finds the maximum in every sliding window of @n@
-- elements of a stream according to the given comparison function (which should
-- define a total ordering). See notes above about elements that are equal. It
-- satisfies:
--
-- @
-- 'slidingWindowMaxBy' f n s = 'map' ('Foldable.maximumBy' f) ('slidingWindow' n s)
-- @
--
-- Except that it is far more efficient, especially when the window size is
-- large: it calls the comparison function /O(m)/ times overall where /m/ is the
-- total number of elements in the stream.
slidingWindowMaxBy :: Monad m => (a -> a -> Ordering) -> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMaxBy :: (a -> a -> Ordering)
-> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMaxBy a -> a -> Ordering
cmp = (a -> a)
-> (a -> a -> Bool)
-> Int
-> Stream (Of a) m b
-> Stream (Of a) m b
forall (m :: * -> *) a p b.
Monad m =>
(a -> p)
-> (p -> p -> Bool)
-> Int
-> Stream (Of a) m b
-> Stream (Of a) m b
slidingWindowOrd a -> a
forall a. a -> a
id (\a
a a
b -> a -> a -> Ordering
cmp a
a a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT)
{-# INLINE slidingWindowMaxBy #-}

-- | 'slidingWindowMinOn' finds the minimum in every sliding window of @n@
-- elements of a stream according to the given projection function. See notes
-- above about elements that are equal. It satisfies:
--
-- @
-- 'slidingWindowMinOn' f n s = 'map' ('Foldable.minimumOn' ('comparing' f)) ('slidingWindow' n s)
-- @
--
-- Except that it is far more efficient, especially when the window size is
-- large: it calls 'compare' on the projected value /O(m)/ times overall where
-- /m/ is the total number of elements in the stream, and it calls the
-- projection function exactly /m/ times.
slidingWindowMinOn :: (Monad m, Ord p) => (a -> p) -> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMinOn :: (a -> p) -> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMinOn a -> p
proj = (a -> p)
-> (p -> p -> Bool)
-> Int
-> Stream (Of a) m b
-> Stream (Of a) m b
forall (m :: * -> *) a p b.
Monad m =>
(a -> p)
-> (p -> p -> Bool)
-> Int
-> Stream (Of a) m b
-> Stream (Of a) m b
slidingWindowOrd a -> p
proj (\p
a p
b -> p -> p -> Ordering
forall a. Ord a => a -> a -> Ordering
compare p
a p
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT)
{-# INLINE slidingWindowMinOn #-}

-- | 'slidingWindowMaxOn' finds the maximum in every sliding window of @n@
-- elements of a stream according to the given projection function. See notes
-- above about elements that are equal. It satisfies:
--
-- @
-- 'slidingWindowMaxOn' f n s = 'map' ('Foldable.maximumOn' ('comparing' f)) ('slidingWindow' n s)
-- @
--
-- Except that it is far more efficient, especially when the window size is
-- large: it calls 'compare' on the projected value /O(m)/ times overall where
-- /m/ is the total number of elements in the stream, and it calls the
-- projection function exactly /m/ times.
slidingWindowMaxOn :: (Monad m, Ord p) => (a -> p) -> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMaxOn :: (a -> p) -> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowMaxOn a -> p
proj = (a -> p)
-> (p -> p -> Bool)
-> Int
-> Stream (Of a) m b
-> Stream (Of a) m b
forall (m :: * -> *) a p b.
Monad m =>
(a -> p)
-> (p -> p -> Bool)
-> Int
-> Stream (Of a) m b
-> Stream (Of a) m b
slidingWindowOrd a -> p
proj (\p
a p
b -> p -> p -> Ordering
forall a. Ord a => a -> a -> Ordering
compare p
a p
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT)
{-# INLINE slidingWindowMaxOn #-}

-- IMPLEMENTATION NOTE [the slidingWindow{Min,Max} functions]
--
-- When one wishes to compute the minimum (or maximum; without loss of
-- generality we will only discuss the minimum case) of a sliding window of a
-- stream, the naive method is to collect all such sliding windows, and then run
-- 'Foldable.minimum' over each window. The issue is that this algorithm is very
-- inefficient: if the stream has $n$ elements, and the sliding window has $k$
-- elements, then there are $n-k+1$ windows, and computing the minimum in each
-- window requires $k-1$ comparisons. So a total of $(k-1)*(n-k+1)$ comparisons
-- are needed, or simply $O(nk)$ when $k$ is much smaller than $n$.
--
-- We can motivate an improvement as follows. Suppose the window size is 3 and
-- the current sliding window has numbers 4, 6, 8; if the next element happens
-- to be 5, there would then be no need to keep the numbers 6 and 8 in the
-- window. Because in the next window we have 6, 8, 5 so 5 will be yielded. In
-- the window after the next we have 8, 5, x so either 5 or x will be yielded.
-- So 6 and 8 will never be yielded.
--
-- This leads to the idea that we can keep a window that is a subsequence of the
-- actual window. But immediately the next problem is, if we don't keep a window
-- of the original window size, there would be no way for us to tell which
-- elements are out of the window. So the idea is to also keep an index of the
-- item along with the item itself. We then have several important invariants:
--
-- (a) The window is sorted according to the index.
-- (b) The window is sorted according to the item itself.
-- (c) The size of the window never has more elements than $k$.
--
-- The window is initially empty. The three-step algorithm to update the window
-- maintains these invariants.
--
-- The overall asymptotic complexity is great. Comparisons only happen in the
-- first part of the update. Each comparison either results in an element being
-- removed from the window (so there can be at most $O(n)$ such comparisons); or
-- that comparison does not result in an element being removed, but such
-- comparisons happen at most once for each element being inserted, which is
-- also $O(n)$. This means an overall $O(n)$ number of comparisons needed.
--
-- I did not invent this algorithm; it's pretty well-known. I'm not sure the
-- algorithm has a name.
slidingWindowOrd :: Monad m => (a -> p) -> (p -> p -> Bool) -> Int -> Stream (Of a) m b -> Stream (Of a) m b
slidingWindowOrd :: (a -> p)
-> (p -> p -> Bool)
-> Int
-> Stream (Of a) m b
-> Stream (Of a) m b
slidingWindowOrd a -> p
proj p -> p -> Bool
f Int
n =
  Int -> Stream (Of a) m b -> Stream (Of a) m b
forall (m :: * -> *) a r.
Monad m =>
Int -> Stream (Of a) m r -> Stream (Of a) m r
dropButRetainAtLeastOne (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Stream (Of a) m b -> Stream (Of a) m b)
-> (Stream (Of a) m b -> Stream (Of a) m b)
-> Stream (Of a) m b
-> Stream (Of a) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream (Of (Maybe a)) m b -> Stream (Of a) m b
forall (m :: * -> *) a r.
Monad m =>
Stream (Of (Maybe a)) m r -> Stream (Of a) m r
catMaybes (Stream (Of (Maybe a)) m b -> Stream (Of a) m b)
-> (Stream (Of a) m b -> Stream (Of (Maybe a)) m b)
-> Stream (Of a) m b
-> Stream (Of a) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlidingWindowOrdState a p -> a -> SlidingWindowOrdState a p)
-> SlidingWindowOrdState a p
-> (SlidingWindowOrdState a p -> Maybe a)
-> Stream (Of a) m b
-> Stream (Of (Maybe a)) m b
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r -> Stream (Of b) m r
scan SlidingWindowOrdState a p -> a -> SlidingWindowOrdState a p
update SlidingWindowOrdState a p
forall a p. SlidingWindowOrdState a p
initial SlidingWindowOrdState a p -> Maybe a
forall a p. SlidingWindowOrdState a p -> Maybe a
extract
  -- The use of dropButRetainAtLeastOne is to gracefully handle edge cases where
  -- the window size is bigger than the length of the entire sequence.
  where
    k :: Int
k = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n -- window size
    initial :: SlidingWindowOrdState a p
initial = Word64
-> Seq (SlidingWindowOrdElement a p) -> SlidingWindowOrdState a p
forall a p.
Word64
-> Seq (SlidingWindowOrdElement a p) -> SlidingWindowOrdState a p
SlidingWindowOrdState Word64
0 Seq (SlidingWindowOrdElement a p)
forall a. Monoid a => a
mempty
    -- All three invariants are satisfied initially. The window is trivially
    -- sorted because it is empty. Its size, zero, is also less than the window
    -- size.
    update :: SlidingWindowOrdState a p -> a -> SlidingWindowOrdState a p
update (SlidingWindowOrdState Word64
i Seq (SlidingWindowOrdElement a p)
w0) a
a =
      let projected :: p
projected = a -> p
proj a
a
          w1 :: Seq (SlidingWindowOrdElement a p)
w1 = (SlidingWindowOrdElement a p -> Bool)
-> Seq (SlidingWindowOrdElement a p)
-> Seq (SlidingWindowOrdElement a p)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileR (\(SlidingWindowOrdElement Word64
_ a
_ p
p) -> p -> p -> Bool
f p
p p
projected) Seq (SlidingWindowOrdElement a p)
w0
      -- Step 1: pop all elements at the back greater than the current one,
      -- because they will never be yielded: the current element will always be
      -- yielded until those popped elements go out of the window. This is
      -- extracting a subsequence of the window, so invariants (a) and (b)
      -- remain satisfied. Since this operation deletes elements, invariant (c)
      -- is maintained.
          w2 :: Seq (SlidingWindowOrdElement a p)
w2 = Seq (SlidingWindowOrdElement a p)
w1 Seq (SlidingWindowOrdElement a p)
-> SlidingWindowOrdElement a p -> Seq (SlidingWindowOrdElement a p)
forall a. Seq a -> a -> Seq a
Seq.|> Word64 -> a -> p -> SlidingWindowOrdElement a p
forall a p. Word64 -> a -> p -> SlidingWindowOrdElement a p
SlidingWindowOrdElement Word64
i a
a p
projected
      -- Step 2: add the current element to the back. Since the current index is
      -- greater than all previous indices, invariant (a) is satisfied.
      -- Invariant (b) is also satisfied because in step 1 we popped elements
      -- greater than the current, so either the window is empty or the back of
      -- the window is smaller than the current one. Invariant (c) may be
      -- violated, but this is fixed below.
          w3 :: Seq (SlidingWindowOrdElement a p)
w3 = (SlidingWindowOrdElement a p -> Bool)
-> Seq (SlidingWindowOrdElement a p)
-> Seq (SlidingWindowOrdElement a p)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileL (\(SlidingWindowOrdElement Word64
j a
_ p
_) -> Word64
j Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
i) Seq (SlidingWindowOrdElement a p)
w2
      -- Step 3: remove elements that are out of the window. Again this is
      -- extracting a subsequence so invariants (a) and (b) are maintained.
      -- Invariant (c) is maintained because the least index still possibly in
      -- the window is i+1-k, in which case we have k elements.
      in Word64
-> Seq (SlidingWindowOrdElement a p) -> SlidingWindowOrdState a p
forall a p.
Word64
-> Seq (SlidingWindowOrdElement a p) -> SlidingWindowOrdState a p
SlidingWindowOrdState (Word64
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) Seq (SlidingWindowOrdElement a p)
w3
    -- Extract the front.
    extract :: SlidingWindowOrdState a p -> Maybe a
extract (SlidingWindowOrdState Word64
_ Seq (SlidingWindowOrdElement a p)
w) =
        case Seq (SlidingWindowOrdElement a p)
-> ViewL (SlidingWindowOrdElement a p)
forall a. Seq a -> ViewL a
Seq.viewl Seq (SlidingWindowOrdElement a p)
w of
          SlidingWindowOrdElement Word64
_ a
m p
_ Seq.:< Seq (SlidingWindowOrdElement a p)
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
m
          ViewL (SlidingWindowOrdElement a p)
_ -> Maybe a
forall a. Maybe a
Nothing
{-# INLINABLE slidingWindowOrd #-}

-- | A 'SlidingWindowOrdState' keeps track of the current sliding window state
-- in 'slidingWindowOrd'. It keeps track of the current index of the item from
-- the stream as well as a 'Seq.Seq' of the current window. See comments above
-- for properties satisfied by the window.
data SlidingWindowOrdState a p =
  SlidingWindowOrdState !Word64
                        !(Seq.Seq (SlidingWindowOrdElement a p))

-- | A 'SlidingWindowOrdElement' is an element with a 'Word64'-based index as
-- well as the projection used for comparison. It is used in the sliding window
-- functions to associate an item with their index and the projected element in
-- the stream.
data SlidingWindowOrdElement a p = SlidingWindowOrdElement !Word64 a p

-- | Similar to 'drop', except that if the input stream doesn't have enough
-- elements, the last one will be yielded. However, if there's none to begin
-- with, this function will also produce none.
dropButRetainAtLeastOne :: Monad m => Int -> Stream (Of a) m r -> Stream (Of a) m r
dropButRetainAtLeastOne :: Int -> Stream (Of a) m r -> Stream (Of a) m r
dropButRetainAtLeastOne Int
0 = Stream (Of a) m r -> Stream (Of a) m r
forall a. a -> a
id
dropButRetainAtLeastOne Int
n = Maybe a -> Int -> Stream (Of a) m r -> Stream (Of a) m r
forall t (m :: * -> *) a a.
(Eq t, Num t, Monad m) =>
Maybe a -> t -> Stream (Of a) m a -> Stream (Of a) m a
loop Maybe a
forall a. Maybe a
Nothing Int
n
  where
    loop :: Maybe a -> t -> Stream (Of a) m a -> Stream (Of a) m a
loop (Just a
final) (-1) Stream (Of a) m a
str = a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
final Stream (Of a) m () -> Stream (Of a) m a -> Stream (Of a) m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream (Of a) m a
str
    loop Maybe a
final t
m Stream (Of a) m a
str = do
      Either a (a, Stream (Of a) m a)
e <- m (Either a (a, Stream (Of a) m a))
-> Stream (Of a) m (Either a (a, Stream (Of a) m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream (Of a) m a -> m (Either a (a, Stream (Of a) m a))
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next Stream (Of a) m a
str)
      case Either a (a, Stream (Of a) m a)
e of
        Left a
r -> do
          case Maybe a
final of
            Maybe a
Nothing -> () -> Stream (Of a) m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just a
l -> a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
l
          a -> Stream (Of a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        Right (a
x, Stream (Of a) m a
rest) -> Maybe a -> t -> Stream (Of a) m a -> Stream (Of a) m a
loop (a -> Maybe a
forall a. a -> Maybe a
Just a
x) (t
m t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Stream (Of a) m a
rest
{-# INLINABLE dropButRetainAtLeastOne #-}


-- | Map monadically over a stream, producing a new stream
--   only containing the 'Just' values.
mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream (Of a) m r -> Stream (Of b) m r
mapMaybeM :: (a -> m (Maybe b)) -> Stream (Of a) m r -> Stream (Of b) m r
mapMaybeM a -> m (Maybe b)
phi = Stream (Of a) m r -> Stream (Of b) m r
loop where
  loop :: Stream (Of a) m r -> Stream (Of b) m r
loop Stream (Of a) m r
stream = case Stream (Of a) m r
stream of
    Return r
r -> r -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r -> Stream (Of b) m r)
-> m (Stream (Of a) m r) -> m (Stream (Of b) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (Of a) m r -> Stream (Of b) m r
loop m (Stream (Of a) m r)
m)
    Step (a
a :> Stream (Of a) m r
snext) -> m (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) -> Stream (Of b) m r)
-> m (Stream (Of b) m r) -> Stream (Of b) m r
forall a b. (a -> b) -> a -> b
$
      ((Maybe b -> Stream (Of b) m r)
 -> m (Maybe b) -> m (Stream (Of b) m r))
-> m (Maybe b)
-> (Maybe b -> Stream (Of b) m r)
-> m (Stream (Of b) m r)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe b -> Stream (Of b) m r)
-> m (Maybe b) -> m (Stream (Of b) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> m (Maybe b)
phi a
a) ((Maybe b -> Stream (Of b) m r) -> m (Stream (Of b) m r))
-> (Maybe b -> Stream (Of b) m r) -> m (Stream (Of b) m r)
forall a b. (a -> b) -> a -> b
$ \Maybe b
x -> case Maybe b
x of
        Maybe b
Nothing -> Stream (Of a) m r -> Stream (Of b) m r
loop Stream (Of a) m r
snext
        Just b
b -> Of b (Stream (Of b) m r) -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (b
b b -> Stream (Of b) m r -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r -> Stream (Of b) m r
loop Stream (Of a) m r
snext)
{-# INLINABLE mapMaybeM #-}