Canceling an Async thread from within the thread itself

Question

Is there a way to use cancel from within a thread invoked with async from the async package? I can see that you can cancel it from outside the thread, but I'm wondering if there could be a cancelSelf :: IO () function which stops its own execution. I could staple something together with unique id generation and a shared Map of Async thread references, which the thread itself could reference, but that just seems too much. Could I get away with an uncaught exception or something?

Answer 1

An async action can cancel itself. It involves a bit of a trick, though.

{-# LANGUAGE RecursiveDo #-}

import Control.Concurrent.Async

main :: IO ()
main = do
    rec let doCancel = cancel calculate
        calculate <- async doCancel
    wait calculate

In theory, you can do that without RecursiveDo, but I've never wanted to write an mfix expression (what RecursiveDo bindings desugar to) by hand.

RecursiveDo allows you to create a mutually-recursive set of definitions inside a do block, even if some of the definitions are bound with <- and some are defined inside a let statement. As always, if there is a real circularity involved, the calculation will diverge. But there are lots of cases where all you want to do is be able to refer to the name of something else like the example above, and RecursiveDo works just fine.

Oh, and the implementation of mfix for IO is terrifying. I'm glad I didn't have to write it myself.

-- Edit --

Since this has received almost no feedback, I've realized it's not completely obvious how to use this in order to solve your problem. So here's an expanded example that uses a combinator to spawn an Async that can cancel itself:

{-# LANGUAGE RecursiveDo #-}

-- obviously want the async library
import Control.Concurrent.Async

-- used in selfCancelableAsync
import Control.Monad      (forever)
import Control.Concurrent (threadDelay)

-- only used for demonstration
import System.Random      (randomIO)

main :: IO ()
main = do
    a <- selfCancelableAsync $ \selfCancel -> do
        choice <- randomIO
        if choice then return "Success!" else selfCancel
    result <- wait a
    putStrLn result

-- spawns an Async that has the ability to cancel itself by
-- using the action passed to the IO action it's running
selfCancelableAsync :: (IO a -> IO b) -> IO (Async b)
selfCancelableAsync withCancel = do
    rec let doCancel = do
                cancel calculate
                -- This must never return to ensure it has the correct type.
                -- It uses threadDelay to ensure it's not hogging resources
                -- if it takes a moment to get killed.
                forever $ threadDelay 1000

        calculate <- async $ withCancel doCancel

    return calculate