on master help sign in
Add right and left folds
84a6418Harendra Kumar
src/Asyncly/Prelude.hs+54−21
@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving#-}
4{-# LANGUAGE GeneralizedNewtypeDeriving#-}
@@ -25,6 +26,9 @@ module Asyncly.Prelude
25 -- * Elimination
26 -- * Elimination
26 , runStreaming
27 , runStreaming
27 , foldr
28 , foldr
29+ , foldrM
30+ , foldl
31+ , foldlM
28 , uncons
32 , uncons
29
33
30 -- * Special folds
34 -- * Special folds
@@ -42,39 +46,68 @@ where
42
46
43import Control.Monad (liftM)
47import Control.Monad (liftM)
44import Data.Semigroup (Semigroup(..))
48import Data.Semigroup (Semigroup(..))
45−import Prelude hiding (drop, take, zipWith, foldr)
49+import Prelude hiding (drop, take, zipWith, foldr,
50+ foldl)
46import Asyncly.Core
51import Asyncly.Core
47
52
48------------------------------------------------------------------------------
53------------------------------------------------------------------------------
49-- Elimination
54-- Elimination
50------------------------------------------------------------------------------
55------------------------------------------------------------------------------
51
56
52−-- | Right fold a stream producing a result in the underlying monad.
57+-- | Right fold.
53−foldr :: Streaming t => (a -> m b -> m b) -> m b -> t m a -> m b
58+foldr :: (Monad m, Streaming t) => (a -> b -> b) -> b -> t m a -> m b
54−foldr f z m = go (toStream m)
59+foldr step acc m = go (toStream m)
55−
56 where
60 where
57−
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)
58− go m1 = (runStream m1) Nothing stop yield
65+ in (runStream m1) Nothing stop yield
59−
66+
60− stop = z
67+-- | Right fold with a monadic step function. See 'toList' for an example use.
61−
68+foldrM :: Streaming t => (a -> m b -> m b) -> m b -> t m a -> m b
62− {-# INLINE yield #-}
69+foldrM step acc m = go (toStream m)
70+ where
71+ go m1 =
72+ let stop = acc
63− yield a Nothing = f a z
73+ yield a Nothing = step a acc
64− yield a (Just x) = f a (go x)
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
65
100
66-- | Decompose a stream into its head and tail. If the stream is empty, returns
101-- | Decompose a stream into its head and tail. If the stream is empty, returns
67-- 'Nothing'. If the stream is non-empty, returns 'Just (a, ma)', where 'a' is
102-- 'Nothing'. If the stream is non-empty, returns 'Just (a, ma)', where 'a' is
68-- the head of the stream and 'ma' its tail.
103-- the head of the stream and 'ma' its tail.
69uncons :: (Streaming t, Monad m, Monoid (t m a))
104uncons :: (Streaming t, Monad m, Monoid (t m a))
70 => t m a -> m (Maybe (a, t m a))
105 => t m a -> m (Maybe (a, t m a))
71−uncons m = (runStream (toStream m)) Nothing stop yield
106+uncons m =
72− where
73− stop = return Nothing
107+ let stop = return Nothing
74−
75− {-# INLINE yield #-}
76− yield a Nothing = return (Just (a, mempty))
108+ yield a Nothing = return (Just (a, mempty))
77− yield a (Just x) = return (Just (a, (fromStream x)))
109+ yield a (Just x) = return (Just (a, (fromStream x)))
110+ in (runStream (toStream m)) Nothing stop yield
78
111
79------------------------------------------------------------------------------
112------------------------------------------------------------------------------
80-- Construction
113-- Construction
@@ -101,7 +134,7 @@ fromCallback k = Stream $ \_ _ yld -> k (\a -> yld a Nothing)
101-- | Convert a stream into a list in the underlying monad.
134-- | Convert a stream into a list in the underlying monad.
102{-# INLINABLE toList #-}
135{-# INLINABLE toList #-}
103toList :: (Monad m, Streaming t) => t m a -> m [a]
136toList :: (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 [])
105
138
106-- | Take first 'n' elements from the stream and discard the rest.
139-- | Take first 'n' elements from the stream and discard the rest.
107take :: Streaming t => Int -> t m a -> t m a
140take :: Streaming t => Int -> t m a -> t m a