Howto abort getChar safely?

Question

I would like to optionally abort the getChar action. I need the following function:

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

In the case of abort <- getChar' callback character is read from standard input, unless abort is called before the character is available. If a character is read, a callback is called with it.

I have the following prototype implementation:

 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 

The problem is that killThread can interrupt the thread after reading char, but before putting () in MVar.

I have no idea how to solve this problem, is it even possible with the basic package? If not, have you seen a similar feature implemented in other packages?

Answer 1

I think the easiest way to achieve this is to do your own buffering. Here is a simple prototype. It is assumed that you call launchIOThread exactly once in your program. It does not handle EOF or other IO exceptions, but it should be easy.

 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

What you want to do is use exception handling constructs, so that regardless of exceptions, MVar always stays in a safe state. In particular, you probably want withMVar .