Merge pull request #35 from hussein-aitlahcen/zipstream-applicative

fix: Zip/AsyncZip applicative instances

Changelog.md

@@ -1,3 +1,8 @@
+## Unreleased
+
+### Bug Fixes
+* Fix Zip/AsyncZip applicative instances to handle applicative injection of function like `pure f <*> s1 <*> s2`
+
 ## 0.1.1
 
 ### Enhancements

src/Streamly/Core.hs

@@ -25,6 +25,7 @@ module Streamly.Core
 
     -- * Construction
     , scons
+    , srepeat
     , snil
 
     -- * Composition
@@ -217,6 +218,9 @@ type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)
 scons :: a -> Maybe (Stream m a) -> Stream m a
 scons a r = Stream $ \_ _ yld -> yld a r
 
+srepeat :: a -> Stream m a
+srepeat a = let x = scons a (Just x) in x
+
 snil :: Stream m a
 snil = Stream $ \_ stp _ -> stp
 

src/Streamly/Streams.hs

@@ -751,7 +751,7 @@ instance Monad m => Functor (ZipStream m) where
         in m Nothing stp yield
 
 instance Monad m => Applicative (ZipStream m) where
-    pure a = ZipStream $ scons a Nothing
+    pure = ZipStream . srepeat
     (<*>) = zipWith id
 
 instance Streaming ZipStream where
@@ -838,7 +838,7 @@ instance Monad m => Functor (ZipAsync m) where
         in m Nothing stp yield
 
 instance MonadAsync m => Applicative (ZipAsync m) where
-    pure a = ZipAsync $ scons a Nothing
+    pure = ZipAsync . srepeat
     (<*>) = zipAsyncWith id
 
 instance Streaming ZipAsync where

test/Main.hs

@@ -422,8 +422,12 @@ zipOps z zM app = do
     it "Applicative zip" $
         let s1 = adapt $ serially $ foldMapWith (<>) return [1..10]
             s2 = adapt $ serially $ foldMapWith (<>) return [1..]
-         in (A.toList . app) ((+) <$> s1 <*> s2)
+            f = A.toList . app
-        `shouldReturn` ([2,4..20] :: [Int])
+            functorial = f $ (+) <$> s1 <*> s2
+            applicative = f $ pure (+) <*> s1 <*> s2
+            expected = ([2,4..20] :: [Int])
+         in (,) <$> functorial <*> applicative
+        `shouldReturn` (expected, expected)
 
 timed :: Int -> StreamT IO Int
 timed x = liftIO (threadDelay (x * 100000)) >> return x