bracket doesn't release resource when inside thread

Question

I'm having trouble with Haskell's bracket: When being run inside a forked thread (using forkFinally) bracket's second argument, the computation that releases resources is not run when the program ends.

Here's code illustrating the issue (I'm aware that in this specific case I could disable buffering to write to the file immediately):

import           System.IO
import           Control.Exception              ( bracket
                                                , throwTo
                                                )

import           Control.Concurrent             ( forkFinally
                                                , threadDelay
                                                )
main = do
  threadId <- forkFinally
    (writeToFile "first_file")
    (\ex -> putStrLn $ "Exception occurred: " ++ show ex)
  putStrLn "Press enter to exit"
  _ <- getLine
  putStrLn "Bye!"

writeToFile :: FilePath -> IO ()
writeToFile file = bracket
  (openFile file AppendMode)
  (\fileHandle -> do
    putStrLn $ "\nClosing handle " ++ show fileHandle
    hClose fileHandle
  )
  (\fileHandle -> mapM_ (addNrAndWait fileHandle) [1 ..])

addNrAndWait :: Handle -> Int -> IO ()
addNrAndWait fileHandle nr =
  let nrStr = show nr
  in  do
        putStrLn $ "Appending " ++ nrStr
        hPutStrLn fileHandle nrStr
        threadDelay 1000000

The computation that releases resources (and writes to the console) is never called:

putStrLn $ "\nClosing handle " ++ show fileHandle
hClose fileHandle

Making the program single threaded by removing the forking code from main gets rid of the issue and the file handle is closed when ending the program with Ctrl + c:

main = writeToFile "first_file"

How do I ensure that the resource-releasing code in bracket is executed when using multiple threads?

Answer 1

using throwTo

Apparently the thread created with forkFinally never gets an exception thrown at and thus the resource-releasing code of bracket never gets executed.

We can fix this by doing this manually using throwTo threadId ThreadKilled:

import           Control.Exception              ( bracket
                                                , throwTo
                                                , AsyncException(ThreadKilled)
                                                )

import           Control.Concurrent             ( forkFinally
                                                , threadDelay
                                                )
main = do
  threadId <- forkFinally
    (writeToFile "first_file")
    (\ex -> putStrLn $ "Exception occurred: " ++ show ex)
  putStrLn "Press enter to exit"
  _ <- getLine
  throwTo threadId ThreadKilled
  putStrLn "Bye!"

Answer 2

The root cause of the problem here is that when main exits, your process just dies. It doesn't wait on any other threads that you've created to finish. So in your original code, you created a thread to write to the file, but it was not allowed to finish.

If you want to kill the thread but force it to clean up, then use throwTo as you did here. If you want the thread to finish, you'll need to wait for that before main returns. See How to force main thread to wait for all its child threads finish in Haskell