8

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

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

In case of abort <- getChar' callback , a character is read from standard input, unless abort is called before a character is available. If a character is read, 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 may abort the thread after reading the char but before putting () into the MVar.

I have no idea how to solve this problem, is it possible at all with the base package? If not, have you seen a similar function implemented in other packages?

Cœur
  • 37,241
  • 25
  • 195
  • 267

2 Answers2

0

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

MathematicalOrchid
  • 61,854
  • 19
  • 123
  • 220
  • The problem is there even if we suppose that `getChar` raises no exceptions, so `withMVar` does not help. –  May 27 '13 at 11:13
0

I think the easiest way to achieve this is to perform your own buffering. Here's a simple prototype. It assumes that you call launchIOThread exactly once in your program. It doesn't handle EOF or other IO exceptions, but that 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
Roman Cheplyaka
  • 37,738
  • 7
  • 72
  • 121
  • Thanks! Is STM and a global buffer inevitable here? What do you think, could `getChar` be defined in `IO` too without compromising its semantics? Edit: I guess yes because `IO` may have global state. –  May 27 '13 at 16:12
  • I am wondering why `getChar' :: (Char -> IO ()) -> IO (IO ())` is not in `Prelude` or `System.IO`, it has simple semantics and it seems impossible to define with existing constructs (I mean without your `Buffer` parameter). –  May 27 '13 at 16:20
  • 1. Yes, there are hacks to create global variables in Haskell. – Roman Cheplyaka May 27 '13 at 16:39
  • 1
    2. Prelude is a module like any other. Placing something it Prelude does not make it magical. Perhaps you mean why this functionality is not provided by GHC's own IO system. I guess, nobody just bothered to do it... – Roman Cheplyaka May 27 '13 at 16:42