@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
12{-# LANGUAGE FlexibleContexts #-}
23{-# LANGUAGE FlexibleInstances #-}
34{-# LANGUAGE GeneralizedNewtypeDeriving#-}
@@ -25,6 +26,9 @@ module Asyncly.Prelude
2526 -- * Elimination
2627 , runStreaming
2728 , foldr
29+ , foldrM
30+ , foldl
31+ , foldlM
2832 , uncons
2933
3034 -- * Special folds
@@ -42,39 +46,68 @@ where
4246
4347import Control.Monad (liftM)
4448import Data.Semigroup (Semigroup(..))
45−import Prelude hiding (drop, take, zipWith, foldr)
49+import Prelude hiding (drop, take, zipWith, foldr,
50+ foldl)
4651import Asyncly.Core
4752
4853------------------------------------------------------------------------------
4954-- Elimination
5055------------------------------------------------------------------------------
5156
52−-- | Right fold a stream producing a result in the underlying monad.
53−foldr :: Streaming t => (a -> m b -> m b) -> m b -> t m a -> m b
54−foldr f z m = go (toStream m)
55−
57+-- | Right fold.
58+foldr :: (Monad m, Streaming t) => (a -> b -> b) -> b -> t m a -> m b
59+foldr step acc m = go (toStream m)
5660 where
57−
58− go m1 = (runStream m1) Nothing stop yield
59−
60− stop = z
61−
62− {-# INLINE yield #-}
63− yield a Nothing = f a z
64− yield a (Just x) = f a (go x)
61+ go m1 =
62+ let stop = return acc
63+ yield a Nothing = return (step a acc)
64+ yield a (Just x) = go x >>= \b -> return (step a b)
65+ in (runStream m1) Nothing stop yield
66+
67+-- | Right fold with a monadic step function. See 'toList' for an example use.
68+foldrM :: Streaming t => (a -> m b -> m b) -> m b -> t m a -> m b
69+foldrM step acc m = go (toStream m)
70+ where
71+ go m1 =
72+ let stop = acc
73+ yield a Nothing = step a acc
74+ yield a (Just x) = step a (go x)
75+ in (runStream m1) Nothing stop yield
76+
77+-- | Strict left fold. This is typed to work with the foldl package. To use
78+-- directly pass 'id' as the third argument.
79+foldl :: (Monad m, Streaming t)
80+ => (x -> a -> x) -> x -> (x -> b) -> t m a -> m b
81+foldl step begin done m = go begin (toStream m)
82+ where
83+ go !acc m1 =
84+ let stop = return (done acc)
85+ yield a Nothing = return (done (step acc a))
86+ yield a (Just x) = go (step acc a) x
87+ in (runStream m1) Nothing stop yield
88+
89+-- | Strict left fold, with monadic step function. This is typed to work
90+-- with the foldl package. To use directly pass 'id' as the third argument.
91+foldlM :: (Monad m, Streaming t)
92+ => (x -> a -> m x) -> m x -> (x -> m b) -> t m a -> m b
93+foldlM step begin done m = go begin (toStream m)
94+ where
95+ go !acc m1 =
96+ let stop = acc >>= done
97+ yield a Nothing = acc >>= \b -> step b a >>= done
98+ yield a (Just x) = acc >>= \b -> go (step b a) x
99+ in (runStream m1) Nothing stop yield
65100
66101-- | Decompose a stream into its head and tail. If the stream is empty, returns
67102-- 'Nothing'. If the stream is non-empty, returns 'Just (a, ma)', where 'a' is
68103-- the head of the stream and 'ma' its tail.
69104uncons :: (Streaming t, Monad m, Monoid (t m a))
70105 => t m a -> m (Maybe (a, t m a))
71−uncons m = (runStream (toStream m)) Nothing stop yield
72− where
73− stop = return Nothing
74−
75− {-# INLINE yield #-}
76− yield a Nothing = return (Just (a, mempty))
77− yield a (Just x) = return (Just (a, (fromStream x)))
106+uncons m =
107+ let stop = return Nothing
108+ yield a Nothing = return (Just (a, mempty))
109+ yield a (Just x) = return (Just (a, (fromStream x)))
110+ in (runStream (toStream m)) Nothing stop yield
78111
79112------------------------------------------------------------------------------
80113-- Construction
@@ -101,7 +134,7 @@ fromCallback k = Stream $ \_ _ yld -> k (\a -> yld a Nothing)
101134-- | Convert a stream into a list in the underlying monad.
102135{-# INLINABLE toList #-}
103136toList :: (Monad m, Streaming t) => t m a -> m [a]
104−toList = foldr (\a xs -> liftM (a :) xs) (return [])
137+toList = foldrM (\a xs -> liftM (a :) xs) (return [])
105138
106139-- | Take first 'n' elements from the stream and discard the rest.
107140take :: Streaming t => Int -> t m a -> t m a