async-strange-race.hs

#!/usr/bin/env stack
{- stack
  script
  --resolver lts-9.1
  --package base
  --package async
-}

import Control.Exception
import Control.Concurrent
import Control.Concurrent.Async

race0 left right =
  withAsync left $ \a ->
  withAsync right $ \b ->
  waitEither a b

main :: IO ()
main = () <$ bracket acquire release action
  where
    sleepForever = threadDelay 100500100500
    acquire = putStrLn "acquire main"
    release _ = putStrLn "release main"
    action _ = race0 a b
    a = sleepForever
    b = bracket acquireB releaseB (const sleepForever)
    acquireB = putStrLn "acquire B"
    releaseB _ = putStrLn "release B" >> threadDelay 1000000