8

我想有选择地中止一个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在读取字符后但在放入()MVar 之前可能会中止线程。

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

4

2 回答 2

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
于 2013-05-27T14:58:24.983 回答
0

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

于 2013-05-27T10:55:09.837 回答