on master help sign in
Add manyInterleave

An interleaving operation for unfolds. Completely experimental as of now to help experiment with such operations using unfolds.

commit29dc3fadb68623bfc1faa5d2771a2640e64673ff authorHarendra Kumar <harendra@composewell.com> dateMon 27 Sep 2021, 12:44 (5 years ago) parentba35e9c
1 file changed+85
src/Streamly/Internal/Data/Unfold/Type.hs+85
src/Streamly/Internal/Data/Unfold/Type.hs+85
@@ -44,6 +44,7 @@ module Streamly.Internal.Data.Unfold.Type
4444 -- * Nesting
4545 , ConcatState (..)
4646 , many
47+ , manyInterleave
4748
4849 -- Applicative
4950 , apSequence
@@ -690,3 +691,87 @@ instance Monad m => Arrow (Unfold m) where
690691 {-# INLINE (***) #-}
691692 u1 *** u2 = zipWith (,) (lmap fst u1) (lmap snd u2)
692693-}
694+
695+------------------------------------------------------------------------------
696+-- Interleaving
697+------------------------------------------------------------------------------
698+
699+-- We can possibly have an "interleave" operation to interleave the streams
700+-- from two seeds:
701+--
702+-- interleave :: Unfold m x a -> Unfold m x a -> Unfold m (x, x) a
703+--
704+-- Alternatively, we can use a signature like zipWith:
705+-- interleave :: Unfold m x a -> Unfold m x a -> Unfold m x a
706+--
707+-- We can implement this in terms of manyInterleave, but that may
708+-- not be as efficient as a custom implementation.
709+--
710+-- Similarly we can also have other binary combining ops like append, mergeBy.
711+-- We already have zipWith.
712+--
713+
714+data ManyInterleaveState o i =
715+ ManyInterleaveOuter o [i]
716+ | ManyInterleaveInner o [i]
717+ | ManyInterleaveInnerL [i] [i]
718+ | ManyInterleaveInnerR [i] [i]
719+
720+-- | 'Streamly.Internal.Data.Stream.IsStream.unfoldManyInterleave' for
721+-- documentation and notes.
722+--
723+-- This is almost identical to unfoldManyInterleave in StreamD module.
724+--
725+-- The 'many' combinator is in fact 'manyAppend' to be more explicit in naming.
726+--
727+-- /Internal/
728+{-# INLINE_NORMAL manyInterleave #-}
729+manyInterleave :: Monad m => Unfold m a b -> Unfold m c a -> Unfold m c b
730+manyInterleave (Unfold istep iinject) (Unfold ostep oinject) =
731+ Unfold step inject
732+
733+ where
734+
735+ inject x = do
736+ ost <- oinject x
737+ return (ManyInterleaveOuter ost [])
738+
739+ {-# INLINE_LATE step #-}
740+ step (ManyInterleaveOuter o ls) = do
741+ r <- ostep o
742+ case r of
743+ Yield a o' -> do
744+ i <- iinject a
745+ i `seq` return (Skip (ManyInterleaveInner o' (i : ls)))
746+ Skip o' -> return $ Skip (ManyInterleaveOuter o' ls)
747+ Stop -> return $ Skip (ManyInterleaveInnerL ls [])
748+
749+ step (ManyInterleaveInner _ []) = undefined
750+ step (ManyInterleaveInner o (st:ls)) = do
751+ r <- istep st
752+ return $ case r of
753+ Yield x s -> Yield x (ManyInterleaveOuter o (s:ls))
754+ Skip s -> Skip (ManyInterleaveInner o (s:ls))
755+ Stop -> Skip (ManyInterleaveOuter o ls)
756+
757+ step (ManyInterleaveInnerL [] []) = return Stop
758+ step (ManyInterleaveInnerL [] rs) =
759+ return $ Skip (ManyInterleaveInnerR [] rs)
760+
761+ step (ManyInterleaveInnerL (st:ls) rs) = do
762+ r <- istep st
763+ return $ case r of
764+ Yield x s -> Yield x (ManyInterleaveInnerL ls (s:rs))
765+ Skip s -> Skip (ManyInterleaveInnerL (s:ls) rs)
766+ Stop -> Skip (ManyInterleaveInnerL ls rs)
767+
768+ step (ManyInterleaveInnerR [] []) = return Stop
769+ step (ManyInterleaveInnerR ls []) =
770+ return $ Skip (ManyInterleaveInnerL ls [])
771+
772+ step (ManyInterleaveInnerR ls (st:rs)) = do
773+ r <- istep st
774+ return $ case r of
775+ Yield x s -> Yield x (ManyInterleaveInnerR (s:ls) rs)
776+ Skip s -> Skip (ManyInterleaveInnerR ls (s:rs))
777+ Stop -> Skip (ManyInterleaveInnerR ls rs)