bracket doesn't release resource when inside thread

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!"

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

using async

Making getLine block the main thread indefinitely doesn't play nice with nohup: It will fail with

<stdin>: hGetLine: invalid argument (Bad file descriptor)

As an alternative to getLine and throwTo, you can use async's functions:

import           Control.Concurrent.Async       ( withAsync, wait )

main = withAsync (writeToFile "first_file") wait

This enables running the program with nohup ./theProgram-exe &¹, for example on a server via SSH.

async also shines when running multiple tasks concurrently:

import           Control.Concurrent.Async       ( race_ )

main = race_ (writeToFile "first_file") (writeToFile "second_file")

The function race_ runs two tasks concurrently and waits until the first result arrives. With our non-terminating writeToFile there won't ever be a regular result, but if one of the tasks throws an exception, the other will be cancelled too. This is useful for running an HTTP and an HTTPS server simultaneously, for example.

To shut down the program cleanly — giving threads a chance to free resources in bracket — I send it the SIGINT signal:

pkill --signal SIGINT theProgram-exe

Handling SIGTERM

To also end threads gracefully on a SIGTERM, we can install a handler that will catch the signal:

import           Control.Concurrent.Async       ( withAsync
                                                , wait
                                                , cancel
                                                , Async
                                                )
import           System.Posix.Signals

main = withAsync
  (writeToFile "first_file")
  (\asy -> do
    cancelOnSigTerm asy
    wait asy
  )

cancelOnSigTerm :: Async a -> IO Handler
cancelOnSigTerm asy = installHandler
  sigTERM
  (Catch $ do
    putStrLn "Caught SIGTERM"
    -- Throws an AsyncCancelled exception to the forked thread, allowing
    -- it to release resources via bracket
    cancel asy
  )
  Nothing

Now, our program will release its resources in bracket when receiving SIGTERM:

pkill theProgram-exe

Here's the equivalent for two concurrent tasks supporting SIGTERM:

import           Control.Concurrent.Async       ( withAsync
                                                , wait
                                                , cancel
                                                , Async
                                                , waitEither_
                                                )
import           System.Posix.Signals

main = raceWith_ cancelOnSigTerm
                 (writeToFile "first_file")
                 (writeToFile "second_file")

raceWith_ :: (Async a -> IO b) -> IO a -> IO a -> IO ()
raceWith_ f left right = withAsync left $ \a -> withAsync right $ \b -> do
  f a
  f b
  waitEither_ a b

For more on the topic of asynchronous Haskell, have a peek at Parallel and Concurrent Programming in Haskell by Simon Marlow.

---

¹_{Call stack build to get an executable at, for example, .stack-work/dist/x86_64-linux-tinfo6/Cabal-2.4.0.1/build/theProgram-exe/theProgram-exe. You can get the path of this directory with stack path --local-install-root.}