Copyright | (c) 2017 Harendra Kumar |
---|---|
License | BSD3 |
Maintainer | streamly@composewell.com |
Stability | experimental |
Portability | GHC |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- data SerialT m a
- type Serial = SerialT IO
- serial :: IsStream t => t m a -> t m a -> t m a
- serially :: IsStream t => SerialT m a -> t m a
- data WSerialT m a
- type WSerial = WSerialT IO
- wSerial :: IsStream t => t m a -> t m a -> t m a
- wSerialFst :: IsStream t => t m a -> t m a -> t m a
- wSerialMin :: IsStream t => t m a -> t m a -> t m a
- wSerially :: IsStream t => WSerialT m a -> t m a
- unfoldrM :: (IsStream t, Monad m) => (b -> m (Maybe (a, b))) -> b -> t m a
- map :: (IsStream t, Monad m) => (a -> b) -> t m a -> t m b
- mapM :: (IsStream t, Monad m) => (a -> m b) -> t m a -> t m b
- type StreamT = SerialT
- type InterleavedT = WSerialT
- (<=>) :: IsStream t => t m a -> t m a -> t m a
- interleaving :: IsStream t => WSerialT m a -> t m a
Serial appending stream
The Semigroup
operation for SerialT
behaves like a regular append
operation. Therefore, when a <> b
is evaluated, stream a
is evaluated
first until it exhausts and then stream b
is evaluated. In other words,
the elements of stream b
are appended to the elements of stream a
. This
operation can be used to fold an infinite lazy container of streams.
import Streamly
import qualified Streamly.Prelude as S
main = (S.toList . serially
$ (S.fromList [1,2]) <> (S.fromList [3,4])) >>= print
[1,2,3,4]
The Monad
instance runs the monadic continuation for each
element of the stream, serially.
main = S.drain . serially
$ do
x <- return 1 <> return 2
S.yieldM $ print x
1 2
SerialT
nests streams serially in a depth first manner.
main = S.drain . serially
$ do
x <- return 1 <> return 2
y <- return 3 <> return 4
S.yieldM $ print (x, y)
(1,3) (1,4) (2,3) (2,4)
We call the monadic code being run for each element of the stream a monadic
continuation. In imperative paradigm we can think of this composition as
nested for
loops and the monadic continuation is the body of the loop. The
loop iterates for all elements of the stream.
Note that the behavior and semantics of SerialT
, including Semigroup
and Monad
instances are exactly like Haskell lists except that SerialT
can contain effectful actions while lists are pure.
In the code above, the serially
combinator can be omitted as the default
stream type is SerialT
.
Since: 0.2.0
Instances
type Serial = SerialT IO Source #
A serial IO stream of elements of type a
. See SerialT
documentation
for more details.
Since: 0.2.0
serially :: IsStream t => SerialT m a -> t m a Source #
Fix the type of a polymorphic stream as SerialT
.
Since: 0.1.0
Serial interleaving stream
The Semigroup
operation for WSerialT
interleaves the elements from the
two streams. Therefore, when a <> b
is evaluated, stream a
is evaluated
first to produce the first element of the combined stream and then stream
b
is evaluated to produce the next element of the combined stream, and
then we go back to evaluating stream a
and so on. In other words, the
elements of stream a
are interleaved with the elements of stream b
.
Note that evaluation of a <> b <> c
does not schedule a
, b
and c
with equal priority. This expression is equivalent to a <> (b <> c)
,
therefore, it fairly interleaves a
with the result of b <> c
. For
example, S.fromList [1,2] <> S.fromList [3,4] <> S.fromList [5,6] ::
WSerialT Identity Int
would result in [1,3,2,5,4,6]. In other words, the
leftmost stream gets the same scheduling priority as the rest of the
streams taken together. The same is true for each subexpression on the right.
Note that this operation cannot be used to fold a container of infinite streams as the state that it needs to maintain is proportional to the number of streams.
The W
in the name stands for wide
or breadth wise scheduling in
contrast to the depth wise scheduling behavior of SerialT
.
import Streamly
import qualified Streamly.Prelude as S
main = (S.toList . wSerially
$ (S.fromList [1,2]) <> (S.fromList [3,4])) >>= print
[1,3,2,4]
Similarly, the Monad
instance interleaves the iterations of the
inner and the outer loop, nesting loops in a breadth first manner.
main = S.drain . wSerially
$ do
x <- return 1 <> return 2
y <- return 3 <> return 4
S.yieldM $ print (x, y)
(1,3) (2,3) (1,4) (2,4)
Since: 0.2.0
Instances
type WSerial = WSerialT IO Source #
An interleaving serial IO stream of elements of type a
. See WSerialT
documentation for more details.
Since: 0.2.0
wSerialFst :: IsStream t => t m a -> t m a -> t m a Source #
Like wSerial
but stops interleaving as soon as the first stream stops.
Since: 0.7.0
wSerialMin :: IsStream t => t m a -> t m a -> t m a Source #
Like wSerial
but stops interleaving as soon as any of the two streams
stops.
Since: 0.7.0
wSerially :: IsStream t => WSerialT m a -> t m a Source #
Fix the type of a polymorphic stream as WSerialT
.
Since: 0.2.0
Construction
unfoldrM :: (IsStream t, Monad m) => (b -> m (Maybe (a, b))) -> b -> t m a Source #
Build a stream by unfolding a monadic step function starting from a
seed. The step function returns the next element in the stream and the next
seed value. When it is done it returns Nothing
and the stream ends. For
example,
let f b = if b > 3 then return Nothing else print b >> return (Just (b, b + 1)) in drain $ unfoldrM f 0
0 1 2 3
Internal
Transformation
Deprecated
type InterleavedT = WSerialT Source #
Deprecated: Please use WSerialT
instead.
Since: 0.1.0