Tengo problemas con Haskell bracket: cuando se ejecuta dentro de un hilo bifurcado (usando forkFinally) bracketel segundo argumento, el cálculo que libera recursos no se ejecuta cuando finaliza el programa.

Aquí hay un código que ilustra el problema (soy consciente de que en este caso específico podría deshabilitar el almacenamiento en búfer para escribir en el archivo de inmediato):

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

El cálculo que libera recursos (y escribe en la consola) nunca se llama:

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

Al hacer que el programa maintenga un solo subproceso al eliminar el código de bifurcación, se elimina el problema y el identificador de archivo se cierra al finalizar el programa con Ctrl+ c:

main = writeToFile "first_file"

¿Cómo me aseguro de que el código de liberación de recursos bracketse ejecute al usar varios subprocesos?

utilizando throwTo

Aparentemente, el hilo creado con forkFinallynunca recibe una excepción y, por lo tanto, el código de liberación de recursos debracket nunca se ejecuta.

Podemos arreglar esto haciendo esto manualmente usando 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!"

La causa raíz del problema aquí es que cuando main sale, su proceso simplemente muere. No espera en ningún otro hilo que hayas creado para terminar. Entonces, en su código original, creó un hilo para escribir en el archivo, pero no se le permitió terminar.

Si quieres matar el hilo pero obligarlo a que se limpie, úsalo throwTocomo lo hiciste aquí. Si desea que el hilo termine, deberá esperar antes de que mainvuelva. Vea Cómo obligar al hilo principal a esperar a que todos sus hilos secundarios terminen en Haskell

utilizando async

Hacer getLinebloquear el hilo principal indefinidamente no funciona bien con nohup: fallará con

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

Como alternativa a getLiney throwTo, puede usar asynclas funciones de :

import           Control.Concurrent.Async       ( withAsync, wait )

main = withAsync (writeToFile "first_file") wait

Esto permite ejecutar el programa con nohup ./theProgram-exe &¹, por ejemplo en un servidor a través de SSH .

async También brilla cuando se ejecutan varias tareas simultáneamente:

import           Control.Concurrent.Async       ( race_ )

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

La función race_ejecuta dos tareas simultáneamente y espera hasta que llegue el primer resultado. Con nuestra finalización writeToFileno habrá un resultado regular, pero si una de las tareas arroja una excepción, la otra también se cancelará. Esto es útil para ejecutar un servidor HTTP y un servidor HTTPS simultáneamente, por ejemplo.

Para cerrar el programa limpiamente, dando a los hilos la oportunidad de liberar recursos bracket, le envío la señal SIGINT :

pkill --signal SIGINT theProgram-exe

Manejo de SIGTERM

Para finalizar también los subprocesos con gracia en un SIGTERM , podemos instalar un controlador que captará la señal:

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 excepion to the forked thread, allowing
    -- it to release resources via bracket
    cancel asy
  )
  Nothing

Ahora, nuestro programa lanzará sus recursos bracketcuando reciba SIGTERM:

pkill theProgram-exe

Aquí está el equivalente para dos tareas concurrentes que admiten 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

Para más información sobre el tema de Haskell asíncrono, eche un vistazo a la programación paralela y concurrente en Haskell por Simon Marlow.

¹ _{Llame stack buildpara obtener un ejecutable en, por ejemplo,.stack-work/dist/x86_64-linux-tinfo6/Cabal-2.4.0.1/build/theProgram-exe/theProgram-exe}