Added folds and foldsM.

Author: DDC

TODO.md

@@ -9,8 +9,6 @@
     - takeWhileM :: Monad m => (a -> m Bool) -> Stream (Of a) m r -> Stream (Of a) m ()
 
 - Splitting and grouping functions (Streaming + Pipes only)
-    - folds :: Monad m => (x -> a -> x) -> x -> (x -> b) -> FreeT (Producer a m) m r -> Producer b m r
-    - foldsM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> FreeT (Producer a m) m r -> Producer b m r
     - breaks :: Monad m => (a -> Bool) -> Stream (Of a) m r -> Stream (Stream (Of a) m) m r
     - break :: Monad m => (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)
     - breakWhen :: Monad m => (x -> a -> x) -> x -> (x -> b) -> (b -> Bool) -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r)

streamy-pipes/lib/Streamy/Pipes.hs

@@ -42,6 +42,8 @@ module Streamy.Pipes (
         , Streamy.Pipes.intercalates
         , Streamy.Pipes.yields
         , Streamy.Pipes.takes
+        , Streamy.Pipes.folds
+        , Streamy.Pipes.foldsM
         , Streamy.Pipes.splitAt
         , Streamy.Pipes.span
     ) where
@@ -185,6 +187,12 @@ yields producer = Groups $ liftF producer
 takes :: Monad m => Int -> Groups a m () -> Groups a m ()
 takes i (Groups gs) = Groups $ PG.takes i gs 
 
+folds :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Groups a m r -> Stream b m r
+folds step begin done (Groups gs) = PG.folds step begin done gs
+
+foldsM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Groups a m r -> Stream b m r
+foldsM step begin done (Groups gs) = PG.foldsM step begin done gs
+
 splitAt :: Monad m => Int -> Stream a m r -> Stream a m (Stream a m r)
 splitAt i producer = view (Pipes.Parse.splitAt i) producer
 

streamy-sig/README.md

@@ -92,6 +92,8 @@ matrix saying which functions are supported by which libraries.
     | intercalates    | X | X |   |
     | yields          | X | X |   |
     | takes           | X | X |   |
+    | folds           | X | X |   |
+    | foldsM          | X | X |   |
     | splitAt         | X | X |   |
     | span            | X | X |   |
 

streamy-sig/sig/Streamy.hsig

@@ -108,6 +108,9 @@ yields :: Monad m => Stream a m r -> Groups a m r
 
 takes :: Monad m => Index -> Groups a m () -> Groups a m ()
 
+folds :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Groups a m r -> Stream b m r
+foldsM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Groups a m r -> Stream b m r
+
 splitAt :: Monad m => Index -> Stream a m r -> Stream a m (Stream a m r)
 
 span :: Monad m => (a -> Bool) -> Stream a m r -> Stream a m (Stream a m r)

streamy-streaming/lib/Streamy/Streaming.hs

@@ -43,6 +43,8 @@ module Streamy.Streaming (
         , Streamy.Streaming.intercalates
         , Streamy.Streaming.yields
         , Streamy.Streaming.takes
+        , Streamy.Streaming.folds
+        , Streamy.Streaming.foldsM
         , Streamy.Streaming.splitAt
         , Streamy.Streaming.span
     ) where
@@ -82,7 +84,7 @@ each :: (Monad m, Foldable f) => f a -> Stream a m ()
 each x = Stream (Q.each x) 
 
 toList :: Monad m => Stream a m r -> m ([a],r)
-toList (Stream s) = toTup <$> Q.toList s
+toList (Stream s) = Q.lazily <$> Q.toList s
 
 toList_ :: Monad m => Stream a m () -> m [a]
 toList_ (Stream s) = Q.toList_ s
@@ -145,13 +147,13 @@ any_ :: Monad m => (a -> Bool) -> Stream a m () -> m Bool
 any_ f (Stream s) = Q.any_ f s
 
 fold :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream a m r -> m (b,r)
-fold step begin done (Stream s) = toTup <$> Q.fold step begin done s 
+fold step begin done (Stream s) = Q.lazily <$> Q.fold step begin done s 
 
 fold_ :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream a m () -> m b
 fold_ step begin done (Stream s) = Q.fold_ step begin done s 
 
 foldM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream a m r -> m (b,r)
-foldM step begin done (Stream s) = toTup <$> Q.foldM step begin done s 
+foldM step begin done (Stream s) = Q.lazily <$> Q.foldM step begin done s 
 
 foldM_ :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream a m () -> m b
 foldM_ step begin done (Stream s) = Q.foldM_ step begin done s 
@@ -186,13 +188,19 @@ yields (Stream s) = Groups $ Q.yields s
 takes :: Monad m => Int -> Groups a m () -> Groups a m ()
 takes i (Groups gs) = Groups $ Q.takes i gs 
 
+folds :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Groups a m r -> Stream b m r
+folds step begin done (Groups gs) = 
+    -- https://stackoverflow.com/questions/45773251/how-to-implement-folds-and-foldsm-from-pipes-group-for-the-streaming-package
+    Stream $ Q.mapped (Q.fold step begin done) gs
+
+foldsM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Groups a m r -> Stream b m r
+foldsM step begin done (Groups gs) = 
+    -- https://stackoverflow.com/questions/45773251/how-to-implement-folds-and-foldsm-from-pipes-group-for-the-streaming-package
+    Stream $ Q.mapped (Q.foldM step begin done) gs
+
 splitAt :: Monad m => Int -> Stream a m r -> Stream a m (Stream a m r)
 splitAt i (Stream s) = Stream <$> Stream (Q.splitAt i s)
 
 span :: Monad m => (a -> Bool) -> Stream a m r -> Stream a m (Stream a m r)
 span f (Stream s) = Stream <$> Stream (Q.span f s)
 
---
-toTup :: Of a r -> (a,r)
-toTup = \(a :> r) -> (a,r)
-

streamy-testsuite/lib/Test/Grouping.hs

@@ -25,6 +25,8 @@ grouping =
     , testCase "intercalates" testIntercalates
     , testCase "yields" testYields
     , testCase "takes" testTakes
+    , testCase "folds" testFolds
+    , testCase "foldsM" testFoldsM
     , testCase "splitAt" testSplitAt
     , testCase "span" testSpan
     ]
@@ -73,3 +75,18 @@ testSpan = do
    assertEqual "" "abc" str1
    assertEqual "" "defg" str2
 
+testFolds :: Assertion
+testFolds = do
+   r <- Y.toList_ . Y.folds (flip (:)) [] id . Y.group $ Y.each "aabbcc"
+   assertEqual "" ["aa","bb","cc"] r
+   
+testFoldsM :: Assertion
+testFoldsM = do
+   ref <- newIORef False
+   r <- Y.toList_ 
+      . Y.foldsM (\x i -> pure (i:x)) (return []) (\x -> writeIORef ref True *> pure x) 
+      . Y.group 
+      $ Y.each "aabbcc"
+   assertEqual "" ["aa","bb","cc"] r
+   ref' <- readIORef ref
+   assertBool "effect" ref'

streamy-testsuite/lib/Test/Grouping/Streamy.hsig

@@ -38,6 +38,8 @@ signature Test.Grouping.Streamy (
         , intercalates
         , yields
         , takes
+        , folds
+        , foldsM
         , splitAt
         , span
     ) where