git.iko.soy/streamly
on bc5617f help sign in
streamly/src/Streamly/Internal/Data/Stream/Zip.hs
222 lines 7.1 kB history raw
1{-# LANGUAGE UndecidableInstances #-}
3-- |
4-- Module : Streamly.Internal.Data.Stream.Zip
5-- Copyright : (c) 2017 Composewell Technologies
6--
7-- License : BSD3
8-- Maintainer : streamly@composewell.com
9-- Stability : experimental
10-- Portability : GHC
11--
12-- To run examples in this module:
13--
14-- >>> import qualified Streamly.Prelude as Stream
15--
16module Streamly.Internal.Data.Stream.Zip
17 (
18 ZipSerialM (..)
19 , ZipSerial
20 , consMZip
21 , zipWithK
22 , zipWithMK
24 , ZipAsyncM(..)
25 , ZipAsync
26 , consMZipAsync
27 , zipAsyncWithK
28 , zipAsyncWithMK
30 -- * Deprecated
31 , ZipStream
32 )
33where
35import Control.Applicative (liftA2)
36import Control.DeepSeq (NFData(..))
37#if MIN_VERSION_deepseq(1,4,3)
38import Control.DeepSeq (NFData1(..))
39#endif
40import Data.Foldable (Foldable(foldl'), fold)
41import Data.Functor.Identity (Identity(..), runIdentity)
42import Data.Maybe (fromMaybe)
43import Data.Semigroup (Endo(..))
44#if __GLASGOW_HASKELL__ < 808
45import Data.Semigroup (Semigroup(..))
46#endif
47import GHC.Exts (IsList(..), IsString(..))
48import Text.Read
49 ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec
50 , readListPrecDefault)
51import Streamly.Internal.BaseCompat ((#.), errorWithoutStackTrace, oneShot)
52import Streamly.Internal.Control.Concurrent (MonadAsync)
53import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)
54import Streamly.Internal.Data.Stream.Serial (SerialT(..))
55import Streamly.Internal.Data.Stream.StreamK.Type (Stream)
57import qualified Streamly.Internal.Data.Stream.Parallel as Par
58import qualified Streamly.Internal.Data.Stream.Prelude as P
59 (cmpBy, eqBy, foldl', foldr, fromList, toList)
60import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
61import qualified Streamly.Internal.Data.Stream.StreamD as D
62import qualified Streamly.Internal.Data.Stream.Serial as Serial
64import Prelude hiding (map, repeat, zipWith, errorWithoutStackTrace)
66#include "Instances.hs"
68-- $setup
69-- >>> import qualified Streamly.Prelude as Stream
70-- >>> import Control.Concurrent (threadDelay)
71-- >>> :{
72-- delay n = do
73-- threadDelay (n * 1000000) -- sleep for n seconds
74-- putStrLn (show n ++ " sec") -- print "n sec"
75-- return n -- IO Int
76-- :}
78{-# INLINE zipWithMK #-}
79zipWithMK :: Monad m =>
80 (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
81zipWithMK f m1 m2 =
82 D.toStreamK $ D.zipWithM f (D.fromStreamK m1) (D.fromStreamK m2)
84{-# INLINE zipWithK #-}
85zipWithK :: Monad m
86 => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
87zipWithK f = zipWithMK (\a b -> return (f a b))
89------------------------------------------------------------------------------
90-- Parallel Zipping
91------------------------------------------------------------------------------
93-- | Like 'zipAsyncWith' but with a monadic zipping function.
94--
95-- @since 0.4.0
96{-# INLINE zipAsyncWithMK #-}
97zipAsyncWithMK :: MonadAsync m
98 => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
99zipAsyncWithMK f m1 m2 = D.toStreamK $
100 D.zipWithM f (Par.mkParallelD $ D.fromStreamK m1)
101 (Par.mkParallelD $ D.fromStreamK m2)
103-- XXX Should we rename this to zipParWith or zipParallelWith? This can happen
104-- along with the change of behvaior to end the stream concurrently.
105--
106-- | Like 'zipWith' but zips concurrently i.e. both the streams being zipped
107-- are evaluated concurrently using the 'ParallelT' concurrent evaluation
108-- style. The maximum number of elements of each stream evaluated in advance
109-- can be controlled by 'maxBuffer'.
110--
111-- The stream ends if stream @a@ or stream @b@ ends. However, if stream @b@
112-- ends while we are still evaluating stream @a@ and waiting for a result then
113-- stream will not end until after the evaluation of stream @a@ finishes. This
114-- behavior can potentially be changed in future to end the stream immediately
115-- as soon as any of the stream end is detected.
116--
117-- @since 0.1.0
118{-# INLINE zipAsyncWithK #-}
119zipAsyncWithK :: MonadAsync m
120 => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
121zipAsyncWithK f = zipAsyncWithMK (\a b -> return (f a b))
123------------------------------------------------------------------------------
124-- Serially Zipping Streams
125------------------------------------------------------------------------------
127-- | For 'ZipSerialM' streams:
128--
129-- @
130-- (<>) = 'Streamly.Prelude.serial'
131-- (<*>) = 'Streamly.Prelude.serial.zipWith' id
132-- @
133--
134-- Applicative evaluates the streams being zipped serially:
135--
136-- >>> s1 = Stream.fromFoldable [1, 2]
137-- >>> s2 = Stream.fromFoldable [3, 4]
138-- >>> s3 = Stream.fromFoldable [5, 6]
139-- >>> Stream.toList $ Stream.fromZipSerial $ (,,) <$> s1 <*> s2 <*> s3
140-- [(1,3,5),(2,4,6)]
141--
142-- /Since: 0.2.0 ("Streamly")/
143--
144-- @since 0.8.0
145newtype ZipSerialM m a = ZipSerialM {getZipSerialM :: Stream m a}
146 deriving (Semigroup, Monoid)
148-- |
149-- @since 0.1.0
150{-# DEPRECATED ZipStream "Please use 'ZipSerialM' instead." #-}
151type ZipStream = ZipSerialM
153-- | An IO stream whose applicative instance zips streams serially.
154--
155-- /Since: 0.2.0 ("Streamly")/
156--
157-- @since 0.8.0
158type ZipSerial = ZipSerialM IO
160consMZip :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a
161consMZip m (ZipSerialM r) = ZipSerialM $ K.consM m r
163LIST_INSTANCES(ZipSerialM)
164NFDATA1_INSTANCE(ZipSerialM)
166instance Monad m => Functor (ZipSerialM m) where
167 {-# INLINE fmap #-}
168 fmap f (ZipSerialM m) = ZipSerialM $ getSerialT $ fmap f (SerialT m)
170instance Monad m => Applicative (ZipSerialM m) where
171 pure = ZipSerialM . getSerialT . Serial.repeat
173 {-# INLINE (<*>) #-}
174 ZipSerialM m1 <*> ZipSerialM m2 = ZipSerialM $ zipWithK id m1 m2
176FOLDABLE_INSTANCE(ZipSerialM)
177TRAVERSABLE_INSTANCE(ZipSerialM)
179------------------------------------------------------------------------------
180-- Parallely Zipping Streams
181------------------------------------------------------------------------------
182--
183-- | For 'ZipAsyncM' streams:
184--
185-- @
186-- (<>) = 'Streamly.Prelude.serial'
187-- (<*>) = 'Streamly.Prelude.serial.zipAsyncWith' id
188-- @
189--
190-- Applicative evaluates the streams being zipped concurrently, the following
191-- would take half the time that it would take in serial zipping:
192--
193-- >>> s = Stream.fromFoldableM $ Prelude.map delay [1, 1, 1]
194-- >>> Stream.toList $ Stream.fromZipAsync $ (,) <$> s <*> s
195-- ...
196-- [(1,1),(1,1),(1,1)]
197--
198-- /Since: 0.2.0 ("Streamly")/
199--
200-- @since 0.8.0
201newtype ZipAsyncM m a = ZipAsyncM {getZipAsyncM :: Stream m a}
202 deriving (Semigroup, Monoid)
204-- | An IO stream whose applicative instance zips streams wAsyncly.
205--
206-- /Since: 0.2.0 ("Streamly")/
207--
208-- @since 0.8.0
209type ZipAsync = ZipAsyncM IO
211consMZipAsync :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a
212consMZipAsync m (ZipAsyncM r) = ZipAsyncM $ K.consM m r
214instance Monad m => Functor (ZipAsyncM m) where
215 {-# INLINE fmap #-}
216 fmap f (ZipAsyncM m) = ZipAsyncM $ getSerialT $ fmap f (SerialT m)
218instance MonadAsync m => Applicative (ZipAsyncM m) where
219 pure = ZipAsyncM . getSerialT . Serial.repeat
221 {-# INLINE (<*>) #-}
222 ZipAsyncM m1 <*> ZipAsyncM m2 = ZipAsyncM $ zipAsyncWithK id m1 m2