{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module provides functions that take one input
-- stream and produce one output stream. These are functions that
-- process a single stream.
module Streaming.Internal.Process
  (
  -- * Stream processors
  -- ** Splitting and inspecting streams of elements
    next
  , uncons
  , splitAt
  , split
  , breaks
  , break
  , breakWhen
  , breakWhen'
  , span
  , group
  , groupBy
  -- ** Sum and compose manipulation
  , distinguish
  , switch
  , separate
  , unseparate
  , eitherToSum
  , sumToEither
  , sumToCompose
  , composeToSum
  -- ** Partitions
  , partitionEithers
  , partition
  -- ** Maybes
  , catMaybes
  , mapMaybe
  , mapMaybeM
  -- ** Direct Transformations
  , hoist
  , map
  , mapM
  , maps
  , mapped
  , mapsPost
  , mapsMPost
  , mappedPost
  , for
  , with
  , subst
  , copy
  , duplicate
  , store
  , chain
  , sequence
  , nubOrd
  , nubOrdOn
  , nubInt
  , nubIntOn
  , filter
  , filterM
  , intersperse
  , drop
  , dropWhile
  , scan
  , scanM
  , scanned
  , delay
  , read
  , show
  , cons
  , slidingWindow
  , wrapEffect
  -- ** Internal
  , destroyExposed
  ) where

import Streaming.Internal.Type
import Prelude.Linear ((&), ($), (.))
import Prelude (Maybe(..), Either(..), Bool(..), Int,
               Ordering(..), Num(..), Eq(..), id, Ord(..), Read(..),
               String, Double)
import qualified Prelude
import Data.Unrestricted.Linear
import qualified Control.Functor.Linear as Control
import System.IO.Linear
import Data.Functor.Sum
import Data.Functor.Compose
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import qualified Data.IntSet as IntSet
import Text.Read (readMaybe)
import Control.Concurrent (threadDelay)
import GHC.Stack


-- # Internal Library
-------------------------------------------------------------------------------

-- | When chunking streams, it's useful to have a combinator
-- that can add an element to the functor that is itself a stream.
-- Basically `consFirstChunk 42 [[1,2,3],[4,5]] = [[42,1,2,3],[4,5]]`.
consFirstChunk :: Control.Monad m =>
  a -> Stream (Stream (Of a) m) m r %1-> Stream (Stream (Of a) m) m r
consFirstChunk :: forall (m :: * -> *) a r.
Monad m =>
a
-> Stream (Stream (Of a) m) m r %1 -> Stream (Stream (Of a) m) m r
consFirstChunk a
a Stream (Stream (Of a) m) m r
stream = Stream (Stream (Of a) m) m r
stream Stream (Stream (Of a) m) m r
%1 -> (Stream (Stream (Of a) m) m r
       %1 -> Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
forall a b. a -> b -> Of a b
:> Stream (Stream (Of a) m) m r
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (r %1 -> Stream (Stream (Of a) m) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r)))
    Effect m (Stream (Stream (Of a) m) m r)
m -> m (Stream (Stream (Of a) m) m r) %1 -> Stream (Stream (Of a) m) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Stream (Of a) m) m r)
 %1 -> Stream (Stream (Of a) m) m r)
%1 -> m (Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Stream (Of a) m) m r %1 -> Stream (Stream (Of a) m) m r)
%1 -> m (Stream (Stream (Of a) m) m r)
%1 -> m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (a
-> Stream (Stream (Of a) m) m r %1 -> Stream (Stream (Of a) m) m r
forall (m :: * -> *) a r.
Monad m =>
a
-> Stream (Stream (Of a) m) m r %1 -> Stream (Stream (Of a) m) m r
consFirstChunk a
a) m (Stream (Stream (Of a) m) m r)
m
    Step Stream (Of a) m (Stream (Stream (Of a) m) m r)
f -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
forall a b. a -> b -> Of a b
:> Stream (Of a) m (Stream (Stream (Of a) m) m r)
f))

-- This is an internal function used in 'seperate' from the original source.
-- It removes functoral and monadic steps and reduces to some type 'b'.
-- Here it's adapted to consume the stream linearly.
destroyExposed
  :: forall f m r b. (Control.Functor f, Control.Monad m) =>
     Stream f m r %1-> (f b %1-> b) -> (m b %1-> b) -> (r %1-> b) -> b
destroyExposed :: forall (f :: * -> *) (m :: * -> *) r b.
(Functor f, Monad m) =>
Stream f m r
%1 -> (f b %1 -> b) -> (m b %1 -> b) -> (r %1 -> b) -> b
destroyExposed Stream f m r
stream0 f b %1 -> b
construct m b %1 -> b
theEffect r %1 -> b
done = (Functor f, Monad m) => Stream f m r %1 -> b
Stream f m r %1 -> b
loop Stream f m r
stream0
  where
    loop :: (Control.Functor f, Control.Monad m) =>
      Stream f m r %1-> b
    loop :: (Functor f, Monad m) => Stream f m r %1 -> b
loop Stream f m r
stream = Stream f m r
stream Stream f m r %1 -> (Stream f m r %1 -> b) %1 -> b
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> b
done r
r
      Effect m (Stream f m r)
m -> m b %1 -> b
theEffect ((Stream f m r %1 -> b) %1 -> m (Stream f m r) %1 -> m b
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (Functor f, Monad m) => Stream f m r %1 -> b
Stream f m r %1 -> b
loop m (Stream f m r)
m)
      Step f (Stream f m r)
f  -> f b %1 -> b
construct ((Stream f m r %1 -> b) %1 -> f (Stream f m r) %1 -> f b
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (Functor f, Monad m) => Stream f m r %1 -> b
Stream f m r %1 -> b
loop f (Stream f m r)
f)


-- # Splitting and inspecting streams of elements
-------------------------------------------------------------------------------

-- Remark. Since the 'a' is not held linearly in the 'Of' pair,
-- we return it inside an 'Ur'.
--
{-| 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    :: Control.Monad m => Stream (Of a) m r %1-> m (Either r    (a, Stream (Of a) m r))
> inspect :: Control.Monad m => Stream (Of a) m r %1-> m (Either r (Of a (Stream (Of a) m r)))
-}
next :: forall a m r. Control.Monad m =>
  Stream (Of a) m r %1-> m (Either r (Ur a, Stream (Of a) m r))
next :: forall a (m :: * -> *) r.
Monad m =>
Stream (Of a) m r %1 -> m (Either r (Ur a, Stream (Of a) m r))
next Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m (Either r (Ur a, Stream (Of a) m r))
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> m (Either r (Ur a, Stream (Of a) m r))
    loop :: Stream (Of a) m r %1 -> m (Either r (Ur a, Stream (Of a) m r))
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r
       %1 -> m (Either r (Ur a, Stream (Of a) m r)))
%1 -> m (Either r (Ur a, Stream (Of a) m r))
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> Either r (Ur a, Stream (Of a) m r)
%1 -> m (Either r (Ur a, Stream (Of a) m r))
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Either r (Ur a, Stream (Of a) m r)
 %1 -> m (Either r (Ur a, Stream (Of a) m r)))
%1 -> Either r (Ur a, Stream (Of a) m r)
%1 -> m (Either r (Ur a, Stream (Of a) m r))
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ r %1 -> Either r (Ur a, Stream (Of a) m r)
forall a b. a -> Either a b
Left r
r
      Effect m (Stream (Of a) m r)
ms -> m (Stream (Of a) m r)
ms m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r
       %1 -> m (Either r (Ur a, Stream (Of a) m r)))
%1 -> m (Either r (Ur a, Stream (Of a) m r))
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= Stream (Of a) m r %1 -> m (Either r (Ur a, Stream (Of a) m r))
forall a (m :: * -> *) r.
Monad m =>
Stream (Of a) m r %1 -> m (Either r (Ur a, Stream (Of a) m r))
next
      Step (a
a :> Stream (Of a) m r
as) -> Either r (Ur a, Stream (Of a) m r)
%1 -> m (Either r (Ur a, Stream (Of a) m r))
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Either r (Ur a, Stream (Of a) m r)
 %1 -> m (Either r (Ur a, Stream (Of a) m r)))
%1 -> Either r (Ur a, Stream (Of a) m r)
%1 -> m (Either r (Ur a, Stream (Of a) m r))
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Ur a, Stream (Of a) m r) %1 -> Either r (Ur a, Stream (Of a) m r)
forall a b. b -> Either a b
Right (a -> Ur a
forall a. a -> Ur a
Ur a
a, Stream (Of a) m r
as)
{-# INLINABLE next #-}

{-| Inspect the first item in a stream of elements, without a return value.

-}
uncons :: forall a m r. (Consumable r, Control.Monad m) =>
  Stream (Of a) m r %1-> m (Maybe (a, Stream (Of a) m r))
uncons :: forall a (m :: * -> *) r.
(Consumable r, Monad m) =>
Stream (Of a) m r %1 -> m (Maybe (a, Stream (Of a) m r))
uncons  Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m (Maybe (a, Stream (Of a) m r))
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> m (Maybe (a, Stream (Of a) m r))
    loop :: Stream (Of a) m r %1 -> m (Maybe (a, Stream (Of a) m r))
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> m (Maybe (a, Stream (Of a) m r)))
%1 -> m (Maybe (a, Stream (Of a) m r))
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r
%1 -> m (Maybe (a, Stream (Of a) m r))
%1 -> m (Maybe (a, Stream (Of a) m r))
forall a b. Consumable a => a %1 -> b %1 -> b
lseq r
r (m (Maybe (a, Stream (Of a) m r))
 %1 -> m (Maybe (a, Stream (Of a) m r)))
%1 -> m (Maybe (a, Stream (Of a) m r))
%1 -> m (Maybe (a, Stream (Of a) m r))
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Maybe (a, Stream (Of a) m r) %1 -> m (Maybe (a, Stream (Of a) m r))
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return Maybe (a, Stream (Of a) m r)
forall a. Maybe a
Nothing
      Effect m (Stream (Of a) m r)
ms -> m (Stream (Of a) m r)
ms m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Maybe (a, Stream (Of a) m r)))
%1 -> m (Maybe (a, Stream (Of a) m r))
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= Stream (Of a) m r %1 -> m (Maybe (a, Stream (Of a) m r))
forall a (m :: * -> *) r.
(Consumable r, Monad m) =>
Stream (Of a) m r %1 -> m (Maybe (a, Stream (Of a) m r))
uncons
      Step (a
a :> Stream (Of a) m r
as) -> Maybe (a, Stream (Of a) m r) %1 -> m (Maybe (a, Stream (Of a) m r))
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Maybe (a, Stream (Of a) m r)
 %1 -> m (Maybe (a, Stream (Of a) m r)))
%1 -> Maybe (a, Stream (Of a) m r)
%1 -> m (Maybe (a, Stream (Of a) m r))
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (a, Stream (Of a) m r) %1 -> Maybe (a, Stream (Of a) m r)
forall a. a -> Maybe a
Just (a
a, Stream (Of a) m r
as)
{-# INLINABLE uncons #-}

{-| 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 :: Control.Monad m => Int -> Stream (Of a) m r %1-> Stream (Of a) m (Stream (Of a) m r)

-}
splitAt :: forall f m r. (Control.Monad m, Control.Functor f) =>
  Int -> Stream f m r %1-> Stream f m (Stream f m r)
splitAt :: forall (f :: * -> *) (m :: * -> *) r.
(Monad m, Functor f) =>
Int -> Stream f m r %1 -> Stream f m (Stream f m r)
splitAt Int
n Stream f m r
stream = Int -> Stream f m r %1 -> Stream f m (Stream f m r)
loop Int
n Stream f m r
stream where
  loop :: Int -> Stream f m r %1-> Stream f m (Stream f m r)
  loop :: Int -> Stream f m r %1 -> Stream f m (Stream f m r)
loop Int
n Stream f m r
stream = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
Prelude.compare Int
n Int
0 of
    Ordering
GT -> Stream f m r
stream Stream f m r
%1 -> (Stream f m r %1 -> Stream f m (Stream f m r))
%1 -> Stream f m (Stream f m r)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> Stream f m r %1 -> Stream f m (Stream f m r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (r %1 -> Stream f m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r)
      Effect m (Stream f m r)
m -> m (Stream f m (Stream f m r)) %1 -> Stream f m (Stream f m r)
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m (Stream f m r)) %1 -> Stream f m (Stream f m r))
%1 -> m (Stream f m (Stream f m r)) %1 -> Stream f m (Stream f m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ m (Stream f m r)
m m (Stream f m r)
%1 -> (Stream f m r %1 -> m (Stream f m (Stream f m r)))
%1 -> m (Stream f m (Stream f m r))
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (Stream f m (Stream f m r) %1 -> m (Stream f m (Stream f m r))
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream f m (Stream f m r) %1 -> m (Stream f m (Stream f m r)))
%1 -> (Stream f m r %1 -> Stream f m (Stream f m r))
%1 -> Stream f m r
%1 -> m (Stream f m (Stream f m r))
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. Int -> Stream f m r %1 -> Stream f m (Stream f m r)
forall (f :: * -> *) (m :: * -> *) r.
(Monad m, Functor f) =>
Int -> Stream f m r %1 -> Stream f m (Stream f m r)
splitAt Int
n)
      Step f (Stream f m r)
f -> f (Stream f m (Stream f m r)) %1 -> Stream f m (Stream f m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream f m (Stream f m r)) %1 -> Stream f m (Stream f m r))
%1 -> f (Stream f m (Stream f m r)) %1 -> Stream f m (Stream f m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream f m r %1 -> Stream f m (Stream f m r))
%1 -> f (Stream f m r) %1 -> f (Stream f m (Stream f m r))
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (Int -> Stream f m r %1 -> Stream f m (Stream f m r)
forall (f :: * -> *) (m :: * -> *) r.
(Monad m, Functor f) =>
Int -> Stream f m r %1 -> Stream f m (Stream f m r)
splitAt (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) f (Stream f m r)
f
    Ordering
_ -> Stream f m r %1 -> Stream f m (Stream f m r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return Stream f m r
stream
{-# INLINABLE splitAt #-}

{-| 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 :: forall a m r. (Eq a, Control.Monad m) =>
  a -> Stream (Of a) m r %1-> Stream (Stream (Of a) m) m r
split :: forall a (m :: * -> *) r.
(Eq a, Monad m) =>
a -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
split a
x Stream (Of a) m r
stream = Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> Stream (Stream (Of a) m) m r
    loop :: Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Stream (Of a) m) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Stream (Of a) m) m r) %1 -> Stream (Stream (Of a) m) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Stream (Of a) m) m r)
 %1 -> Stream (Stream (Of a) m) m r)
%1 -> m (Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ m (Stream (Of a) m r)
m m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Stream (Stream (Of a) m) m r))
%1 -> m (Stream (Stream (Of a) m) m r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (Stream (Stream (Of a) m) m r %1 -> m (Stream (Stream (Of a) m) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Stream (Of a) m) m r
 %1 -> m (Stream (Stream (Of a) m) m r))
%1 -> (Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r)
%1 -> Stream (Of a) m r
%1 -> m (Stream (Stream (Of a) m) m r)
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. a -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
(Eq a, Monad m) =>
a -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
split a
x)
      Step (a
a :> Stream (Of a) m r
as) -> case a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x of
        Bool
True -> a -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
(Eq a, Monad m) =>
a -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
split a
x Stream (Of a) m r
as
        Bool
False -> a
-> Stream (Stream (Of a) m) m r %1 -> Stream (Stream (Of a) m) m r
forall (m :: * -> *) a r.
Monad m =>
a
-> Stream (Stream (Of a) m) m r %1 -> Stream (Stream (Of a) m) m r
consFirstChunk a
a (a -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
(Eq a, Monad m) =>
a -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
split a
x Stream (Of a) m r
as)
{-# INLINABLE split #-}

{-| Break a sequence upon meeting an element that 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 :: forall a m r. Control.Monad m =>
  (a -> Bool) -> Stream (Of a) m r %1-> Stream (Of a) m (Stream (Of a) m r)
break :: forall a (m :: * -> *) r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
break a -> Bool
f Stream (Of a) m r
stream = Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> Stream (Of a) m (Stream (Of a) m r)
    loop :: Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r))
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). 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))
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m (Stream (Of a) m r))
 %1 -> Stream (Of a) m (Stream (Of a) m r))
%1 -> m (Stream (Of a) m (Stream (Of a) m r))
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r))
%1 -> m (Stream (Of a) m r)
%1 -> m (Stream (Of a) m (Stream (Of a) m r))
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap ((a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
forall a (m :: * -> *) r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
break a -> Bool
f) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> case a -> Bool
f a
a of
        Bool
True -> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r))
%1 -> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
as)
        Bool
False -> Of a (Stream (Of a) m (Stream (Of a) m r))
%1 -> 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)
%1 -> Of a (Stream (Of a) m (Stream (Of a) m r))
forall a b. a -> b -> Of a b
:> ((a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
forall a (m :: * -> *) r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
break a -> Bool
f Stream (Of a) m r
as))
{-# INLINABLE break #-}

{-| 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 :: forall a m r. Control.Monad m =>
  (a -> Bool) -> Stream (Of a) m r %1-> Stream (Stream (Of a) m) m r
breaks :: forall a (m :: * -> *) r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
breaks a -> Bool
f Stream (Of a) m r
stream = Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> Stream (Stream (Of a) m) m r
    loop :: Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Stream (Of a) m) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Stream (Of a) m) m r) %1 -> Stream (Stream (Of a) m) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Stream (Of a) m) m r)
 %1 -> Stream (Stream (Of a) m) m r)
%1 -> m (Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap ((a -> Bool) -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
breaks a -> Bool
f) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> case a -> Bool
f a
a of
        Bool
True -> (a -> Bool) -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
breaks a -> Bool
f Stream (Of a) m r
as
        Bool
False -> a
-> Stream (Stream (Of a) m) m r %1 -> Stream (Stream (Of a) m) m r
forall (m :: * -> *) a r.
Monad m =>
a
-> Stream (Stream (Of a) m) m r %1 -> Stream (Stream (Of a) m) m r
consFirstChunk a
a ((a -> Bool) -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
breaks a -> Bool
f Stream (Of a) m r
as)
{-# INLINABLE breaks #-}

-- Remark. The funny type of this seems to be made to interoperate well with
-- `purely` from the `foldl` package.
--
{-| 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 :: forall m a x b r. Control.Monad m
          => (x -> a -> x) -> x -> (x -> b) -> (b -> Bool)
          -> Stream (Of a) m r %1-> Stream (Of a) m (Stream (Of a) m r)
breakWhen :: forall (m :: * -> *) a x b r.
Monad m =>
(x -> a -> x)
-> x
-> (x -> b)
-> (b -> Bool)
-> Stream (Of a) m r
%1 -> Stream (Of a) m (Stream (Of a) m r)
breakWhen x -> a -> x
step x
x x -> b
end b -> Bool
pred Stream (Of a) m r
stream = Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> Stream (Of a) m (Stream (Of a) m r)
    loop :: Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r))
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). 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))
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m (Stream (Of a) m r))
 %1 -> Stream (Of a) m (Stream (Of a) m r))
%1 -> m (Stream (Of a) m (Stream (Of a) m r))
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r))
%1 -> m (Stream (Of a) m r)
%1 -> m (Stream (Of a) m (Stream (Of a) m r))
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap ((x -> a -> x)
-> x
-> (x -> b)
-> (b -> Bool)
-> Stream (Of a) m r
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a x b r.
Monad m =>
(x -> a -> x)
-> x
-> (x -> b)
-> (b -> Bool)
-> Stream (Of a) m r
%1 -> Stream (Of a) m (Stream (Of a) m r)
breakWhen x -> a -> x
step x
x x -> b
end b -> Bool
pred) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> case b -> Bool
pred (x -> b
end (x -> a -> x
step x
x a
a)) of
        Bool
False -> Of a (Stream (Of a) m (Stream (Of a) m r))
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of a (Stream (Of a) m (Stream (Of a) m r))
 %1 -> Stream (Of a) m (Stream (Of a) m r))
%1 -> Of a (Stream (Of a) m (Stream (Of a) m r))
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ a
a a
-> Stream (Of a) m (Stream (Of a) m r)
%1 -> Of a (Stream (Of a) m (Stream (Of a) m r))
forall a b. a -> b -> Of a b
:> ((x -> a -> x)
-> x
-> (x -> b)
-> (b -> Bool)
-> Stream (Of a) m r
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a x b r.
Monad m =>
(x -> a -> x)
-> x
-> (x -> b)
-> (b -> Bool)
-> Stream (Of a) m r
%1 -> Stream (Of a) m (Stream (Of a) m r)
breakWhen x -> a -> x
step (x -> a -> x
step x
x a
a) x -> b
end b -> Bool
pred Stream (Of a) m r
as)
        Bool
True -> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
as))
{-# INLINABLE breakWhen #-}

-- | Breaks on the first element to satisfy the predicate
breakWhen' :: Control.Monad m =>
  (a -> Bool) -> Stream (Of a) m r %1-> Stream (Of a) m (Stream (Of a) m r)
breakWhen' :: forall (m :: * -> *) a r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
breakWhen' a -> Bool
f Stream (Of a) m r
stream = (Bool -> a -> Bool)
-> Bool
-> (Bool -> Bool)
-> (Bool -> Bool)
-> Stream (Of a) m r
%1 -> Stream (Of a) m (Stream (Of a) m r)
forall (m :: * -> *) a x b r.
Monad m =>
(x -> a -> x)
-> x
-> (x -> b)
-> (b -> Bool)
-> Stream (Of a) m r
%1 -> Stream (Of a) m (Stream (Of a) m r)
breakWhen (\Bool
_ a
a -> a -> Bool
f a
a) Bool
True Bool -> Bool
forall a. a -> a
id Bool -> Bool
forall a. a -> a
id Stream (Of a) m r
stream
{-# INLINE breakWhen' #-}

-- | Stream elements until one fails the condition, return the rest.
span :: Control.Monad m =>
  (a -> Bool) -> Stream (Of a) m r %1-> Stream (Of a) m (Stream (Of a) m r)
span :: forall (m :: * -> *) a r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
span a -> Bool
f = (a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
forall a (m :: * -> *) r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)
break (Bool -> Bool
Prelude.not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. a -> Bool
f)
{-# INLINE span #-}

{-| 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 :: forall a m r. Control.Monad m =>
  (a -> a -> Bool) -> Stream (Of a) m r %1-> Stream (Stream (Of a) m) m r
groupBy :: forall a (m :: * -> *) r.
Monad m =>
(a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
groupBy a -> a -> Bool
equals Stream (Of a) m r
stream = Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> Stream (Stream (Of a) m) m r
    loop :: Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Stream (Of a) m) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Stream (Of a) m) m r) %1 -> Stream (Stream (Of a) m) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Stream (Of a) m) m r)
 %1 -> Stream (Stream (Of a) m) m r)
%1 -> m (Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap ((a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
Monad m =>
(a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
groupBy a -> a -> Bool
equals) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> Stream (Of a) m r
as Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
        Return r
r -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
forall a b. a -> b -> Of a b
:> Stream (Stream (Of a) m) m r
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (r %1 -> Stream (Stream (Of a) m) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r)))
        Effect m (Stream (Of a) m r)
m -> m (Stream (Stream (Of a) m) m r) %1 -> Stream (Stream (Of a) m) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Stream (Of a) m) m r)
 %1 -> Stream (Stream (Of a) m) m r)
%1 -> m (Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$
          m (Stream (Of a) m r)
m m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Stream (Stream (Of a) m) m r))
%1 -> m (Stream (Stream (Of a) m) m r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (\Stream (Of a) m r
s -> Stream (Stream (Of a) m) m r %1 -> m (Stream (Stream (Of a) m) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Stream (Of a) m) m r
 %1 -> m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Stream (Of a) m) m r
%1 -> m (Stream (Stream (Of a) m) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
Monad m =>
(a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
groupBy a -> a -> Bool
equals (Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
s)))
        Step (a
a' :> Stream (Of a) m r
as') -> case a -> a -> Bool
equals a
a a
a' of
          Bool
False ->
            Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> 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)
 %1 -> Stream (Stream (Of a) m) m r)
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
 %1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ a
a a
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
forall a b. a -> b -> Of a b
:> (Stream (Stream (Of a) m) m r
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (Stream (Stream (Of a) m) m r
 %1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Stream (Of a) m) m r
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
Monad m =>
(a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
groupBy a -> a -> Bool
equals (Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
as')))
          Bool
True ->
            Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> 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)
 %1 -> Stream (Stream (Of a) m) m r)
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Stream (Stream (Of a) m) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
 %1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ a
a a
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
forall a b. a -> b -> Of a b
:> (Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
 %1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ a
a' a
-> Stream (Of a) m (Stream (Stream (Of a) m) m r)
%1 -> Of a (Stream (Of a) m (Stream (Stream (Of a) m) m r))
forall a b. a -> b -> Of a b
:> (Stream (Stream (Of a) m) m r
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (Stream (Stream (Of a) m) m r
 %1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r))
%1 -> Stream (Stream (Of a) m) m r
%1 -> Stream (Of a) m (Stream (Stream (Of a) m) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
Monad m =>
(a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
groupBy a -> a -> Bool
equals Stream (Of a) m r
as'))
{-# 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 :: (Control.Monad m, Eq a) =>
  Stream (Of a) m r %1-> Stream (Stream (Of a) m) m r
group :: forall (m :: * -> *) a r.
(Monad m, Eq a) =>
Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
group = (a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
forall a (m :: * -> *) r.
Monad m =>
(a -> a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r
groupBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINE group #-}

-- # Sum and compose manipulation
-------------------------------------------------------------------------------

-- Remark. Most of these functions are general and were merely cut and pasted
-- from the original library.

distinguish :: (a -> Bool) -> Of a r -> Sum (Of a) (Of a) r
distinguish :: forall a r. (a -> Bool) -> Of a r -> Sum (Of a) (Of a) r
distinguish a -> Bool
predicate (a
a :> r
b) = case a -> Bool
predicate a
a of
  Bool
True -> 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)
  Bool
False -> 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 #-}

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

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

sumToEither :: Sum (Of a) (Of b) r ->  Of (Either a b) r
sumToEither :: forall a b r. 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 :: forall a b r. 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 :: forall (f :: * -> *) r. 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 :: forall (f :: * -> *) r. 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 #-}

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

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

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

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

   Or we can write them to separate files or whatever.

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

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

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

-}
separate :: forall m f g r.
  (Control.Monad m, Control.Functor f, Control.Functor g) =>
  Stream (Sum f g) m r -> Stream f (Stream g m) r
separate :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f, Functor g) =>
Stream (Sum f g) m r -> Stream f (Stream g m) r
separate Stream (Sum f g) m r
stream = Stream (Sum f g) m r
%1 -> (Sum f g (Stream f (Stream g m) r)
       %1 -> Stream f (Stream g m) r)
-> (m (Stream f (Stream g m) r) %1 -> Stream f (Stream g m) r)
-> (r %1 -> Stream f (Stream g m) r)
-> Stream f (Stream g m) r
forall (f :: * -> *) (m :: * -> *) r b.
(Functor f, Monad m) =>
Stream f m r
%1 -> (f b %1 -> b) -> (m b %1 -> b) -> (r %1 -> b) -> b
destroyExposed Stream (Sum f g) m r
stream Sum f g (Stream f (Stream g m) r) %1 -> Stream f (Stream g m) r
fromSum (Stream g m (Stream f (Stream g m) r) %1 -> Stream f (Stream g m) r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream g m (Stream f (Stream g m) r)
 %1 -> Stream f (Stream g m) r)
%1 -> (m (Stream f (Stream g m) r)
       %1 -> Stream g m (Stream f (Stream g m) r))
%1 -> m (Stream f (Stream g m) r)
%1 -> Stream f (Stream g m) r
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. m (Stream f (Stream g m) r)
%1 -> Stream g m (Stream f (Stream g m) r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift) r %1 -> Stream f (Stream g m) r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return
  where
    fromSum :: Sum f g (Stream f (Stream g m) r) %1-> (Stream f (Stream g m) r)
    fromSum :: Sum f g (Stream f (Stream g m) r) %1 -> Stream f (Stream g m) r
fromSum Sum f g (Stream f (Stream g m) r)
x = Sum f g (Stream f (Stream g m) r)
x Sum f g (Stream f (Stream g m) r)
%1 -> (Sum f g (Stream f (Stream g m) r)
       %1 -> Stream f (Stream g m) r)
%1 -> Stream f (Stream g m) r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      InL f (Stream f (Stream g m) r)
fss -> f (Stream f (Stream g m) r) %1 -> Stream f (Stream g m) r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step f (Stream f (Stream g m) r)
fss
      InR g (Stream f (Stream g m) r)
gss -> Stream g m (Stream f (Stream g m) r) %1 -> Stream f (Stream g m) r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (g (Stream g m (Stream f (Stream g m) r))
%1 -> Stream g m (Stream f (Stream g m) r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (g (Stream g m (Stream f (Stream g m) r))
 %1 -> Stream g m (Stream f (Stream g m) r))
%1 -> g (Stream g m (Stream f (Stream g m) r))
%1 -> Stream g m (Stream f (Stream g m) r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream f (Stream g m) r
 %1 -> Stream g m (Stream f (Stream g m) r))
%1 -> g (Stream f (Stream g m) r)
%1 -> g (Stream g m (Stream f (Stream g m) r))
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream f (Stream g m) r %1 -> Stream g m (Stream f (Stream g m) r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return g (Stream f (Stream g m) r)
gss)
{-# INLINABLE separate #-}

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

-- # Partitions
-------------------------------------------------------------------------------

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

 -}
partition :: forall a m r. Control.Monad m =>
  (a -> Bool) -> Stream (Of a) m r %1-> Stream (Of a) (Stream (Of a) m) r
partition :: forall a (m :: * -> *) r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
partition a -> Bool
pred = Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
loop
  where
    loop :: Stream (Of a) m r %1-> Stream (Of a) (Stream (Of a) m) r
    loop :: Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) (Stream (Of a) m) r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of a) (Stream (Of a) m) r
forall r (f :: * -> *) (m :: * -> *). 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)
%1 -> Stream (Of a) (Stream (Of a) m) r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect ((Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) m (Stream (Of a) m r)
%1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
loop (m (Stream (Of a) m r) %1 -> Stream (Of a) m (Stream (Of a) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift m (Stream (Of a) m r)
m))
      Step (a
a :> Stream (Of a) m r
as) -> case a -> Bool
pred a
a of
        Bool
True -> Of a (Stream (Of a) (Stream (Of a) m) r)
%1 -> 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
%1 -> Of a (Stream (Of a) (Stream (Of a) m) r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of a) m r
as)
        Bool
False -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) (Stream (Of a) m) r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
 %1 -> Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) (Stream (Of a) m) r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of a (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
%1 -> 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 (Of a (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
 %1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
%1 -> Of a (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
%1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ a
a a
-> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
%1 -> 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
%1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of a) m r
as))

{-| Separate left and right values in distinct streams. ('separate' is
    a more powerful, functor-general, equivalent using 'Sum' in place of 'Either').

> partitionEithers = separate . maps S.eitherToSum
> lefts  = hoist S.effects . partitionEithers
> rights = S.effects . partitionEithers
> rights = S.concat

-}
partitionEithers :: Control.Monad m =>
  Stream (Of (Either a b)) m r %1-> Stream (Of a) (Stream (Of b) m) r
partitionEithers :: forall (m :: * -> *) a b r.
Monad m =>
Stream (Of (Either a b)) m r
%1 -> Stream (Of a) (Stream (Of b) m) r
partitionEithers = Stream (Of (Either a b)) m r
%1 -> Stream (Of a) (Stream (Of b) m) r
forall (m :: * -> *) a b r.
Monad m =>
Stream (Of (Either a b)) m r
%1 -> Stream (Of a) (Stream (Of b) m) r
loop
  where
    loop :: Control.Monad m =>
      Stream (Of (Either a b)) m r %1-> Stream (Of a) (Stream (Of b) m) r
    loop :: forall (m :: * -> *) a b r.
Monad m =>
Stream (Of (Either a b)) m r
%1 -> Stream (Of a) (Stream (Of b) m) r
loop Stream (Of (Either a b)) m r
stream = Stream (Of (Either a b)) m r
stream Stream (Of (Either a b)) m r
%1 -> (Stream (Of (Either a b)) m r
       %1 -> Stream (Of a) (Stream (Of b) m) r)
%1 -> Stream (Of a) (Stream (Of b) m) r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of a) (Stream (Of b) m) r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of (Either a b)) m r)
m -> Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
%1 -> Stream (Of a) (Stream (Of b) m) r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
 %1 -> Stream (Of a) (Stream (Of b) m) r)
%1 -> Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
%1 -> Stream (Of a) (Stream (Of b) m) r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of (Either a b)) m r
 %1 -> Stream (Of a) (Stream (Of b) m) r)
%1 -> Stream (Of b) m (Stream (Of (Either a b)) m r)
%1 -> Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of (Either a b)) m r
%1 -> Stream (Of a) (Stream (Of b) m) r
forall (m :: * -> *) a b r.
Monad m =>
Stream (Of (Either a b)) m r
%1 -> Stream (Of a) (Stream (Of b) m) r
loop (m (Stream (Of (Either a b)) m r)
%1 -> Stream (Of b) m (Stream (Of (Either a b)) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift m (Stream (Of (Either a b)) m r)
m)
      Step (Left a
a :> Stream (Of (Either a b)) m r
as) -> Of a (Stream (Of a) (Stream (Of b) m) r)
%1 -> Stream (Of a) (Stream (Of b) m) r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a
-> Stream (Of a) (Stream (Of b) m) r
%1 -> Of a (Stream (Of a) (Stream (Of b) m) r)
forall a b. a -> b -> Of a b
:> Stream (Of (Either a b)) m r
%1 -> Stream (Of a) (Stream (Of b) m) r
forall (m :: * -> *) a b r.
Monad m =>
Stream (Of (Either a b)) m r
%1 -> Stream (Of a) (Stream (Of b) m) r
loop Stream (Of (Either a b)) m r
as)
      Step (Right b
b :> Stream (Of (Either a b)) m r
as) -> Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
%1 -> Stream (Of a) (Stream (Of b) m) r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
 %1 -> Stream (Of a) (Stream (Of b) m) r)
%1 -> Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
%1 -> Stream (Of a) (Stream (Of b) m) r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Of b (Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r))
%1 -> Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of b (Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r))
 %1 -> Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r))
%1 -> Of b (Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r))
%1 -> Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ b
b b
-> Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
%1 -> Of b (Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r))
forall a b. a -> b -> Of a b
:> Stream (Of a) (Stream (Of b) m) r
%1 -> Stream (Of b) m (Stream (Of a) (Stream (Of b) m) r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (Stream (Of (Either a b)) m r
%1 -> Stream (Of a) (Stream (Of b) m) r
forall (m :: * -> *) a b r.
Monad m =>
Stream (Of (Either a b)) m r
%1 -> Stream (Of a) (Stream (Of b) m) r
loop Stream (Of (Either a b)) m r
as))


-- # Maybes
-------------------------------------------------------------------------------

{-| 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 :: Control.Monad m => Stream (Of (Maybe a)) m r %1-> Stream (Of a) m r
catMaybes :: forall (m :: * -> *) a r.
Monad m =>
Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r
catMaybes Stream (Of (Maybe a)) m r
stream = Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r
forall (m :: * -> *) a r.
Monad m =>
Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r
loop Stream (Of (Maybe a)) m r
stream
  where
    loop :: Control.Monad m => Stream (Of (Maybe a)) m r %1-> Stream (Of a) m r
    loop :: forall (m :: * -> *) a r.
Monad m =>
Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r
loop Stream (Of (Maybe a)) m r
stream = Stream (Of (Maybe a)) m r
stream Stream (Of (Maybe a)) m r
%1 -> (Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of (Maybe a)) m r)
m -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of (Maybe a)) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r
forall (m :: * -> *) a r.
Monad m =>
Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r
catMaybes m (Stream (Of (Maybe a)) m r)
m
      Step (Maybe a
maybe :> Stream (Of (Maybe a)) m r
as) -> case Maybe a
maybe of
        Maybe a
Nothing -> Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r
forall (m :: * -> *) a r.
Monad m =>
Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r
catMaybes Stream (Of (Maybe a)) m r
as
        Just a
a -> Of a (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of a (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> Of a (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ a
a a -> Stream (Of a) m r %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> (Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r
forall (m :: * -> *) a r.
Monad m =>
Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r
catMaybes Stream (Of (Maybe a)) m r
as)
{-# 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 :: forall a b m r. Control.Monad m =>
  (a -> Maybe b) -> Stream (Of a) m r %1-> Stream (Of b) m r
mapMaybe :: forall a b (m :: * -> *) r.
Monad m =>
(a -> Maybe b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
mapMaybe a -> Maybe b
f Stream (Of a) m r
stream = Stream (Of a) m r %1 -> Stream (Of b) m r
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> Stream (Of b) m r
    loop :: Stream (Of a) m r %1 -> Stream (Of b) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of b) m r)
%1 -> Stream (Of b) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of b) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
ms -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ m (Stream (Of a) m r)
ms m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Stream (Of b) m r))
%1 -> m (Stream (Of b) m r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of b) m r %1 -> m (Stream (Of b) m r))
%1 -> (Stream (Of a) m r %1 -> Stream (Of b) m r)
%1 -> Stream (Of a) m r
%1 -> m (Stream (Of b) m r)
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. (a -> Maybe b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
forall a b (m :: * -> *) r.
Monad m =>
(a -> Maybe b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
mapMaybe a -> Maybe b
f)
      Step (a
a :> Stream (Of a) m r
s) -> case a -> Maybe b
f a
a of
        Just b
b -> Of b (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of b (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> Of b (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ b
b b -> Stream (Of b) m r %1 -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> ((a -> Maybe b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
forall a b (m :: * -> *) r.
Monad m =>
(a -> Maybe b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
mapMaybe a -> Maybe b
f Stream (Of a) m r
s)
        Maybe b
Nothing -> (a -> Maybe b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
forall a b (m :: * -> *) r.
Monad m =>
(a -> Maybe b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
mapMaybe a -> Maybe b
f Stream (Of a) m r
s
{-# INLINABLE mapMaybe #-}

-- Note: the first function needs to wrap the 'b' in an 'Ur'
-- since the control monad is bound and the 'b' ends up in the first
-- unrestricted spot of 'Of'.
--
-- | Map monadically over a stream, producing a new stream
--   only containing the 'Just' values.
mapMaybeM :: forall a m b r. Control.Monad m =>
  (a -> m (Maybe (Ur b))) -> Stream (Of a) m r %1-> Stream (Of b) m r
mapMaybeM :: forall a (m :: * -> *) b r.
Monad m =>
(a -> m (Maybe (Ur b)))
-> Stream (Of a) m r %1 -> Stream (Of b) m r
mapMaybeM a -> m (Maybe (Ur b))
f Stream (Of a) m r
stream = Stream (Of a) m r %1 -> Stream (Of b) m r
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> Stream (Of b) m r
    loop :: Stream (Of a) m r %1 -> Stream (Of b) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of b) m r)
%1 -> Stream (Of b) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of b) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of b) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap ((a -> m (Maybe (Ur b)))
-> Stream (Of a) m r %1 -> Stream (Of b) m r
forall a (m :: * -> *) b r.
Monad m =>
(a -> m (Maybe (Ur b)))
-> Stream (Of a) m r %1 -> Stream (Of b) m r
mapMaybeM a -> m (Maybe (Ur b))
f) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Control.do
        Maybe (Ur b)
mb <- a -> m (Maybe (Ur b))
f a
a
        Maybe (Ur b)
mb Maybe (Ur b)
%1 -> (Maybe (Ur b) %1 -> m (Stream (Of b) m r))
%1 -> m (Stream (Of b) m r)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
          Maybe (Ur b)
Nothing -> Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of b) m r %1 -> m (Stream (Of b) m r))
%1 -> Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (a -> m (Maybe (Ur b)))
-> Stream (Of a) m r %1 -> Stream (Of b) m r
forall a (m :: * -> *) b r.
Monad m =>
(a -> m (Maybe (Ur b)))
-> Stream (Of a) m r %1 -> Stream (Of b) m r
mapMaybeM a -> m (Maybe (Ur b))
f Stream (Of a) m r
as
          Just (Ur b
b) -> Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of b) m r %1 -> m (Stream (Of b) m r))
%1 -> Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of b (Stream (Of b) m r) %1 -> 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 %1 -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> (a -> m (Maybe (Ur b)))
-> Stream (Of a) m r %1 -> Stream (Of b) m r
forall a (m :: * -> *) b r.
Monad m =>
(a -> m (Maybe (Ur b)))
-> Stream (Of a) m r %1 -> Stream (Of b) m r
mapMaybeM a -> m (Maybe (Ur b))
f Stream (Of a) m r
as)
{-# INLINABLE mapMaybeM #-}

-- # Direct Transformations
-------------------------------------------------------------------------------

{-| Change the effects of one monad to another with a transformation.
    This is one of the fundamental transformations on streams.
    Compare with 'maps':

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

-}
hoist :: forall f m n r. (Control.Monad m, Control.Functor f) =>
  (forall a. m a %1-> n a) ->
  Stream f m r %1-> Stream f n r
hoist :: forall (f :: * -> *) (m :: * -> *) (n :: * -> *) r.
(Monad m, Functor f) =>
(forall a. m a %1 -> n a) -> Stream f m r %1 -> Stream f n r
hoist forall a. m a %1 -> n a
f Stream f m r
stream = Stream f m r %1 -> Stream f n r
loop Stream f m r
stream where
  loop :: Stream f m r %1-> Stream f n r
  loop :: Stream f m r %1 -> Stream f n r
loop Stream f m r
stream = Stream f m r
stream Stream f m r
%1 -> (Stream f m r %1 -> Stream f n r) %1 -> Stream f n r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> Stream f n r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
    Effect m (Stream f m r)
m -> n (Stream f n r) %1 -> Stream f n r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (n (Stream f n r) %1 -> Stream f n r)
%1 -> n (Stream f n r) %1 -> Stream f n r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ m (Stream f n r) %1 -> n (Stream f n r)
forall a. m a %1 -> n a
f (m (Stream f n r) %1 -> n (Stream f n r))
%1 -> m (Stream f n r) %1 -> n (Stream f n r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream f m r %1 -> Stream f n r)
%1 -> m (Stream f m r) %1 -> m (Stream f n r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream f m r %1 -> Stream f n r
loop m (Stream f m r)
m
    Step f (Stream f m r)
f -> f (Stream f n r) %1 -> Stream f n r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream f n r) %1 -> Stream f n r)
%1 -> f (Stream f n r) %1 -> Stream f n r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream f m r %1 -> Stream f n r)
%1 -> f (Stream f m r) %1 -> f (Stream f n r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream f m r %1 -> Stream f n r
loop f (Stream f m r)
f
{-# INLINABLE hoist #-}

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

@
\>\>\> S.stdoutLn $ S.map reverse $ each' (words "alpha beta")
ahpla
ateb
@
-}
map :: Control.Monad m => (a -> b) -> Stream (Of a) m r %1-> Stream (Of b) m r
map :: forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map a -> b
f = (forall x. Of a x %1 -> Of b x)
-> Stream (Of a) m r %1 -> Stream (Of b) m r
forall (f :: * -> *) (g :: * -> *) (m :: * -> *) r.
(Monad m, Functor f) =>
(forall x. f x %1 -> g x) -> Stream f m r %1 -> Stream g m r
maps (\(a
x :> x
rest) -> a -> b
f a
x b -> x %1 -> Of b x
forall a b. a -> b -> Of a b
:> x
rest)
{-# INLINABLE map #-}

-- Remark.
--
-- The functor transformation in functions like maps, mapped, mapsPost,
-- and such must be linear since the 'Stream' data type holds each
-- functor step with a linear arrow.

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

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

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

-- Remark: Since the mapping function puts its result in a control monad,
-- it must be used exactly once after the monadic value is bound.
-- As a result the mapping function needs to return an 'Ur b'
-- so that we can place the 'b' in the first argument of the
-- 'Of' constructor, which is unrestricted.
--
{-| 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 :: Control.Monad m =>
  (a -> m (Ur b)) -> Stream (Of a) m r %1-> Stream (Of b) m r
mapM :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m (Ur b)) -> Stream (Of a) m r %1 -> Stream (Of b) m r
mapM a -> m (Ur b)
f Stream (Of a) m r
s = (a -> m (Ur b)) -> Stream (Of a) m r %1 -> Stream (Of b) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> m (Ur b)) -> Stream (Of a) m r %1 -> Stream (Of b) m r
loop a -> m (Ur b)
f Stream (Of a) m r
s
  where
    loop :: Control.Monad m =>
      (a -> m (Ur b)) -> Stream (Of a) m r %1-> Stream (Of b) m r
    loop :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m (Ur b)) -> Stream (Of a) m r %1 -> Stream (Of b) m r
loop a -> m (Ur b)
f Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of b) m r)
%1 -> Stream (Of b) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of b) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of b) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap ((a -> m (Ur b)) -> Stream (Of a) m r %1 -> Stream (Of b) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> m (Ur b)) -> Stream (Of a) m r %1 -> Stream (Of b) m r
loop a -> m (Ur b)
f) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Control.do
        Ur b
b <- a -> m (Ur b)
f a
a
        Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of b) m r %1 -> m (Stream (Of b) m r))
%1 -> Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of b (Stream (Of b) m r) %1 -> 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 %1 -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> ((a -> m (Ur b)) -> Stream (Of a) m r %1 -> Stream (Of b) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> m (Ur b)) -> Stream (Of a) m r %1 -> Stream (Of b) m r
loop a -> m (Ur b)
f Stream (Of a) m r
as))
{-# INLINABLE mapM #-}

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

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

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

{- | Map layers of one functor to another with a transformation involving the base monad.

     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)

     where @f@ and @g@ are @Control.Monad@s

     '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 :: forall f g m r . (Control.Monad m, Control.Functor f) =>
  (forall x. f x %1-> m (g x)) -> Stream f m r %1-> Stream g m r
mapped :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) r.
(Monad m, Functor f) =>
(forall x. f x %1 -> m (g x)) -> Stream f m r %1 -> Stream g m r
mapped forall x. f x %1 -> m (g x)
phi = Stream f m r %1 -> Stream g m r
loop
  where
  loop :: Stream f m r %1-> Stream g m r
  loop :: Stream f m r %1 -> Stream g m r
loop Stream f m r
stream = Stream f m r
stream Stream f m r
%1 -> (Stream f m r %1 -> Stream g m r) %1 -> Stream g m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> Stream g m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
    Effect m (Stream f m r)
m -> m (Stream g m r) %1 -> Stream g m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream g m r) %1 -> Stream g m r)
%1 -> m (Stream g m r) %1 -> Stream g m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream f m r %1 -> Stream g m r)
%1 -> m (Stream f m r) %1 -> m (Stream g m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream f m r %1 -> Stream g m r
loop m (Stream f m r)
m
    Step f (Stream f m r)
f -> m (Stream g m r) %1 -> Stream g m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream g m r) %1 -> Stream g m r)
%1 -> m (Stream g m r) %1 -> Stream g m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (g (Stream g m r) %1 -> Stream g m r)
%1 -> m (g (Stream g m r)) %1 -> m (Stream g m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap g (Stream g m r) %1 -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (m (g (Stream g m r)) %1 -> m (Stream g m r))
%1 -> m (g (Stream g m r)) %1 -> m (Stream g m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ f (Stream g m r) %1 -> m (g (Stream g m r))
forall x. f x %1 -> m (g x)
phi (f (Stream g m r) %1 -> m (g (Stream g m r)))
%1 -> f (Stream g m r) %1 -> m (g (Stream g m r))
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream f m r %1 -> Stream g m r)
%1 -> f (Stream f m r) %1 -> f (Stream g m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream f m r %1 -> Stream g m r
loop f (Stream f m r)
f

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

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

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

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

-}
{-# INLINABLE mapped #-}

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

{-| A version of 'mapped' that imposes a @Control.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 :: forall m f g r. (Control.Monad m, Control.Functor g) =>
  (forall x. f x %1-> m (g x)) -> Stream f m r %1-> Stream g m r
mappedPost :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor g) =>
(forall x. f x %1 -> m (g x)) -> Stream f m r %1 -> Stream g m r
mappedPost forall x. f x %1 -> m (g x)
phi = Stream f m r %1 -> Stream g m r
loop
  where
  loop :: Stream f m r %1-> Stream g m r
  loop :: Stream f m r %1 -> Stream g m r
loop Stream f m r
stream = Stream f m r
stream Stream f m r
%1 -> (Stream f m r %1 -> Stream g m r) %1 -> Stream g m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> Stream g m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
    Effect m (Stream f m r)
m -> m (Stream g m r) %1 -> Stream g m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream g m r) %1 -> Stream g m r)
%1 -> m (Stream g m r) %1 -> Stream g m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream f m r %1 -> Stream g m r)
%1 -> m (Stream f m r) %1 -> m (Stream g m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream f m r %1 -> Stream g m r
loop m (Stream f m r)
m
    Step f (Stream f m r)
f -> m (Stream g m r) %1 -> Stream g m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream g m r) %1 -> Stream g m r)
%1 -> m (Stream g m r) %1 -> Stream g m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (g (Stream f m r) %1 -> Stream g m r)
%1 -> m (g (Stream f m r)) %1 -> m (Stream g m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (g (Stream g m r) %1 -> Stream g m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (g (Stream g m r) %1 -> Stream g m r)
%1 -> (g (Stream f m r) %1 -> g (Stream g m r))
%1 -> g (Stream f m r)
%1 -> Stream g m r
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. (Stream f m r %1 -> Stream g m r)
%1 -> g (Stream f m r) %1 -> g (Stream g m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream f m r %1 -> Stream g m r
loop) (m (g (Stream f m r)) %1 -> m (Stream g m r))
%1 -> m (g (Stream f m r)) %1 -> m (Stream g m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ f (Stream f m r) %1 -> m (g (Stream f m r))
forall x. f x %1 -> m (g x)
phi f (Stream f m r)
f
{-# INLINABLE mappedPost #-}

-- | @for@ replaces each element of a stream with an associated stream. Note that the
-- associated stream may layer any control functor.
for :: forall f m r a x . (Control.Monad m, Control.Functor f, Consumable x) =>
  Stream (Of a) m r %1-> (a -> Stream f m x) -> Stream f m r
for :: forall (f :: * -> *) (m :: * -> *) r a x.
(Monad m, Functor f, Consumable x) =>
Stream (Of a) m r %1 -> (a -> Stream f m x) -> Stream f m r
for Stream (Of a) m r
stream a -> Stream f m x
expand = Stream (Of a) m r %1 -> Stream f m r
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> Stream f m r
    loop :: Stream (Of a) m r %1 -> Stream f m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream f m r) %1 -> Stream f m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream f m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream f m r) %1 -> Stream f m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) %1 -> Stream f m r)
%1 -> m (Stream f m r) %1 -> Stream f m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream f m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream f m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of a) m r %1 -> Stream f m r
loop m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> Control.do
         x
x <- a -> Stream f m x
expand a
a
         x %1 -> Stream f m r %1 -> Stream f m r
forall a b. Consumable a => a %1 -> b %1 -> b
lseq x
x (Stream f m r %1 -> Stream f m r)
%1 -> Stream f m r %1 -> Stream f m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Stream (Of a) m r %1 -> Stream f m r
loop Stream (Of a) m r
as
{-# INLINABLE for #-}

-- Note: since the 'x' is discarded inside a control functor,
-- we need it to be consumable
--
{-| 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 :: forall f m r a x . (Control.Monad m, Control.Functor f, Consumable x) =>
  Stream (Of a) m r %1-> (a -> f x) -> Stream f m r
with :: forall (f :: * -> *) (m :: * -> *) r a x.
(Monad m, Functor f, Consumable x) =>
Stream (Of a) m r %1 -> (a -> f x) -> Stream f m r
with Stream (Of a) m r
s a -> f x
f = Stream (Of a) m r %1 -> Stream f m r
loop Stream (Of a) m r
s
  where
    loop :: Stream (Of a) m r %1-> Stream f m r
    loop :: Stream (Of a) m r %1 -> Stream f m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream f m r) %1 -> Stream f m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream f m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream f m r) %1 -> Stream f m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) %1 -> Stream f m r)
%1 -> m (Stream f m r) %1 -> Stream f m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream f m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream f m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of a) m r %1 -> Stream f m r
loop m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> f (Stream f m r) %1 -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (f (Stream f m r) %1 -> Stream f m r)
%1 -> f (Stream f m r) %1 -> Stream f m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (x %1 -> Stream f m r) %1 -> f x %1 -> f (Stream f m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (x %1 -> Stream f m r %1 -> Stream f m r
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` (Stream (Of a) m r %1 -> Stream f m r
loop Stream (Of a) m r
as)) (a -> f x
f a
a)
{-# INLINABLE with #-}

{-| 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 :: (Control.Monad m, Control.Functor f, Consumable x) =>
  (a -> f x) -> Stream (Of a) m r %1-> Stream f m r
subst :: forall (m :: * -> *) (f :: * -> *) x a r.
(Monad m, Functor f, Consumable x) =>
(a -> f x) -> Stream (Of a) m r %1 -> Stream f m r
subst = (Stream (Of a) m r %1 -> (a -> f x) -> Stream f m r)
-> (a -> f x) -> Stream (Of a) m r %1 -> Stream f m r
forall a b c. (a %1 -> b -> c) -> b -> a %1 -> c
flip Stream (Of a) m r %1 -> (a -> f x) -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r a x.
(Monad m, Functor f, Consumable x) =>
Stream (Of a) m r %1 -> (a -> f x) -> Stream f m r
with where
  flip :: (a %1-> b -> c) -> b -> a %1-> c
  flip :: forall a b c. (a %1 -> b -> c) -> b -> a %1 -> c
flip a %1 -> b -> c
f b
b a
a = a %1 -> b -> c
f a
a b
b
{-# INLINE subst #-}

{-| Duplicate the content of a 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. @Control.Monad@, @Control.Functor@, 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 :: forall a m r . Control.Monad m =>
     Stream (Of a) m r %1-> Stream (Of a) (Stream (Of a) m) r
copy :: forall a (m :: * -> *) r.
Monad m =>
Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
copy = Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) (Stream (Of a) m) r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
 %1 -> Stream (Of a) (Stream (Of a) m) r)
%1 -> (Stream (Of a) (Stream (Of a) m) r
       %1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
%1 -> Stream (Of a) (Stream (Of a) m) r
%1 -> Stream (Of a) (Stream (Of a) m) r
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. Stream (Of a) (Stream (Of a) m) r
%1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of a) (Stream (Of a) m) r
 %1 -> Stream (Of a) (Stream (Of a) m) r)
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) m r
%1 -> Stream (Of a) (Stream (Of a) m) r
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
loop
  where
    loop :: Stream (Of a) m r %1-> Stream (Of a) (Stream (Of a) m) r
    loop :: Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) (Stream (Of a) m) r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of a) (Stream (Of a) m) r
forall r (f :: * -> *) (m :: * -> *). 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)
%1 -> Stream (Of a) (Stream (Of a) m) r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
 %1 -> Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) (Stream (Of a) m) r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) m (Stream (Of a) m r)
%1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
loop (m (Stream (Of a) m r) %1 -> Stream (Of a) m (Stream (Of a) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift m (Stream (Of a) m r)
m)
      Step (a
a :> Stream (Of a) m r
as) -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) (Stream (Of a) m) r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
 %1 -> Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
%1 -> Stream (Of a) (Stream (Of a) m) r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of a (Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r))
%1 -> 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)
%1 -> 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
%1 -> Stream (Of a) m (Stream (Of a) (Stream (Of a) m) r)
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return (Of a (Stream (Of a) (Stream (Of a) m) r)
%1 -> 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
%1 -> Of a (Stream (Of a) (Stream (Of a) m) r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
loop Stream (Of a) m r
as)))
{-# INLINABLE copy#-}

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


-- Note: to use the stream linearly the first argument
-- must be a linear function
--
{-| 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 this:

> storeM ::  (forall s m . Control.Monad m => Stream (Of a) m s %1-> m (Of b s))
>         -> (Control.Monad n => Stream (Of a) n r %1-> Stream (Of a) n (Of b r))
> storeM = store

    It is clear from this type that we are just using the general instance:

> instance (Control.Functor f, Control.Monad m)   => Control.Monad (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.
    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 :: Control.Monad m =>
  (Stream (Of a) (Stream (Of a) m) r %1-> t) -> Stream (Of a) m r %1-> t
store :: forall (m :: * -> *) a r t.
Monad m =>
(Stream (Of a) (Stream (Of a) m) r %1 -> t)
-> Stream (Of a) m r %1 -> t
store Stream (Of a) (Stream (Of a) m) r %1 -> t
f Stream (Of a) m r
x = Stream (Of a) (Stream (Of a) m) r %1 -> t
f (Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
forall a (m :: * -> *) r.
Monad m =>
Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r
copy Stream (Of a) m r
x)
{-# INLINE store #-}

-- Note: since we discard the 'y' inside a control monad, it needs to be
-- consumable
--
{-| 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 :: forall a m r y . (Control.Monad m, Consumable y) =>
  (a -> m y) -> Stream (Of a) m r %1-> Stream (Of a) m r
chain :: forall a (m :: * -> *) r y.
(Monad m, Consumable y) =>
(a -> m y) -> Stream (Of a) m r %1 -> Stream (Of a) m r
chain a -> m y
f = Stream (Of a) m r %1 -> Stream (Of a) m r
loop
  where
    loop :: Stream (Of a) m r %1-> Stream (Of a) m r
    loop :: Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m  -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of a) m r %1 -> 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) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Control.do
        y
y <- a -> m y
f a
a
        Stream (Of a) m r %1 -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of a) m r %1 -> m (Stream (Of a) m r))
%1 -> Stream (Of a) m r %1 -> m (Stream (Of a) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ y %1 -> Stream (Of a) m r %1 -> Stream (Of a) m r
forall a b. Consumable a => a %1 -> b %1 -> b
lseq y
y (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
as)
{-# INLINABLE chain #-}

-- Note: since the value of type 'a' is inside a control monad but
-- needs to be used in an unrestricted position in 'Of', the input stream
-- needs to hold values of type 'm (Ur a)'.
--
{-| 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 :: Control.Monad m => Stream (Of (m a)) m r %1-> Stream (Of a) m r

-}
sequence :: forall a m r . Control.Monad m =>
  Stream (Of (m (Ur a))) m r %1-> Stream (Of a) m r
sequence :: forall a (m :: * -> *) r.
Monad m =>
Stream (Of (m (Ur a))) m r %1 -> Stream (Of a) m r
sequence = Stream (Of (m (Ur a))) m r %1 -> Stream (Of a) m r
loop
  where
    loop :: Stream (Of (m (Ur a))) m r %1-> Stream (Of a) m r
    loop :: Stream (Of (m (Ur a))) m r %1 -> Stream (Of a) m r
loop Stream (Of (m (Ur a))) m r
stream = Stream (Of (m (Ur a))) m r
stream Stream (Of (m (Ur a))) m r
%1 -> (Stream (Of (m (Ur a))) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of (m (Ur a))) m r)
m -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of (m (Ur a))) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of (m (Ur a))) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of (m (Ur a))) m r %1 -> Stream (Of a) m r
loop m (Stream (Of (m (Ur a))) m r)
m
      Step (m (Ur a)
ma :> Stream (Of (m (Ur a))) m r
mas) -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Control.do
        Ur a
a <- m (Ur a)
ma
        Stream (Of a) m r %1 -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of a) m r %1 -> m (Stream (Of a) m r))
%1 -> Stream (Of a) m r %1 -> m (Stream (Of a) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of (m (Ur a))) m r %1 -> Stream (Of a) m r
loop Stream (Of (m (Ur a))) m r
mas)
{-# INLINABLE sequence #-}

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

-}
nubOrd :: (Control.Monad m, Ord a) => Stream (Of a) m r %1-> Stream (Of a) m r
nubOrd :: forall (m :: * -> *) a r.
(Monad m, Ord a) =>
Stream (Of a) m r %1 -> Stream (Of a) m r
nubOrd = (a -> a) -> Stream (Of a) m r %1 -> Stream (Of a) m r
forall (m :: * -> *) a b r.
(Monad m, Ord b) =>
(a -> b) -> Stream (Of a) m r %1 -> 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 :: forall m a b r . (Control.Monad m, Ord b) =>
  (a -> b) -> Stream (Of a) m r %1-> Stream (Of a) m r
nubOrdOn :: forall (m :: * -> *) a b r.
(Monad m, Ord b) =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of a) m r
nubOrdOn a -> b
f Stream (Of a) m r
xs = Set b -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop Set b
forall a. Set a
Set.empty Stream (Of a) m r
xs
  where
  loop :: Set.Set b -> Stream (Of a) m r %1-> Stream (Of a) m r
  loop :: Set b -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop !Set b
set Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (Set b -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop Set b
set) m (Stream (Of a) m r)
m
    Step (a
a :> Stream (Of a) m r
as) -> case b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (a -> b
f a
a) Set b
set of
         Bool
True -> Set b -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop Set b
set Stream (Of a) m r
as
         Bool
False-> Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Set b -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop (b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert (a -> b
f a
a) Set b
set) Stream (Of a) m r
as)

{-| More efficient versions of above when working with 'Int's that use 'Data.IntSet.IntSet'. -}
nubInt :: Control.Monad m => Stream (Of Int) m r %1-> Stream (Of Int) m r
nubInt :: forall (m :: * -> *) r.
Monad m =>
Stream (Of Int) m r %1 -> Stream (Of Int) m r
nubInt = (Int -> Int) -> Stream (Of Int) m r %1 -> Stream (Of Int) m r
forall (m :: * -> *) a r.
Monad m =>
(a -> Int) -> Stream (Of a) m r %1 -> Stream (Of a) m r
nubIntOn Int -> Int
forall a. a -> a
id
{-# INLINE nubInt #-}

nubIntOn :: forall m a r . (Control.Monad m) =>
  (a -> Int) -> Stream (Of a) m r %1-> Stream (Of a) m r
nubIntOn :: forall (m :: * -> *) a r.
Monad m =>
(a -> Int) -> Stream (Of a) m r %1 -> Stream (Of a) m r
nubIntOn a -> Int
f Stream (Of a) m r
xs = IntSet -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop IntSet
IntSet.empty Stream (Of a) m r
xs
  where
  loop :: IntSet.IntSet -> Stream (Of a) m r %1-> Stream (Of a) m r
  loop :: IntSet -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop !IntSet
set Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (IntSet -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop IntSet
set) m (Stream (Of a) m r)
m
    Step (a
a :> Stream (Of a) m r
as) -> case Int -> IntSet -> Bool
IntSet.member (a -> Int
f a
a) IntSet
set of
         Bool
True -> IntSet -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop IntSet
set Stream (Of a) m r
as
         Bool
False-> Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> IntSet -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop (Int -> IntSet -> IntSet
IntSet.insert (a -> Int
f a
a) IntSet
set) Stream (Of a) m r
as)

-- | Skip elements of a stream that fail a predicate
filter  :: forall a m r . Control.Monad m =>
  (a -> Bool) -> Stream (Of a) m r %1-> Stream (Of a) m r
filter :: forall a (m :: * -> *) r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of a) m r
filter a -> Bool
pred = Stream (Of a) m r %1 -> Stream (Of a) m r
loop
  where
    loop :: Stream (Of a) m r %1-> Stream (Of a) m r
    loop :: Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of a) m r %1 -> Stream (Of a) m r
loop m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> case a -> Bool
pred a
a of
        Bool
True -> Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
as)
        Bool
False -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
as
{-# INLINE filter #-}

-- | Skip elements of a stream that fail a monadic test
filterM  :: forall a m r . Control.Monad m =>
  (a -> m Bool) -> Stream (Of a) m r %1-> Stream (Of a) m r
filterM :: forall a (m :: * -> *) r.
Monad m =>
(a -> m Bool) -> Stream (Of a) m r %1 -> Stream (Of a) m r
filterM a -> m Bool
pred = Stream (Of a) m r %1 -> Stream (Of a) m r
loop
  where
    loop :: Stream (Of a) m r %1-> Stream (Of a) m r
    loop :: Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m-> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of a) m r %1 -> 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) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Control.do
        Bool
bool <- a -> m Bool
pred a
a
        Bool
bool Bool
%1 -> (Bool %1 -> m (Stream (Of a) m r))
%1 -> m (Stream (Of a) m r)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
          Bool
True -> Stream (Of a) m r %1 -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of a) m r %1 -> m (Stream (Of a) m r))
%1 -> Stream (Of a) m r %1 -> m (Stream (Of a) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
as)
          Bool
False -> Stream (Of a) m r %1 -> m (Stream (Of a) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of a) m r %1 -> m (Stream (Of a) m r))
%1 -> Stream (Of a) m r %1 -> m (Stream (Of a) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
as
{-# INLINE filterM #-}

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

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

-}
intersperse :: forall a m r . Control.Monad m =>
  a -> Stream (Of a) m r %1-> Stream (Of a) m r
intersperse :: forall a (m :: * -> *) r.
Monad m =>
a -> Stream (Of a) m r %1 -> Stream (Of a) m r
intersperse a
x Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (a -> Stream (Of a) m r %1 -> Stream (Of a) m r
forall a (m :: * -> *) r.
Monad m =>
a -> Stream (Of a) m r %1 -> Stream (Of a) m r
intersperse a
x) m (Stream (Of a) m r)
m
    Step (a
a :> Stream (Of a) m r
as) -> a -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop a
a Stream (Of a) m r
as
  where
    -- Given the first element of a stream, intersperse the bound
    -- element named 'x'
    loop :: a -> Stream (Of a) m r %1-> Stream (Of a) m r
    loop :: a -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop !a
a Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r)
      Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (a -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop a
a) m (Stream (Of a) m r)
m
      Step (a
a' :> Stream (Of a) m r
as) -> Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> a -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop a
a' Stream (Of a) m r
as))
{-# INLINABLE intersperse #-}

{-|  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 :: forall a m r. (HasCallStack, Control.Monad m) =>
  Int -> Stream (Of a) m r %1-> Stream (Of a) m r
drop :: forall a (m :: * -> *) r.
(HasCallStack, Monad m) =>
Int -> Stream (Of a) m r %1 -> Stream (Of a) m r
drop Int
n Stream (Of a) m r
stream = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 of
  Ordering
LT -> [Char] -> Stream (Of a) m r %1 -> Stream (Of a) m r
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"drop called with negative int" (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Stream (Of a) m r
stream
  Ordering
EQ -> Stream (Of a) m r
stream
  Ordering
GT -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
stream where
    loop :: Stream (Of a) m r %1-> Stream (Of a) m r
    loop :: Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (Int -> Stream (Of a) m r %1 -> Stream (Of a) m r
forall a (m :: * -> *) r.
(HasCallStack, Monad m) =>
Int -> Stream (Of a) m r %1 -> Stream (Of a) m r
drop Int
n) m (Stream (Of a) m r)
m
      Step (a
_ :> Stream (Of a) m r
as) -> Int -> Stream (Of a) m r %1 -> Stream (Of a) m r
forall a (m :: * -> *) r.
(HasCallStack, Monad m) =>
Int -> Stream (Of a) m r %1 -> Stream (Of a) m r
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Stream (Of a) m r
as
{-# INLINABLE drop #-}

{- | 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 :: forall a m r . Control.Monad m =>
  (a -> Bool) -> Stream (Of a) m r %1-> Stream (Of a) m r
dropWhile :: forall a (m :: * -> *) r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of a) m r
dropWhile a -> Bool
pred = Stream (Of a) m r %1 -> Stream (Of a) m r
loop
  where
    loop :: Stream (Of a) m r %1-> Stream (Of a) m r
    loop :: Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> Stream (Of a) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of a) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of a) m r) %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> Stream (Of a) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of a) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of a) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Stream (Of a) m r %1 -> Stream (Of a) m r
loop m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> case a -> Bool
pred a
a of
        Bool
True -> Stream (Of a) m r %1 -> Stream (Of a) m r
loop Stream (Of a) m r
as
        Bool
False -> Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
as)
{-# INLINABLE dropWhile #-}

{-| 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 :: forall a x b m r . Control.Monad m =>
  (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1-> Stream (Of b) m r
scan :: forall a x b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
scan x -> a -> x
step x
begin x -> b
done Stream (Of a) m r
stream = Of b (Stream (Of b) m r) %1 -> 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 %1 -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> x -> Stream (Of a) m r %1 -> Stream (Of b) m r
loop x
begin Stream (Of a) m r
stream)
  where
    loop :: x -> Stream (Of a) m r %1-> Stream (Of b) m r
    loop :: x -> Stream (Of a) m r %1 -> Stream (Of b) m r
loop !x
acc Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of b) m r)
%1 -> Stream (Of b) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of b) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of b) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (x -> Stream (Of a) m r %1 -> Stream (Of b) m r
loop x
acc) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> Of b (Stream (Of b) m r) %1 -> 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 %1 -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> x -> Stream (Of a) m r %1 -> Stream (Of b) m r
loop x
acc' Stream (Of a) m r
as) where
        !acc' :: x
acc' = x -> a -> x
step x
acc a
a
{-# INLINABLE scan #-}

-- Note: since the accumulated value (inside the control monad) is used both in
-- populating the output stream and in accumulation, it needs to be wrapped in
-- an 'Ur' accross the function
--
{-| 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 :: forall a x b m r . Control.Monad m =>
  (x %1-> a -> m (Ur x)) ->
  m (Ur x) ->
  (x %1-> m (Ur b)) ->
  Stream (Of a) m r %1->
  Stream (Of b) m r
scanM :: forall a x b (m :: * -> *) r.
Monad m =>
(x %1 -> a -> m (Ur x))
-> m (Ur x)
-> (x %1 -> m (Ur b))
-> Stream (Of a) m r
%1 -> Stream (Of b) m r
scanM x %1 -> a -> m (Ur x)
step m (Ur x)
mx x %1 -> m (Ur b)
done Stream (Of a) m r
stream = Stream (Of a) m r %1 -> Stream (Of b) m r
loop Stream (Of a) m r
stream
  where
    loop :: Stream (Of a) m r %1-> Stream (Of b) m r
    loop :: Stream (Of a) m r %1 -> Stream (Of b) m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of b) m r)
%1 -> Stream (Of b) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Control.do
        Ur x
x <- m (Ur x)
mx
        Ur b
b <- x %1 -> m (Ur b)
done x
x
        Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of b) m r %1 -> m (Stream (Of b) m r))
%1 -> Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of b (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of b (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> Of b (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ b
b b -> Stream (Of b) m r %1 -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> r %1 -> Stream (Of b) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of b) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap ((x %1 -> a -> m (Ur x))
-> m (Ur x)
-> (x %1 -> m (Ur b))
-> Stream (Of a) m r
%1 -> Stream (Of b) m r
forall a x b (m :: * -> *) r.
Monad m =>
(x %1 -> a -> m (Ur x))
-> m (Ur x)
-> (x %1 -> m (Ur b))
-> Stream (Of a) m r
%1 -> Stream (Of b) m r
scanM x %1 -> a -> m (Ur x)
step m (Ur x)
mx x %1 -> m (Ur b)
done) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> m (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Control.do
        Ur x
x <- m (Ur x)
mx
        Ur b
b <- x %1 -> m (Ur b)
done x
x
        Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream (Of b) m r %1 -> m (Stream (Of b) m r))
%1 -> Stream (Of b) m r %1 -> m (Stream (Of b) m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Of b (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of b (Stream (Of b) m r) %1 -> Stream (Of b) m r)
%1 -> Of b (Stream (Of b) m r) %1 -> Stream (Of b) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ b
b b -> Stream (Of b) m r %1 -> Of b (Stream (Of b) m r)
forall a b. a -> b -> Of a b
:> ((x %1 -> a -> m (Ur x))
-> m (Ur x)
-> (x %1 -> m (Ur b))
-> Stream (Of a) m r
%1 -> Stream (Of b) m r
forall a x b (m :: * -> *) r.
Monad m =>
(x %1 -> a -> m (Ur x))
-> m (Ur x)
-> (x %1 -> m (Ur b))
-> Stream (Of a) m r
%1 -> Stream (Of b) m r
scanM x %1 -> a -> m (Ur x)
step (x %1 -> a -> m (Ur x)
step x
x a
a) x %1 -> m (Ur b)
done Stream (Of a) m r
as)
{-# 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 :: forall a x b m r . Control.Monad m =>
  (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1-> Stream (Of (a,b)) m r
scanned :: forall a x b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> Stream (Of (a, b)) m r
scanned x -> a -> x
step x
begin x -> b
done = x -> Stream (Of a) m r %1 -> Stream (Of (a, b)) m r
loop x
begin
  where
    loop :: x -> Stream (Of a) m r %1-> Stream (Of (a,b)) m r
    loop :: x -> Stream (Of a) m r %1 -> Stream (Of (a, b)) m r
loop !x
x Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream (Of (a, b)) m r)
%1 -> Stream (Of (a, b)) m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
      Return r
r -> r %1 -> Stream (Of (a, b)) m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
      Effect m (Stream (Of a) m r)
m -> m (Stream (Of (a, b)) m r) %1 -> Stream (Of (a, b)) m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream (Of (a, b)) m r) %1 -> Stream (Of (a, b)) m r)
%1 -> m (Stream (Of (a, b)) m r) %1 -> Stream (Of (a, b)) m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Stream (Of a) m r %1 -> Stream (Of (a, b)) m r)
%1 -> m (Stream (Of a) m r) %1 -> m (Stream (Of (a, b)) m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (x -> Stream (Of a) m r %1 -> Stream (Of (a, b)) m r
loop x
x) m (Stream (Of a) m r)
m
      Step (a
a :> Stream (Of a) m r
as) -> Control.do
        let !acc :: b
acc = x -> b
done (x -> a -> x
step x
x a
a)
        Of (a, b) (Stream (Of (a, b)) m ()) %1 -> Stream (Of (a, b)) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of (a, b) (Stream (Of (a, b)) m ()) %1 -> Stream (Of (a, b)) m ())
%1 -> Of (a, b) (Stream (Of (a, b)) m ())
%1 -> Stream (Of (a, b)) m ()
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (a
a, b
acc) (a, b)
-> Stream (Of (a, b)) m () -> Of (a, b) (Stream (Of (a, b)) m ())
forall a b. a -> b -> Of a b
:> () -> Stream (Of (a, b)) m ()
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return () -- same as yield
        x -> Stream (Of a) m r %1 -> Stream (Of (a, b)) m r
loop (x -> a -> x
step x
x a
a) Stream (Of a) m r
as
{-# INLINABLE scanned #-}

-- Note: this skips failed parses
-- XXX re-write with Text
--
{- | 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 :: (Control.Monad m, Read a) =>
  Stream (Of String) m r %1-> Stream (Of a) m r
read :: forall (m :: * -> *) a r.
(Monad m, Read a) =>
Stream (Of [Char]) m r %1 -> Stream (Of a) m r
read = ([Char] -> Maybe a)
-> Stream (Of [Char]) m r %1 -> Stream (Of a) m r
forall a b (m :: * -> *) r.
Monad m =>
(a -> Maybe b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
mapMaybe [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe
{-# INLINE read #-}

{-| Interpolate a delay of n seconds between yields.
-}
delay :: forall a r. Double -> Stream (Of a) IO r %1-> Stream (Of a) IO r
delay :: forall a r. Double -> Stream (Of a) IO r %1 -> Stream (Of a) IO r
delay Double
seconds = Stream (Of a) IO r %1 -> Stream (Of a) IO r
loop
  where
    pico :: Int
pico = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
Prelude.truncate (Double
seconds Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000000)
    loop :: Stream (Of a) IO r %1-> Stream (Of a) IO r
    loop :: Stream (Of a) IO r %1 -> Stream (Of a) IO r
loop Stream (Of a) IO r
stream = Control.do
      Either r (Ur a, Stream (Of a) IO r)
e <- IO (Either r (Ur a, Stream (Of a) IO r))
%1 -> Stream (Of a) IO (Either r (Ur a, Stream (Of a) IO r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift (IO (Either r (Ur a, Stream (Of a) IO r))
 %1 -> Stream (Of a) IO (Either r (Ur a, Stream (Of a) IO r)))
%1 -> IO (Either r (Ur a, Stream (Of a) IO r))
%1 -> Stream (Of a) IO (Either r (Ur a, Stream (Of a) IO r))
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Stream (Of a) IO r %1 -> IO (Either r (Ur a, Stream (Of a) IO r))
forall a (m :: * -> *) r.
Monad m =>
Stream (Of a) m r %1 -> m (Either r (Ur a, Stream (Of a) m r))
next Stream (Of a) IO r
stream
      Either r (Ur a, Stream (Of a) IO r)
e Either r (Ur a, Stream (Of a) IO r)
%1 -> (Either r (Ur a, Stream (Of a) IO r)
       %1 -> Stream (Of a) IO r)
%1 -> Stream (Of a) IO r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
        Left r
r -> r %1 -> Stream (Of a) IO r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
        Right (Ur a
a,Stream (Of a) IO r
rest) -> Control.do
          Of a (Stream (Of a) IO ()) -> Stream (Of a) IO ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (a
a a -> Stream (Of a) IO () -> Of a (Stream (Of a) IO ())
forall a b. a -> b -> Of a b
:> () -> Stream (Of a) IO ()
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return ()) -- same as yield
          IO () %1 -> Stream (Of a) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift (IO () %1 -> Stream (Of a) IO ())
%1 -> IO () %1 -> Stream (Of a) IO ()
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ IO () %1 -> IO ()
forall a. IO a %1 -> IO a
fromSystemIO (IO () %1 -> IO ()) %1 -> IO () %1 -> IO ()
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Int -> IO ()
threadDelay Int
pico
          Stream (Of a) IO r %1 -> Stream (Of a) IO r
loop Stream (Of a) IO r
rest
{-# INLINABLE delay #-}

show :: (Control.Monad m, Prelude.Show a) =>
  Stream (Of a) m r %1-> Stream (Of String) m r
show :: forall (m :: * -> *) a r.
(Monad m, Show a) =>
Stream (Of a) m r %1 -> Stream (Of [Char]) m r
show = (a -> [Char]) -> Stream (Of a) m r %1 -> Stream (Of [Char]) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map a -> [Char]
forall a. Show a => a -> [Char]
Prelude.show
{-# INLINE show #-}


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

> cons a stream = yield a Control.>> 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 :: Control.Monad m => a -> Stream (Of a) m r %1-> Stream (Of a) m r
cons :: forall (m :: * -> *) a r.
Monad m =>
a -> Stream (Of a) m r %1 -> Stream (Of a) m r
cons a
a Stream (Of a) m r
str = Of a (Stream (Of a) m r) %1 -> 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 %1 -> Of a (Stream (Of a) m r)
forall a b. a -> b -> Of a b
:> Stream (Of a) m r
str)
{-# INLINE cons #-}

-- Note. The action function that is the second argument must be linear since
-- it gets its argument from binding to the first argument, which uses a
-- control monad.
--
{-| 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 :: (Control.Monad m, Control.Functor f, Consumable y) =>
  m a -> (a %1-> m y) -> Stream f m r %1-> Stream f m r
wrapEffect :: forall (m :: * -> *) (f :: * -> *) y a r.
(Monad m, Functor f, Consumable y) =>
m a -> (a %1 -> m y) -> Stream f m r %1 -> Stream f m r
wrapEffect m a
ma a %1 -> m y
action Stream f m r
stream = Stream f m r
stream Stream f m r
%1 -> (Stream f m r %1 -> Stream f m r) %1 -> Stream f m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
  Return r
r -> r %1 -> Stream f m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
  Effect m (Stream f m r)
m -> m (Stream f m r) %1 -> Stream f m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) %1 -> Stream f m r)
%1 -> m (Stream f m r) %1 -> Stream f m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Control.do
    a
a <- m a
ma
    y
y <- a %1 -> m y
action a
a
    y %1 -> m (Stream f m r) %1 -> m (Stream f m r)
forall a b. Consumable a => a %1 -> b %1 -> b
lseq y
y (m (Stream f m r) %1 -> m (Stream f m r))
%1 -> m (Stream f m r) %1 -> m (Stream f m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ m (Stream f m r)
m
  Step f (Stream f m r)
f -> m (Stream f m r) %1 -> Stream f m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream f m r) %1 -> Stream f m r)
%1 -> m (Stream f m r) %1 -> Stream f m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Control.do
    a
a <- m a
ma
    y
y <- a %1 -> m y
action a
a
    Stream f m r %1 -> m (Stream f m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream f m r %1 -> m (Stream f m r))
%1 -> Stream f m r %1 -> m (Stream f m r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ y %1 -> Stream f m r %1 -> Stream f m r
forall a b. Consumable a => a %1 -> b %1 -> b
lseq y
y (Stream f m r %1 -> Stream f m r)
%1 -> Stream f m r %1 -> Stream f m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ f (Stream f m r) %1 -> Stream f m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step f (Stream f m r)
f

{-| '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 :: forall a b m. Control.Monad m => Int -> Stream (Of a) m b
              %1-> Stream (Of (Seq.Seq a)) m b
slidingWindow :: forall a b (m :: * -> *).
Monad m =>
Int -> Stream (Of a) m b %1 -> Stream (Of (Seq a)) m b
slidingWindow Int
n = Int -> Seq a -> Stream (Of a) m b %1 -> 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. Seq a
Seq.empty
  where
    -- Given the current sliding window, yield it and then recurse with
    -- updated sliding window
    window :: Seq.Seq a -> Stream (Of a) m b %1-> Stream (Of (Seq.Seq a)) m b
    window :: Seq a -> Stream (Of a) m b %1 -> Stream (Of (Seq a)) m b
window !Seq a
sequ Stream (Of a) m b
str = Control.do
      Either b (Ur a, Stream (Of a) m b)
e <- m (Either b (Ur a, Stream (Of a) m b))
%1 -> Stream (Of (Seq a)) m (Either b (Ur a, Stream (Of a) m b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift (Stream (Of a) m b %1 -> m (Either b (Ur a, Stream (Of a) m b))
forall a (m :: * -> *) r.
Monad m =>
Stream (Of a) m r %1 -> m (Either r (Ur a, Stream (Of a) m r))
next Stream (Of a) m b
str)
      Either b (Ur a, Stream (Of a) m b)
e Either b (Ur a, Stream (Of a) m b)
%1 -> (Either b (Ur a, Stream (Of a) m b)
       %1 -> Stream (Of (Seq a)) m b)
%1 -> Stream (Of (Seq a)) m b
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
        Left b
r -> b %1 -> Stream (Of (Seq a)) m b
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return b
r
        Right (Ur a
a,Stream (Of a) m b
rest) -> Control.do
          Of (Seq a) (Stream (Of (Seq a)) m ())
%1 -> Stream (Of (Seq a)) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Of (Seq a) (Stream (Of (Seq a)) m ())
 %1 -> Stream (Of (Seq a)) m ())
%1 -> Of (Seq a) (Stream (Of (Seq a)) m ())
%1 -> Stream (Of (Seq a)) m ()
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (Seq a
sequ Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
a) Seq a
-> Stream (Of (Seq a)) m ()
-> Of (Seq a) (Stream (Of (Seq a)) m ())
forall a b. a -> b -> Of a b
:> () -> Stream (Of (Seq a)) m ()
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return () -- same as yield
          Seq a -> Stream (Of a) m b %1 -> 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 Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
a) Stream (Of a) m b
rest
    -- Collect the first n elements in a sequence and call 'window'
    setup ::
      Int -> Seq.Seq a -> Stream (Of a) m b %1-> Stream (Of (Seq.Seq a)) m b
    setup :: Int -> Seq a -> Stream (Of a) m b %1 -> Stream (Of (Seq a)) m b
setup Int
0 !Seq a
sequ Stream (Of a) m b
str = Control.do
       Of (Seq a) (Stream (Of (Seq a)) m ()) -> Stream (Of (Seq a)) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Seq a
sequ Seq a
-> Stream (Of (Seq a)) m ()
-> Of (Seq a) (Stream (Of (Seq a)) m ())
forall a b. a -> b -> Of a b
:> () -> Stream (Of (Seq a)) m ()
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return ()) -- same as yield
       Seq a -> Stream (Of a) m b %1 -> 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 Int
n' Seq a
sequ Stream (Of a) m b
str = Control.do
      Either b (Ur a, Stream (Of a) m b)
e <- m (Either b (Ur a, Stream (Of a) m b))
%1 -> Stream (Of (Seq a)) m (Either b (Ur a, Stream (Of a) m b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift (m (Either b (Ur a, Stream (Of a) m b))
 %1 -> Stream (Of (Seq a)) m (Either b (Ur a, Stream (Of a) m b)))
%1 -> m (Either b (Ur a, Stream (Of a) m b))
%1 -> Stream (Of (Seq a)) m (Either b (Ur a, Stream (Of a) m b))
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Stream (Of a) m b %1 -> m (Either b (Ur a, Stream (Of a) m b))
forall a (m :: * -> *) r.
Monad m =>
Stream (Of a) m r %1 -> m (Either r (Ur a, Stream (Of a) m r))
next Stream (Of a) m b
str
      Either b (Ur a, Stream (Of a) m b)
e Either b (Ur a, Stream (Of a) m b)
%1 -> (Either b (Ur a, Stream (Of a) m b)
       %1 -> Stream (Of (Seq a)) m b)
%1 -> Stream (Of (Seq a)) m b
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
        Left b
r -> Control.do
          Of (Seq a) (Stream (Of (Seq a)) m ()) -> Stream (Of (Seq a)) m ()
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Seq a
sequ Seq a
-> Stream (Of (Seq a)) m ()
-> Of (Seq a) (Stream (Of (Seq a)) m ())
forall a b. a -> b -> Of a b
:> () -> Stream (Of (Seq a)) m ()
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return ()) -- same as yield
          b %1 -> Stream (Of (Seq a)) m b
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return b
r
        Right (Ur a
x,Stream (Of a) m b
rest) -> Int -> Seq a -> Stream (Of a) m b %1 -> Stream (Of (Seq a)) m b
setup (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
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 #-}