git.iko.soy/streamly
on master help sign in
cleanup Monoid instance
commit63f965a784ff1527d6844c535c35158c9c98e31a authorHarendra Kumar <harendra.kumar@gmail.com> dateThu 17 Aug 2017, 01:43 (9 years ago) parent6ea73b3
2 files changed+12−17
compare with master
unifiedsplit
src/Asyncly/AsyncT.hs+10−15 test/Main.hs+2−2
src/Asyncly/AsyncT.hs+10−15
@@ -102,6 +102,14 @@ type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)
102102-- Monad
103103------------------------------------------------------------------------------
104104
105+-- | Appends the results of two AsyncT computations in order.
106+instance Monad m => Monoid (AsyncT m a) where
107+ mempty = AsyncT $ \_ stp _ -> stp
108+ mappend (AsyncT m1) m2 = AsyncT $ \ctx stp yld ->
109+ m1 ctx ((runAsyncT m2) ctx stp yld) $ \a c r ->
110+ let yield x = yld a c (Just x)
111+ in maybe (yield m2) (\rx -> yield $ mappend rx m2) r
112+
105113-- We do not use bind for parallelism. That is, we do not start each iteration
106114-- of the list in parallel. That will introduce too much uncontrolled
107115-- parallelism. Instead we control parallelism using <|>, it is used for
@@ -114,13 +122,6 @@ type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)
114122-- thread or not based on the level of the bind in the tree. Maybe at some
115123-- point we shall be able to do that?
116124
117−-- XXX make this (<>)
118−serially :: AsyncT m a -> AsyncT m a -> AsyncT m a
119−serially (AsyncT m1) m2 = AsyncT $ \ctx stp yld ->
120− m1 ctx ((runAsyncT m2) ctx stp yld) $ \a c r ->
121− let yield x = yld a c (Just x)
122− in maybe (yield m2) (\rx -> yield $ serially rx m2) r
123−
124125instance Monad m => Monad (AsyncT m) where
125126 return a = AsyncT $ \ctx _ yld -> yld a ctx Nothing
126127
@@ -130,7 +131,7 @@ instance Monad m => Monad (AsyncT m) where
130131 m Nothing stp $ \a _ r ->
131132 let run x = (runAsyncT x) Nothing stp yld
132133 next = f a
133− in maybe (run next) (\rx -> run $ serially next (rx >>= f)) r
134+ in maybe (run next) (\rx -> run $ next <> (rx >>= f)) r
134135
135136------------------------------------------------------------------------------
136137-- Functor
@@ -299,12 +300,6 @@ instance MonadAsync m => MonadPlus (AsyncT m) where
299300 mzero = empty
300301 mplus = (<|>)
301302
302−-- XXX Move it in the beginning
303−-- | Appends the results of two AsyncT computations in order.
304−instance MonadAsync m => Monoid (AsyncT m a) where
305− mempty = empty
306− mappend x y = serially x y
307−
308303------------------------------------------------------------------------------
309304-- Num
310305------------------------------------------------------------------------------
@@ -363,7 +358,7 @@ instance MonadThrow m => MonadThrow (AsyncT m) where
363358-- MonadRecorder
364359------------------------------------------------------------------------------
365360
366−instance (Monad m, MonadRecorder m) => MonadRecorder (AsyncT m) where
361+instance MonadRecorder m => MonadRecorder (AsyncT m) where
367362 getJournal = lift getJournal
368363 putJournal = lift . putJournal
369364 play = lift . play
test/Main.hs+2−2
@@ -18,14 +18,14 @@ main = hspec $ do
1818 runAsyncly (liftIO $ putStrLn "hello") `shouldReturn` ()
1919 it "Captures a return value using toList" $
2020 toList (return 0) `shouldReturn` ([0] :: [Int])
21+ it "Monoid composition" $
22+ toList (return 0 <> return 1) `shouldReturn` ([0, 1] :: [Int])
2123 it "simple runAsyncly and 'then' with IO" $
2224 runAsyncly (liftIO (putStrLn "hello") >> liftIO (putStrLn "world")) `shouldReturn` ()
2325 it "Then and toList" $
2426 toList (return 1 >> return 2) `shouldReturn` ([2] :: [Int])
2527 it "Bind and toList" $
2628 toList (do x <- return 1; y <- return 2; return (x + y)) `shouldReturn` ([3] :: [Int])
27− it "Monoid composition" $
28− toList (return 0 <> return 1) `shouldReturn` ([0, 1] :: [Int])
2929 it "Alternative composition" $
3030 ((toList $ (return 0 <|> return 1)) >>= return . sort) `shouldReturn` ([0, 1] :: [Int])
3131 it "Alternative composition - each" $