on master help sign in
Define type specific functor/applicative instances
commit8f89d922cc7057e85f04364de4613b4dfe5397b2 authorHarendra Kumar <harendra.kumar@gmail.com> dateWed 25 Oct 2017, 16:18 (9 years ago) parentc9a821b
2 files changed+63−14
src/Asyncly/AsyncT.hs+5−3 src/Asyncly/Prelude.hs+58−11
src/Asyncly/AsyncT.hs+5−3
@@ -29,6 +29,7 @@ module Asyncly.AsyncT
2929 , (<=>)
3030 , (<|)
3131
32+ , yielding
3233 , interleave
3334 , parallel
3435 , parLeft
@@ -126,6 +127,9 @@ newtype Stream m a =
126127-- | A monad that can do asynchronous (or parallel) IO operations.
127128type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)
128129
130+yielding :: a -> Stream m a
131+yielding a = Stream $ \_ _ yld -> yld a Nothing
132+
129133------------------------------------------------------------------------------
130134-- Monoid
131135------------------------------------------------------------------------------
@@ -163,10 +167,8 @@ instance Monad m => Functor (Stream m) where
163167-- Applicative
164168------------------------------------------------------------------------------
165169
166−-- The newtype ZipAsync provides a parallel zip applicative instance
167−
168170instance Monad m => Applicative (Stream m) where
169− pure a = Stream $ \_ _ yld -> yld a Nothing
171+ pure = yielding
170172 (<*>) = ap
171173
172174------------------------------------------------------------------------------
src/Asyncly/Prelude.hs+58−11
@@ -54,7 +54,7 @@ module Asyncly.Prelude
5454where
5555
5656import Control.Applicative (Alternative (..), liftA2)
57−import Control.Monad (MonadPlus(..))
57+import Control.Monad (MonadPlus(..), ap, liftM)
5858import Control.Monad.Base (MonadBase (..))
5959import Control.Monad.Catch (MonadThrow)
6060import Control.Monad.Error.Class (MonadError(..))
@@ -140,8 +140,7 @@ instance (Monad m, Floating a) => Floating (StreamT m a) where
140140------------------------------------------------------------------------------
141141
142142newtype InterleavedT m a = InterleavedT {getInterleavedT :: Stream m a}
143− deriving (Functor, Applicative, Semigroup, Monoid,
144− MonadTrans, MonadIO, MonadThrow)
143+ deriving (Semigroup, Monoid, MonadTrans, MonadIO, MonadThrow)
145144
146145deriving instance MonadAsync m => Alternative (InterleavedT m)
147146deriving instance MonadAsync m => MonadPlus (InterleavedT m)
@@ -157,6 +156,7 @@ instance Streaming InterleavedT where
157156-- | Execute a monadic action for each element in the stream, in a fairly
158157-- interleaved manner i.e. iterations yield alternately.
159158instance Monad m => Monad (InterleavedT m) where
159+ return = pure
160160 (InterleavedT (Stream m)) >>= f = InterleavedT $ Stream $ \_ stp yld ->
161161 let run x = (runStream x) Nothing stp yld
162162 yield a Nothing = run $ getInterleavedT (f a)
@@ -165,6 +165,21 @@ instance Monad m => Monad (InterleavedT m) where
165165 getInterleavedT ((InterleavedT r) >>= f)
166166 in m Nothing stp yield
167167
168+------------------------------------------------------------------------------
169+-- Functor
170+------------------------------------------------------------------------------
171+
172+instance Monad m => Functor (InterleavedT m) where
173+ fmap = liftM
174+
175+------------------------------------------------------------------------------
176+-- Applicative
177+------------------------------------------------------------------------------
178+
179+instance Monad m => Applicative (InterleavedT m) where
180+ pure = InterleavedT . yielding
181+ (<*>) = ap
182+
168183------------------------------------------------------------------------------
169184-- Num
170185------------------------------------------------------------------------------
@@ -216,7 +231,7 @@ instance (Monad m, Floating a) => Floating (InterleavedT m a) where
216231------------------------------------------------------------------------------
217232
218233newtype AsyncT m a = AsyncT {getAsyncT :: Stream m a}
219− deriving (Functor, Applicative, Semigroup, Monoid, MonadTrans)
234+ deriving (Semigroup, Monoid, MonadTrans)
220235
221236deriving instance MonadAsync m => MonadIO (AsyncT m)
222237deriving instance MonadAsync m => MonadThrow (AsyncT m)
@@ -250,15 +265,31 @@ parbind k m f = go m
250265-- iterations in parallel, but giving preference to iterations started
251266-- earlier.
252267instance MonadAsync m => Monad (AsyncT m) where
268+ return = pure
253269 (AsyncT m) >>= f = AsyncT $ parbind par m g
254270 where g x = getAsyncT (f x)
255271 par = parallel (CtxType Conjunction LIFO)
256272
273+------------------------------------------------------------------------------
274+-- Functor
275+------------------------------------------------------------------------------
276+
277+instance MonadAsync m => Functor (AsyncT m) where
278+ fmap = liftM
279+
280+------------------------------------------------------------------------------
281+-- Applicative
282+------------------------------------------------------------------------------
283+
284+instance MonadAsync m => Applicative (AsyncT m) where
285+ pure = AsyncT . yielding
286+ (<*>) = ap
287+
257288------------------------------------------------------------------------------
258289-- Num
259290------------------------------------------------------------------------------
260291
261−instance (Monad m, Num a) => Num (AsyncT m a) where
292+instance (MonadAsync m, Num a) => Num (AsyncT m a) where
262293 fromInteger n = pure (fromInteger n)
263294
264295 negate = fmap negate
@@ -269,14 +300,14 @@ instance (Monad m, Num a) => Num (AsyncT m a) where
269300 (*) = liftA2 (*)
270301 (-) = liftA2 (-)
271302
272−instance (Monad m, Fractional a) => Fractional (AsyncT m a) where
303+instance (MonadAsync m, Fractional a) => Fractional (AsyncT m a) where
273304 fromRational n = pure (fromRational n)
274305
275306 recip = fmap recip
276307
277308 (/) = liftA2 (/)
278309
279−instance (Monad m, Floating a) => Floating (AsyncT m a) where
310+instance (MonadAsync m, Floating a) => Floating (AsyncT m a) where
280311 pi = pure pi
281312
282313 exp = fmap exp
@@ -305,7 +336,7 @@ instance (Monad m, Floating a) => Floating (AsyncT m a) where
305336------------------------------------------------------------------------------
306337
307338newtype ParallelT m a = ParallelT {getParallelT :: Stream m a}
308− deriving (Functor, Applicative, Semigroup, Monoid, MonadTrans)
339+ deriving (Semigroup, Monoid, MonadTrans)
309340
310341deriving instance MonadAsync m => MonadIO (ParallelT m)
311342deriving instance MonadAsync m => MonadThrow (ParallelT m)
@@ -324,15 +355,31 @@ instance Streaming ParallelT where
324355-- iterations in a fairly parallel manner, i.e. all iterations are equally
325356-- likely to run.
326357instance MonadAsync m => Monad (ParallelT m) where
358+ return = pure
327359 (ParallelT m) >>= f = ParallelT $ parbind par m g
328360 where g x = getParallelT (f x)
329361 par = parallel (CtxType Conjunction FIFO)
330362
363+------------------------------------------------------------------------------
364+-- Functor
365+------------------------------------------------------------------------------
366+
367+instance MonadAsync m => Functor (ParallelT m) where
368+ fmap = liftM
369+
370+------------------------------------------------------------------------------
371+-- Applicative
372+------------------------------------------------------------------------------
373+
374+instance MonadAsync m => Applicative (ParallelT m) where
375+ pure = ParallelT . yielding
376+ (<*>) = ap
377+
331378------------------------------------------------------------------------------
332379-- Num
333380------------------------------------------------------------------------------
334381
335−instance (Monad m, Num a) => Num (ParallelT m a) where
382+instance (MonadAsync m, Num a) => Num (ParallelT m a) where
336383 fromInteger n = pure (fromInteger n)
337384
338385 negate = fmap negate
@@ -343,14 +390,14 @@ instance (Monad m, Num a) => Num (ParallelT m a) where
343390 (*) = liftA2 (*)
344391 (-) = liftA2 (-)
345392
346−instance (Monad m, Fractional a) => Fractional (ParallelT m a) where
393+instance (MonadAsync m, Fractional a) => Fractional (ParallelT m a) where
347394 fromRational n = pure (fromRational n)
348395
349396 recip = fmap recip
350397
351398 (/) = liftA2 (/)
352399
353−instance (Monad m, Floating a) => Floating (ParallelT m a) where
400+instance (MonadAsync m, Floating a) => Floating (ParallelT m a) where
354401 pi = pure pi
355402
356403 exp = fmap exp