Elegant egress from `Async` actions - haskell

Question

Is there a simple way of cancelling an Async a value, such that it won't be interrupted in the middle of some critical action? I suppose I could use a semaphore inside a loop condition.
async $ whileM readSemaphore runLoopBody
But I'd like to know whether async or some other related library supports it out-of-the-box.
My code, as requested.
-- |
-- TODO | - Rename (?)
-- - Time-out
awaitResult :: String -> IO a -> IO a
awaitResult s act = do
putStr s
sem <- newMVar True
a <- async $ ellipsis sem
r <- act
swapMVar sem False
return r
where
ellipsis :: MVar Bool -> IO ()
ellipsis sem = void $ do
whileM (readMVar sem) $ forM [". ", ".. ", "...", " "] $ \dots -> do
putStr dots
cursorBackward 3
threadDelay (floor $ 0.4 * second)
-- TODO | - If the Windows console wasn't shit, I'd use a checkmark
putStr " (" >> withPretty fgGreen "done" >> putStrLn ")"

Answer 1

The phrasing of the question made me think of a more antagonistic relationship, in which case using Control.Concurrent.mask to limit when the task can be interrupted should be reasonable.
Based on the updated code it seems the threads have a tight coupling and the first alternative I can think of would be spawning the action instead of the indicator and using poll, which I think is less noisy than the MVar route:
import Control.Monad (forM_)
import Control.Exception (throw)
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (Async,async,poll)
second :: (Num a) => a
second = 1000000
awaitResult :: String -> IO a -> IO a
awaitResult s act = do
putStrLn s
a <- async $ act
ellipsis a
where
ellipsis :: Async a -> IO a
ellipsis a = do
result <- poll a
case result of
Nothing -> do
forM_ [". ",".. ","..."," "] $ \dots -> do
putStr dots
putStr "\r"
threadDelay $ floor $ 0.4 * second
ellipsis a
Just (Left e) -> throw e
Just (Right x) -> return x
main = awaitResult "testing" (threadDelay (5 * second) >> return 5)