diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,180 @@
+# Revision history for lifted-async
+
+## v0.11.0 - 2025-09-06
+
+* Drop support for GHC 7 and allow base-4.22 ([#47](https://github.com/maoe/lifted-async/pull/47))
+
+## v0.10.2.7 - 2024-11-03
+
+* Allow base-4.21, tasty-bench-0.4, bump Haskell CI to GHC 9.12.0 ([#46](https://github.com/maoe/lifted-async/pull/46))
+
+## v0.10.2.6 - 2024-10-05
+
+* Allow base-4.20, bump CI to GHC 9.10.1 (([#44](https://github.com/maoe/lifted-async/issues/44)))
+
+## v0.10.2.5 - 2023-11-11
+
+* Support GHC 9.8 ([#42](https://github.com/maoe/lifted-async/issues/42))
+* Allow base-4.19, bump CI to GHC 9.8.1 ([#43](https://github.com/maoe/lifted-async/pull/43))
+
+## v0.10.2.4 - 2022-03-19
+
+* Support mtl-2.3.1, allow base-4.18 (GHC 9.6) ([#41](https://github.com/maoe/lifted-async/pull/41))
+
+## v0.10.2.3 - 2022-08-13
+
+* Allow base-4.17 (GHC 9.4) and bump CI to latest GHC versions ([#39](https://github.com/maoe/lifted-async/pull/39))
+
+## v0.10.2.2 - 2021-11-02
+
+* Allow base-4.17 for GHC 9.2.1 ([#37](https://github.com/maoe/lifted-async/pull/37))
+
+## v0.10.2.1 - 2021-07-23
+
+* Relax upper version bound for tasty-bench
+
+## v0.10.2 - 2021-04-02
+
+* Define withAsync in terms of corresponding function from async ([#36](https://github.com/maoe/lifted-async/pull/36))
+  * Fixes [#34](https://github.com/maoe/lifted-async/issues/34)
+
+## v0.10.1.3 - 2021-02-26
+
+* Support GHC 9.0.1 ([#33](https://github.com/maoe/lifted-async/pull/33))
+* Switch from Travis CI to GitHub Actions
+* Switch from criterion to tasty-bench
+
+## v0.10.1.2 - 2020-07-23
+
+* Relax upper version bound for tasty-expected-failure
+
+## v0.10.1.1 - 2020-06-29
+
+* Bump up cabal-version to 1.24
+
+## v0.10.1 - 2020-06-29
+
+* Fix typechecking errors with GHC HEAD 8.11 ([#31](https://github.com/maoe/lifted-async/pull/31))
+
+## v0.10.0.6 - 2020-03-31
+
+* Relax upper version bound for base to suppose GHC 8.10 ([#30](https://github.com/maoe/lifted-async/pull/30))
+
+## v0.10.0.5 - 2020-02-08
+
+* Relax upper version bounds for constraints
+
+## v0.10.0.4 - 2019-05-03
+
+* Relax upper version bounds for base and constraints
+
+## v0.10.0.3 - 2018-09-25
+
+* Relax upper version bound for base to support GHC 8.6.1
+
+## v0.10.0.2 - 2018-05-13
+
+* Allow test_link to fail because it's non-deterministic (#26)
+
+## v0.10.0.1 - 2018-03-10
+
+* Relax upper version bound for base in GHC 8.4.1 (#25)
+
+## v0.10.0 - 2018-02-08
+
+* Support only async >= 2.2
+* Drop support for monad-control == 0.*
+* Drop support for GHC < 7.10
+
+## v0.9.3.3 - 2018-01-22
+
+* Relax upper version bound for constraints
+
+## v0.9.3.2 - 2017-12-12
+
+* Minor improvements in the cabal file
+
+## v0.9.3.1 - 2017-12-12
+
+* Relax upper version bound for tasty-hunit
+
+## v0.9.3 - 2017-06-26
+
+* Add Haddock comments for concurrently_ (#23)
+* Add replicateConcurrently and replicateConcurrently_
+* Test with GHC 8.2.1 on Travis
+
+## v0.9.2 - 2017-06-24
+
+* Add concurrently_ (#22)
+
+## v0.9.1.1 - 2017-01-26
+
+* Relax upper version bound for constraints
+
+## v0.9.1 - 2017-01-13
+
+* Add (for|map)Concurrently_ (#21)
+
+## v0.9.0 - 2016-05-22
+
+* Leverage `StM m a ~ a` in the `Safe` module for faster `wait`/`poll`/`race`/`concurrently`
+
+## v0.8.0.1 - 2015-01-17
+
+* Relax upper bound for constraints
+
+## v0.8.0 - 2016-01-10
+
+* Drop Monad instance for Concurrently
+* Expose STM operations
+* Relax upper bound for base and async
+* Add Monoid and Semigroup instances for Concurrently
+
+## v0.7.0.2 - 2015-11-26
+
+* Relax upper bound for the constraints package
+    * Upper bound remains < 0.6 for GHC < 7.8 as constraints-0.6 requires the closed type families extension.
+* Drop support for GHC 7.4.2
+
+## v0.7.0.1 - 2015-05-18
+
+* Fix typecheck error with GHC HEAD (#17)
+
+## v0.7.0 - 2015-03-30
+
+* Fix the unnecessarily constrained type of link2 (#16)
+* Turn the caveat in the Safe module into a WARNING pragma (#15)
+
+## v0.6.0.1 - 2015-01-14
+
+* Increase the lower bound for base to >= 4.5
+
+## v0.6.0 - 2015-01-13
+
+* Replace `StM m a ~ a` in the type signatures with `Forall (Pure m)` (#12)
+
+## v0.5.0.1 - 2014-12-29
+
+* Fix build issues in the test suite (#11 and others)
+
+## v0.5.0 - 2014-12-29
+
+* Simplify the type of `Concurrently` (#10)
+
+## v0.4.0 - 2014-12-29
+
+* Accept `constraints > 0.4` as well even when built with ghc < 7.8.
+* Support for GHC 7.10.1
+
+## v0.3.0 - 2014-12-28
+
+* Support for `monad-control == 1.0.*`
+    * `waitEither_` and `race_` now discard monadic effects besides `IO`. This is a breaking change.
+    * `Control.Concurrent.Async.Lifted.Safe` is added.
+* Add `Monad` instance for `Concurrently`
+* Relax upper bound for base
+
 ## v0.2.0.2 - 2014-08-20
 
 * Fix build failure in the test suite (#6)
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2012, Mitsutoshi Aoe
+Copyright (c) 2012-2017, Mitsutoshi Aoe
 
 All rights reserved.
 
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,18 +1,15 @@
 lifted-async
 ==========
-[![Build Status](https://secure.travis-ci.org/maoe/lifted-async.png)](http://travis-ci.org/maoe/lifted-async)
-[![Coverage Status](https://coveralls.io/repos/maoe/lifted-async/badge.png)](https://coveralls.io/r/maoe/lifted-async)
+[![Hackage](https://img.shields.io/hackage/v/lifted-async.svg)](https://hackage.haskell.org/package/lifted-async)
+[![Hackage-Deps](https://img.shields.io/hackage-deps/v/lifted-async.svg)](http://packdeps.haskellers.com/feed?needle=lifted-async)
+[![lifted-async on Stackage LTS](https://stackage.org/package/lifted-async/badge/lts)](http://stackage.org/lts/package/lifted-async)
+[![Haskell-CI](https://github.com/maoe/lifted-async/actions/workflows/haskell-ci.yml/badge.svg?branch=master)](https://github.com/maoe/lifted-async/actions/workflows/haskell-ci.yml)
+[![Gitter](https://badges.gitter.im/maoe/lifted-async.svg)](https://gitter.im/maoe/lifted-async?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge)
 
 This package provides IO operations from [async](http://hackage.haskell.org/package/async) package lifted to any instance of `MonadBase` or `MonadBaseControl` from [monad-control](http://hackage.haskell.org/package/monad-control) package.
 
-You can install this library using cabal:
-
-```
-cabal install lifted-async
-```
-
 Contact information
 ==========
 
-This library is written and maintained by Mitsutoshi Aoe <maoe@foldr.in>.
+This library is written and maintained by Mitsutoshi Aoe <me@maoe.name>.
 [Pull requests](https://github.com/maoe/lifted-async/pulls) and [bug reports](https://github.com/maoe/lifted-async/issues) are welcome. A chat room is available on [Gitter](https://gitter.im/maoe/lifted-async).
diff --git a/benchmarks/Benchmarks.hs b/benchmarks/Benchmarks.hs
--- a/benchmarks/Benchmarks.hs
+++ b/benchmarks/Benchmarks.hs
@@ -1,40 +1,46 @@
-{-# LANGUAGE BangPatterns #-}
 module Main where
 import Control.Exception (SomeException(..))
 
-import Criterion.Main
+import Test.Tasty.Bench (bench, bgroup, defaultMain, nfIO, whnfIO)
 import qualified Control.Concurrent.Async as A
 import qualified Control.Concurrent.Async.Lifted as L
+import qualified Control.Concurrent.Async.Lifted.Safe as LS
 
 main :: IO ()
 main = defaultMain
   [ bgroup "async-wait"
       [ bench "async" $ whnfIO asyncWait_async
       , bench "lifted-async" $ whnfIO asyncWait_liftedAsync
-      ]
-  , bgroup "async-cancel-waitCatch"
-      [ bench "async" $ whnfIO asyncCancelWaitCatch_async
-      , bench "lifted-async" $ whnfIO asyncCancelWaitCatch_liftedAsync
+      , bench "lifted-async-safe" $ whnfIO asyncWait_liftedAsyncSafe
       ]
+  -- , bgroup "async-cancel-waitCatch"
+  --     [ bench "async" $ whnfIO asyncCancelWaitCatch_async
+  --     , bench "lifted-async" $ whnfIO asyncCancelWaitCatch_liftedAsync
+  --     , bench "lifted-async-safe" $ whnfIO asyncCancelWaitCatch_liftedAsyncSafe
+  --     ]
   , bgroup "waitAny"
       [ bench "async" $ whnfIO waitAny_async
       , bench "lifted-async" $ whnfIO waitAny_liftedAsync
+      , bench "lifted-async-safe" $ whnfIO waitAny_liftedAsyncSafe
       ]
   , bgroup "race"
       [ bench "async" $ nfIO race_async
       , bench "lifted-async" $ nfIO race_liftedAsync
+      , bench "lifted-async-safe" $ nfIO race_liftedAsyncSafe
       , bench "async (inlined)" $ nfIO race_async_inlined
       , bench "lifted-async (inlined)" $ nfIO race_liftedAsync_inlined
       ]
   , bgroup "concurrently"
       [ bench "async" $ nfIO concurrently_async
       , bench "lifted-async" $ nfIO concurrently_liftedAsync
+      , bench "lifted-async-safe" $ nfIO concurrently_liftedAsyncSafe
       , bench "async (inlined)" $ nfIO concurrently_async_inlined
       , bench "lifted-async (inlined)" $ nfIO concurrently_liftedAsync_inlined
       ]
   , bgroup "mapConcurrently"
       [ bench "async" $ nfIO mapConcurrently_async
       , bench "lifted-async" $ nfIO mapConcurrently_liftedAsync
+      , bench "lifted-async-safe" $ nfIO mapConcurrently_liftedAsyncSafe
       ]
   ]
 
@@ -48,6 +54,11 @@
   a <- L.async (return 1)
   L.wait a
 
+asyncWait_liftedAsyncSafe :: IO Int
+asyncWait_liftedAsyncSafe = do
+  a <- LS.async (return 1)
+  LS.wait a
+
 asyncCancelWaitCatch_async :: IO (Either SomeException Int)
 asyncCancelWaitCatch_async = do
   a <- A.async (return 1)
@@ -60,6 +71,12 @@
   L.cancel a
   L.waitCatch a
 
+asyncCancelWaitCatch_liftedAsyncSafe :: IO (Either SomeException Int)
+asyncCancelWaitCatch_liftedAsyncSafe = do
+  a <- LS.async (return 1)
+  LS.cancel a
+  LS.waitCatch a
+
 waitAny_async :: IO Int
 waitAny_async = do
   as <- mapM (A.async . return) [1..10]
@@ -72,6 +89,12 @@
   (_, n) <- L.waitAny as
   return n
 
+waitAny_liftedAsyncSafe :: IO Int
+waitAny_liftedAsyncSafe = do
+  as <- mapM (LS.async . return) [1..10]
+  (_, n) <- LS.waitAny as
+  return n
+
 race_async :: IO (Either Int Int)
 race_async =
   A.race (return 1) (return 2)
@@ -80,6 +103,10 @@
 race_liftedAsync =
   L.race (return 1) (return 2)
 
+race_liftedAsyncSafe :: IO (Either Int Int)
+race_liftedAsyncSafe =
+  LS.race (return 1) (return 2)
+
 race_async_inlined :: IO (Either Int Int)
 race_async_inlined =
   A.withAsync (return 1) $ \a ->
@@ -100,6 +127,10 @@
 concurrently_liftedAsync =
   L.concurrently (return 1) (return 2)
 
+concurrently_liftedAsyncSafe :: IO (Int, Int)
+concurrently_liftedAsyncSafe =
+  LS.concurrently (return 1) (return 2)
+
 concurrently_async_inlined :: IO (Int, Int)
 concurrently_async_inlined =
   A.withAsync (return 1) $ \a ->
@@ -119,3 +150,7 @@
 mapConcurrently_liftedAsync :: IO [Int]
 mapConcurrently_liftedAsync =
   L.mapConcurrently return [1..10]
+
+mapConcurrently_liftedAsyncSafe :: IO [Int]
+mapConcurrently_liftedAsyncSafe =
+  LS.mapConcurrently return [1..10]
diff --git a/lifted-async.cabal b/lifted-async.cabal
--- a/lifted-async.cabal
+++ b/lifted-async.cabal
@@ -1,18 +1,33 @@
+cabal-version:       1.24
 name:                lifted-async
-version:             0.2.0.2
+version:             0.11.0
 synopsis:            Run lifted IO operations asynchronously and wait for their results
 homepage:            https://github.com/maoe/lifted-async
 bug-reports:         https://github.com/maoe/lifted-async/issues
 license:             BSD3
 license-file:        LICENSE
 author:              Mitsutoshi Aoe
-maintainer:          Mitsutoshi Aoe <maoe@foldr.in>
-copyright:           Copyright (C) 2012-2014 Mitsutoshi Aoe
+maintainer:          Mitsutoshi Aoe <me@maoe.name>
+copyright:           Copyright (C) 2012-2025 Mitsutoshi Aoe
 category:            Concurrency
 build-type:          Simple
-cabal-version:       >= 1.8
+tested-with:
+  GHC == 9.14.1
+  GHC == 9.12.2
+  GHC == 9.10.2
+  GHC == 9.8.4
+  GHC == 9.6.7
+  GHC == 9.4.8
+  GHC == 9.2.8
+  GHC == 9.0.2
+  GHC == 8.10.7
+  GHC == 8.8.4
+  GHC == 8.6.5
+  GHC == 8.4.4
+  GHC == 8.2.2
+  GHC == 8.0.2
 
-extra-source-files:
+extra-doc-files:
   README.md
   CHANGELOG.md
 
@@ -21,16 +36,19 @@
   instance of 'MonadBase' or 'MonadBaseControl'.
 
 library
+  hs-source-dirs: src
   exposed-modules:
     Control.Concurrent.Async.Lifted
+    Control.Concurrent.Async.Lifted.Safe
   build-depends:
-      base >= 4.3 && < 4.8
-    , async >= 2.0.1
-    , lifted-base >= 0.2
-    , monad-control >= 0.3.1
-    , transformers-base >= 0.4
+      base >= 4.9 && < 4.23
+    , async >= 2.2 && < 2.3
+    , lifted-base >= 0.2 && < 0.3
+    , transformers-base >= 0.4 && < 0.5
+    , monad-control == 1.0.*
+    , constraints >= 0.2 && < 0.15
   ghc-options: -Wall
-  hs-source-dirs: src
+  default-language: Haskell2010
 
 test-suite test-lifted-async
   type: exitcode-stdio-1.0
@@ -40,60 +58,56 @@
     Test.Async.Common
     Test.Async.IO
     Test.Async.State
+    Test.Async.Reader
+  ghc-options: -Wall -threaded
   build-depends:
       base
-    , HUnit
     , lifted-async
     , lifted-base
-    , monad-control
     , mtl
     , tasty
-    , tasty-hunit == 0.9.*
+    , tasty-expected-failure < 0.13
+    , tasty-hunit >= 0.9 && < 0.11
     , tasty-th
+  default-language: Haskell2010
 
 test-suite regression-tests
   type: exitcode-stdio-1.0
   hs-source-dirs: tests
   main-is: RegressionTests.hs
-  ghc-options: -Wall -O -threaded
+  ghc-options: -Wall -threaded
   build-depends:
       base
-    , async
     , lifted-async
-    , mtl
-    , tasty-hunit == 0.9.*
+    , tasty-hunit >= 0.9 && < 0.11
     , tasty-th
+  default-language: Haskell2010
 
 benchmark benchmark-lifted-async
   type: exitcode-stdio-1.0
   hs-source-dirs: benchmarks
   main-is: Benchmarks.hs
-  ghc-options: -Wall -O
+  ghc-options: -Wall
   build-depends:
       base
     , async
-    , criterion
-    , deepseq
+    , tasty-bench < 0.5
     , lifted-async
+  default-language: Haskell2010
 
 benchmark benchmark-lifted-async-threaded
   type: exitcode-stdio-1.0
   hs-source-dirs: benchmarks
   main-is: Benchmarks.hs
-  ghc-options: -Wall -O -threaded
+  ghc-options: -Wall -threaded
   build-depends:
       base
     , async
-    , criterion
-    , deepseq
+    , tasty-bench < 0.5
     , lifted-async
+  default-language: Haskell2010
 
 source-repository head
   type: git
   branch: develop
-  location: https://github.com/maoe/lifted-async.git
-
-source-repository this
-  type: git
-  tag: v0.2.0.2
   location: https://github.com/maoe/lifted-async.git
diff --git a/src/Control/Concurrent/Async/Lifted.hs b/src/Control/Concurrent/Async/Lifted.hs
--- a/src/Control/Concurrent/Async/Lifted.hs
+++ b/src/Control/Concurrent/Async/Lifted.hs
@@ -1,32 +1,45 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 {- |
 Module      : Control.Concurrent.Async.Lifted
-Copyright   : Copyright (C) 2012-2014 Mitsutoshi Aoe
+Copyright   : Copyright (C) 2012-2018 Mitsutoshi Aoe
 License     : BSD-style (see the file LICENSE)
 Maintainer  : Mitsutoshi Aoe <maoe@foldr.in>
 Stability   : experimental
 
-This is a wrapped version of "Control.Concurrent.Async" with types generalized
+This is a wrapped version of @Control.Concurrent.Async@ with types generalized
 from 'IO' to all monads in either 'MonadBase' or 'MonadBaseControl'.
+
+All the functions restore the monadic effects in the forked computation
+unless specified otherwise.
+
+If your monad stack satisfies @'StM' m a ~ a@ (e.g. the reader monad), consider
+using @Control.Concurrent.Async.Lifted.Safe@ module, which prevents you from
+messing up monadic effects.
 -}
 
 module Control.Concurrent.Async.Lifted
   ( -- * Asynchronous actions
     A.Async
     -- ** Spawning
-  , async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask
+  , async, asyncBound, asyncOn
+  , asyncWithUnmask, asyncOnWithUnmask
 
     -- ** Spawning with automatic 'cancel'ation
   , withAsync, withAsyncBound, withAsyncOn
   , withAsyncWithUnmask, withAsyncOnWithUnmask
 
     -- ** Quering 'Async's
-  , wait, poll, waitCatch, cancel, cancelWith
+  , wait, poll, waitCatch
+  , cancel
+  , uninterruptibleCancel
+  , cancelWith
   , A.asyncThreadId
+  , A.AsyncCancelled(..)
 
     -- ** STM operations
   , A.waitSTM, A.pollSTM, A.waitCatchSTM
@@ -37,20 +50,34 @@
   , waitEither_
   , waitBoth
 
+    -- ** Waiting for multiple 'Async's in STM
+  , A.waitAnySTM
+  , A.waitAnyCatchSTM
+  , A.waitEitherSTM
+  , A.waitEitherCatchSTM
+  , A.waitEitherSTM_
+  , A.waitBothSTM
+
     -- ** Linking
   , link, link2
+  , A.ExceptionInLinkedThread(..)
 
     -- * Convenient utilities
-  , race, race_, concurrently, mapConcurrently
+  , race, race_, concurrently, concurrently_
+  , mapConcurrently, mapConcurrently_
+  , forConcurrently, forConcurrently_
+  , replicateConcurrently, replicateConcurrently_
   , Concurrently(..)
+
+  , A.compareAsyncs
   ) where
 
 import Control.Applicative
 import Control.Concurrent (threadDelay)
-import Control.Monad ((>=>), forever, liftM, void)
-import Data.Traversable (Traversable(..))
+import Control.Monad ((>=>), forever, void)
+import Data.Foldable (fold)
 import GHC.IO (unsafeUnmask)
-import Prelude hiding (mapM)
+import Prelude
 
 import Control.Concurrent.Async (Async)
 import Control.Exception.Lifted (SomeException, Exception)
@@ -59,6 +86,10 @@
 import qualified Control.Concurrent.Async as A
 import qualified Control.Exception.Lifted as E
 
+#if !MIN_VERSION_base(4, 11, 0)
+import Data.Semigroup (Semigroup((<>)))
+#endif
+
 -- | Generalized version of 'A.async'.
 async :: MonadBaseControl IO m => m a -> m (Async (StM m a))
 async = asyncUsing A.async
@@ -102,7 +133,7 @@
   => m a
   -> (Async (StM m a) -> m b)
   -> m b
-withAsync = withAsyncUsing async
+withAsync = liftWithAsync A.withAsync
 {-# INLINABLE withAsync #-}
 
 -- | Generalized version of 'A.withAsyncBound'.
@@ -111,9 +142,17 @@
   => m a
   -> (Async (StM m a) -> m b)
   -> m b
-withAsyncBound = withAsyncUsing asyncBound
+withAsyncBound = liftWithAsync A.withAsyncBound
 {-# INLINABLE withAsyncBound #-}
 
+liftWithAsync
+  :: MonadBaseControl IO m
+  => (IO (StM m a) -> (Async (StM m a) -> IO (StM m b)) -> IO (StM m b))
+  -> (m a -> (Async (StM m a) -> m b) -> m b)
+liftWithAsync withA action cont = restoreM =<< do
+  liftBaseWith $ \runInIO -> do
+    withA (runInIO action) (runInIO . cont)
+
 -- | Generalized version of 'A.withAsyncOn'.
 withAsyncOn
   :: MonadBaseControl IO m
@@ -170,8 +209,20 @@
   -> m (Maybe (Either SomeException a))
 poll a =
   liftBase (A.poll a) >>=
-  maybe (return Nothing) (liftM Just . sequenceEither)
+  maybe (return Nothing) (fmap Just . sequenceEither)
 
+-- | Generalized version of 'A.cancel'.
+cancel :: MonadBase IO m => Async a -> m ()
+cancel = liftBase . A.cancel
+
+-- | Generalized version of 'A.cancelWith'.
+cancelWith :: (MonadBase IO m, Exception e) => Async a -> e -> m ()
+cancelWith = (liftBase .) . A.cancelWith
+
+-- | Generalized version of 'A.uninterruptibleCancel'.
+uninterruptibleCancel :: MonadBase IO m => Async a -> m ()
+uninterruptibleCancel = liftBase . A.uninterruptibleCancel
+
 -- | Generalized version of 'A.waitCatch'.
 waitCatch
   :: MonadBaseControl IO m
@@ -179,14 +230,6 @@
   -> m (Either SomeException a)
 waitCatch a = liftBase (A.waitCatch a) >>= sequenceEither
 
--- | Generalized version of 'A.cancel'.
-cancel :: MonadBase IO m => Async (StM m a) -> m ()
-cancel = liftBase . A.cancel
-
--- | Generalized version of 'A.cancelWith'.
-cancelWith :: (MonadBase IO m, Exception e) => Async (StM m a) -> e -> m ()
-cancelWith = (liftBase .) . A.cancelWith
-
 -- | Generalized version of 'A.waitAny'.
 waitAny :: MonadBaseControl IO m => [Async (StM m a)] -> m (Async (StM m a), a)
 waitAny as = do
@@ -205,8 +248,14 @@
   return (a, r)
 
 -- | Generalized version of 'A.waitAnyCancel'.
-waitAnyCancel :: MonadBase IO m => [Async a] -> m (Async a, a)
-waitAnyCancel = liftBase . A.waitAnyCancel
+waitAnyCancel
+  :: MonadBaseControl IO m
+  => [Async (StM m a)]
+  -> m (Async (StM m a), a)
+waitAnyCancel as = do
+  (a, s) <- liftBase $ A.waitAnyCancel as
+  r <- restoreM s
+  return (a, r)
 
 -- | Generalized version of 'A.waitAnyCatchCancel'.
 waitAnyCatchCancel
@@ -226,7 +275,7 @@
   -> m (Either a b)
 waitEither a b =
   liftBase (A.waitEither a b) >>=
-  either (liftM Left . restoreM) (liftM Right . restoreM)
+  either (fmap Left . restoreM) (fmap Right . restoreM)
 
 -- | Generalized version of 'A.waitEitherCatch'.
 waitEitherCatch
@@ -236,7 +285,7 @@
   -> m (Either (Either SomeException a) (Either SomeException b))
 waitEitherCatch a b =
   liftBase (A.waitEitherCatch a b) >>=
-  either (liftM Left . sequenceEither) (liftM Right . sequenceEither)
+  either (fmap Left . sequenceEither) (fmap Right . sequenceEither)
 
 -- | Generalized version of 'A.waitEitherCancel'.
 waitEitherCancel
@@ -246,7 +295,7 @@
   -> m (Either a b)
 waitEitherCancel a b =
   liftBase (A.waitEitherCancel a b) >>=
-  either (liftM Left . restoreM) (liftM Right . restoreM)
+  either (fmap Left . restoreM) (fmap Right . restoreM)
 
 -- | Generalized version of 'A.waitEitherCatchCancel'.
 waitEitherCatchCancel
@@ -256,15 +305,18 @@
   -> m (Either (Either SomeException a) (Either SomeException b))
 waitEitherCatchCancel a b =
   liftBase (A.waitEitherCatch a b) >>=
-  either (liftM Left . sequenceEither) (liftM Right . sequenceEither)
+  either (fmap Left . sequenceEither) (fmap Right . sequenceEither)
 
 -- | Generalized version of 'A.waitEither_'.
+--
+-- NOTE: This function discards the monadic effects besides IO in the forked
+-- computation.
 waitEither_
-  :: MonadBaseControl IO m
-  => Async (StM m a)
-  -> Async (StM m b)
+  :: MonadBase IO m
+  => Async a
+  -> Async b
   -> m ()
-waitEither_ = (void .) . waitEither
+waitEither_ a b = liftBase (A.waitEither_ a b)
 
 -- | Generalized version of 'A.waitBoth'.
 waitBoth
@@ -280,11 +332,11 @@
 {-# INLINABLE waitBoth #-}
 
 -- | Generalized version of 'A.link'.
-link :: MonadBase IO m => Async (StM m a) -> m ()
+link :: MonadBase IO m => Async a -> m ()
 link = liftBase . A.link
 
 -- | Generalized version of 'A.link2'.
-link2 :: MonadBase IO m => Async (StM m a) -> Async (StM m b) -> m ()
+link2 :: MonadBase IO m => Async a -> Async b -> m ()
 link2 = (liftBase .) . A.link2
 
 -- | Generalized version of 'A.race'.
@@ -296,6 +348,9 @@
 {-# INLINABLE race #-}
 
 -- | Generalized version of 'A.race_'.
+--
+-- NOTE: This function discards the monadic effects besides IO in the forked
+-- computation.
 race_ :: MonadBaseControl IO m => m a -> m b -> m ()
 race_ left right =
   withAsync left $ \a ->
@@ -311,6 +366,11 @@
   waitBoth a b
 {-# INLINABLE concurrently #-}
 
+-- | Generalized version of 'A.concurrently_'.
+concurrently_ :: MonadBaseControl IO m => m a -> m b -> m ()
+concurrently_ left right = void $ concurrently left right
+{-# INLINABLE concurrently_ #-}
+
 -- | Generalized version of 'A.mapConcurrently'.
 mapConcurrently
   :: (Traversable t, MonadBaseControl IO m)
@@ -319,41 +379,89 @@
   -> m (t b)
 mapConcurrently f = runConcurrently . traverse (Concurrently . f)
 
+-- | Generalized version of 'A.mapConcurrently_'.
+mapConcurrently_
+  :: (Foldable t, MonadBaseControl IO m)
+  => (a -> m b)
+  -> t a
+  -> m ()
+mapConcurrently_ f = runConcurrently . foldMap (Concurrently . void . f)
+
+-- | Generalized version of 'A.forConcurrently'.
+forConcurrently
+  :: (Traversable t, MonadBaseControl IO m)
+  => t a
+  -> (a -> m b)
+  -> m (t b)
+forConcurrently = flip mapConcurrently
+
+-- | Generalized version of 'A.forConcurrently_'.
+forConcurrently_
+  :: (Foldable t, MonadBaseControl IO m)
+  => t a
+  -> (a -> m b)
+  -> m ()
+forConcurrently_ = flip mapConcurrently_
+
+-- | Generalized version of 'A.replicateConcurrently'.
+replicateConcurrently
+  :: MonadBaseControl IO m
+  => Int
+  -> m a
+  -> m [a]
+replicateConcurrently n =
+  runConcurrently . sequenceA . replicate n . Concurrently
+
+-- | Generalized version of 'A.replicateConcurrently_'.
+replicateConcurrently_
+  :: MonadBaseControl IO m
+  => Int
+  -> m a
+  -> m ()
+replicateConcurrently_ n =
+  runConcurrently . fold . replicate n . Concurrently . void
+
 -- | Generalized version of 'A.Concurrently'.
 --
--- A value of type @Concurrently b m a@ is an IO-based operation that can be
+-- A value of type @'Concurrently' m a@ is an IO-based operation that can be
 -- composed with other 'Concurrently' values, using the 'Applicative' and
 -- 'Alternative' instances.
 --
--- Calling 'runConcurrently' on a value of type @Concurrently b m a@ will
+-- Calling 'runConcurrently' on a value of type @'Concurrently' m a@ will
 -- execute the IO-based lifted operations it contains concurrently, before
 -- delivering the result of type 'a'.
 --
 -- For example
 --
--- > (page1, page2, page3) <- runConcurrently $ (,,)
--- >   <$> Concurrently (getURL "url1")
--- >   <*> Concurrently (getURL "url2")
--- >   <*> Concurrently (getURL "url3")
-newtype Concurrently (b :: * -> *) m a = Concurrently { runConcurrently :: m a }
-
--- NOTE: The phantom type variable @b :: * -> *@ in 'Concurrently' is needed to
--- avoid @UndecidableInstances@ in the following instance declarations.
--- See https://github.com/maoe/lifted-async/issues/4 for alternative
--- implementaions.
+-- @
+--   (page1, page2, page3) <- 'runConcurrently' $ (,,)
+--     '<$>' 'Concurrently' (getURL "url1")
+--     '<*>' 'Concurrently' (getURL "url2")
+--     '<*>' 'Concurrently' (getURL "url3")
+-- @
+newtype Concurrently m a = Concurrently { runConcurrently :: m a }
 
-instance (b ~ IO, Functor m) => Functor (Concurrently b m) where
+instance Functor m => Functor (Concurrently m) where
   fmap f (Concurrently a) = Concurrently $ f <$> a
 
-instance (b ~ IO, MonadBaseControl b m) => Applicative (Concurrently b m) where
+instance MonadBaseControl IO m => Applicative (Concurrently m) where
   pure = Concurrently . pure
   Concurrently fs <*> Concurrently as =
     Concurrently $ uncurry ($) <$> concurrently fs as
 
-instance (b ~ IO, MonadBaseControl b m) => Alternative (Concurrently b m) where
-  empty = Concurrently . liftBaseWith . const $ forever (threadDelay maxBound)
+instance MonadBaseControl IO m => Alternative (Concurrently m) where
+  empty = Concurrently $ liftBaseWith $ \_ -> forever $ threadDelay maxBound
   Concurrently as <|> Concurrently bs =
     Concurrently $ either id id <$> race as bs
 
+instance (MonadBaseControl IO m, Semigroup a) =>
+  Semigroup (Concurrently m a) where
+    (<>) = liftA2 (<>)
+
+instance (MonadBaseControl IO m, Semigroup a, Monoid a) =>
+  Monoid (Concurrently m a) where
+    mempty = pure mempty
+    mappend = (<>)
+
 sequenceEither :: MonadBaseControl IO m => Either e (StM m a) -> m (Either e a)
-sequenceEither = either (return . Left) (liftM Right . restoreM)
+sequenceEither = either (return . Left) (fmap Right . restoreM)
diff --git a/src/Control/Concurrent/Async/Lifted/Safe.hs b/src/Control/Concurrent/Async/Lifted/Safe.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Concurrent/Async/Lifted/Safe.hs
@@ -0,0 +1,442 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{- |
+Module      : Control.Concurrent.Async.Lifted.Safe
+Copyright   : Copyright (C) 2012-2018 Mitsutoshi Aoe
+License     : BSD-style (see the file LICENSE)
+Maintainer  : Mitsutoshi Aoe <maoe@foldr.in>
+Stability   : experimental
+
+This is a safe variant of @Control.Concurrent.Async.Lifted@.
+
+This module assumes your monad stack to satisfy @'StM' m a ~ a@ so you can't
+mess up monadic effects. If your monad stack is stateful, use
+@Control.Concurrent.Async.Lifted@ with special care.
+-}
+
+module Control.Concurrent.Async.Lifted.Safe
+  (
+    -- * Asynchronous actions
+    A.Async
+
+  , Pure
+  , Forall
+    -- ** Spawning
+  , async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask
+
+    -- ** Spawning with automatic 'cancel'ation
+  , withAsync, withAsyncBound, withAsyncOn
+  , withAsyncWithUnmask, withAsyncOnWithUnmask
+
+    -- ** Quering 'Async's
+  , wait, poll, waitCatch
+  , cancel
+  , uninterruptibleCancel
+  , cancelWith
+  , A.asyncThreadId
+  , A.AsyncCancelled(..)
+
+    -- ** STM operations
+  , A.waitSTM, A.pollSTM, A.waitCatchSTM
+
+    -- ** Waiting for multiple 'Async's
+  , waitAny, waitAnyCatch, waitAnyCancel, waitAnyCatchCancel
+  , waitEither, waitEitherCatch, waitEitherCancel, waitEitherCatchCancel
+  , waitEither_
+  , waitBoth
+
+    -- ** Waiting for multiple 'Async's in STM
+  , A.waitAnySTM
+  , A.waitAnyCatchSTM
+  , A.waitEitherSTM
+  , A.waitEitherCatchSTM
+  , A.waitEitherSTM_
+  , A.waitBothSTM
+
+    -- ** Linking
+  , Unsafe.link, Unsafe.link2
+  , A.ExceptionInLinkedThread(..)
+
+    -- * Convenient utilities
+  , race, race_, concurrently, concurrently_
+  , mapConcurrently, mapConcurrently_
+  , forConcurrently, forConcurrently_
+  , replicateConcurrently, replicateConcurrently_
+  , Concurrently(..)
+
+  , A.compareAsyncs
+  )
+  where
+
+import Control.Applicative
+import Control.Concurrent (threadDelay)
+import Control.Monad
+import Data.Foldable (fold)
+
+import Control.Concurrent.Async (Async)
+import Control.Exception.Lifted (SomeException, Exception)
+import Control.Monad.Base (MonadBase(..))
+import Control.Monad.Trans.Control hiding (restoreM)
+import Data.Constraint ((\\), (:-))
+import Data.Constraint.Forall (Forall, inst)
+import qualified Control.Concurrent.Async as A
+
+import qualified Control.Concurrent.Async.Lifted as Unsafe
+
+#if !MIN_VERSION_base(4, 11, 0)
+import Data.Semigroup (Semigroup((<>)))
+#endif
+
+-- | Generalized version of 'A.async'.
+async
+  :: forall m a. (MonadBaseControl IO m, Forall (Pure m))
+  => m a -> m (Async a)
+async = Unsafe.async
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.asyncBound'.
+asyncBound
+  :: forall m a. (MonadBaseControl IO m, Forall (Pure m))
+  => m a -> m (Async a)
+asyncBound = Unsafe.asyncBound
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.asyncOn'.
+asyncOn
+  :: forall m a. (MonadBaseControl IO m, Forall (Pure m))
+  => Int -> m a -> m (Async a)
+asyncOn cpu m = Unsafe.asyncOn cpu m
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.asyncWithUnmask'.
+asyncWithUnmask
+  :: forall m a. (MonadBaseControl IO m, Forall (Pure m))
+  => ((forall b. m b -> m b) -> m a)
+  -> m (Async a)
+asyncWithUnmask restore = Unsafe.asyncWithUnmask restore
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.asyncOnWithUnmask'.
+asyncOnWithUnmask
+  :: forall m a. (MonadBaseControl IO m, Forall (Pure m))
+  => Int
+  -> ((forall b. m b -> m b) -> m a)
+  -> m (Async a)
+asyncOnWithUnmask cpu restore = Unsafe.asyncOnWithUnmask cpu restore
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.withAsync'.
+withAsync
+  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
+  => m a
+  -> (Async a -> m b)
+  -> m b
+withAsync = Unsafe.withAsync
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.withAsyncBound'.
+withAsyncBound
+  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
+  => m a
+  -> (Async a -> m b)
+  -> m b
+withAsyncBound = Unsafe.withAsyncBound
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.withAsyncOn'.
+withAsyncOn
+  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
+  => Int
+  -> m a
+  -> (Async a -> m b)
+  -> m b
+withAsyncOn = Unsafe.withAsyncOn
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.withAsyncWithUnmask'.
+withAsyncWithUnmask
+  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
+  => ((forall c. m c -> m c) -> m a)
+  -> (Async a -> m b)
+  -> m b
+withAsyncWithUnmask restore = Unsafe.withAsyncWithUnmask restore
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.withAsyncOnWithUnmask'.
+withAsyncOnWithUnmask
+  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
+  => Int
+  -> ((forall c. m c -> m c) -> m a)
+  -> (Async a -> m b)
+  -> m b
+withAsyncOnWithUnmask cpu restore = Unsafe.withAsyncOnWithUnmask cpu restore
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.wait'.
+wait
+  :: forall m a. (MonadBase IO m, Forall (Pure m))
+  => Async a -> m a
+wait = liftBase . A.wait
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.poll'.
+poll
+  :: forall m a. (MonadBase IO m, Forall (Pure m))
+  => Async a
+  -> m (Maybe (Either SomeException a))
+poll = liftBase . A.poll
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.waitCatch'.
+waitCatch
+  :: forall m a. (MonadBase IO m, Forall (Pure m))
+  => Async a
+  -> m (Either SomeException a)
+waitCatch = liftBase . A.waitCatch
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.cancel'.
+cancel :: MonadBase IO m => Async a -> m ()
+cancel = Unsafe.cancel
+
+-- | Generalized version of 'A.cancelWith'.
+cancelWith :: (MonadBase IO m, Exception e) => Async a -> e -> m ()
+cancelWith = Unsafe.cancelWith
+
+-- | Generalized version of 'A.uninterruptibleCancel'.
+uninterruptibleCancel :: MonadBase IO m => Async a -> m ()
+uninterruptibleCancel = Unsafe.uninterruptibleCancel
+
+-- | Generalized version of 'A.waitAny'.
+waitAny
+  :: forall m a. (MonadBase IO m, Forall (Pure m))
+  => [Async a] -> m (Async a, a)
+waitAny = liftBase . A.waitAny
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.waitAnyCatch'.
+waitAnyCatch
+  :: forall m a. (MonadBase IO m, Forall (Pure m))
+  => [Async a]
+  -> m (Async a, Either SomeException a)
+waitAnyCatch = liftBase . A.waitAnyCatch
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.waitAnyCancel'.
+waitAnyCancel
+  :: forall m a. (MonadBase IO m, Forall (Pure m))
+  => [Async a]
+  -> m (Async a, a)
+waitAnyCancel = liftBase . A.waitAnyCancel
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.waitAnyCatchCancel'.
+waitAnyCatchCancel
+  :: forall m a. (MonadBase IO m, Forall (Pure m))
+  => [Async a]
+  -> m (Async a, Either SomeException a)
+waitAnyCatchCancel = liftBase . A.waitAnyCatchCancel
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+
+-- | Generalized version of 'A.waitEither'.
+waitEither
+  :: forall m a b. (MonadBase IO m, Forall (Pure m))
+  => Async a
+  -> Async b
+  -> m (Either a b)
+waitEither = (liftBase .) . A.waitEither
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+  \\ (inst :: Forall (Pure m) :- Pure m b)
+
+-- | Generalized version of 'A.waitEitherCatch'.
+waitEitherCatch
+  :: forall m a b. (MonadBase IO m, Forall (Pure m))
+  => Async a
+  -> Async b
+  -> m (Either (Either SomeException a) (Either SomeException b))
+waitEitherCatch = (liftBase .) . A.waitEitherCatch
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+  \\ (inst :: Forall (Pure m) :- Pure m b)
+
+-- | Generalized version of 'A.waitEitherCancel'.
+waitEitherCancel
+  :: forall m a b. (MonadBase IO m, Forall (Pure m))
+  => Async a
+  -> Async b
+  -> m (Either a b)
+waitEitherCancel = (liftBase .) . A.waitEitherCancel
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+  \\ (inst :: Forall (Pure m) :- Pure m b)
+
+-- | Generalized version of 'A.waitEitherCatchCancel'.
+waitEitherCatchCancel
+  :: forall m a b. (MonadBase IO m, Forall (Pure m))
+  => Async a
+  -> Async b
+  -> m (Either (Either SomeException a) (Either SomeException b))
+waitEitherCatchCancel = (liftBase .) . A.waitEitherCatchCancel
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+  \\ (inst :: Forall (Pure m) :- Pure m b)
+
+-- | Generalized version of 'A.waitEither_'
+waitEither_ :: MonadBase IO m => Async a -> Async b -> m ()
+waitEither_ = Unsafe.waitEither_
+
+-- | Generalized version of 'A.waitBoth'.
+waitBoth
+  :: forall m a b. (MonadBase IO m, Forall (Pure m))
+  => Async a
+  -> Async b
+  -> m (a, b)
+waitBoth = (liftBase .) . A.waitBoth
+  \\ (inst :: Forall (Pure m) :- Pure m a)
+  \\ (inst :: Forall (Pure m) :- Pure m b)
+
+-- | Generalized version of 'A.race'.
+race
+  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
+  => m a -> m b -> m (Either a b)
+race = liftBaseOp2_ A.race
+
+-- | Generalized version of 'A.race_'.
+race_
+  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
+  => m a -> m b -> m ()
+race_ = liftBaseOp2_ A.race_
+
+-- | Generalized version of 'A.concurrently'.
+concurrently
+  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
+  => m a -> m b -> m (a, b)
+concurrently = liftBaseOp2_ A.concurrently
+
+-- | Generalized version of 'A.concurrently_'.
+concurrently_
+  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
+  => m a -> m b -> m ()
+concurrently_ = liftBaseOp2_ A.concurrently_
+
+-- | Similar to 'A.liftBaseOp_' but takes a binary function
+-- and leverages @'StM' m a ~ a@.
+liftBaseOp2_
+  :: forall base m a b c. (MonadBaseControl base m, Forall (Pure m))
+  => (base a -> base b -> base c)
+  -> m a -> m b -> m c
+liftBaseOp2_ f left right = liftBaseWith $ \run -> f
+  (run left \\ (inst :: Forall (Pure m) :- Pure m a))
+  (run right \\ (inst :: Forall (Pure m) :- Pure m b))
+
+-- | Generalized version of 'A.mapConcurrently'.
+mapConcurrently
+  :: (Traversable t, MonadBaseControl IO m, Forall (Pure m))
+  => (a -> m b)
+  -> t a
+  -> m (t b)
+mapConcurrently f = runConcurrently . traverse (Concurrently . f)
+
+-- | Generalized version of 'A.mapConcurrently_'.
+mapConcurrently_
+  :: (Foldable t, MonadBaseControl IO m, Forall (Pure m))
+  => (a -> m b)
+  -> t a
+  -> m ()
+mapConcurrently_ f = runConcurrently . foldMap (Concurrently . void . f)
+
+-- | Generalized version of 'A.forConcurrently'.
+forConcurrently
+  :: (Traversable t, MonadBaseControl IO m, Forall (Pure m))
+  => t a
+  -> (a -> m b)
+  -> m (t b)
+forConcurrently = flip mapConcurrently
+
+-- | Generalized version of 'A.forConcurrently_'.
+forConcurrently_
+  :: (Foldable t, MonadBaseControl IO m, Forall (Pure m))
+  => t a
+  -> (a -> m b)
+  -> m ()
+forConcurrently_ = flip mapConcurrently_
+
+-- | Generalized version of 'A.replicateConcurrently'.
+replicateConcurrently
+  :: (MonadBaseControl IO m, Forall (Pure m))
+  => Int
+  -> m a
+  -> m [a]
+replicateConcurrently n =
+  runConcurrently . sequenceA . replicate n . Concurrently
+
+-- | Generalized version of 'A.replicateConcurrently_'.
+replicateConcurrently_
+  :: (MonadBaseControl IO m, Forall (Pure m))
+  => Int
+  -> m a
+  -> m ()
+replicateConcurrently_ n =
+  runConcurrently . fold . replicate n . Concurrently . void
+
+-- | Generalized version of 'A.Concurrently'.
+--
+-- A value of type @'Concurrently' m a@ is an IO-based operation that can be
+-- composed with other 'Concurrently' values, using the 'Applicative' and
+-- 'Alternative' instances.
+--
+-- Calling 'runConcurrently' on a value of type @'Concurrently' m a@ will
+-- execute the IO-based lifted operations it contains concurrently, before
+-- delivering the result of type 'a'.
+--
+-- For example
+--
+-- @
+--   (page1, page2, page3) <- 'runConcurrently' $ (,,)
+--     '<$>' 'Concurrently' (getURL "url1")
+--     '<*>' 'Concurrently' (getURL "url2")
+--     '<*>' 'Concurrently' (getURL "url3")
+-- @
+data Concurrently m a where
+  Concurrently
+    :: Forall (Pure m) => { runConcurrently :: m a } -> Concurrently m a
+
+-- | Most of the functions in this module have @'Forall' ('Pure' m)@ in their
+-- constraints, which means they require the monad 'm' satisfies
+-- @'StM' m a ~ a@ for all 'a'.
+class StM m a ~ a => Pure m a
+instance StM m a ~ a => Pure m a
+
+instance Functor m => Functor (Concurrently m) where
+  fmap f (Concurrently a) = Concurrently $ f <$> a
+
+instance (MonadBaseControl IO m, Forall (Pure m)) =>
+  Applicative (Concurrently m) where
+    pure = Concurrently . pure
+    Concurrently (fs :: m (a -> b)) <*> Concurrently as =
+      Concurrently (uncurry ($) <$> concurrently fs as)
+        \\ (inst :: Forall (Pure m) :- Pure m a)
+        \\ (inst :: Forall (Pure m) :- Pure m (a -> b))
+
+instance (MonadBaseControl IO m, Forall (Pure m)) =>
+  Alternative (Concurrently m) where
+    empty = Concurrently $ liftBaseWith $ \_ -> forever $ threadDelay maxBound
+    Concurrently (as :: m a) <|> Concurrently bs =
+      Concurrently (either id id <$> race as bs)
+        \\ (inst :: Forall (Pure m) :- Pure m a)
+        \\ (inst :: Forall (Pure m) :- Pure m b)
+
+instance (MonadBaseControl IO m, Semigroup a, Forall (Pure m)) =>
+  Semigroup (Concurrently m a) where
+    (<>) = liftA2 (<>)
+
+instance (MonadBaseControl IO m, Semigroup a, Monoid a, Forall (Pure m)) =>
+  Monoid (Concurrently m a) where
+    mempty = pure mempty
+    mappend = (<>)
diff --git a/tests/Test/Async/Common.hs b/tests/Test/Async/Common.hs
--- a/tests/Test/Async/Common.hs
+++ b/tests/Test/Async/Common.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 module Test.Async.Common
   ( value
@@ -6,19 +5,15 @@
   , module X
   ) where
 
-import Data.Typeable
-
 import Control.Exception.Lifted
 import Test.Tasty as X
 import Test.Tasty.HUnit as X
 import Test.Tasty.TH as X
 
-import Control.Concurrent.Async.Lifted as X
-
 value :: Int
 value = 42
 
 data TestException = TestException
-  deriving (Eq, Show, Typeable)
+  deriving (Eq, Show)
 
 instance Exception TestException
diff --git a/tests/Test/Async/IO.hs b/tests/Test/Async/IO.hs
--- a/tests/Test/Async/IO.hs
+++ b/tests/Test/Async/IO.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Test.Async.IO
   ( ioTestGroup
@@ -8,6 +9,7 @@
 import Control.Concurrent.Lifted
 import Control.Exception.Lifted as E
 
+import Control.Concurrent.Async.Lifted.Safe
 import Test.Async.Common
 
 ioTestGroup :: TestTree
@@ -53,7 +55,7 @@
   a <- withAsync (threadDelay 1000000) $ return
   r <- waitCatch a
   case r of
-    Left e  -> fromException e @?= Just ThreadKilled
+    Left e  -> fromException e @?= Just AsyncCancelled
     Right _ -> assertFailure ""
 
 case_async_cancel :: Assertion
diff --git a/tests/Test/Async/Reader.hs b/tests/Test/Async/Reader.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/Async/Reader.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Test.Async.Reader
+  ( readerTestGroup
+  ) where
+import Control.Monad (void, when)
+import Control.Monad.Reader (runReaderT, liftIO)
+import Data.Maybe (isJust, isNothing)
+
+import Control.Concurrent.Lifted
+import Control.Exception.Lifted as E
+import Test.Tasty.ExpectedFailure
+
+import Control.Concurrent.Async.Lifted.Safe
+import Test.Async.Common
+
+readerTestGroup :: TestTree
+readerTestGroup = $(testGroupGenerator)
+
+case_async_waitCatch :: Assertion
+case_async_waitCatch = do
+  r <- flip runReaderT value $ do
+    a <- async $ return value
+    waitCatch a
+  case r of
+    Left _  -> assertFailure "An exception must not be raised."
+    Right e -> do
+      e @?= value
+
+case_async_wait :: Assertion
+case_async_wait = do
+  r <- flip runReaderT value $ do
+    a <- async $ return value
+    wait a
+  r @?= value
+
+case_async_exwaitCatch :: Assertion
+case_async_exwaitCatch = do
+  r <- flip runReaderT value $ do
+    a <- async $ throwIO TestException
+    waitCatch a
+  case r of
+    Left e ->
+      fromException e @?= Just TestException
+    Right _ -> assertFailure "An exception must be raised."
+
+case_async_exwait :: Assertion
+case_async_exwait =
+  void $ flip runReaderT value $ do
+    a <- async $ throwIO TestException
+    (wait a >> liftIO (assertFailure "An exception must be raised"))
+      `E.catch` \e ->
+        liftIO $ e @?= TestException
+
+case_withAsync_waitCatch :: Assertion
+case_withAsync_waitCatch =
+  void $ flip runReaderT value $ do
+    withAsync (return value) $ \a -> do
+      r <- waitCatch a
+      case r of
+        Left _  -> liftIO $ assertFailure "An exception must not be raised."
+        Right e -> do
+          liftIO $ e @?= value
+
+case_withAsync_wait2 :: Assertion
+case_withAsync_wait2 = do
+  r <- flip runReaderT value $ do
+    a <- withAsync (threadDelay 1000000) $ return
+    waitCatch a
+  case r of
+    Left e  -> do
+      fromException e @?= Just AsyncCancelled
+    Right _ -> assertFailure "An exception must be raised."
+
+case_async_cancel :: Assertion
+case_async_cancel = sequence_ $ replicate 1000 run
+  where
+    run = do
+      r <- flip runReaderT value $ do
+        a <- async $ return value
+        cancelWith a TestException
+        waitCatch a
+      case r of
+        Left e ->
+          fromException e @?= Just TestException
+        Right r' ->
+          r' @?= value
+
+case_async_poll :: Assertion
+case_async_poll =
+  void $ flip runReaderT value $ do
+    a <- async (threadDelay 1000000)
+    r <- poll a
+    when (isJust r) $
+      liftIO $ assertFailure "The result must be nothing."
+    r' <- poll a   -- poll twice, just to check we don't deadlock
+    when (isJust r') $
+      liftIO $ assertFailure "The result must be Nothing."
+
+case_async_poll2 :: Assertion
+case_async_poll2 =
+  void $ flip runReaderT value $ do
+    a <- async (return value)
+    void $ wait a
+    r <- poll a
+    when (isNothing r) $
+      liftIO $ assertFailure "The result must not be Nothing."
+    r' <- poll a   -- poll twice, just to check we don't deadlock
+    when (isNothing r') $
+      liftIO $ assertFailure "The result must not be Nothing."
+
+test_ignored :: [TestTree]
+test_ignored =
+  [ ignoreTestBecause "see #26" $ testCase "link" $ do
+    r <- try $ flip runReaderT value $ do
+      a <- async $ threadDelay 1000000 >> return value
+      link a
+      cancelWith a TestException
+      wait a
+    case r of
+      Left e -> case fromException e of
+        Just (ExceptionInLinkedThread _ e') ->
+          fromException e' @?= Just TestException
+        Nothing -> assertFailure $
+          "expected ExceptionInLinkedThread _ TestException"
+            ++ " but got " ++ show e
+      Right _ -> assertFailure "An exception must be raised."
+  ]
diff --git a/tests/Test/Async/State.hs b/tests/Test/Async/State.hs
--- a/tests/Test/Async/State.hs
+++ b/tests/Test/Async/State.hs
@@ -2,12 +2,15 @@
 module Test.Async.State
   ( stateTestGroup
   ) where
-import Control.Monad.State
+import Control.Monad (void, when)
+import Control.Monad.State (runStateT, get, modify, liftIO)
 import Data.Maybe (isJust, isNothing)
 
 import Control.Concurrent.Lifted
 import Control.Exception.Lifted as E
+import Test.Tasty.ExpectedFailure
 
+import Control.Concurrent.Async.Lifted
 import Test.Async.Common
 
 stateTestGroup :: TestTree
@@ -72,7 +75,7 @@
     waitCatch a
   case r of
     Left e  -> do
-      fromException e @?= Just ThreadKilled
+      fromException e @?= Just AsyncCancelled
       s @?= value
     Right _ -> assertFailure "An exception must be raised."
 
@@ -115,12 +118,19 @@
     when (isNothing r') $
       liftIO $ assertFailure "The result must not be Nothing."
 
+case_withAsync_waitEither :: Assertion
+case_withAsync_waitEither = do
+  (_, s) <- flip runStateT value $ do
+    withAsync (modify (+1)) $ \a ->
+      waitEither a a
+  liftIO $ s @?= value + 1
+
 case_withAsync_waitEither_ :: Assertion
 case_withAsync_waitEither_ = do
   ((), s) <- flip runStateT value $ do
     withAsync (modify (+1)) $ \a ->
       waitEither_ a a
-  liftIO $ s @?= value + 1
+  liftIO $ s @?= value
 
 case_withAsync_waitBoth1 :: Assertion
 case_withAsync_waitBoth1 = do
@@ -138,14 +148,20 @@
         waitBoth a b
   liftIO $ s @?= value
 
-case_link :: Assertion
-case_link = do
-  r <- try $ flip runStateT value $ do
-    a <- async $ threadDelay 1000000 >> return value
-    link a
-    cancelWith a TestException
-    wait a
-  case r of
-    Left e -> do
-      fromException e @?= Just TestException
-    Right _ -> assertFailure "An exception must be raised."
+test_ignored :: [TestTree]
+test_ignored =
+  [ ignoreTestBecause "see #26" $ testCase "link" $ do
+    r <- try $ flip runStateT value $ do
+      a <- async $ threadDelay 1000000 >> return value
+      link a
+      cancelWith a TestException
+      wait a
+    case r of
+      Left e -> case fromException e of
+        Just (ExceptionInLinkedThread _ e') ->
+          fromException e' @?= Just TestException
+        Nothing -> assertFailure $
+          "expected ExceptionInLinkedThread _ TestException"
+            ++ " but got " ++ show e
+      Right _ -> assertFailure "An exception must be raised."
+  ]
diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs
--- a/tests/TestSuite.hs
+++ b/tests/TestSuite.hs
@@ -1,12 +1,14 @@
-{-# LANGUAGE ScopedTypeVariables,DeriveDataTypeable #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Main where
 import Test.Tasty (defaultMain, testGroup)
 
 import Test.Async.IO
 import Test.Async.State
+import Test.Async.Reader
 
 main :: IO ()
 main = defaultMain $ testGroup "lifted-async test suite"
   [ ioTestGroup
   , stateTestGroup
+  , readerTestGroup
   ]