Tôi gặp rắc rối với Haskell bracket: Khi được chạy bên trong một đối số thứ hai (sử dụng forkFinally) bracketđối số thứ hai, tính toán giải phóng tài nguyên không chạy khi chương trình kết thúc.

Đây là mã minh họa vấn đề (Tôi biết rằng trong trường hợp cụ thể này, tôi có thể vô hiệu hóa bộ đệm để ghi vào tệp ngay lập tức):

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

Tính toán giải phóng tài nguyên (và ghi vào bàn điều khiển) không bao giờ được gọi là:

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

Làm cho chương trình đơn luồng bằng cách loại bỏ mã forking mainkhỏi vấn đề và xử lý tệp bị đóng khi kết thúc chương trình với Ctrl+ c:

main = writeToFile "first_file"

Làm thế nào để tôi đảm bảo rằng mã giải phóng tài nguyên bracketđược thực thi khi sử dụng nhiều luồng?

sử dụng throwTo

Rõ ràng luồng được tạo ra forkFinallykhông bao giờ bị ngoại lệ ném vào và do đó mã giải phóng tài nguyên bracketkhông bao giờ được thực thi.

Chúng tôi có thể khắc phục điều này bằng cách thực hiện thủ công bằng cách sử dụng 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!"

Nguyên nhân sâu xa của vấn đề ở đây là khi mainthoát ra, quá trình của bạn chỉ chết. Nó không chờ đợi trên bất kỳ chủ đề khác mà bạn đã tạo để hoàn thành. Vì vậy, trong mã gốc của bạn, bạn đã tạo một luồng để ghi vào tệp, nhưng nó không được phép kết thúc.

Nếu bạn muốn giết luồng nhưng buộc nó phải dọn sạch, thì hãy sử dụng throwTonhư bạn đã làm ở đây. Nếu bạn muốn chuỗi kết thúc, bạn sẽ cần đợi nó trước khi maintrả về. Xem Cách buộc luồng chính để chờ tất cả các luồng con của nó kết thúc trong Haskell

sử dụng async

Tạo getLinekhối chủ đề chính vô thời hạn không chơi tốt với nohup: Nó sẽ thất bại với

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

Thay thế cho getLinevà throwTo, bạn có thể sử dụng asynccác chức năng của :

import           Control.Concurrent.Async       ( withAsync, wait )

main = withAsync (writeToFile "first_file") wait

Điều này cho phép chạy chương trình với nohup ./theProgram-exe &, ví dụ trên máy chủ thông qua SSH .

async cũng tỏa sáng khi chạy nhiều tác vụ đồng thời:

import           Control.Concurrent.Async       ( race_ )

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

Hàm race_chạy hai tác vụ đồng thời và đợi cho đến khi kết quả đầu tiên đến. Với việc không chấm dứt của chúng tôi writeToFilesẽ không bao giờ có kết quả thường xuyên, nhưng nếu một trong các nhiệm vụ ném ngoại lệ, thì nhiệm vụ khác cũng sẽ bị hủy. Ví dụ, điều này hữu ích để chạy HTTP và máy chủ HTTPS.

Để tắt chương trình một cách sạch sẽ - tạo cơ hội cho các chủ đề giải phóng tài nguyên bracket- Tôi gửi cho nó tín hiệu SIGINT :

pkill --signal SIGINT theProgram-exe

Xử lý SIGTERM

Để kết thúc các chuỗi một cách duyên dáng trên SIGTERM , chúng ta có thể cài đặt một trình xử lý sẽ bắt tín hiệu:

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

Bây giờ, chương trình của chúng tôi sẽ giải phóng tài nguyên của nó bracketkhi nhận SIGTERM:

pkill theProgram-exe

Đây là tương đương cho hai nhiệm vụ đồng thời hỗ trợ 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

Để biết thêm về chủ đề Haskell không đồng bộ, hãy xem qua Lập trình song song và đồng thời trong Haskell của Simon Marlow.

¹ _{Gọi stack buildđể có được một thực thi tại, ví dụ,.stack-work/dist/x86_64-linux-tinfo6/Cabal-2.4.0.1/build/theProgram-exe/theProgram-exe}