8f89d92 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Define type specific functor/applicative instances

8f89d92Harendra Kumar9 years ago

src/Asyncly/AsyncT.hs+5−3

compare with master

unifiedsplit

@@ -29,6 +29,7 @@ module Asyncly.AsyncT

29 , (<=>)

30 , (<|)

32+ , yielding

32 , interleave

33 , interleave

33 , parallel

34 , parallel

34 , parLeft

35 , parLeft

@@ -126,6 +127,9 @@ newtype Stream m a =

126-- | A monad that can do asynchronous (or parallel) IO operations.

127-- | A monad that can do asynchronous (or parallel) IO operations.

127type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)

128type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)

128

129

130+yielding :: a -> Stream m a

131+yielding a = Stream $ \_ _ yld -> yld a Nothing

132+

129------------------------------------------------------------------------------

133------------------------------------------------------------------------------

130-- Monoid

134-- Monoid

131------------------------------------------------------------------------------

135------------------------------------------------------------------------------

@@ -163,10 +167,8 @@ instance Monad m => Functor (Stream m) where

163-- Applicative

167-- Applicative

164------------------------------------------------------------------------------

168------------------------------------------------------------------------------

165

169

166−-- The newtype ZipAsync provides a parallel zip applicative instance

167−

168instance Monad m => Applicative (Stream m) where

170instance Monad m => Applicative (Stream m) where

169− pure a = Stream $ \_ _ yld -> yld a Nothing

171+ pure = yielding

170 (<*>) = ap

172 (<*>) = ap

171

173

172------------------------------------------------------------------------------

174------------------------------------------------------------------------------

src/Asyncly/Prelude.hs+58−11

@@ -54,7 +54,7 @@ module Asyncly.Prelude

54where

56import Control.Applicative (Alternative (..), liftA2)

57−import Control.Monad (MonadPlus(..))

57+import Control.Monad (MonadPlus(..), ap, liftM)

58import Control.Monad.Base (MonadBase (..))

59import Control.Monad.Catch (MonadThrow)

60import Control.Monad.Error.Class (MonadError(..))

@@ -140,8 +140,7 @@ instance (Monad m, Floating a) => Floating (StreamT m a) where

140------------------------------------------------------------------------------

141

142newtype 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)

145

144

146deriving instance MonadAsync m => Alternative (InterleavedT m)

145deriving instance MonadAsync m => Alternative (InterleavedT m)

147deriving instance MonadAsync m => MonadPlus (InterleavedT m)

146deriving instance MonadAsync m => MonadPlus (InterleavedT m)

@@ -157,6 +156,7 @@ instance Streaming InterleavedT where

157-- | Execute a monadic action for each element in the stream, in a fairly

156-- | Execute a monadic action for each element in the stream, in a fairly

158-- interleaved manner i.e. iterations yield alternately.

157-- interleaved manner i.e. iterations yield alternately.

159instance Monad m => Monad (InterleavedT m) where

158instance Monad m => Monad (InterleavedT m) where

159+ return = pure

160 (InterleavedT (Stream m)) >>= f = InterleavedT $ Stream $ \_ stp yld ->

161 let run x = (runStream x) Nothing stp yld

162 yield a Nothing = run $ getInterleavedT (f a)

@@ -165,6 +165,21 @@ instance Monad m => Monad (InterleavedT m) where

165 getInterleavedT ((InterleavedT r) >>= f)

166 in m Nothing stp yield

167

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+

168------------------------------------------------------------------------------

183------------------------------------------------------------------------------

169-- Num

184-- Num

170------------------------------------------------------------------------------

185------------------------------------------------------------------------------

@@ -216,7 +231,7 @@ instance (Monad m, Floating a) => Floating (InterleavedT m a) where

216------------------------------------------------------------------------------

231------------------------------------------------------------------------------

217

232

218newtype AsyncT m a = AsyncT {getAsyncT :: Stream m a}

233newtype AsyncT m a = AsyncT {getAsyncT :: Stream m a}

219− deriving (Functor, Applicative, Semigroup, Monoid, MonadTrans)

234+ deriving (Semigroup, Monoid, MonadTrans)

220

235

221deriving instance MonadAsync m => MonadIO (AsyncT m)

236deriving instance MonadAsync m => MonadIO (AsyncT m)

222deriving instance MonadAsync m => MonadThrow (AsyncT m)

237deriving instance MonadAsync m => MonadThrow (AsyncT m)

@@ -250,15 +265,31 @@ parbind k m f = go m

250-- iterations in parallel, but giving preference to iterations started

265-- iterations in parallel, but giving preference to iterations started

251-- earlier.

266-- earlier.

252instance MonadAsync m => Monad (AsyncT m) where

267instance MonadAsync m => Monad (AsyncT m) where

268+ return = pure

253 (AsyncT m) >>= f = AsyncT $ parbind par m g

269 (AsyncT m) >>= f = AsyncT $ parbind par m g

254 where g x = getAsyncT (f x)

270 where g x = getAsyncT (f x)

255 par = parallel (CtxType Conjunction LIFO)

271 par = parallel (CtxType Conjunction LIFO)

256

272

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+

257------------------------------------------------------------------------------

288------------------------------------------------------------------------------

258-- Num

289-- Num

259------------------------------------------------------------------------------

290------------------------------------------------------------------------------

260

291

261−instance (Monad m, Num a) => Num (AsyncT m a) where

292+instance (MonadAsync m, Num a) => Num (AsyncT m a) where

262 fromInteger n = pure (fromInteger n)

293 fromInteger n = pure (fromInteger n)

263

294

264 negate = fmap negate

295 negate = fmap negate

@@ -269,14 +300,14 @@ instance (Monad m, Num a) => Num (AsyncT m a) where

269 (*) = liftA2 (*)

300 (*) = liftA2 (*)

270 (-) = liftA2 (-)

301 (-) = liftA2 (-)

271

302

272−instance (Monad m, Fractional a) => Fractional (AsyncT m a) where

303+instance (MonadAsync m, Fractional a) => Fractional (AsyncT m a) where

273 fromRational n = pure (fromRational n)

304 fromRational n = pure (fromRational n)

274

305

275 recip = fmap recip

306 recip = fmap recip

276

307

277 (/) = liftA2 (/)

308 (/) = liftA2 (/)

278

309

279−instance (Monad m, Floating a) => Floating (AsyncT m a) where

310+instance (MonadAsync m, Floating a) => Floating (AsyncT m a) where

280 pi = pure pi

311 pi = pure pi

281

312

282 exp = fmap exp

313 exp = fmap exp

@@ -305,7 +336,7 @@ instance (Monad m, Floating a) => Floating (AsyncT m a) where

305------------------------------------------------------------------------------

336------------------------------------------------------------------------------

306

337

307newtype ParallelT m a = ParallelT {getParallelT :: Stream m a}

338newtype ParallelT m a = ParallelT {getParallelT :: Stream m a}

308− deriving (Functor, Applicative, Semigroup, Monoid, MonadTrans)

339+ deriving (Semigroup, Monoid, MonadTrans)

309

340

310deriving instance MonadAsync m => MonadIO (ParallelT m)

341deriving instance MonadAsync m => MonadIO (ParallelT m)

311deriving instance MonadAsync m => MonadThrow (ParallelT m)

342deriving instance MonadAsync m => MonadThrow (ParallelT m)

@@ -324,15 +355,31 @@ instance Streaming ParallelT where

324-- iterations in a fairly parallel manner, i.e. all iterations are equally

355-- iterations in a fairly parallel manner, i.e. all iterations are equally

325-- likely to run.

356-- likely to run.

326instance MonadAsync m => Monad (ParallelT m) where

357instance MonadAsync m => Monad (ParallelT m) where

358+ return = pure

327 (ParallelT m) >>= f = ParallelT $ parbind par m g

359 (ParallelT m) >>= f = ParallelT $ parbind par m g

328 where g x = getParallelT (f x)

360 where g x = getParallelT (f x)

329 par = parallel (CtxType Conjunction FIFO)

361 par = parallel (CtxType Conjunction FIFO)

330

362

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+

331------------------------------------------------------------------------------

378------------------------------------------------------------------------------

332-- Num

379-- Num

333------------------------------------------------------------------------------

380------------------------------------------------------------------------------

334

381

335−instance (Monad m, Num a) => Num (ParallelT m a) where

382+instance (MonadAsync m, Num a) => Num (ParallelT m a) where

336 fromInteger n = pure (fromInteger n)

383 fromInteger n = pure (fromInteger n)

337

384

338 negate = fmap negate

385 negate = fmap negate

@@ -343,14 +390,14 @@ instance (Monad m, Num a) => Num (ParallelT m a) where

343 (*) = liftA2 (*)

390 (*) = liftA2 (*)

344 (-) = liftA2 (-)

391 (-) = liftA2 (-)

345

392

346−instance (Monad m, Fractional a) => Fractional (ParallelT m a) where

393+instance (MonadAsync m, Fractional a) => Fractional (ParallelT m a) where

347 fromRational n = pure (fromRational n)

394 fromRational n = pure (fromRational n)

348

395

349 recip = fmap recip

396 recip = fmap recip

350

397

351 (/) = liftA2 (/)

398 (/) = liftA2 (/)

352

399

353−instance (Monad m, Floating a) => Floating (ParallelT m a) where

400+instance (MonadAsync m, Floating a) => Floating (ParallelT m a) where

354 pi = pure pi

401 pi = pure pi

355

402

356 exp = fmap exp

403 exp = fmap exp