Làm thế nào để hủy bỏ getChar một cách an toàn?

Question

Tôi muốn tùy chọn hủy bỏ hành động getChar. tôi cần những chức năng sau:

getChar' :: (Char -> IO()) -> IO (IO()) 

Trong trường hợp abort <- getChar' callback, một nhân vật được đọc từ đầu vào tiêu chuẩn, trừ khi abort được gọi trước khi một nhân vật có sẵn. Nếu một ký tự được đọc, callback được gọi với ký tự đó.

Tôi có việc thực hiện nguyên mẫu sau:

import Control.Monad 
import Control.Concurrent 

getChar' :: (Char -> IO()) -> IO (IO()) 
getChar' callback = do 
    v <- newEmptyMVar 
    tid <- forkIO $ do 
     c <- getChar 
     b <- tryPutMVar v() 
     when b $ callback c 
    return $ do 
     b <- tryPutMVar v() 
     when b $ killThread tid 

Vấn đề là killThread có thể hủy bỏ các chủ đề sau khi đọc char nhưng trước khi đưa () vào MVAr.

Tôi không biết làm thế nào để giải quyết vấn đề này, có thể nào ở tất cả với gói cơ sở không? Nếu không, bạn có thấy một chức năng tương tự được thực hiện trong các gói khác không?

Answer 1

Tôi nghĩ cách dễ nhất để đạt được điều này là thực hiện bộ đệm của riêng bạn. Đây là một nguyên mẫu đơn giản. Nó giả định rằng bạn gọi launchIOThread chính xác một lần trong chương trình của bạn. Nó không xử lý EOF hoặc các ngoại lệ IO khác, nhưng điều đó phải dễ dàng.

import Control.Concurrent 
import Control.Concurrent.STM 
import Data.Maybe 
import Control.Monad 

type Buffer = TVar (Maybe Char) 

launchIOThread :: IO Buffer 
launchIOThread = do 
    buf <- atomically $ newTVar Nothing 
    _ <- forkIO $ ioThread buf 
    return buf 

ioThread :: Buffer -> IO() 
ioThread buf = loop where 
    loop = 
    join $ atomically $ do 
     contents <- readTVar buf 
     if isJust contents -- no-one has taken the character yet 
     then retry -- relax 
     else return $ do 
      c <- getChar 
      atomically $ writeTVar buf (Just c) 
      loop 

getChar' :: Buffer -> (Char -> IO()) -> IO (IO()) 
getChar' buf callback = do 
    abortFlag <- atomically $ newTVar False 

    _ <- forkIO $ doGetChar abortFlag 

    return $ atomically $ writeTVar abortFlag True 

    where 
    doGetChar abortFlag = join $ atomically $ do 
     mbC <- readTVar buf 
     abort <- readTVar abortFlag 
     case mbC of 
     Just c -> 
      do writeTVar buf Nothing; return $ callback c 
     Nothing | abort -> return $ return() 
     _ -> retry 

Answer 2

Điều bạn muốn làm là sử dụng các cấu trúc xử lý ngoại lệ, bất kể ngoại lệ, MVar luôn được giữ ở trạng thái an toàn. Cụ thể, bạn có thể muốn withMVar.