Move definition of Step to Stream.Monadic
[darcs-mirrors/vector.git] / Data / Vector / Fusion / Stream / Monadic.hs
1 {-# LANGUAGE ExistentialQuantification #-}
2
3 -- |
4 -- Module : Data.Vector.Fusion.Stream.Monadic
5 -- Copyright : (c) Roman Leshchinskiy 2008
6 -- License : BSD-style
7 --
8 -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
9 -- Stability : experimental
10 -- Portability : non-portable
11 --
12 -- Monadic streams
13 --
14
15 #include "phases.h"
16
17 module Data.Vector.Fusion.Stream.Monadic (
18 Stream(..), Step(..),
19
20 -- * Size hints
21 size, sized,
22
23 -- * Length
24 length, null,
25
26 -- * Construction
27 empty, singleton, cons, snoc, replicate, (++),
28
29 -- * Accessing elements
30 head, last, (!!),
31
32 -- * Substreams
33 extract, init, tail, take, drop,
34
35 -- * Mapping and zipping
36 map, mapM, mapM_, zipWith, zipWithM,
37
38 -- * Filtering
39 filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,
40
41 -- * Searching
42 elem, notElem, find, findM, findIndex, findIndexM,
43
44 -- * Folding
45 foldl, foldlM, foldM, foldl1, foldl1M,
46 foldl', foldlM', foldl1', foldl1M',
47 foldr, foldrM, foldr1, foldr1M,
48
49 -- * Unfolding
50 unfold, unfoldM,
51
52 -- * Scans
53 prescanl, prescanlM, prescanl', prescanlM',
54
55 toList, fromList
56 ) where
57
58 import Data.Vector.Fusion.Stream.Size
59
60 import Control.Monad ( liftM )
61 import Prelude hiding ( length, null,
62 replicate, (++),
63 head, last, (!!),
64 init, tail, take, drop,
65 map, mapM, mapM_, zipWith,
66 filter, takeWhile, dropWhile,
67 elem, notElem,
68 foldl, foldl1, foldr, foldr1 )
69 import qualified Prelude
70
71 -- | Result of taking a single step in a stream
72 data Step s a = Yield a s -- ^ a new element and a new seed
73 | Skip s -- ^ just a new seed
74 | Done -- ^ end of stream
75
76 -- | Monadic streams
77 data Stream m a = forall s. Stream (s -> m (Step s a)) s Size
78
79 -- | 'Size' hint of a 'Stream'
80 size :: Stream m a -> Size
81 {-# INLINE size #-}
82 size (Stream _ _ sz) = sz
83
84 -- | Attach a 'Size' hint to a 'Stream'
85 sized :: Stream m a -> Size -> Stream m a
86 {-# INLINE_STREAM sized #-}
87 sized (Stream step s _) sz = Stream step s sz
88
89 -- Length
90 -- ------
91
92 -- | Length of a 'Stream'
93 length :: Monad m => Stream m a -> m Int
94 {-# INLINE_STREAM length #-}
95 length s = foldl' (\n _ -> n+1) 0 s
96
97 -- | Check if a 'Stream' is empty
98 null :: Monad m => Stream m a -> m Bool
99 {-# INLINE_STREAM null #-}
100 null s = foldr (\_ _ -> False) True s
101
102
103 -- Construction
104 -- ------------
105
106 -- | Empty 'Stream'
107 empty :: Monad m => Stream m a
108 {-# INLINE_STREAM empty #-}
109 empty = Stream (const (return Done)) () (Exact 0)
110
111 -- | Singleton 'Stream'
112 singleton :: Monad m => a -> Stream m a
113 {-# INLINE_STREAM singleton #-}
114 singleton x = Stream (return . step) True (Exact 1)
115 where
116 {-# INLINE step #-}
117 step True = Yield x False
118 step False = Done
119
120 -- | Replicate a value to a given length
121 replicate :: Monad m => Int -> a -> Stream m a
122 {-# INLINE_STREAM replicate #-}
123 replicate n x = Stream (return . step) n (Exact (max n 0))
124 where
125 {-# INLINE step #-}
126 step i | i > 0 = Yield x (i-1)
127 | otherwise = Done
128
129 -- | Prepend an element
130 cons :: Monad m => a -> Stream m a -> Stream m a
131 {-# INLINE cons #-}
132 cons x s = singleton x ++ s
133
134 -- | Append an element
135 snoc :: Monad m => Stream m a -> a -> Stream m a
136 {-# INLINE snoc #-}
137 snoc s x = s ++ singleton x
138
139 infixr 5 ++
140 -- | Concatenate two 'Stream's
141 (++) :: Monad m => Stream m a -> Stream m a -> Stream m a
142 {-# INLINE_STREAM (++) #-}
143 Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)
144 where
145 step (Left sa) = do
146 r <- stepa sa
147 case r of
148 Yield x sa' -> return $ Yield x (Left sa')
149 Skip sa' -> return $ Skip (Left sa')
150 Done -> return $ Skip (Right sb)
151 step (Right sb) = do
152 r <- stepb sb
153 case r of
154 Yield x sb' -> return $ Yield x (Right sb')
155 Skip sb' -> return $ Skip (Right sb')
156 Done -> return $ Done
157
158 -- Accessing elements
159 -- ------------------
160
161 -- | First element of the 'Stream' or error if empty
162 head :: Monad m => Stream m a -> m a
163 {-# INLINE_STREAM head #-}
164 head (Stream step s _) = head_loop s
165 where
166 head_loop s = do
167 r <- step s
168 case r of
169 Yield x _ -> return x
170 Skip s' -> head_loop s'
171 Done -> errorEmptyStream "head"
172
173 -- | Last element of the 'Stream' or error if empty
174 last :: Monad m => Stream m a -> m a
175 {-# INLINE_STREAM last #-}
176 last (Stream step s _) = last_loop0 s
177 where
178 last_loop0 s = do
179 r <- step s
180 case r of
181 Yield x s' -> last_loop1 x s'
182 Skip s' -> last_loop0 s'
183 Done -> errorEmptyStream "last"
184
185 last_loop1 x s = do
186 r <- step s
187 case r of
188 Yield y s' -> last_loop1 y s'
189 Skip s' -> last_loop1 x s'
190 Done -> return x
191
192 -- | Element at the given position
193 (!!) :: Monad m => Stream m a -> Int -> m a
194 {-# INLINE (!!) #-}
195 s !! i = head (drop i s)
196
197 -- Substreams
198 -- ----------
199
200 -- | Extract a substream of the given length starting at the given position.
201 extract :: Monad m => Stream m a -> Int -- ^ starting index
202 -> Int -- ^ length
203 -> Stream m a
204 {-# INLINE extract #-}
205 extract s i n = take n (drop i s)
206
207 -- | All but the last element
208 init :: Monad m => Stream m a -> Stream m a
209 {-# INLINE_STREAM init #-}
210 init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)
211 where
212 {-# INLINE step' #-}
213 step' (Nothing, s) = liftM (\r ->
214 case r of
215 Yield x s' -> Skip (Just x, s')
216 Skip s' -> Skip (Nothing, s')
217 Done -> Done -- FIXME: should be an error
218 ) (step s)
219
220 step' (Just x, s) = liftM (\r ->
221 case r of
222 Yield y s' -> Yield x (Just y, s')
223 Skip s' -> Skip (Just x, s')
224 Done -> Done
225 ) (step s)
226
227 -- | All but the first element
228 tail :: Monad m => Stream m a -> Stream m a
229 {-# INLINE_STREAM tail #-}
230 tail (Stream step s sz) = Stream step' (Left s) (sz - 1)
231 where
232 {-# INLINE step' #-}
233 step' (Left s) = liftM (\r ->
234 case r of
235 Yield x s' -> Skip (Right s')
236 Skip s' -> Skip (Left s')
237 Done -> Done -- FIXME: should be error?
238 ) (step s)
239
240 step' (Right s) = liftM (\r ->
241 case r of
242 Yield x s' -> Yield x (Right s')
243 Skip s' -> Skip (Right s')
244 Done -> Done
245 ) (step s)
246
247 -- | The first @n@ elements
248 take :: Monad m => Int -> Stream m a -> Stream m a
249 {-# INLINE_STREAM take #-}
250 take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)
251 where
252 {-# INLINE step' #-}
253 step' (s, i) | i < n = liftM (\r ->
254 case r of
255 Yield x s' -> Yield x (s', i+1)
256 Skip s' -> Skip (s', i)
257 Done -> Done
258 ) (step s)
259 step' (s, i) = return Done
260
261 -- | All but the first @n@ elements
262 drop :: Monad m => Int -> Stream m a -> Stream m a
263 {-# INLINE_STREAM drop #-}
264 drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n)
265 where
266 {-# INLINE step' #-}
267 step' (s, Just i) | i > 0 = liftM (\r ->
268 case r of
269 Yield x s' -> Skip (s', Just (i-1))
270 Skip s' -> Skip (s', Just i)
271 Done -> Done
272 ) (step s)
273 | otherwise = return $ Skip (s, Nothing)
274
275 step' (s, Nothing) = liftM (\r ->
276 case r of
277 Yield x s' -> Yield x (s', Nothing)
278 Skip s' -> Skip (s', Nothing)
279 Done -> Done
280 ) (step s)
281
282
283 -- Mapping/zipping
284 -- ---------------
285
286 instance Monad m => Functor (Stream m) where
287 {-# INLINE fmap #-}
288 fmap = map
289
290 -- | Map a function over a 'Stream'
291 map :: Monad m => (a -> b) -> Stream m a -> Stream m b
292 {-# INLINE map #-}
293 map f = mapM (return . f)
294
295 -- | Map a monadic function over a 'Stream'
296 mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b
297 {-# INLINE_STREAM mapM #-}
298 mapM f (Stream step s n) = Stream step' s n
299 where
300 {-# INLINE step' #-}
301 step' s = do
302 r <- step s
303 case r of
304 Yield x s' -> liftM (`Yield` s') (f x)
305 Skip s' -> return (Skip s')
306 Done -> return Done
307
308 -- | Execute a monadic action for each element of the 'Stream'
309 mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()
310 {-# INLINE_STREAM mapM_ #-}
311 mapM_ m (Stream step s _) = mapM_go s
312 where
313 mapM_go s = do
314 r <- step s
315 case r of
316 Yield x s' -> do { m x; mapM_go s' }
317 Skip s' -> mapM_go s'
318 Done -> return ()
319
320 -- | Zip two 'Stream's with the given function
321 zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
322 {-# INLINE zipWith #-}
323 zipWith f = zipWithM (\a b -> return (f a b))
324
325 -- | Zip two 'Stream's with the given monadic function
326 zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
327 {-# INLINE_STREAM zipWithM #-}
328 zipWithM f (Stream stepa sa na) (Stream stepb sb nb)
329 = Stream step (sa, sb, Nothing) (smaller na nb)
330 where
331 {-# INLINE step #-}
332 step (sa, sb, Nothing) = liftM (\r ->
333 case r of
334 Yield x sa' -> Skip (sa', sb, Just x)
335 Skip sa' -> Skip (sa', sb, Nothing)
336 Done -> Done
337 ) (stepa sa)
338
339 step (sa, sb, Just x) = do
340 r <- stepb sb
341 case r of
342 Yield y sb' ->
343 do
344 z <- f x y
345 return $ Yield z (sa, sb', Nothing)
346 Skip sb' -> return $ Skip (sa, sb', Just x)
347 Done -> return $ Done
348
349 -- Filtering
350 -- ---------
351
352 -- | Drop elements which do not satisfy the predicate
353 filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
354 {-# INLINE filter #-}
355 filter f = filterM (return . f)
356
357 -- | Drop elements which do not satisfy the monadic predicate
358 filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
359 {-# INLINE_STREAM filterM #-}
360 filterM f (Stream step s n) = Stream step' s (toMax n)
361 where
362 {-# INLINE step' #-}
363 step' s = do
364 r <- step s
365 case r of
366 Yield x s' -> do
367 b <- f x
368 return $ if b then Yield x s'
369 else Skip s'
370 Skip s' -> return $ Skip s'
371 Done -> return $ Done
372
373 -- | Longest prefix of elements that satisfy the predicate
374 takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
375 {-# INLINE takeWhile #-}
376 takeWhile f = takeWhileM (return . f)
377
378 -- | Longest prefix of elements that satisfy the monadic predicate
379 takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
380 {-# INLINE_STREAM takeWhileM #-}
381 takeWhileM f (Stream step s n) = Stream step' s (toMax n)
382 where
383 {-# INLINE step' #-}
384 step' s = do
385 r <- step s
386 case r of
387 Yield x s' -> do
388 b <- f x
389 return $ if b then Yield x s' else Done
390 Skip s' -> return $ Skip s'
391 Done -> return $ Done
392
393 -- | Drop the longest prefix of elements that satisfy the predicate
394 dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
395 {-# INLINE dropWhile #-}
396 dropWhile f = dropWhileM (return . f)
397
398 data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s
399
400 -- | Drop the longest prefix of elements that satisfy the monadic predicate
401 dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
402 {-# INLINE_STREAM dropWhileM #-}
403 dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)
404 where
405 -- NOTE: we jump through hoops here to have only one Yield; local data
406 -- declarations would be nice!
407
408 {-# INLINE step' #-}
409 step' (DropWhile_Drop s)
410 = do
411 r <- step s
412 case r of
413 Yield x s' -> do
414 b <- f x
415 return $ if b then Skip (DropWhile_Drop s')
416 else Skip (DropWhile_Yield x s')
417 Skip s' -> return $ Skip (DropWhile_Drop s')
418 Done -> return $ Done
419
420 step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s)
421
422 step' (DropWhile_Next s)
423 = liftM (\r ->
424 case r of
425 Yield x s' -> Skip (DropWhile_Yield x s')
426 Skip s' -> Skip (DropWhile_Next s')
427 Done -> Done
428 ) (step s)
429
430 -- Searching
431 -- ---------
432
433 infix 4 `elem`
434 -- | Check whether the 'Stream' contains an element
435 elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
436 {-# INLINE_STREAM elem #-}
437 elem x (Stream step s _) = elem_loop s
438 where
439 elem_loop s = do
440 r <- step s
441 case r of
442 Yield y s' | x == y -> return True
443 | otherwise -> elem_loop s'
444 Skip s' -> elem_loop s'
445 Done -> return False
446
447 infix 4 `notElem`
448 -- | Inverse of `elem`
449 notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
450 {-# INLINE notElem #-}
451 notElem x s = liftM not (elem x s)
452
453 -- | Yield 'Just' the first element that satisfies the predicate or 'Nothing'
454 -- if no such element exists.
455 find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)
456 {-# INLINE find #-}
457 find f = findM (return . f)
458
459 -- | Yield 'Just' the first element that satisfies the monadic predicate or
460 -- 'Nothing' if no such element exists.
461 findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)
462 {-# INLINE_STREAM findM #-}
463 findM f (Stream step s _) = find_loop s
464 where
465 find_loop s = do
466 r <- step s
467 case r of
468 Yield x s' -> do
469 b <- f x
470 if b then return $ Just x
471 else find_loop s'
472 Skip s' -> find_loop s'
473 Done -> return Nothing
474
475 -- | Yield 'Just' the index of the first element that satisfies the predicate
476 -- or 'Nothing' if no such element exists.
477 findIndex :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe Int)
478 {-# INLINE_STREAM findIndex #-}
479 findIndex f = findIndexM (return . f)
480
481 -- | Yield 'Just' the index of the first element that satisfies the monadic
482 -- predicate or 'Nothing' if no such element exists.
483 findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int)
484 {-# INLINE_STREAM findIndexM #-}
485 findIndexM f (Stream step s _) = findIndex_loop s 0
486 where
487 findIndex_loop s i = do
488 r <- step s
489 case r of
490 Yield x s' -> do
491 b <- f x
492 if b then return $ Just i
493 else findIndex_loop s' (i+1)
494 Skip s' -> findIndex_loop s' i
495 Done -> return Nothing
496
497 -- Folding
498 -- -------
499
500 -- | Left fold
501 foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
502 {-# INLINE foldl #-}
503 foldl f = foldlM (\a b -> return (f a b))
504
505 -- | Left fold with a monadic operator
506 foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
507 {-# INLINE_STREAM foldlM #-}
508 foldlM m z (Stream step s _) = foldlM_go z s
509 where
510 foldlM_go z s = do
511 r <- step s
512 case r of
513 Yield x s' -> do { z' <- m z x; foldlM_go z' s' }
514 Skip s' -> foldlM_go z s'
515 Done -> return z
516
517 -- | Same as 'foldlM'
518 foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
519 {-# INLINE foldM #-}
520 foldM = foldlM
521
522 -- | Left fold over a non-empty 'Stream'
523 foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
524 {-# INLINE foldl1 #-}
525 foldl1 f = foldl1M (\a b -> return (f a b))
526
527 -- | Left fold over a non-empty 'Stream' with a monadic operator
528 foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
529 {-# INLINE_STREAM foldl1M #-}
530 foldl1M f (Stream step s sz) = foldl1M_go s
531 where
532 foldl1M_go s = do
533 r <- step s
534 case r of
535 Yield x s' -> foldlM f x (Stream step s' (sz - 1))
536 Skip s' -> foldl1M_go s'
537 Done -> errorEmptyStream "foldl1M"
538
539 -- | Left fold with a strict accumulator
540 foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
541 {-# INLINE foldl' #-}
542 foldl' f = foldlM' (\a b -> return (f a b))
543
544 -- | Left fold with a strict accumulator and a monadic operator
545 foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
546 {-# INLINE_STREAM foldlM' #-}
547 foldlM' m z (Stream step s _) = foldlM'_go z s
548 where
549 foldlM'_go z s = z `seq`
550 do
551 r <- step s
552 case r of
553 Yield x s' -> do { z' <- m z x; foldlM'_go z' s' }
554 Skip s' -> foldlM'_go z s'
555 Done -> return z
556
557 -- | Left fold over a non-empty 'Stream' with a strict accumulator
558 foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a
559 {-# INLINE foldl1' #-}
560 foldl1' f = foldl1M' (\a b -> return (f a b))
561
562 -- | Left fold over a non-empty 'Stream' with a strict accumulator and a
563 -- monadic operator
564 foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
565 {-# INLINE_STREAM foldl1M' #-}
566 foldl1M' f (Stream step s sz) = foldl1M'_go s
567 where
568 foldl1M'_go s = do
569 r <- step s
570 case r of
571 Yield x s' -> foldlM' f x (Stream step s' (sz - 1))
572 Skip s' -> foldl1M'_go s'
573 Done -> errorEmptyStream "foldl1M'"
574
575 -- | Right fold
576 foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b
577 {-# INLINE foldr #-}
578 foldr f = foldrM (\a b -> return (f a b))
579
580 -- | Right fold with a monadic operator
581 foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b
582 {-# INLINE_STREAM foldrM #-}
583 foldrM f z (Stream step s _) = foldrM_go s
584 where
585 foldrM_go s = do
586 r <- step s
587 case r of
588 Yield x s' -> f x =<< foldrM_go s'
589 Skip s' -> foldrM_go s'
590 Done -> return z
591
592 -- | Right fold over a non-empty stream
593 foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
594 {-# INLINE foldr1 #-}
595 foldr1 f = foldr1M (\a b -> return (f a b))
596
597 -- | Right fold over a non-empty stream with a monadic operator
598 foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
599 {-# INLINE_STREAM foldr1M #-}
600 foldr1M f (Stream step s _) = foldr1M_go0 s
601 where
602 foldr1M_go0 s = do
603 r <- step s
604 case r of
605 Yield x s' -> foldr1M_go1 x s'
606 Skip s' -> foldr1M_go0 s'
607 Done -> errorEmptyStream "foldr1M"
608
609 foldr1M_go1 x s = do
610 r <- step s
611 case r of
612 Yield y s' -> f x =<< foldr1M_go1 y s'
613 Skip s' -> foldr1M_go1 x s'
614 Done -> return x
615
616 -- Unfolding
617 -- ---------
618
619 -- | Unfold
620 unfold :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a
621 {-# INLINE_STREAM unfold #-}
622 unfold f = unfoldM (return . f)
623
624 -- | Unfold with a monadic function
625 unfoldM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a
626 {-# INLINE_STREAM unfoldM #-}
627 unfoldM f s = Stream step s Unknown
628 where
629 {-# INLINE step #-}
630 step s = liftM (\r ->
631 case r of
632 Just (x, s') -> Yield x s'
633 Nothing -> Done
634 ) (f s)
635
636 -- Scans
637 -- -----
638
639 -- | Prefix scan
640 prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
641 {-# INLINE prescanl #-}
642 prescanl f = prescanlM (\a b -> return (f a b))
643
644 -- | Prefix scan with a monadic operator
645 prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
646 {-# INLINE_STREAM prescanlM #-}
647 prescanlM f z (Stream step s sz) = Stream step' (s,z) sz
648 where
649 {-# INLINE step' #-}
650 step' (s,x) = do
651 r <- step s
652 case r of
653 Yield y s' -> do
654 z <- f x y
655 return $ Yield x (s', z)
656 Skip s' -> return $ Skip (s', x)
657 Done -> return Done
658
659 -- | Prefix scan with strict accumulator
660 prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
661 {-# INLINE prescanl' #-}
662 prescanl' f = prescanlM' (\a b -> return (f a b))
663
664 -- | Prefix scan with strict accumulator and a monadic operator
665 prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
666 {-# INLINE_STREAM prescanlM' #-}
667 prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz
668 where
669 {-# INLINE step' #-}
670 step' (s,x) = x `seq`
671 do
672 r <- step s
673 case r of
674 Yield y s' -> do
675 z <- f x y
676 return $ Yield x (s', z)
677 Skip s' -> return $ Skip (s', x)
678 Done -> return Done
679
680 -- Conversions
681 -- -----------
682
683 -- | Convert a 'Stream' to a list
684 toList :: Monad m => Stream m a -> m [a]
685 {-# INLINE toList #-}
686 toList = foldr (:) []
687
688 -- | Convert a list to a 'Stream'
689 fromList :: Monad m => [a] -> Stream m a
690 {-# INLINE_STREAM fromList #-}
691 fromList xs = Stream step xs Unknown
692 where
693 step (x:xs) = return (Yield x xs)
694 step [] = return Done
695
696
697 errorEmptyStream :: String -> a
698 errorEmptyStream s = error $ "Data.Vector.Fusion.Stream.Monadic."
699 Prelude.++ s Prelude.++ ": empty stream"
700