git.iko.soy/streamly
on master help sign in
Add tests for functor/applicative/bind with empty/monoid
c0d2b00Harendra Kumar
src/Asyncly/AsyncT.hs+1−6
compare with master
unifiedsplit
@@ -173,12 +173,7 @@ instance Monad m => Functor (AsyncT m) where
173-- Applicative
173-- Applicative
174------------------------------------------------------------------------------
174------------------------------------------------------------------------------
175
175
176−-- Note: We cannot have the applicative instance run the two actions in
176+-- The newtype ZipAsync provides a parallel zip applicative instance
177−-- parallel. This is because the first action can always return empty and in
178−-- case it returns empty we should not be starting the second action. Therefore
179−-- we can only start the second action after getting a result from the first.
180−-- For running applicative actions in parallel we can use the async package and
181−-- lift the result into AsyncT.
182
177
183instance Monad m => Applicative (AsyncT m) where
178instance Monad m => Applicative (AsyncT m) where
184 pure a = AsyncT $ \_ _ yld -> yld a Nothing
179 pure a = AsyncT $ \_ _ yld -> yld a Nothing
test/Main.hs+50
@@ -26,6 +26,45 @@ main = hspec $ do
26 it "MonadPlus - mzero" $
26 it "MonadPlus - mzero" $
27 (toList mzero) `shouldReturn` ([] :: [Int])
27 (toList mzero) `shouldReturn` ([] :: [Int])
28
28
29+ ---------------------------------------------------------------------------
30+ -- Functor
31+ ---------------------------------------------------------------------------
32+
33+ describe "Functor (fmap)" $ do
34+ it "Simple fmap" $
35+ (toList $ fmap (+1) (return 1)) `shouldReturn` ([2] :: [Int])
36+ it "fmap on composed (<>)" $
37+ (toList $ fmap (+1) (return 1 <> return 2))
38+ `shouldReturn` ([2,3] :: [Int])
39+ it "fmap on composed (<|>)" $
40+ (toList $ fmap (+1) (return 1 <|> return 2))
41+ `shouldReturn` ([2,3] :: [Int])
42+
43+ ---------------------------------------------------------------------------
44+ -- Applicative
45+ ---------------------------------------------------------------------------
46+
47+ describe "Applicative" $ do
48+ it "Simple apply" $
49+ (toList $ (,) <$> (return 1) <*> (return 2))
50+ `shouldReturn` ([(1,2)] :: [(Int, Int)])
51+
52+ it "Apply - serial composed first argument" $
53+ (toList $ (,) <$> (return 1 <> return 2) <*> (return 3))
54+ `shouldReturn` ([(1,3),(2,3)] :: [(Int, Int)])
55+
56+ it "Apply - serial composed second argument" $
57+ (toList $ (,) <$> (return 1) <*> (return 2 <> return 3))
58+ `shouldReturn` ([(1,2),(1,3)] :: [(Int, Int)])
59+
60+ it "Apply - parallel composed first argument" $
61+ (toList $ (,) <$> (return 1 <|> return 2) <*> (return 3))
62+ `shouldReturn` ([(1,3),(2,3)] :: [(Int, Int)])
63+
64+ it "Apply - parallel composed second argument" $
65+ (toList $ (,) <$> (return 1) <*> (return 2 <|> return 3))
66+ `shouldReturn` ([(1,2),(1,3)] :: [(Int, Int)])
67+
29 ---------------------------------------------------------------------------
68 ---------------------------------------------------------------------------
30 -- Binds
69 -- Binds
31 ---------------------------------------------------------------------------
70 ---------------------------------------------------------------------------
@@ -36,11 +75,17 @@ main = hspec $ do
36 describe "Pure bind parallel DFS" $ pureBind (>>|)
75 describe "Pure bind parallel DFS" $ pureBind (>>|)
37 describe "Pure bind parallel BFS" $ pureBind (>|>)
76 describe "Pure bind parallel BFS" $ pureBind (>|>)
38
77
78+ describe "Bind (>>=) with empty" $ bindEmpty (>>=)
79+ describe "Bind (>->) with empty" $ bindEmpty (>->)
80+ describe "Bind (>|>) with empty" $ bindEmpty (>|>)
81+ describe "Bind (>>|) with empty" $ bindEmpty (>>|)
82+
39 ---------------------------------------------------------------------------
83 ---------------------------------------------------------------------------
40 -- Monoidal Compositions
84 -- Monoidal Compositions
41 ---------------------------------------------------------------------------
85 ---------------------------------------------------------------------------
42
86
43 describe "Serial Composition (<>)" $ compose (<>) id
87 describe "Serial Composition (<>)" $ compose (<>) id
88+ describe "Serial Composition (mappend)" $ compose mappend id
44 describe "Left biased parallel Composition (<|)" $ compose (<|) sort
89 describe "Left biased parallel Composition (<|)" $ compose (<|) sort
45 describe "Fair parallel Composition (<|>)" $ compose (<|>) sort
90 describe "Fair parallel Composition (<|>)" $ compose (<|>) sort
46
91
@@ -169,6 +214,11 @@ pureBind f = do
169 toList (return 1 `f` \x -> return 2 `f` \y -> return (x + y))
214 toList (return 1 `f` \x -> return 2 `f` \y -> return (x + y))
170 `shouldReturn` ([3] :: [Int])
215 `shouldReturn` ([3] :: [Int])
171
216
217+bindEmpty :: (AsyncT IO Int -> (Int -> AsyncT IO Int) -> AsyncT IO Int) -> Spec
218+bindEmpty f = it "Binds with empty" $
219+ (toList (return 1 `f` \_ -> empty `f` \_ -> return 2))
220+ `shouldReturn` ([] :: [Int])
221+
172interleaved
222interleaved
173 :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
223 :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
174 -> Spec
224 -> Spec