Question

我想有选择地中止getChar行动。我需要以下功能：

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

如果是abort <- getChar' callback，则从标准输入读取一个字符，除非在字符可用之前调用abort。如果读取了某个字符，则会使用它调用callback。

我有以下原型实现：

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

问题是killThread可能会在读取char之后但在将()放入MVar之前中止线程。

我不知道如何解决这个问题，是否可以使用基础包？如果没有，你看到其他包中实现了类似的功能吗？

Answer 1

我认为实现这一目标的最简单方法是执行自己的缓冲。这是一个简单的原型。它假定您在程序中只调用launchIOThread一次。它不处理EOF或其他IO异常，但这应该很容易。

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

您要做的是使用异常处理结构，这样无论异常如何，MVar始终处于安全状态。特别是，您可能需要withMVar。

如何安全地中止getChar？

2 个答案: