Skip to content

Commit 2776115

Browse files
cootcoot
committed
MonadAsync: refactor ReaderT instance
1 parent f8cdb58 commit 2776115

File tree

1 file changed

+36
-36
lines changed

1 file changed

+36
-36
lines changed

‎io-classes/src/Control/Monad/Class/MonadAsync.hs

Lines changed: 36 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -457,35 +457,35 @@ tryAll = try
457457
-- ReaderT instance
458458
--
459459

460-
newtype WrappedAsync r (m :: Type -> Type) a =
461-
WrappedAsync { unWrapAsync :: Async m a }
460+
newtype AsyncReaderT r (m :: Type -> Type) a =
461+
AsyncReaderT { getAsyncReaderT :: Async m a }
462462

463463
instance ( MonadAsync m
464464
, MonadCatch (STM m)
465465
, MonadFork m
466466
, MonadMask m
467467
) => MonadAsync (ReaderT r m) where
468-
type Async (ReaderT r m) = WrappedAsync r m
469-
asyncThreadId (WrappedAsync a) = asyncThreadId a
468+
type Async (ReaderT r m) = AsyncReaderT r m
469+
asyncThreadId (AsyncReaderT a) = asyncThreadId a
470470

471-
async (ReaderT ma) = ReaderT $ \r -> WrappedAsync <$> async (ma r)
472-
asyncBound (ReaderT ma) = ReaderT $ \r -> WrappedAsync <$> asyncBound (ma r)
473-
asyncOn n (ReaderT ma) = ReaderT $ \r -> WrappedAsync <$> asyncOn n (ma r)
471+
async (ReaderT ma) = ReaderT $ \r -> AsyncReaderT <$> async (ma r)
472+
asyncBound (ReaderT ma) = ReaderT $ \r -> AsyncReaderT <$> asyncBound (ma r)
473+
asyncOn n (ReaderT ma) = ReaderT $ \r -> AsyncReaderT <$> asyncOn n (ma r)
474474
withAsync (ReaderT ma) f = ReaderT $ \r -> withAsync (ma r)
475-
$ \a -> runReaderT (f (WrappedAsync a)) r
475+
$ \a -> runReaderT (f (AsyncReaderT a)) r
476476
withAsyncBound (ReaderT ma) f = ReaderT $ \r -> withAsyncBound (ma r)
477-
$ \a -> runReaderT (f (WrappedAsync a)) r
477+
$ \a -> runReaderT (f (AsyncReaderT a)) r
478478
withAsyncOn n (ReaderT ma) f = ReaderT $ \r -> withAsyncOn n (ma r)
479-
$ \a -> runReaderT (f (WrappedAsync a)) r
479+
$ \a -> runReaderT (f (AsyncReaderT a)) r
480480

481-
asyncWithUnmask f = ReaderT $ \r -> fmap WrappedAsync
481+
asyncWithUnmask f = ReaderT $ \r -> fmap AsyncReaderT
482482
$ asyncWithUnmask
483483
$ \unmask -> runReaderT (f (liftF unmask)) r
484484
where
485485
liftF :: (m a -> m a) -> ReaderT r m a -> ReaderT r m a
486486
liftF g (ReaderT r) = ReaderT (g . r)
487487

488-
asyncOnWithUnmask n f = ReaderT $ \r -> fmap WrappedAsync
488+
asyncOnWithUnmask n f = ReaderT $ \r -> fmap AsyncReaderT
489489
$ asyncOnWithUnmask n
490490
$ \unmask -> runReaderT (f (liftF unmask)) r
491491
where
@@ -495,52 +495,52 @@ instance ( MonadAsync m
495495
withAsyncWithUnmask action f =
496496
ReaderT $ \r -> withAsyncWithUnmask (\unmask -> case action (liftF unmask) of
497497
ReaderT ma -> ma r)
498-
$ \a -> runReaderT (f (WrappedAsync a)) r
498+
$ \a -> runReaderT (f (AsyncReaderT a)) r
499499
where
500500
liftF :: (m a -> m a) -> ReaderT r m a -> ReaderT r m a
501501
liftF g (ReaderT r) = ReaderT (g . r)
502502

503503
withAsyncOnWithUnmask n action f =
504504
ReaderT $ \r -> withAsyncOnWithUnmask n (\unmask -> case action (liftF unmask) of
505505
ReaderT ma -> ma r)
506-
$ \a -> runReaderT (f (WrappedAsync a)) r
506+
$ \a -> runReaderT (f (AsyncReaderT a)) r
507507
where
508508
liftF :: (m a -> m a) -> ReaderT r m a -> ReaderT r m a
509509
liftF g (ReaderT r) = ReaderT (g . r)
510510

511-
waitCatchSTM = WrappedSTM . waitCatchSTM . unWrapAsync
512-
pollSTM = WrappedSTM . pollSTM . unWrapAsync
511+
waitCatchSTM = lift . waitCatchSTM . getAsyncReaderT
512+
pollSTM = lift . pollSTM . getAsyncReaderT
513513

514514
race (ReaderT ma) (ReaderT mb) = ReaderT $ \r -> race (ma r) (mb r)
515515
race_ (ReaderT ma) (ReaderT mb) = ReaderT $ \r -> race_ (ma r) (mb r)
516516
concurrently (ReaderT ma) (ReaderT mb) = ReaderT $ \r -> concurrently (ma r) (mb r)
517517

518-
wait = lift . wait . unWrapAsync
519-
poll = lift . poll . unWrapAsync
520-
waitCatch = lift . waitCatch . unWrapAsync
521-
cancel = lift . cancel . unWrapAsync
518+
wait = lift . wait . getAsyncReaderT
519+
poll = lift . poll . getAsyncReaderT
520+
waitCatch = lift . waitCatch . getAsyncReaderT
521+
cancel = lift . cancel . getAsyncReaderT
522522
uninterruptibleCancel = lift . uninterruptibleCancel
523-
. unWrapAsync
523+
. getAsyncReaderT
524524
cancelWith = (lift .: cancelWith)
525-
. unWrapAsync
526-
waitAny = fmap (first WrappedAsync)
525+
. getAsyncReaderT
526+
waitAny = fmap (first AsyncReaderT)
527527
. lift . waitAny
528-
. map unWrapAsync
529-
waitAnyCatch = fmap (first WrappedAsync)
528+
. map getAsyncReaderT
529+
waitAnyCatch = fmap (first AsyncReaderT)
530530
. lift . waitAnyCatch
531-
. map unWrapAsync
532-
waitAnyCancel = fmap (first WrappedAsync)
531+
. map getAsyncReaderT
532+
waitAnyCancel = fmap (first AsyncReaderT)
533533
. lift . waitAnyCancel
534-
. map unWrapAsync
535-
waitAnyCatchCancel = fmap (first WrappedAsync)
534+
. map getAsyncReaderT
535+
waitAnyCatchCancel = fmap (first AsyncReaderT)
536536
. lift . waitAnyCatchCancel
537-
. map unWrapAsync
538-
waitEither = on (lift .: waitEither) unWrapAsync
539-
waitEitherCatch = on (lift .: waitEitherCatch) unWrapAsync
540-
waitEitherCancel = on (lift .: waitEitherCancel) unWrapAsync
541-
waitEitherCatchCancel = on (lift .: waitEitherCatchCancel) unWrapAsync
542-
waitEither_ = on (lift .: waitEither_) unWrapAsync
543-
waitBoth = on (lift .: waitBoth) unWrapAsync
537+
. map getAsyncReaderT
538+
waitEither = on (lift .: waitEither) getAsyncReaderT
539+
waitEitherCatch = on (lift .: waitEitherCatch) getAsyncReaderT
540+
waitEitherCancel = on (lift .: waitEitherCancel) getAsyncReaderT
541+
waitEitherCatchCancel = on (lift .: waitEitherCatchCancel) getAsyncReaderT
542+
waitEither_ = on (lift .: waitEither_) getAsyncReaderT
543+
waitBoth = on (lift .: waitBoth) getAsyncReaderT
544544

545545

546546
--

0 commit comments

Comments
 (0)