on 206e353 help sign in
569 lines 18 kB history raw
1{-# OPTIONS_GHC -Wno-orphans #-}
3-- |
4-- Module : Streamly.Internal.Data.Stream.IsStream.Generate
5-- Copyright : (c) 2017 Composewell Technologies
6-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
8-- Stability : experimental
9-- Portability : GHC
10--
11-- Most of the combinators in this module can be implemented as unfolds. Some
12-- of them however can only be expressed in terms StreamK e.g. cons/consM,
13-- fromFoldable, mfix. We can possibly remove those from this module which can
14-- be expressed as unfolds. Unless we want to use rewrite rules to rewrite them
15-- as StreamK when StreamK is used, avoiding conversion to StreamD. Will that
16-- help? Are there any other reasons to keep these and not use unfolds?
18module Streamly.Internal.Data.Stream.IsStream.Generate
19 (
20 -- * Primitives
21 K.nil
22 , K.nilM
23 , K.cons
24 , (K..:)
26 , consM
27 , (|:)
29 -- * From 'Unfold'
30 , unfold
31 , unfold0
33 -- * Unfolding
34 , unfoldr
35 , unfoldrM
37 -- * From Values
38 , yield
39 , yieldM
40 , repeat
41 , repeatM
42 , replicate
43 , replicateM
45 -- * Enumeration
46 , Enumerable (..)
47 , enumerate
48 , enumerateTo
50 -- * Time Enumeration
51 , times
52 , absTimes
53 , absTimesWith
54 , relTimes
55 , relTimesWith
56 , durations
57 , ticks
58 , timeout
60 -- * From Generators
61 , fromIndices
62 , fromIndicesM
63 -- , generate
64 -- , generateM
66 -- * Iteration
67 , iterate
68 , iterateM
70 -- * Cyclic Elements
71 , K.mfix
73 -- * From Containers
74 , P.fromList
75 , fromListM
76 , K.fromFoldable
77 , fromFoldableM
78 , fromCallback
80 -- * Deprecated
81 , K.once
82 , each
83 , fromHandle
84 , currentTime
85 )
86where
88#include "inline.hs"
90import Control.Monad.IO.Class (MonadIO(..))
91import Data.Void (Void)
92import Streamly.Internal.Data.Unfold.Type (Unfold)
93import Streamly.Internal.Data.SVar (MonadAsync, Rate (..))
94import Streamly.Internal.Data.Stream.IsStream.Enumeration
95 (Enumerable(..), enumerate, enumerateTo)
96import Streamly.Internal.Data.Stream.IsStream.Common
97 (absTimesWith, concatM, relTimesWith, timesWith, yield, yieldM, repeatM)
98import Streamly.Internal.Data.Stream.Prelude (fromStreamS)
99import Streamly.Internal.Data.Stream.StreamD (fromStreamD)
100import Streamly.Internal.Data.Stream.StreamK (IsStream((|:), consM))
101import Streamly.Internal.Data.Stream.Serial (SerialT, WSerialT)
102import Streamly.Internal.Data.Stream.Zip (ZipSerialM)
103import Streamly.Internal.Data.Time.Units (AbsTime , RelTime64, addToAbsTime64)
105import qualified Streamly.Internal.Data.Stream.Parallel as Par
106import qualified Streamly.Internal.Data.Stream.Prelude as P
107import qualified Streamly.Internal.Data.Stream.Serial as Serial
108import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D
109import qualified Streamly.Internal.Data.Stream.StreamK as K
110#ifdef USE_STREAMK_ONLY
111import qualified Streamly.Internal.Data.Stream.StreamK as S
112#else
113import qualified Streamly.Internal.Data.Stream.StreamD.Generate as S
114#endif
115import qualified System.IO as IO
117import Prelude hiding (iterate, replicate, repeat)
119-- $setup
120-- >>> :m
121-- >>> import Prelude hiding (iterate, replicate, repeat)
122-- >>> import qualified Streamly.Prelude as Stream
123-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
124-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold
125-- >>> import Control.Concurrent (threadDelay)
127------------------------------------------------------------------------------
128-- From Unfold
129------------------------------------------------------------------------------
131-- | Convert an 'Unfold' into a stream by supplying it an input seed.
132--
133-- >>> Stream.drain $ Stream.unfold (Unfold.replicateM 3) (putStrLn "hello")
134-- hello
135-- hello
136-- hello
137--
138-- /Since: 0.7.0/
139{-# INLINE unfold #-}
140unfold :: (IsStream t, Monad m) => Unfold m a b -> a -> t m b
141unfold unf x = fromStreamD $ D.unfold unf x
143-- | Convert an 'Unfold' with a closed input end into a stream.
144--
145-- /Pre-release/
146{-# INLINE unfold0 #-}
147unfold0 :: (IsStream t, Monad m) => Unfold m Void b -> t m b
148unfold0 unf = unfold unf (error "unfold0: unexpected void evaluation")
150------------------------------------------------------------------------------
151-- Generation by Unfolding
152------------------------------------------------------------------------------
154-- |
155-- @
156-- unfoldr step s =
157-- case step s of
158-- Nothing -> 'K.nil'
159-- Just (a, b) -> a \`cons` unfoldr step b
160-- @
161--
162-- Build a stream by unfolding a /pure/ step function @step@ starting from a
163-- seed @s@. The step function returns the next element in the stream and the
164-- next seed value. When it is done it returns 'Nothing' and the stream ends.
165-- For example,
166--
167-- @
168-- let f b =
169-- if b > 3
170-- then Nothing
171-- else Just (b, b + 1)
172-- in toList $ unfoldr f 0
173-- @
174-- @
175-- [0,1,2,3]
176-- @
177--
178-- @since 0.1.0
179{-# INLINE_EARLY unfoldr #-}
180unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a
181unfoldr step seed = fromStreamS (S.unfoldr step seed)
182{-# RULES "unfoldr fallback to StreamK" [1]
183 forall a b. S.toStreamK (S.unfoldr a b) = K.unfoldr a b #-}
185-- | Build a stream by unfolding a /monadic/ step function starting from a
186-- seed. The step function returns the next element in the stream and the next
187-- seed value. When it is done it returns 'Nothing' and the stream ends. For
188-- example,
189--
190-- @
191-- let f b =
192-- if b > 3
193-- then return Nothing
194-- else print b >> return (Just (b, b + 1))
195-- in drain $ unfoldrM f 0
196-- @
197-- @
198-- 0
199-- 1
200-- 2
201-- 3
202-- @
203-- When run concurrently, the next unfold step can run concurrently with the
204-- processing of the output of the previous step. Note that more than one step
205-- cannot run concurrently as the next step depends on the output of the
206-- previous step.
207--
208-- @
209-- (fromAsync $ S.unfoldrM (\\n -> liftIO (threadDelay 1000000) >> return (Just (n, n + 1))) 0)
210-- & S.foldlM' (\\_ a -> threadDelay 1000000 >> print a) ()
211-- @
212--
213-- /Concurrent/
214--
215-- /Since: 0.1.0/
216{-# INLINE_EARLY unfoldrM #-}
217unfoldrM :: (IsStream t, MonadAsync m) => (b -> m (Maybe (a, b))) -> b -> t m a
218unfoldrM = K.unfoldrM
220{-# RULES "unfoldrM serial" unfoldrM = unfoldrMSerial #-}
221{-# INLINE_EARLY unfoldrMSerial #-}
222unfoldrMSerial :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> SerialT m a
223unfoldrMSerial = Serial.unfoldrM
225{-# RULES "unfoldrM wSerial" unfoldrM = unfoldrMWSerial #-}
226{-# INLINE_EARLY unfoldrMWSerial #-}
227unfoldrMWSerial :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> WSerialT m a
228unfoldrMWSerial = Serial.unfoldrM
230{-# RULES "unfoldrM zipSerial" unfoldrM = unfoldrMZipSerial #-}
231{-# INLINE_EARLY unfoldrMZipSerial #-}
232unfoldrMZipSerial :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> ZipSerialM m a
233unfoldrMZipSerial = Serial.unfoldrM
235------------------------------------------------------------------------------
236-- From Values
237------------------------------------------------------------------------------
239-- |
240-- Generate an infinite stream by repeating a pure value.
241--
242-- @since 0.4.0
243{-# INLINE_NORMAL repeat #-}
244repeat :: (IsStream t, Monad m) => a -> t m a
245repeat = fromStreamS . S.repeat
247-- |
248-- @
249-- replicate = take n . repeat
250-- @
251--
252-- Generate a stream of length @n@ by repeating a value @n@ times.
253--
254-- @since 0.6.0
255{-# INLINE_NORMAL replicate #-}
256replicate :: (IsStream t, Monad m) => Int -> a -> t m a
257replicate n = fromStreamS . S.replicate n
259-- |
260-- @
261-- replicateM = take n . repeatM
262-- @
263--
264-- Generate a stream by performing a monadic action @n@ times. Same as:
265--
266-- @
267-- drain $ fromSerial $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)
268-- drain $ fromAsync $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)
269-- @
270--
271-- /Concurrent/
272--
273-- @since 0.1.1
274{-# INLINE_EARLY replicateM #-}
275replicateM :: (IsStream t, MonadAsync m) => Int -> m a -> t m a
276replicateM = K.replicateM
278{-# RULES "replicateM serial" replicateM = replicateMSerial #-}
279{-# INLINE replicateMSerial #-}
280replicateMSerial :: MonadAsync m => Int -> m a -> SerialT m a
281replicateMSerial n = fromStreamS . S.replicateM n
283------------------------------------------------------------------------------
284-- Time Enumeration
285------------------------------------------------------------------------------
287-- | @times@ returns a stream of time value tuples with clock of 10 ms
288-- granularity. The first component of the tuple is an absolute time reference
289-- (epoch) denoting the start of the stream and the second component is a time
290-- relative to the reference.
291--
292-- >>> Stream.mapM_ (\x -> print x >> threadDelay 1000000) $ Stream.take 3 $ Stream.times
293-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))
294-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))
295-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))
296--
297-- Note: This API is not safe on 32-bit machines.
298--
299-- /Pre-release/
300--
301{-# INLINE times #-}
302times :: (IsStream t, MonadAsync m) => t m (AbsTime, RelTime64)
303times = timesWith 0.01
305-- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms
306-- granularity.
307--
308-- >>> Stream.mapM_ print $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimes
309-- AbsTime (TimeSpec {sec = ..., nsec = ...})
310-- AbsTime (TimeSpec {sec = ..., nsec = ...})
311-- AbsTime (TimeSpec {sec = ..., nsec = ...})
312--
313-- Note: This API is not safe on 32-bit machines.
314--
315-- /Pre-release/
316--
317{-# INLINE absTimes #-}
318absTimes :: (IsStream t, MonadAsync m, Functor (t m)) => t m AbsTime
319absTimes = fmap (uncurry addToAbsTime64) times
321{-# DEPRECATED currentTime "Please use absTimes instead" #-}
322{-# INLINE currentTime #-}
323currentTime :: (IsStream t, MonadAsync m, Functor (t m))
324 => Double -> t m AbsTime
325currentTime = absTimesWith
327-- | @relTimes@ returns a stream of relative time values starting from 0,
328-- using a clock of granularity 10 ms.
329--
330-- >>> Stream.mapM_ print $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimes
331-- RelTime64 (NanoSecond64 ...)
332-- RelTime64 (NanoSecond64 ...)
333-- RelTime64 (NanoSecond64 ...)
334--
335-- Note: This API is not safe on 32-bit machines.
336--
337-- /Pre-release/
338--
339{-# INLINE relTimes #-}
340relTimes :: (IsStream t, MonadAsync m, Functor (t m)) => t m RelTime64
341relTimes = fmap snd times
343-- | @durations g@ returns a stream of relative time values measuring the time
344-- elapsed since the immediate predecessor element of the stream was generated.
345-- The first element of the stream is always 0. @durations@ uses a clock of
346-- granularity @g@ specified in seconds. A low granularity clock is more
347-- expensive in terms of CPU usage. The minimum granularity is 1 millisecond.
348-- Durations lower than 1 ms will be 0.
349--
350-- Note: This API is not safe on 32-bit machines.
351--
352-- /Unimplemented/
353--
354{-# INLINE durations #-}
355durations :: -- (IsStream t, MonadAsync m) =>
356 Double -> t m RelTime64
357durations = undefined
359-- | Generate ticks at the specified rate. The rate is adaptive, the tick
360-- generation speed can be increased or decreased at different times to achieve
361-- the specified rate. The specific behavior for different styles of 'Rate'
362-- specifications is documented under 'Rate'. The effective maximum rate
363-- achieved by a stream is governed by the processor speed.
364--
365-- /Unimplemented/
366--
367{-# INLINE ticks #-}
368ticks :: -- (IsStream t, MonadAsync m) =>
369 Rate -> t m ()
370ticks = undefined
372-- | Generate a singleton event at or after the specified absolute time. Note
373-- that this is different from a threadDelay, a threadDelay starts from the
374-- time when the action is evaluated, whereas if we use AbsTime based timeout
375-- it will immediately expire if the action is evaluated too late.
376--
377-- /Unimplemented/
378--
379{-# INLINE timeout #-}
380timeout :: -- (IsStream t, MonadAsync m) =>
381 AbsTime -> t m ()
382timeout = undefined
384------------------------------------------------------------------------------
385-- From Generator functions
386------------------------------------------------------------------------------
388-- XXX we can remove it and recommend the definition in terms of enumerate and
389-- map. Check performance equivalence.
390--
391-- |
392-- @
393-- fromIndices f = fmap f $ Stream.enumerateFrom 0
394-- fromIndices f = let g i = f i \`cons` g (i + 1) in g 0
395-- @
396--
397-- Generate an infinite stream, whose values are the output of a function @f@
398-- applied on the corresponding index. Index starts at 0.
399--
400-- >>> Stream.toList $ Stream.take 5 $ Stream.fromIndices id
401-- [0,1,2,3,4]
402--
403-- @since 0.6.0
404{-# INLINE fromIndices #-}
405fromIndices :: (IsStream t, Monad m) => (Int -> a) -> t m a
406fromIndices = fromStreamS . S.fromIndices
408--
409-- |
410-- @
411-- fromIndicesM f = Stream.mapM f $ Stream.enumerateFrom 0
412-- fromIndicesM f = let g i = f i \`consM` g (i + 1) in g 0
413-- @
414--
415-- Generate an infinite stream, whose values are the output of a monadic
416-- function @f@ applied on the corresponding index. Index starts at 0.
417--
418-- /Concurrent/
419--
420-- @since 0.6.0
421{-# INLINE_EARLY fromIndicesM #-}
422fromIndicesM :: (IsStream t, MonadAsync m) => (Int -> m a) -> t m a
423fromIndicesM = K.fromIndicesM
425{-# RULES "fromIndicesM serial" fromIndicesM = fromIndicesMSerial #-}
426{-# INLINE fromIndicesMSerial #-}
427fromIndicesMSerial :: MonadAsync m => (Int -> m a) -> SerialT m a
428fromIndicesMSerial = fromStreamS . S.fromIndicesM
430------------------------------------------------------------------------------
431-- Iterating functions
432------------------------------------------------------------------------------
434-- |
435-- @
436-- iterate f x = x \`cons` iterate f x
437-- @
438--
439-- Generate an infinite stream with @x@ as the first element and each
440-- successive element derived by applying the function @f@ on the previous
441-- element.
442--
443-- @
444-- > S.toList $ S.take 5 $ S.iterate (+1) 1
445-- [1,2,3,4,5]
446-- @
447--
448-- @since 0.1.2
449{-# INLINE_NORMAL iterate #-}
450iterate :: (IsStream t, Monad m) => (a -> a) -> a -> t m a
451iterate step = fromStreamS . S.iterate step
453-- |
454-- @
455-- iterateM f m = m >>= \a -> return a \`consM` iterateM f (f a)
456-- @
457--
458-- Generate an infinite stream with the first element generated by the action
459-- @m@ and each successive element derived by applying the monadic function
460-- @f@ on the previous element.
461--
462-- When run concurrently, the next iteration can run concurrently with the
463-- processing of the previous iteration. Note that more than one iteration
464-- cannot run concurrently as the next iteration depends on the output of the
465-- previous iteration.
466--
467-- @
468-- drain $ fromSerial $ S.take 10 $ S.iterateM
469-- (\\x -> threadDelay 1000000 >> print x >> return (x + 1)) (return 0)
470--
471-- drain $ fromAsync $ S.take 10 $ S.iterateM
472-- (\\x -> threadDelay 1000000 >> print x >> return (x + 1)) (return 0)
473-- @
474--
475-- /Concurrent/
476--
477-- /Since: 0.1.2/
478--
479-- /Since: 0.7.0 (signature change)/
480{-# INLINE_EARLY iterateM #-}
481iterateM :: (IsStream t, MonadAsync m) => (a -> m a) -> m a -> t m a
482iterateM = K.iterateM
484{-# RULES "iterateM serial" iterateM = iterateMSerial #-}
485{-# INLINE iterateMSerial #-}
486iterateMSerial :: MonadAsync m => (a -> m a) -> m a -> SerialT m a
487iterateMSerial step = fromStreamS . S.iterateM step
489------------------------------------------------------------------------------
490-- Conversions
491------------------------------------------------------------------------------
493-- |
494-- @
495-- fromFoldableM = 'Prelude.foldr' 'consM' 'K.nil'
496-- @
497--
498-- Construct a stream from a 'Foldable' containing monadic actions.
499--
500-- @
501-- drain $ fromSerial $ S.fromFoldableM $ replicateM 10 (threadDelay 1000000 >> print 1)
502-- drain $ fromAsync $ S.fromFoldableM $ replicateM 10 (threadDelay 1000000 >> print 1)
503-- @
504--
505-- /Concurrent (do not use with 'fromParallel' on infinite containers)/
506--
507-- @since 0.3.0
508{-# INLINE fromFoldableM #-}
509fromFoldableM :: (IsStream t, MonadAsync m, Foldable f) => f (m a) -> t m a
510fromFoldableM = Prelude.foldr consM K.nil
512-- |
513-- @
514-- fromListM = 'Prelude.foldr' 'K.consM' 'K.nil'
515-- @
516--
517-- Construct a stream from a list of monadic actions. This is more efficient
518-- than 'fromFoldableM' for serial streams.
519--
520-- @since 0.4.0
521{-# INLINE_EARLY fromListM #-}
522fromListM :: (MonadAsync m, IsStream t) => [m a] -> t m a
523fromListM = fromFoldableM
524{-# RULES "fromListM fallback to StreamK" [1]
525 forall a. D.toStreamK (D.fromListM a) = fromFoldableM a #-}
527{-# RULES "fromListM serial" fromListM = fromListMSerial #-}
528{-# INLINE_EARLY fromListMSerial #-}
529fromListMSerial :: MonadAsync m => [m a] -> SerialT m a
530fromListMSerial = fromStreamD . D.fromListM
532-- | Same as 'fromFoldable'.
533--
534-- @since 0.1.0
535{-# DEPRECATED each "Please use fromFoldable instead." #-}
536{-# INLINE each #-}
537each :: (IsStream t, Foldable f) => f a -> t m a
538each = K.fromFoldable
540-- | Read lines from an IO Handle into a stream of Strings.
541--
542-- @since 0.1.0
543{-# DEPRECATED fromHandle
544 "Please use Streamly.FileSystem.Handle module (see the changelog)" #-}
545fromHandle :: (IsStream t, MonadIO m) => IO.Handle -> t m String
546fromHandle h = go
547 where
548 go = K.mkStream $ \_ yld _ stp -> do
549 eof <- liftIO $ IO.hIsEOF h
550 if eof
551 then stp
552 else do
553 str <- liftIO $ IO.hGetLine h
554 yld str go
556-- XXX This should perhaps be moved to Parallel
557--
558-- | Takes a callback setter function and provides it with a callback. The
559-- callback when invoked adds a value at the tail of the stream. Returns a
560-- stream of values generated by the callback.
561--
562-- /Pre-release/
563--
564{-# INLINE fromCallback #-}
565fromCallback :: MonadAsync m => ((a -> m ()) -> m ()) -> SerialT m a
566fromCallback setCallback = concatM $ do
567 (callback, stream) <- Par.newCallbackStream
568 setCallback callback
569 return stream