on 665e7df help sign in
460 lines 14 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving#-}
6{-# LANGUAGE InstanceSigs #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE UndecidableInstances #-} -- XXX
11-- |
12-- Module : Streamly.Internal.Data.Stream.Serial
13-- Copyright : (c) 2017 Harendra Kumar
14--
15-- License : BSD3
16-- Maintainer : streamly@composewell.com
17-- Stability : experimental
18-- Portability : GHC
19--
20--
21module Streamly.Internal.Data.Stream.Serial
22 (
23 -- * Serial appending stream
24 SerialT
25 , Serial
26 , K.serial
27 , serially
29 -- * Serial interleaving stream
30 , WSerialT
31 , WSerial
32 , wSerial
33 , wSerialFst
34 , wSerialMin
35 , wSerially
37 -- * Construction
38 , unfoldrM
40 -- * Transformation
41 , map
42 , mapM
44 -- * Deprecated
45 , StreamT
46 , InterleavedT
47 , (<=>)
48 , interleaving
49 )
50where
52import Control.Applicative (liftA2)
53import Control.DeepSeq (NFData(..))
54#if MIN_VERSION_deepseq(1,4,3)
55import Control.DeepSeq (NFData1(..))
56#endif
57import Control.Monad.Base (MonadBase(..), liftBaseDefault)
58import Control.Monad.Catch (MonadThrow, throwM)
59-- import Control.Monad.Error.Class (MonadError(..))
60import Control.Monad.IO.Class (MonadIO(..))
61import Control.Monad.Reader.Class (MonadReader(..))
62import Control.Monad.State.Class (MonadState(..))
63import Control.Monad.Trans.Class (MonadTrans(lift))
64import Data.Functor.Identity (Identity(..), runIdentity)
65import Data.Foldable (fold)
66#if __GLASGOW_HASKELL__ < 808
67import Data.Semigroup (Semigroup(..))
68#endif
69import GHC.Exts (IsList(..), IsString(..))
70import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec,
71 readListPrecDefault)
72import Prelude hiding (map, mapM)
74import Streamly.Internal.Data.Stream.StreamK (IsStream(..), adapt, Stream, mkStream,
75 foldStream)
76import qualified Streamly.Internal.Data.Stream.Prelude as P
77import qualified Streamly.Internal.Data.Stream.StreamK as K
78import qualified Streamly.Internal.Data.Stream.StreamD as D
80#include "Instances.hs"
81#include "inline.hs"
83------------------------------------------------------------------------------
84-- SerialT
85------------------------------------------------------------------------------
87-- | The 'Semigroup' operation for 'SerialT' behaves like a regular append
88-- operation. Therefore, when @a <> b@ is evaluated, stream @a@ is evaluated
89-- first until it exhausts and then stream @b@ is evaluated. In other words,
90-- the elements of stream @b@ are appended to the elements of stream @a@. This
91-- operation can be used to fold an infinite lazy container of streams.
92--
93-- @
94-- import Streamly
95-- import qualified "Streamly.Prelude" as S
96--
97-- main = (S.toList . 'serially' $ (S.fromList [1,2]) \<\> (S.fromList [3,4])) >>= print
98-- @
99-- @
100-- [1,2,3,4]
101-- @
102--
103-- The 'Monad' instance runs the /monadic continuation/ for each
104-- element of the stream, serially.
105--
106-- @
107-- main = S.drain . 'serially' $ do
108-- x <- return 1 \<\> return 2
109-- S.yieldM $ print x
110-- @
111-- @
112-- 1
113-- 2
114-- @
115--
116-- 'SerialT' nests streams serially in a depth first manner.
117--
118-- @
119-- main = S.drain . 'serially' $ do
120-- x <- return 1 \<\> return 2
121-- y <- return 3 \<\> return 4
122-- S.yieldM $ print (x, y)
123-- @
124-- @
125-- (1,3)
126-- (1,4)
127-- (2,3)
128-- (2,4)
129-- @
130--
131-- We call the monadic code being run for each element of the stream a monadic
132-- continuation. In imperative paradigm we can think of this composition as
133-- nested @for@ loops and the monadic continuation is the body of the loop. The
134-- loop iterates for all elements of the stream.
135--
136-- Note that the behavior and semantics of 'SerialT', including 'Semigroup'
137-- and 'Monad' instances are exactly like Haskell lists except that 'SerialT'
138-- can contain effectful actions while lists are pure.
139--
140-- In the code above, the 'serially' combinator can be omitted as the default
141-- stream type is 'SerialT'.
142--
143-- @since 0.2.0
144newtype SerialT m a = SerialT {getSerialT :: Stream m a}
145 deriving (Semigroup, Monoid, MonadTrans)
147-- | A serial IO stream of elements of type @a@. See 'SerialT' documentation
148-- for more details.
149--
150-- @since 0.2.0
151type Serial = SerialT IO
153-- |
154-- @since 0.1.0
155{-# DEPRECATED StreamT "Please use 'SerialT' instead." #-}
156type StreamT = SerialT
158-- | Fix the type of a polymorphic stream as 'SerialT'.
159--
160-- @since 0.1.0
161serially :: IsStream t => SerialT m a -> t m a
162serially = adapt
164{-# INLINE consMSerial #-}
165{-# SPECIALIZE consMSerial :: IO a -> SerialT IO a -> SerialT IO a #-}
166consMSerial :: Monad m => m a -> SerialT m a -> SerialT m a
167consMSerial m ms = fromStream $ K.consMStream m (toStream ms)
169instance IsStream SerialT where
170 toStream = getSerialT
171 fromStream = SerialT
172 consM = consMSerial
173 (|:) = consMSerial
175------------------------------------------------------------------------------
176-- Monad
177------------------------------------------------------------------------------
179instance Monad m => Monad (SerialT m) where
180 return = pure
181 {-# INLINE (>>=) #-}
182 (>>=) = K.bindWith K.serial
183 {-# INLINE (>>) #-}
184 (>>) = (*>)
186 -- StreamD based implementation
187 -- return = SerialT . D.fromStreamD . D.yield
188 -- m >>= f = D.fromStreamD $ D.concatMap (\a -> D.toStreamD (f a)) (D.toStreamD m)
190------------------------------------------------------------------------------
191-- Other instances
192------------------------------------------------------------------------------
194{-# INLINE mapM #-}
195mapM :: (IsStream t, Monad m) => (a -> m b) -> t m a -> t m b
196mapM f m = D.fromStreamD $ D.mapM f $ D.toStreamD m
198-- |
199-- @
200-- map = fmap
201-- @
202--
203-- Same as 'fmap'.
204--
205-- @
206-- > S.toList $ S.map (+1) $ S.fromList [1,2,3]
207-- [2,3,4]
208-- @
209--
210-- @since 0.4.0
211{-# INLINE map #-}
212map :: (IsStream t, Monad m) => (a -> b) -> t m a -> t m b
213map f = mapM (return . f)
215{-# INLINE apSerial #-}
216apSerial :: Monad m => SerialT m (a -> b) -> SerialT m a -> SerialT m b
217apSerial (SerialT m1) (SerialT m2) = D.fromStreamD $ D.toStreamD m1 <*> D.toStreamD m2
219{-# INLINE apSequence #-}
220apSequence :: Monad m => SerialT m a -> SerialT m b -> SerialT m b
221apSequence (SerialT m1) (SerialT m2) = D.fromStreamD $ D.toStreamD m1 *> D.toStreamD m2
223instance Monad m => Applicative (SerialT m) where
224 {-# INLINE pure #-}
225 pure = SerialT . K.yield
226 {-# INLINE (<*>) #-}
227 (<*>) = apSerial
228 {-# INLINE (*>) #-}
229 (*>) = apSequence
231MONAD_COMMON_INSTANCES(SerialT,)
232LIST_INSTANCES(SerialT)
233NFDATA1_INSTANCE(SerialT)
234FOLDABLE_INSTANCE(SerialT)
235TRAVERSABLE_INSTANCE(SerialT)
237------------------------------------------------------------------------------
238-- WSerialT
239------------------------------------------------------------------------------
241-- | The 'Semigroup' operation for 'WSerialT' interleaves the elements from the
242-- two streams. Therefore, when @a <> b@ is evaluated, stream @a@ is evaluated
243-- first to produce the first element of the combined stream and then stream
244-- @b@ is evaluated to produce the next element of the combined stream, and
245-- then we go back to evaluating stream @a@ and so on. In other words, the
246-- elements of stream @a@ are interleaved with the elements of stream @b@.
247--
248-- Note that when multiple actions are combined like @a <> b <> c ... <> z@ we
249-- interleave them in a binary fashion i.e. @a@ and @b@ are interleaved with
250-- each other and the result is interleaved with @c@ and so on. This will not
251-- act as a true round-robin scheduling across all the streams. Note that this
252-- operation cannot be used to fold a container of infinite streams as the
253-- state that it needs to maintain is proportional to the number of streams.
254--
255-- @
256-- import Streamly
257-- import qualified "Streamly.Prelude" as S
258--
259-- main = (S.toList . 'wSerially' $ (S.fromList [1,2]) \<\> (S.fromList [3,4])) >>= print
260-- @
261-- @
262-- [1,3,2,4]
263-- @
264--
265-- Similarly, the 'Monad' instance interleaves the iterations of the
266-- inner and the outer loop, nesting loops in a breadth first manner.
267--
268--
269-- @
270-- main = S.drain . 'wSerially' $ do
271-- x <- return 1 \<\> return 2
272-- y <- return 3 \<\> return 4
273-- S.yieldM $ print (x, y)
274-- @
275-- @
276-- (1,3)
277-- (2,3)
278-- (1,4)
279-- (2,4)
280-- @
281--
282-- @since 0.2.0
283newtype WSerialT m a = WSerialT {getWSerialT :: Stream m a}
284 deriving (MonadTrans)
286-- | An interleaving serial IO stream of elements of type @a@. See 'WSerialT'
287-- documentation for more details.
288--
289-- @since 0.2.0
290type WSerial = WSerialT IO
292-- |
293-- @since 0.1.0
294{-# DEPRECATED InterleavedT "Please use 'WSerialT' instead." #-}
295type InterleavedT = WSerialT
297-- | Fix the type of a polymorphic stream as 'WSerialT'.
298--
299-- @since 0.2.0
300wSerially :: IsStream t => WSerialT m a -> t m a
301wSerially = adapt
303-- | Same as 'wSerially'.
304--
305-- @since 0.1.0
306{-# DEPRECATED interleaving "Please use wSerially instead." #-}
307interleaving :: IsStream t => WSerialT m a -> t m a
308interleaving = wSerially
310consMWSerial :: Monad m => m a -> WSerialT m a -> WSerialT m a
311consMWSerial m ms = fromStream $ K.consMStream m (toStream ms)
313instance IsStream WSerialT where
314 toStream = getWSerialT
315 fromStream = WSerialT
317 {-# INLINE consM #-}
318 {-# SPECIALIZE consM :: IO a -> WSerialT IO a -> WSerialT IO a #-}
319 consM :: Monad m => m a -> WSerialT m a -> WSerialT m a
320 consM = consMWSerial
322 {-# INLINE (|:) #-}
323 {-# SPECIALIZE (|:) :: IO a -> WSerialT IO a -> WSerialT IO a #-}
324 (|:) :: Monad m => m a -> WSerialT m a -> WSerialT m a
325 (|:) = consMWSerial
327------------------------------------------------------------------------------
328-- Semigroup
329------------------------------------------------------------------------------
331-- Additionally we can have m elements yield from the first stream and n
332-- elements yielding from the second stream. We can also have time slicing
333-- variants of positional interleaving, e.g. run first stream for m seconds and
334-- run the second stream for n seconds.
335--
336-- Similar combinators can be implemented using WAhead style.
338-- | Polymorphic version of the 'Semigroup' operation '<>' of 'WSerialT'.
339-- Interleaves two streams, yielding one element from each stream alternately.
340-- When one stream stops the rest of the other stream is used in the output
341-- stream.
342--
343-- @since 0.2.0
344{-# INLINE wSerial #-}
345wSerial :: IsStream t => t m a -> t m a -> t m a
346wSerial m1 m2 = mkStream $ \st yld sng stp -> do
347 let stop = foldStream st yld sng stp m2
348 single a = yld a m2
349 yieldk a r = yld a (wSerial m2 r)
350 foldStream st yieldk single stop m1
352-- | Like `wSerial` but stops interleaving as soon as the first stream stops.
353--
354-- @since 0.7.0
355{-# INLINE wSerialFst #-}
356wSerialFst :: IsStream t => t m a -> t m a -> t m a
357wSerialFst m1 m2 = mkStream $ \st yld sng stp -> do
358 let yieldFirst a r = yld a (yieldSecond r m2)
359 in foldStream st yieldFirst sng stp m1
361 where
363 yieldSecond s1 s2 = mkStream $ \st yld sng stp -> do
364 let stop = foldStream st yld sng stp s1
365 single a = yld a s1
366 yieldk a r = yld a (wSerial s1 r)
367 in foldStream st yieldk single stop s2
369-- | Like `wSerial` but stops interleaving as soon as any of the two streams
370-- stops.
371--
372-- @since 0.7.0
373{-# INLINE wSerialMin #-}
374wSerialMin :: IsStream t => t m a -> t m a -> t m a
375wSerialMin m1 m2 = mkStream $ \st yld sng stp -> do
376 let stop = stp
377 single a = sng a
378 yieldk a r = yld a (wSerial m2 r)
379 foldStream st yieldk single stop m1
381instance Semigroup (WSerialT m a) where
382 (<>) = wSerial
384infixr 5 <=>
386-- | Same as 'wSerial'.
387--
388-- @since 0.1.0
389{-# DEPRECATED (<=>) "Please use 'wSerial' instead." #-}
390{-# INLINE (<=>) #-}
391(<=>) :: IsStream t => t m a -> t m a -> t m a
392(<=>) = wSerial
394------------------------------------------------------------------------------
395-- Monoid
396------------------------------------------------------------------------------
398instance Monoid (WSerialT m a) where
399 mempty = K.nil
400 mappend = (<>)
402{-# INLINE apWSerial #-}
403apWSerial :: Monad m => WSerialT m (a -> b) -> WSerialT m a -> WSerialT m b
404apWSerial (WSerialT m1) (WSerialT m2) =
405 let f x1 = K.concatMapBy wSerial (pure . x1) m2
406 in WSerialT $ K.concatMapBy wSerial f m1
408instance Monad m => Applicative (WSerialT m) where
409 {-# INLINE pure #-}
410 pure = WSerialT . K.yield
411 {-# INLINE (<*>) #-}
412 (<*>) = apWSerial
414------------------------------------------------------------------------------
415-- Monad
416------------------------------------------------------------------------------
418instance Monad m => Monad (WSerialT m) where
419 return = pure
420 {-# INLINE (>>=) #-}
421 (>>=) = K.bindWith wSerial
423------------------------------------------------------------------------------
424-- Other instances
425------------------------------------------------------------------------------
427MONAD_COMMON_INSTANCES(WSerialT,)
428LIST_INSTANCES(WSerialT)
429NFDATA1_INSTANCE(WSerialT)
430FOLDABLE_INSTANCE(WSerialT)
431TRAVERSABLE_INSTANCE(WSerialT)
433------------------------------------------------------------------------------
434-- Construction
435------------------------------------------------------------------------------
437-- | Build a stream by unfolding a /monadic/ step function starting from a
438-- seed. The step function returns the next element in the stream and the next
439-- seed value. When it is done it returns 'Nothing' and the stream ends. For
440-- example,
441--
442-- @
443-- let f b =
444-- if b > 3
445-- then return Nothing
446-- else print b >> return (Just (b, b + 1))
447-- in drain $ unfoldrM f 0
448-- @
449-- @
450-- 0
451-- 1
452-- 2
453-- 3
454-- @
455--
456-- /Internal/
457--
458{-# INLINE unfoldrM #-}
459unfoldrM :: (IsStream t, Monad m) => (b -> m (Maybe (a, b))) -> b -> t m a
460unfoldrM step seed = D.fromStreamD (D.unfoldrM step seed)