@@ -6,8 +6,11 @@
66{-# LANGUAGE InstanceSigs #-}
77{-# LANGUAGE MultiParamTypeClasses #-}
88{-# LANGUAGE RankNTypes #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
910{-# LANGUAGE UndecidableInstances #-} -- XXX
1011
12+#include "inline.hs"
13+
1114-- |
1215-- Module : Streamly.Streams.StreamK
1316-- Copyright : (c) 2017 Harendra Kumar
@@ -32,22 +35,21 @@ module Streamly.Streams.StreamK
3235 , adapt
3336
3437 -- * The stream type
35− , Stream (..)
36− , unStreamIsolated
37− , isolateStream
38− , unstreamShared
39− , runStreamSVar
38+ , Stream
4039
41− -- * Construction
40+ -- * Construction Primitives
4241 , mkStream
4342 , nil
4443 , cons
4544 , (.:)
4645
47− -- * Asynchronous construction
48− , nilK
49− , yieldK
50− , consK
46+ -- * Elimination Primitives
47+ , foldStream
48+ , foldStreamShared
49+ , foldStreamSVar
50+
51+ -- * Transformation Primitives
52+ , unShare
5153
5254 -- * Deconstruction
5355 , uncons
@@ -71,7 +73,6 @@ module Streamly.Streams.StreamK
7173
7274 -- * Elimination
7375 -- ** General Folds
74− , foldStream
7576 , foldr
7677 , foldrM
7778 , foldr1
@@ -150,7 +151,7 @@ module Streamly.Streams.StreamK
150151 , serial
151152
152153 -- * Utilities
153− , consMSerial
154+ , consMStream
154155 , bindWith
155156 , withLocal
156157
@@ -161,10 +162,7 @@ module Streamly.Streams.StreamK
161162where
162163
163164import Control.Monad (void)
164−import Control.Monad.IO.Class (MonadIO(liftIO))
165165import Control.Monad.Reader.Class (MonadReader(..))
166−import Control.Monad.Trans.Class (MonadTrans(lift))
167−import Data.Semigroup (Semigroup(..))
168166import Prelude
169167 hiding (foldl, foldr, last, map, mapM, mapM_, repeat, sequence,
170168 take, filter, all, any, takeWhile, drop, dropWhile, minimum,
@@ -173,182 +171,18 @@ import Prelude
173171import qualified Prelude
174172
175173import Streamly.SVar
174+import Streamly.Streams.StreamK.Type
176175
177−------------------------------------------------------------------------------
178−-- The basic stream type
179−------------------------------------------------------------------------------
180−
181−-- | The type @Stream m a@ represents a monadic stream of values of type 'a'
182−-- constructed using actions in monad 'm'. It uses stop, singleton and yield
183−-- continuations equivalent to the following direct style type:
184−--
185−-- @
186−-- data Stream m a = Stop | Singleton a | Yield a (Stream m a)
187−-- @
188−--
189−-- To facilitate parallel composition we maintain a local state in an 'SVar'
190−-- that is shared across and is used for synchronization of the streams being
191−-- composed.
192−--
193−-- The singleton case can be expressed in terms of stop and yield but we have
194−-- it as a separate case to optimize composition operations for streams with
195−-- single element. We build singleton streams in the implementation of 'pure'
196−-- for Applicative and Monad, and in 'lift' for MonadTrans.
197−--
198−newtype Stream m a =
199− Stream {
200− unStream :: forall r.
201− State Stream m a -- state
202− -> m r -- stop
203− -> (a -> m r) -- singleton
204− -> (a -> Stream m a -> m r) -- yield
205− -> m r
206− }
207−
208−-- XXX make this the default "unStream"
209−-- | unwraps the Stream type producing the stream function that can be run with
210−-- continuations.
211−{-# INLINE unStreamIsolated #-}
212−unStreamIsolated ::
213− Stream m a
214− -> State Stream m a -- state
215− -> m r -- stop
216− -> (a -> m r) -- singleton
217− -> (a -> Stream m a -> m r) -- yield
218− -> m r
219−unStreamIsolated x st = unStream x (rstState st)
220−
221−{-# INLINE isolateStream #-}
222−isolateStream :: Stream m a -> Stream m a
223−isolateStream x = Stream $ \st stp sng yld ->
224− unStreamIsolated x st stp sng yld
225−
226−-- | Like unstream, but passes a shared SVar across continuations.
227−{-# INLINE unstreamShared #-}
228−unstreamShared ::
229− Stream m a
230− -> State Stream m a -- state
231− -> m r -- stop
232− -> (a -> m r) -- singleton
233− -> (a -> Stream m a -> m r) -- yield
234− -> m r
235−unstreamShared = unStream
236−
237−-- Run the stream using a run function associated with the SVar that runs the
238−-- streams with a captured snapshot of the monadic state.
239−{-# INLINE runStreamSVar #-}
240−runStreamSVar
241− :: MonadIO m
242− => SVar Stream m a
243− -> Stream m a
244− -> State Stream m a -- state
245− -> m r -- stop
246− -> (a -> m r) -- singleton
247− -> (a -> Stream m a -> m r) -- yield
248− -> m ()
249−runStreamSVar sv m st stp sng yld =
250− let mrun = runInIO $ svarMrun sv
251− in void $ liftIO $ mrun $ unStream m st stp sng yld
252−
253−------------------------------------------------------------------------------
254−-- Types that can behave as a Stream
255−------------------------------------------------------------------------------
256−
257−infixr 5 `consM`
258−infixr 5 |:
259−
260−-- | Class of types that can represent a stream of elements of some type 'a' in
261−-- some monad 'm'.
262−--
263−-- @since 0.2.0
264−class IsStream t where
265− toStream :: t m a -> Stream m a
266− fromStream :: Stream m a -> t m a
267− -- | Constructs a stream by adding a monadic action at the head of an
268− -- existing stream. For example:
269− --
270− -- @
271− -- > toList $ getLine \`consM` getLine \`consM` nil
272− -- hello
273− -- world
274− -- ["hello","world"]
275− -- @
276− --
277− -- /Concurrent (do not use 'parallely' to construct infinite streams)/
278− --
279− -- @since 0.2.0
280− consM :: MonadAsync m => m a -> t m a -> t m a
281− -- | Operator equivalent of 'consM'. We can read it as "@parallel colon@"
282− -- to remember that @|@ comes before ':'.
283− --
284− -- @
285− -- > toList $ getLine |: getLine |: nil
286− -- hello
287− -- world
288− -- ["hello","world"]
289− -- @
290− --
291− -- @
292− -- let delay = threadDelay 1000000 >> print 1
293− -- runStream $ serially $ delay |: delay |: delay |: nil
294− -- runStream $ parallely $ delay |: delay |: delay |: nil
295− -- @
296− --
297− -- /Concurrent (do not use 'parallely' to construct infinite streams)/
298− --
299− -- @since 0.2.0
300− (|:) :: MonadAsync m => m a -> t m a -> t m a
301− -- We can define (|:) just as 'consM' but it is defined explicitly for each
302− -- type because we want to use SPECIALIZE pragma on the definition.
303−
304−-- | Same as 'IsStream'.
305−--
306−-- @since 0.1.0
307−{-# DEPRECATED Streaming "Please use IsStream instead." #-}
308−type Streaming = IsStream
309−
310−-------------------------------------------------------------------------------
311−-- Type adapting combinators
312−-------------------------------------------------------------------------------
313−
314−-- | Adapt any specific stream type to any other specific stream type.
315−--
316−-- @since 0.1.0
317−adapt :: (IsStream t1, IsStream t2) => t1 m a -> t2 m a
318−adapt = fromStream . toStream
319−
320−------------------------------------------------------------------------------
321−-- Building a stream
322−------------------------------------------------------------------------------
323−
324−-- | Build a stream from an 'SVar', a stop continuation, a singleton stream
325−-- continuation and a yield continuation.
326−mkStream:: IsStream t
327− => (forall r. State Stream m a
328− -> m r
329− -> (a -> m r)
330− -> (a -> t m a -> m r)
331− -> m r)
332− -> t m a
333−mkStream k = fromStream $ Stream $ \st stp sng yld ->
334− let yieldk a r = yld a (toStream r)
335− in k (rstState st) stp sng yieldk
176+-- | Detach a stream from an SVar
177+{-# INLINE unShare #-}
178+unShare :: IsStream t => t m a -> t m a
179+unShare x = mkStream $ \st yld sng stp ->
180+ foldStream st yld sng stp x
336181
337182------------------------------------------------------------------------------
338183-- Construction
339184------------------------------------------------------------------------------
340185
341−-- | An empty stream.
342−--
343−-- @
344−-- > toList nil
345−-- []
346−-- @
347−--
348−-- @since 0.1.0
349−nil :: IsStream t => t m a
350−nil = fromStream $ Stream $ \_ stp _ _ -> stp
351−
352186infixr 5 `cons`
353187
354188-- faster than consM because there is no bind.
@@ -363,8 +197,9 @@ infixr 5 `cons`
363197-- @
364198--
365199-- @since 0.1.0
200+{-# INLINE cons #-}
366201cons :: IsStream t => a -> t m a -> t m a
367−cons a r = fromStream $ Stream $ \_ _ _ yld -> yld a (toStream r)
202+cons a r = mkStream $ \_ yld _ _ -> yld a r
368203
369204infixr 5 .:
370205
@@ -376,50 +211,10 @@ infixr 5 .:
376211-- @
377212--
378213-- @since 0.1.1
214+{-# INLINE (.:) #-}
379215(.:) :: IsStream t => a -> t m a -> t m a
380216(.:) = cons
381217
382−{-# INLINE consMSerial #-}
383−consMSerial :: (Monad m) => m a -> Stream m a -> Stream m a
384−consMSerial m r = Stream $ \_ _ _ yld -> m >>= \a -> yld a r
385−
386−------------------------------------------------------------------------------
387−-- Asynchronous construction
388−------------------------------------------------------------------------------
389−
390−-- | Make an empty stream from a callback function.
391−nilK :: IsStream t => (forall r. m r -> m r) -> t m a
392−nilK k = fromStream $ Stream $ \_ stp _ _ -> k stp
393−
394−-- | Make a singleton stream from a one shot callback function.
395−yieldK :: IsStream t => (forall r. (a -> m r) -> m r) -> t m a
396−yieldK k = fromStream $ Stream $ \_ _ sng _ -> k sng
397−
398−-- | Construct a stream from a callback function.
399−consK :: IsStream t => (forall r. (a -> m r) -> m r) -> t m a -> t m a
400−consK k r = fromStream $ Stream $ \_ _ _ yld -> k (\x -> yld x (toStream r))
401−
402−-- XXX consK with concurrent callbacks
403−-- XXX Build a stream from a repeating callback function.
404−
405−-------------------------------------------------------------------------------
406−-- IsStream Stream
407−-------------------------------------------------------------------------------
408−
409−instance IsStream Stream where
410− toStream = id
411− fromStream = id
412−
413− {-# INLINE consM #-}
414− {-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-}
415− consM :: Monad m => m a -> Stream m a -> Stream m a
416− consM = consMSerial
417−
418− {-# INLINE (|:) #-}
419− {-# SPECIALIZE (|:) :: IO a -> Stream IO a -> Stream IO a #-}
420− (|:) :: Monad m => m a -> Stream m a -> Stream m a
421− (|:) = consMSerial
422−
423218-------------------------------------------------------------------------------
424219-- Deconstruction
425220-------------------------------------------------------------------------------
@@ -429,43 +224,56 @@ uncons :: (IsStream t, Monad m) => t m a -> m (Maybe (a, t m a))
429224uncons m =
430225 let stop = return Nothing
431226 single a = return (Just (a, nil))
432− yieldk a r = return (Just (a, fromStream r))
433− in unStream (toStream m) defState stop single yieldk
227+ yieldk a r = return (Just (a, r))
228+ in foldStream defState yieldk single stop m
434229
435230-------------------------------------------------------------------------------
436231-- Generation
437232-------------------------------------------------------------------------------
438233
234+{-# INLINE_NORMAL build #-}
235+build :: IsStream t => forall a. (forall b. (a -> b -> b) -> b -> b) -> t m a
236+build g = g cons nil
237+
238+{-# INLINE_NORMAL _augment #-}
239+_augment
240+ :: IsStream t
241+ => forall a. (forall b. (a -> b -> b) -> b -> b) -> t m a -> t m a
242+_augment g xs = g cons xs
243+
244+{-# INLINE_NORMAL _buildM #-}
245+_buildM
246+ :: (IsStream t, MonadAsync m)
247+ => forall a. ((m a -> t m a -> t m a) -> t m a -> t m a) -> t m a
248+_buildM g = g consM nil
249+
439250{-# INLINE unfoldr #-}
440251unfoldr :: IsStream t => (b -> Maybe (a, b)) -> b -> t m a
441−unfoldr step = fromStream . go
442− where
443− go s = Stream $ \_ stp _ yld ->
444− case step s of
445− Nothing -> stp
446− Just (a, b) -> yld a (go b)
252+unfoldr step b0 = build $ \cns nl ->
253+ let go s =
254+ case step s of
255+ Just (a, b) -> a `cns` go b
256+ Nothing -> nl
257+ in go b0
447258
448259{-# INLINE unfoldrM #-}
449260unfoldrM :: (IsStream t, MonadAsync m) => (b -> m (Maybe (a, b))) -> b -> t m a
450261unfoldrM step = go
451262 where
452− go s = fromStream $ Stream $ \svr stp sng yld -> do
263+ go s = mkStream $ \st yld sng stp -> do
453264 mayb <- step s
454265 case mayb of
455266 Nothing -> stp
456267 Just (a, b) ->
457− unStream (toStream (return a |: go b)) svr stp sng yld
268+ foldStreamShared st yld sng stp $ return a |: go b
458269
459270-------------------------------------------------------------------------------
460271-- Special generation
461272-------------------------------------------------------------------------------
462273
274+{-# INLINE yield #-}
463275yield :: IsStream t => a -> t m a
464−yield a = fromStream $ Stream $ \_ _ single _ -> single a
465−
466−{-# INLINE yieldM #-}
467−yieldM :: (Monad m, IsStream t) => m a -> t m a
468−yieldM m = fromStream $ Stream $ \_ _ single _ -> m >>= single
276+yield a = mkStream $ \_ _ single _ -> single a
469277
470278-- | Same as yieldM
471279--
@@ -484,14 +292,17 @@ once = yieldM
484292-- Generate an infinite stream by repeating a pure value.
485293--
486294-- @since 0.4.0
295+{-# INLINE repeat #-}
487296repeat :: IsStream t => a -> t m a
488297repeat a = let x = cons a x in x
489298
299+{-# INLINE replicateM #-}
490300replicateM :: (IsStream t, MonadAsync m) => Int -> m a -> t m a
491301replicateM n m = go n
492302 where
493303 go cnt = if cnt <= 0 then nil else m |: go (cnt - 1)
494304
305+{-# INLINE replicate #-}
495306replicate :: IsStream t => Int -> a -> t m a
496307replicate n a = go n
497308 where
@@ -518,47 +329,34 @@ fromList :: IsStream t => [a] -> t m a
518329fromList = fromFoldable
519330
520331{-# INLINE fromStreamK #-}
521−fromStreamK :: Stream m a -> Stream m a
522−fromStreamK = id
332+fromStreamK :: IsStream t => Stream m a -> t m a
333+fromStreamK = fromStream
523334
524335-------------------------------------------------------------------------------
525336-- Elimination by Folding
526337-------------------------------------------------------------------------------
527338
528−-- | Fold a stream by providing an SVar, a stop continuation, a singleton
529−-- continuation and a yield continuation.
530−foldStream
531− :: IsStream t
532− => State Stream m a
533− -> m r
534− -> (a -> m r)
535− -> (a -> t m a -> m r)
536− -> t m a
537− -> m r
538−foldStream st blank single step m =
539− let yieldk a x = step a (fromStream x)
540− in unStream (toStream m) st blank single yieldk
541−
542339-- | Lazy right associative fold.
340+{-# INLINE foldr #-}
543341foldr :: (IsStream t, Monad m) => (a -> b -> b) -> b -> t m a -> m b
544−foldr step acc m = go (toStream m)
342+foldr step acc m = go m
545343 where
546344 go m1 =
547345 let stop = return acc
548346 single a = return (step a acc)
549347 yieldk a r = go r >>= \b -> return (step a b)
550− in unStream m1 defState stop single yieldk
348+ in foldStream defState yieldk single stop m1
551349
552350-- | Lazy right fold with a monadic step function.
553351{-# INLINE foldrM #-}
554352foldrM :: (IsStream t, Monad m) => (a -> b -> m b) -> b -> t m a -> m b
555−foldrM step acc m = go (toStream m)
353+foldrM step acc m = go m
556354 where
557355 go m1 =
558356 let stop = return acc
559357 single a = step a acc
560358 yieldk a r = go r >>= step a
561− in unStream m1 defState stop single yieldk
359+ in foldStream defState yieldk single stop m1
562360
563361{-# INLINE foldr1 #-}
564362foldr1 :: (IsStream t, Monad m) => (a -> a -> a) -> t m a -> m (Maybe a)
@@ -566,13 +364,13 @@ foldr1 step m = do
566364 r <- uncons m
567365 case r of
568366 Nothing -> return Nothing
569− Just (h, t) -> fmap Just (go h (toStream t))
367+ Just (h, t) -> fmap Just (go h t)
570368 where
571369 go p m1 =
572370 let stp = return p
573371 single a = return $ step a p
574372 yieldk a r = fmap (step p) (go a r)
575− in unStream m1 defState stp single yieldk
373+ in foldStream defState yieldk single stp m1
576374
577375-- | Strict left fold with an extraction function. Like the standard strict
578376-- left fold, but applies a user supplied extraction function (the third
@@ -581,28 +379,31 @@ foldr1 step m = do
581379--
582380-- Note that the accumulator is always evaluated including the initial value.
583381{-# INLINE foldx #-}
584−foldx :: (IsStream t, Monad m)
382+foldx :: forall t m a b x. (IsStream t, Monad m)
585383 => (x -> a -> x) -> x -> (x -> b) -> t m a -> m b
586−foldx step begin done m = get $ go (toStream m) begin
384+foldx step begin done m = get $ go m begin
587385 where
588386 {-# NOINLINE get #-}
387+ get :: t m x -> m b
589388 get m1 =
590389 -- XXX we are not strictly evaluating the accumulator here. Is this
591390 -- okay?
592391 let single = return . done
593− in unStream m1 undefined undefined single undefined
392+ -- XXX this is foldSingleton. why foldStreamShared?
393+ in foldStreamShared undefined undefined single undefined m1
594394
595395 -- Note, this can be implemented by making a recursive call to "go",
596396 -- however that is more expensive because of unnecessary recursion
597397 -- that cannot be tail call optimized. Unfolding recursion explicitly via
598398 -- continuations is much more efficient.
599− go m1 !acc = Stream $ \_ _ sng yld ->
399+ go :: t m a -> x -> t m x
400+ go m1 !acc = mkStream $ \_ yld sng _ ->
600401 let stop = sng acc
601402 single a = sng $ step acc a
602− yieldk a r =
603− let stream = go r (step acc a)
604− in unStream stream defState undefined sng yld
605− in unStream m1 defState stop single yieldk
403+ -- XXX this is foldNonEmptyStream
404+ yieldk a r = foldStream defState yld sng undefined $
405+ go r (step acc a)
406+ in foldStream defState yieldk single stop m1
606407
607408-- | Strict left associative fold.
608409{-# INLINE foldl' #-}
@@ -611,17 +412,19 @@ foldl' step begin = foldx step begin id
611412
612413-- XXX replace the recursive "go" with explicit continuations.
613414-- | Like 'foldx', but with a monadic step function.
415+{-# INLINABLE foldxM #-}
614416foldxM :: (IsStream t, Monad m)
615417 => (x -> a -> m x) -> m x -> (x -> m b) -> t m a -> m b
616−foldxM step begin done m = go begin (toStream m)
418+foldxM step begin done m = go begin m
617419 where
618420 go !acc m1 =
619421 let stop = acc >>= done
620422 single a = acc >>= \b -> step b a >>= done
621423 yieldk a r = acc >>= \b -> step b a >>= \x -> go (return x) r
622− in unStream m1 defState stop single yieldk
424+ in foldStream defState yieldk single stop m1
623425
624426-- | Like 'foldl'' but with a monadic step function.
427+{-# INLINE foldlM' #-}
625428foldlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> m b
626429foldlM' step begin = foldxM step (return begin) return
627430
@@ -629,15 +432,18 @@ foldlM' step begin = foldxM step (return begin) return
629432-- Specialized folds
630433------------------------------------------------------------------------------
631434
435+-- |
436+-- > runStream = foldl' (\_ _ -> ()) ()
437+-- > runStream = mapM_ (\_ -> return ())
632438{-# INLINE runStream #-}
633439runStream :: (Monad m, IsStream t) => t m a -> m ()
634−runStream m = go (toStream m)
440+runStream = go
635441 where
636442 go m1 =
637443 let stop = return ()
638444 single _ = return ()
639− yieldk _ r = go (toStream r)
640− in unStream m1 defState stop single yieldk
445+ yieldk _ r = go r
446+ in foldStream defState yieldk single stop m1
641447
642448{-# INLINE null #-}
643449null :: (IsStream t, Monad m) => t m a -> m Bool
@@ -645,7 +451,7 @@ null m =
645451 let stop = return True
646452 single _ = return False
647453 yieldk _ _ = return False
648− in unStream (toStream m) defState stop single yieldk
454+ in foldStream defState yieldk single stop m
649455
650456{-# INLINE head #-}
651457head :: (IsStream t, Monad m) => t m a -> m (Maybe a)
@@ -653,69 +459,71 @@ head m =
653459 let stop = return Nothing
654460 single a = return (Just a)
655461 yieldk a _ = return (Just a)
656− in unStream (toStream m) defState stop single yieldk
462+ in foldStream defState yieldk single stop m
657463
658464{-# INLINE tail #-}
659465tail :: (IsStream t, Monad m) => t m a -> m (Maybe (t m a))
660466tail m =
661467 let stop = return Nothing
662468 single _ = return $ Just nil
663− yieldk _ r = return $ Just $ fromStream r
664− in unStream (toStream m) defState stop single yieldk
469+ yieldk _ r = return $ Just r
470+ in foldStream defState yieldk single stop m
665471
666472{-# INLINE init #-}
667473init :: (IsStream t, Monad m) => t m a -> m (Maybe (t m a))
668−init m = go1 (toStream m)
474+init m = go1 m
669475 where
670476 go1 m1 = do
671477 r <- uncons m1
672478 case r of
673479 Nothing -> return Nothing
674− Just (h, t) -> return . Just . fromStream $ go h t
675− go p m1 = Stream $ \_ stp sng yld ->
480+ Just (h, t) -> return . Just $ go h t
481+ go p m1 = mkStream $ \_ yld sng stp ->
676482 let single _ = sng p
677483 yieldk a x = yld p $ go a x
678− in unStream m1 defState stp single yieldk
484+ in foldStream defState yieldk single stp m1
679485
680486{-# INLINE elem #-}
681487elem :: (IsStream t, Monad m, Eq a) => a -> t m a -> m Bool
682−elem e m = go (toStream m)
488+elem e m = go m
683489 where
684490 go m1 =
685491 let stop = return False
686492 single a = return (a == e)
687493 yieldk a r = if a == e then return True else go r
688− in unStream m1 defState stop single yieldk
494+ in foldStream defState yieldk single stop m1
689495
690496{-# INLINE notElem #-}
691497notElem :: (IsStream t, Monad m, Eq a) => a -> t m a -> m Bool
692−notElem e m = go (toStream m)
498+notElem e m = go m
693499 where
694500 go m1 =
695501 let stop = return True
696502 single a = return (a /= e)
697503 yieldk a r = if a == e then return False else go r
698− in unStream m1 defState stop single yieldk
504+ in foldStream defState yieldk single stop m1
699505
506+{-# INLINABLE all #-}
700507all :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m Bool
701−all p m = go (toStream m)
508+all p m = go m
702509 where
703510 go m1 =
704511 let single a | p a = return True
705512 | otherwise = return False
706513 yieldk a r | p a = go r
707514 | otherwise = return False
708− in unStream m1 defState (return True) single yieldk
515+ in foldStream defState yieldk single (return True) m1
709516
517+{-# INLINABLE any #-}
710518any :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m Bool
711−any p m = go (toStream m)
519+any p m = go m
712520 where
713521 go m1 =
714522 let single a | p a = return True
715523 | otherwise = return False
716524 yieldk a r | p a = return True
717525 | otherwise = go r
718− in unStream m1 defState (return False) single yieldk
526+ in foldStream defState yieldk single (return False) m1
719527
720528-- | Extract the last element of the stream, if any.
721529{-# INLINE last #-}
@@ -724,13 +532,13 @@ last = foldx (\_ y -> Just y) Nothing id
724532
725533{-# INLINE minimum #-}
726534minimum :: (IsStream t, Monad m, Ord a) => t m a -> m (Maybe a)
727−minimum m = go Nothing (toStream m)
535+minimum m = go Nothing m
728536 where
729537 go Nothing m1 =
730538 let stop = return Nothing
731539 single a = return (Just a)
732540 yieldk a r = go (Just a) r
733− in unStream m1 defState stop single yieldk
541+ in foldStream defState yieldk single stop m1
734542
735543 go (Just res) m1 =
736544 let stop = return (Just res)
@@ -742,19 +550,19 @@ minimum m = go Nothing (toStream m)
742550 if res <= a
743551 then go (Just res) r
744552 else go (Just a) r
745− in unStream m1 defState stop single yieldk
553+ in foldStream defState yieldk single stop m1
746554
747555{-# INLINE minimumBy #-}
748556minimumBy
749557 :: (IsStream t, Monad m)
750558 => (a -> a -> Ordering) -> t m a -> m (Maybe a)
751−minimumBy cmp m = go Nothing (toStream m)
559+minimumBy cmp m = go Nothing m
752560 where
753561 go Nothing m1 =
754562 let stop = return Nothing
755563 single a = return (Just a)
756564 yieldk a r = go (Just a) r
757− in unStream m1 defState stop single yieldk
565+ in foldStream defState yieldk single stop m1
758566
759567 go (Just res) m1 =
760568 let stop = return (Just res)
@@ -764,17 +572,17 @@ minimumBy cmp m = go Nothing (toStream m)
764572 yieldk a r = case cmp res a of
765573 GT -> go (Just a) r
766574 _ -> go (Just res) r
767− in unStream m1 defState stop single yieldk
575+ in foldStream defState yieldk single stop m1
768576
769577{-# INLINE maximum #-}
770578maximum :: (IsStream t, Monad m, Ord a) => t m a -> m (Maybe a)
771−maximum m = go Nothing (toStream m)
579+maximum m = go Nothing m
772580 where
773581 go Nothing m1 =
774582 let stop = return Nothing
775583 single a = return (Just a)
776584 yieldk a r = go (Just a) r
777− in unStream m1 defState stop single yieldk
585+ in foldStream defState yieldk single stop m1
778586
779587 go (Just res) m1 =
780588 let stop = return (Just res)
@@ -786,17 +594,17 @@ maximum m = go Nothing (toStream m)
786594 if res <= a
787595 then go (Just a) r
788596 else go (Just res) r
789− in unStream m1 defState stop single yieldk
597+ in foldStream defState yieldk single stop m1
790598
791599{-# INLINE maximumBy #-}
792600maximumBy :: (IsStream t, Monad m) => (a -> a -> Ordering) -> t m a -> m (Maybe a)
793−maximumBy cmp m = go Nothing (toStream m)
601+maximumBy cmp m = go Nothing m
794602 where
795603 go Nothing m1 =
796604 let stop = return Nothing
797605 single a = return (Just a)
798606 yieldk a r = go (Just a) r
799− in unStream m1 defState stop single yieldk
607+ in foldStream defState yieldk single stop m1
800608
801609 go (Just res) m1 =
802610 let stop = return (Just res)
@@ -806,11 +614,11 @@ maximumBy cmp m = go Nothing (toStream m)
806614 yieldk a r = case cmp res a of
807615 GT -> go (Just res) r
808616 _ -> go (Just a) r
809− in unStream m1 defState stop single yieldk
617+ in foldStream defState yieldk single stop m1
810618
811619{-# INLINE (!!) #-}
812620(!!) :: (IsStream t, Monad m) => t m a -> Int -> m (Maybe a)
813−m !! i = go i (toStream m)
621+m !! i = go i m
814622 where
815623 go n m1 =
816624 let single a | n == 0 = return $ Just a
@@ -818,22 +626,22 @@ m !! i = go i (toStream m)
818626 yieldk a x | n < 0 = return Nothing
819627 | n == 0 = return $ Just a
820628 | otherwise = go (n - 1) x
821− in unStream m1 defState (return Nothing) single yieldk
629+ in foldStream defState yieldk single (return Nothing) m1
822630
823631{-# INLINE lookup #-}
824632lookup :: (IsStream t, Monad m, Eq a) => a -> t m (a, b) -> m (Maybe b)
825−lookup e m = go (toStream m)
633+lookup e m = go m
826634 where
827635 go m1 =
828636 let single (a, b) | a == e = return $ Just b
829637 | otherwise = return Nothing
830638 yieldk (a, b) x | a == e = return $ Just b
831639 | otherwise = go x
832− in unStream m1 defState (return Nothing) single yieldk
640+ in foldStream defState yieldk single (return Nothing) m1
833641
834642{-# INLINE findM #-}
835643findM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> m (Maybe a)
836−findM p m = go (toStream m)
644+findM p m = go m
837645 where
838646 go m1 =
839647 let single a = do
@@ -842,7 +650,7 @@ findM p m = go (toStream m)
842650 yieldk a x = do
843651 b <- p a
844652 if b then return $ Just a else go x
845− in unStream m1 defState (return Nothing) single yieldk
653+ in foldStream defState yieldk single (return Nothing) m1
846654
847655{-# INLINE find #-}
848656find :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m (Maybe a)
@@ -850,14 +658,15 @@ find p = findM (return . p)
850658
851659{-# INLINE findIndices #-}
852660findIndices :: IsStream t => (a -> Bool) -> t m a -> t m Int
853−findIndices p = fromStream . go 0 . toStream
661+findIndices p = go 0
854662 where
855− go offset m1 = Stream $ \st stp sng yld ->
663+ go offset m1 = mkStream $ \st yld sng stp ->
856664 let single a | p a = sng offset
857665 | otherwise = stp
858666 yieldk a x | p a = yld offset $ go (offset + 1) x
859− | otherwise = unStream (go (offset + 1) x) st stp sng yld
860− in unStream m1 (rstState st) stp single yieldk
667+ | otherwise = foldStream (adaptState st) yld sng stp $
668+ go (offset + 1) x
669+ in foldStream (adaptState st) yieldk single stp m1
861670
862671------------------------------------------------------------------------------
863672-- Map and Fold
@@ -865,14 +674,15 @@ findIndices p = fromStream . go 0 . toStream
865674
866675-- | Apply a monadic action to each element of the stream and discard the
867676-- output of the action.
677+{-# INLINE mapM_ #-}
868678mapM_ :: (IsStream t, Monad m) => (a -> m b) -> t m a -> m ()
869−mapM_ f m = go (toStream m)
679+mapM_ f m = go m
870680 where
871681 go m1 =
872682 let stop = return ()
873683 single a = void (f a)
874684 yieldk a r = f a >> go r
875− in unStream m1 defState stop single yieldk
685+ in foldStream defState yieldk single stop m1
876686
877687------------------------------------------------------------------------------
878688-- Converting folds
@@ -893,14 +703,14 @@ toStreamK = id
893703{-# INLINE scanx #-}
894704scanx :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b
895705scanx step begin done m =
896− cons (done begin) $ fromStream $ go (toStream m) begin
706+ cons (done begin) $ go m begin
897707 where
898− go m1 !acc = Stream $ \st stp sng yld ->
708+ go m1 !acc = mkStream $ \st yld sng stp ->
899709 let single a = sng (done $ step acc a)
900710 yieldk a r =
901711 let s = step acc a
902712 in yld (done s) (go r s)
903− in unStream m1 (rstState st) stp single yieldk
713+ in foldStream (adaptState st) yieldk single stp m1
904714
905715{-# INLINE scanl' #-}
906716scanl' :: IsStream t => (b -> a -> b) -> b -> t m a -> t m b
@@ -912,91 +722,84 @@ scanl' step begin = scanx step begin id
912722
913723{-# INLINE filter #-}
914724filter :: IsStream t => (a -> Bool) -> t m a -> t m a
915−filter p m = fromStream $ go (toStream m)
725+filter p m = go m
916726 where
917− go m1 = Stream $ \st stp sng yld ->
727+ go m1 = mkStream $ \st yld sng stp ->
918728 let single a | p a = sng a
919729 | otherwise = stp
920730 yieldk a r | p a = yld a (go r)
921− | otherwise = unStream r (rstState st) stp single yieldk
922− in unStream m1 (rstState st) stp single yieldk
731+ | otherwise = foldStream st yieldk single stp r
732+ in foldStream st yieldk single stp m1
923733
924734{-# INLINE take #-}
925735take :: IsStream t => Int -> t m a -> t m a
926−take n m = fromStream $ go n (toStream m)
736+take n m = go n m
927737 where
928− go n1 m1 = Stream $ \st stp sng yld ->
738+ go n1 m1 = mkStream $ \st yld sng stp ->
929739 let yieldk a r = yld a (go (n1 - 1) r)
930740 in if n1 <= 0
931741 then stp
932− else unStream m1 (rstState st) stp sng yieldk
742+ else foldStream st yieldk sng stp m1
933743
934744{-# INLINE takeWhile #-}
935745takeWhile :: IsStream t => (a -> Bool) -> t m a -> t m a
936−takeWhile p m = fromStream $ go (toStream m)
746+takeWhile p m = go m
937747 where
938− go m1 = Stream $ \st stp sng yld ->
748+ go m1 = mkStream $ \st yld sng stp ->
939749 let single a | p a = sng a
940750 | otherwise = stp
941751 yieldk a r | p a = yld a (go r)
942752 | otherwise = stp
943− in unStream m1 (rstState st) stp single yieldk
753+ in foldStream st yieldk single stp m1
944754
755+{-# INLINE drop #-}
945756drop :: IsStream t => Int -> t m a -> t m a
946−drop n m = fromStream $ Stream $ \st stp sng yld ->
947− unStream (go n (toStream m)) (rstState st) stp sng yld
757+drop n m = fromStream $ unShare (go n (toStream m))
948758 where
949− go n1 m1 = Stream $ \st stp sng yld ->
759+ go n1 m1 = mkStream $ \st yld sng stp ->
950760 let single _ = stp
951− yieldk _ r = (unStream $ go (n1 - 1) r) st stp sng yld
761+ yieldk _ r = foldStreamShared st yld sng stp $ go (n1 - 1) r
952762 -- Somehow "<=" check performs better than a ">"
953763 in if n1 <= 0
954− then unStream m1 st stp sng yld
955− else unStream m1 st stp single yieldk
764+ then foldStreamShared st yld sng stp m1
765+ else foldStreamShared st yieldk single stp m1
956766
957767{-# INLINE dropWhile #-}
958768dropWhile :: IsStream t => (a -> Bool) -> t m a -> t m a
959−dropWhile p m = fromStream $ go (toStream m)
769+dropWhile p m = go m
960770 where
961− go m1 = Stream $ \st stp sng yld ->
771+ go m1 = mkStream $ \st yld sng stp ->
962772 let single a | p a = stp
963773 | otherwise = sng a
964− yieldk a r | p a = unStream r (rstState st) stp single yieldk
774+ yieldk a r | p a = foldStream st yieldk single stp r
965775 | otherwise = yld a r
966− in unStream m1 (rstState st) stp single yieldk
776+ in foldStream st yieldk single stp m1
967777
968778-------------------------------------------------------------------------------
969779-- Mapping
970780-------------------------------------------------------------------------------
971781
972−{-# INLINE map #-}
973−map :: (IsStream t, Monad m) => (a -> b) -> t m a -> t m b
974−map f m = fromStream $ Stream $ \st stp sng yld ->
975− let single = sng . f
976− yieldk a r = yld (f a) (fmap f r)
977− in unStream (toStream m) (rstState st) stp single yieldk
978−
979782-- Be careful when modifying this, this uses a consM (|:) deliberately to allow
980783-- other stream types to overload it.
981784{-# INLINE mapM #-}
982785mapM :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m b
983−mapM f m = go (toStream m)
786+mapM f m = go m
984787 where
985− go m1 = fromStream $ Stream $ \st stp sng yld ->
788+ go m1 = mkStream $ \st yld sng stp ->
986789 let single a = f a >>= sng
987− yieldk a r = unStream (toStream (f a |: go r)) st stp sng yld
988− in unStream m1 (rstState st) stp single yieldk
790+ yieldk a r = foldStreamShared st yld sng stp $ f a |: go r
791+ in foldStream (adaptState st) yieldk single stp m1
989792
990793-- Be careful when modifying this, this uses a consM (|:) deliberately to allow
991794-- other stream types to overload it.
992795{-# INLINE sequence #-}
993796sequence :: (IsStream t, MonadAsync m) => t m (m a) -> t m a
994−sequence m = go (toStream m)
797+sequence m = go m
995798 where
996− go m1 = fromStream $ Stream $ \st stp sng yld ->
799+ go m1 = mkStream $ \st yld sng stp ->
997800 let single ma = ma >>= sng
998− yieldk ma r = unStream (toStream $ ma |: go r) st stp sng yld
999− in unStream m1 (rstState st) stp single yieldk
801+ yieldk ma r = foldStreamShared st yld sng stp $ ma |: go r
802+ in foldStream (adaptState st) yieldk single stp m1
1000803
1001804-------------------------------------------------------------------------------
1002805-- Inserting
@@ -1004,21 +807,21 @@ sequence m = go (toStream m)
1004807
1005808{-# INLINE intersperseM #-}
1006809intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a
1007−intersperseM a m = fromStream $ prependingStart (toStream m)
810+intersperseM a m = prependingStart m
1008811 where
1009− prependingStart m1 = Stream $ \st stp sng yld ->
1010− let yieldk i x = unStream (return i |: go x) st stp sng yld
1011− in unStream m1 (rstState st) stp sng yieldk
1012− go m2 = fromStream $ Stream $ \st stp sng yld ->
1013− let single i = unStream (a |: yield i) st stp sng yld
1014− yieldk i x = unStream (a |: return i |: go x) st stp sng yld
1015− in unStream m2 (rstState st) stp single yieldk
812+ prependingStart m1 = mkStream $ \st yld sng stp ->
813+ let yieldk i x = foldStreamShared st yld sng stp $ return i |: go x
814+ in foldStream st yieldk sng stp m1
815+ go m2 = mkStream $ \st yld sng stp ->
816+ let single i = foldStreamShared st yld sng stp $ a |: yield i
817+ yieldk i x = foldStreamShared st yld sng stp $ a |: return i |: go x
818+ in foldStream st yieldk single stp m2
1016819
1017820{-# INLINE insertBy #-}
1018821insertBy :: IsStream t => (a -> a -> Ordering) -> a -> t m a -> t m a
1019−insertBy cmp x m = fromStream $ go (toStream m)
822+insertBy cmp x m = go m
1020823 where
1021− go m1 = Stream $ \st _ _ yld ->
824+ go m1 = mkStream $ \st yld _ _ ->
1022825 let single a = case cmp x a of
1023826 GT -> yld a (yield x)
1024827 _ -> yld x (yield a)
@@ -1026,7 +829,7 @@ insertBy cmp x m = fromStream $ go (toStream m)
1026829 yieldk a r = case cmp x a of
1027830 GT -> yld a (go r)
1028831 _ -> yld x (a `cons` r)
1029− in unStream m1 (rstState st) stop single yieldk
832+ in foldStream st yieldk single stop m1
1030833
1031834------------------------------------------------------------------------------
1032835-- Deleting
@@ -1034,14 +837,14 @@ insertBy cmp x m = fromStream $ go (toStream m)
1034837
1035838{-# INLINE deleteBy #-}
1036839deleteBy :: IsStream t => (a -> a -> Bool) -> a -> t m a -> t m a
1037−deleteBy eq x m = fromStream $ go (toStream m)
840+deleteBy eq x m = go m
1038841 where
1039− go m1 = Stream $ \st stp sng yld ->
842+ go m1 = mkStream $ \st yld sng stp ->
1040843 let single a = if eq x a then stp else sng a
1041844 yieldk a r = if eq x a
1042− then unStream r (rstState st) stp sng yld
845+ then foldStream st yld sng stp r
1043846 else yld a (go r)
1044− in unStream m1 (rstState st) stp single yieldk
847+ in foldStream st yieldk single stp m1
1045848
1046849-------------------------------------------------------------------------------
1047850-- Map and Filter
@@ -1049,70 +852,67 @@ deleteBy eq x m = fromStream $ go (toStream m)
1049852
1050853{-# INLINE mapMaybe #-}
1051854mapMaybe :: IsStream t => (a -> Maybe b) -> t m a -> t m b
1052−mapMaybe f m = go (toStream m)
855+mapMaybe f m = go m
1053856 where
1054− go m1 = fromStream $ Stream $ \st stp sng yld ->
857+ go m1 = mkStream $ \st yld sng stp ->
1055858 let single a = case f a of
1056859 Just b -> sng b
1057860 Nothing -> stp
1058861 yieldk a r = case f a of
1059− Just b -> yld b (toStream $ go r)
1060− Nothing -> unStream r (rstState st) stp single yieldk
1061− in unStream m1 (rstState st) stp single yieldk
862+ Just b -> yld b $ go r
863+ Nothing -> foldStream (adaptState st) yieldk single stp r
864+ in foldStream (adaptState st) yieldk single stp m1
1062865
1063866------------------------------------------------------------------------------
1064867-- Serial Zipping
1065868------------------------------------------------------------------------------
1066869
1067−{-# INLINE zipWithS #-}
1068−zipWithS :: (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
1069−zipWithS f = go
870+-- | Zip two streams serially using a pure zipping function.
871+--
872+-- @since 0.1.0
873+{-# INLINABLE zipWith #-}
874+zipWith :: IsStream t => (a -> b -> c) -> t m a -> t m b -> t m c
875+zipWith f = go
1070876 where
1071− go mx my = Stream $ \st stp sng yld -> do
877+ go mx my = mkStream $ \st yld sng stp -> do
1072878 let merge a ra =
1073879 let single2 b = sng (f a b)
1074880 yield2 b rb = yld (f a b) (go ra rb)
1075− in unStream my (rstState st) stp single2 yield2
881+ in foldStream (adaptState st) yield2 single2 stp my
1076882 let single1 a = merge a nil
1077883 yield1 = merge
1078− unStream mx (rstState st) stp single1 yield1
1079−
1080−-- | Zip two streams serially using a pure zipping function.
1081−--
1082−-- @since 0.1.0
1083−{-# INLINABLE zipWith #-}
1084−zipWith :: IsStream t => (a -> b -> c) -> t m a -> t m b -> t m c
1085−zipWith f m1 m2 = fromStream $ zipWithS f (toStream m1) (toStream m2)
884+ foldStream (adaptState st) yield1 single1 stp mx
1086885
1087886-- | Zip two streams serially using a monadic zipping function.
1088887--
1089888-- @since 0.1.0
889+{-# INLINABLE zipWithM #-}
1090890zipWithM :: (IsStream t, Monad m) => (a -> b -> m c) -> t m a -> t m b -> t m c
1091−zipWithM f m1 m2 = fromStream $ go (toStream m1) (toStream m2)
891+zipWithM f m1 m2 = go m1 m2
1092892 where
1093− go mx my = Stream $ \st stp sng yld -> do
893+ go mx my = mkStream $ \st yld sng stp -> do
1094894 let merge a ra =
1095− let runIt x = unStream x (rstState st) stp sng yld
895+ let runIt x = foldStream st yld sng stp x
1096896 single2 b = f a b >>= sng
1097897 yield2 b rb = f a b >>= \x -> runIt (x `cons` go ra rb)
1098− in unStream my (rstState st) stp single2 yield2
898+ in foldStream (adaptState st) yield2 single2 stp my
1099899 let single1 a = merge a nil
1100900 yield1 = merge
1101− unStream mx (rstState st) stp single1 yield1
901+ foldStream (adaptState st) yield1 single1 stp mx
1102902
1103903------------------------------------------------------------------------------
1104904-- Merging
1105905------------------------------------------------------------------------------
1106906
1107−{-# INLINE mergeByS #-}
1108−mergeByS
1109− :: Monad m
1110− => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
1111−mergeByS cmp = go
907+{-# INLINE mergeByM #-}
908+mergeByM
909+ :: (IsStream t, Monad m)
910+ => (a -> a -> m Ordering) -> t m a -> t m a -> t m a
911+mergeByM cmp = go
1112912 where
1113− go mx my = Stream $ \st stp sng yld -> do
913+ go mx my = mkStream $ \st yld sng stp -> do
1114914 let mergeWithY a ra =
1115− let stop2 = unStream mx (rstState st) stp sng yld
915+ let stop2 = foldStream st yld sng stp mx
1116916 single2 b = do
1117917 r <- cmp a b
1118918 case r of
@@ -1123,17 +923,11 @@ mergeByS cmp = go
1123923 case r of
1124924 GT -> yld b (go (a `cons` ra) rb)
1125925 _ -> yld a (go ra (b `cons` rb))
1126− in unStream my (rstState st) stop2 single2 yield2
1127− let stopX = unStream my (rstState st) stp sng yld
926+ in foldStream st yield2 single2 stop2 my
927+ let stopX = foldStream st yld sng stp my
1128928 singleX a = mergeWithY a nil
1129929 yieldX = mergeWithY
1130− unStream mx (rstState st) stopX singleX yieldX
1131−
1132−{-# INLINABLE mergeByM #-}
1133−mergeByM
1134− :: (IsStream t, Monad m)
1135− => (a -> a -> m Ordering) -> t m a -> t m a -> t m a
1136−mergeByM f m1 m2 = fromStream $ mergeByS f (toStream m1) (toStream m2)
930+ foldStream st yieldX singleX stopX mx
1137931
1138932{-# INLINABLE mergeBy #-}
1139933mergeBy
@@ -1151,48 +945,14 @@ the m = do
1151945 r <- uncons m
1152946 case r of
1153947 Nothing -> return Nothing
1154− Just (h, t) -> go h (toStream t)
948+ Just (h, t) -> go h t
1155949 where
1156950 go h m1 =
1157951 let single a | h == a = return $ Just h
1158952 | otherwise = return Nothing
1159953 yieldk a r | h == a = go h r
1160954 | otherwise = return Nothing
1161− in unStream m1 defState (return $ Just h) single yieldk
1162−
1163−------------------------------------------------------------------------------
1164−-- Semigroup
1165−------------------------------------------------------------------------------
1166−
1167−-- | Concatenates two streams sequentially i.e. the first stream is
1168−-- exhausted completely before yielding any element from the second stream.
1169−{-# INLINE serial #-}
1170−serial :: Stream m a -> Stream m a -> Stream m a
1171−serial m1 m2 = go m1
1172− where
1173− go (Stream m) = Stream $ \st stp sng yld ->
1174− let stop = unStream m2 (rstState st) stp sng yld
1175− single a = yld a m2
1176− yieldk a r = yld a (go r)
1177− in m (rstState st) stop single yieldk
1178−
1179−instance Semigroup (Stream m a) where
1180− (<>) = serial
1181−
1182−------------------------------------------------------------------------------
1183−-- Monoid
1184−------------------------------------------------------------------------------
1185−
1186−instance Monoid (Stream m a) where
1187− mempty = nil
1188− mappend = (<>)
1189−
1190−-------------------------------------------------------------------------------
1191−-- Functor
1192−-------------------------------------------------------------------------------
1193−
1194−instance Monad m => Functor (Stream m) where
1195− fmap = map
955+ in foldStream defState yieldk single (return $ Just h) m1
1196956
1197957-------------------------------------------------------------------------------
1198958-- Bind utility
@@ -1200,40 +960,40 @@ instance Monad m => Functor (Stream m) where
1200960
1201961{-# INLINE bindWith #-}
1202962bindWith
1203− :: (forall c. Stream m c -> Stream m c -> Stream m c)
1204− -> Stream m a
1205− -> (a -> Stream m b)
1206− -> Stream m b
1207−bindWith par m f = go m
963+ :: IsStream t
964+ => (forall c. t m c -> t m c -> t m c)
965+ -> t m a
966+ -> (a -> t m b)
967+ -> t m b
968+bindWith par m1 f = go m1
1208969 where
1209− go (Stream g) =
1210− Stream $ \st stp sng yld ->
1211− let runShared x = unstreamShared x st stp sng yld
1212− runIsolated x = unStreamIsolated x st stp sng yld
1213−
1214− single a = runIsolated $ f a
1215− yieldk a r = runShared $ isolateStream (f a) `par` go r
1216− in g (rstState st) stp single yieldk
970+ go m =
971+ mkStream $ \st yld sng stp ->
972+ let foldShared = foldStreamShared st yld sng stp
973+ single a = foldShared $ unShare (f a)
974+ yieldk a r = foldShared $ unShare (f a) `par` go r
975+ in foldStream (adaptState st) yieldk single stp m
1217976
1218977------------------------------------------------------------------------------
1219978-- Alternative & MonadPlus
1220979------------------------------------------------------------------------------
1221980
1222981_alt :: Stream m a -> Stream m a -> Stream m a
1223−_alt m1 m2 = Stream $ \st stp sng yld ->
1224− let stop = unStream m2 (rstState st) stp sng yld
1225− in unStream m1 (rstState st) stop sng yld
982+_alt m1 m2 = mkStream $ \st yld sng stp ->
983+ let stop = foldStream st yld sng stp m2
984+ in foldStream st yld sng stop m1
1226985
1227986------------------------------------------------------------------------------
1228987-- MonadReader
1229988------------------------------------------------------------------------------
1230989
990+{-# INLINABLE withLocal #-}
1231991withLocal :: MonadReader r m => (r -> r) -> Stream m a -> Stream m a
1232992withLocal f m =
1233− Stream $ \st stp sng yld ->
993+ mkStream $ \st yld sng stp ->
1234994 let single = local f . sng
1235995 yieldk a r = local f $ yld a (withLocal f r)
1236− in unStream m (rstState st) (local f stp) single yieldk
996+ in foldStream st yieldk single (local f stp) m
1237997
1238998------------------------------------------------------------------------------
1239999-- MonadError
@@ -1245,16 +1005,9 @@ withCatchError
12451005 :: MonadError e m
12461006 => Stream m a -> (e -> Stream m a) -> Stream m a
12471007withCatchError m h =
1248− Stream $ \_ stp sng yld ->
1008+ mkStream $ \_ stp sng yld ->
12491009 let run x = unStream x Nothing stp sng yieldk
12501010 handle r = r `catchError` \e -> run $ h e
12511011 yieldk a r = yld a (withCatchError r h)
12521012 in handle $ run m
12531013-}
1254−
1255−-------------------------------------------------------------------------------
1256−-- Transformers
1257−-------------------------------------------------------------------------------
1258−
1259−instance MonadTrans Stream where
1260− lift = yieldM