Skip to content

Instantly share code, notes, and snippets.

@np
Created February 15, 2018 10:45
Show Gist options
  • Save np/5d99a1a33b4bf9704c2de8ea2d22c1fa to your computer and use it in GitHub Desktop.
Save np/5d99a1a33b4bf9704c2de8ea2d22c1fa to your computer and use it in GitHub Desktop.
Cleaning Async resources upon cancel
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception
main :: IO ()
main = do
let f = 1000000
v <- newMVar ()
let debug = withMVar v . const . putStrLn
a <- recProc debug (replicate 10 (3 * f))
debug "Waiting main"
threadDelay f
debug "Canceling main"
cancel a
debug "Finishing main"
where
recProc :: (String -> IO ()) -> [Int] -> IO (Async ())
recProc _ [] = async (return ())
recProc debug (n:ns) = do
let l = show $ length ns
debug $ "Spawning " ++ l
async $ do
debug $ "Spawned " ++ l
a <- recProc debug ns
debug $ "Waiting " ++ l
threadDelay n `catch` \(_ :: SomeException) -> do
debug $ "Canceling " ++ l
cancel a
debug $ "Finishing " ++ l
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment