{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving#-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Streamly.Streams.Zip
(
K.zipWith
, K.zipWithM
, zipAsyncWith
, zipAsyncWithM
, ZipSerialM
, ZipSerial
, ZipStream
, zipSerially
, zipping
, ZipAsyncM
, ZipAsync
, zipAsyncly
, zippingAsync
)
where
import Data.Semigroup (Semigroup(..))
import Prelude hiding (map, repeat, zipWith)
import Streamly.Streams.StreamK (IsStream(..), Stream(..))
import Streamly.Streams.Async (mkAsync')
import Streamly.Streams.Serial (map)
import Streamly.SVar (MonadAsync, rstState)
import qualified Streamly.Streams.StreamK as K
#include "Instances.hs"
newtype ZipSerialM m a = ZipSerialM {getZipSerialM :: Stream m a}
deriving (Semigroup, Monoid)
{-# DEPRECATED ZipStream "Please use 'ZipSerialM' instead." #-}
type ZipStream = ZipSerialM
type ZipSerial a = ZipSerialM IO a
zipSerially :: IsStream t => ZipSerialM m a -> t m a
zipSerially = K.adapt
{-# DEPRECATED zipping "Please use zipSerially instead." #-}
zipping :: IsStream t => ZipSerialM m a -> t m a
zipping = zipSerially
instance IsStream ZipSerialM where
toStream = getZipSerialM
fromStream = ZipSerialM
{-# INLINE consM #-}
{-# SPECIALIZE consM :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-}
consM :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a
consM m r = fromStream $ K.consMSerial m (toStream r)
{-# INLINE (|:) #-}
{-# SPECIALIZE (|:) :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-}
(|:) :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a
m |: r = fromStream $ K.consMSerial m (toStream r)
instance Monad m => Functor (ZipSerialM m) where
fmap = map
instance Monad m => Applicative (ZipSerialM m) where
pure = ZipSerialM . K.repeat
m1 <*> m2 = fromStream $ K.zipWith id (toStream m1) (toStream m2)
zipAsyncWith :: (IsStream t, MonadAsync m)
=> (a -> b -> c) -> t m a -> t m b -> t m c
zipAsyncWith f m1 m2 = fromStream $ Stream $ \st stp sng yld -> do
ma <- mkAsync' (rstState st) m1
mb <- mkAsync' (rstState st) m2
unStream (toStream (K.zipWith f ma mb)) (rstState st) stp sng yld
zipAsyncWithM :: (IsStream t, MonadAsync m)
=> (a -> b -> m c) -> t m a -> t m b -> t m c
zipAsyncWithM f m1 m2 = fromStream $ Stream $ \st stp sng yld -> do
ma <- mkAsync' (rstState st) m1
mb <- mkAsync' (rstState st) m2
unStream (toStream (K.zipWithM f ma mb)) (rstState st) stp sng yld
newtype ZipAsyncM m a = ZipAsyncM {getZipAsyncM :: Stream m a}
deriving (Semigroup, Monoid)
type ZipAsync a = ZipAsyncM IO a
zipAsyncly :: IsStream t => ZipAsyncM m a -> t m a
zipAsyncly = K.adapt
{-# DEPRECATED zippingAsync "Please use zipAsyncly instead." #-}
zippingAsync :: IsStream t => ZipAsyncM m a -> t m a
zippingAsync = zipAsyncly
instance IsStream ZipAsyncM where
toStream = getZipAsyncM
fromStream = ZipAsyncM
{-# INLINE consM #-}
{-# SPECIALIZE consM :: IO a -> ZipAsyncM IO a -> ZipAsyncM IO a #-}
consM :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a
consM m r = fromStream $ K.consMSerial m (toStream r)
{-# INLINE (|:) #-}
{-# SPECIALIZE (|:) :: IO a -> ZipAsyncM IO a -> ZipAsyncM IO a #-}
(|:) :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a
m |: r = fromStream $ K.consMSerial m (toStream r)
instance Monad m => Functor (ZipAsyncM m) where
fmap = map
instance MonadAsync m => Applicative (ZipAsyncM m) where
pure = ZipAsyncM . K.repeat
m1 <*> m2 = zipAsyncWith id m1 m2