Block until keypress or given time of day

Question

How does one block until the earlier of (1) a keypress or (2) a previously input time of day in hh:mm format is reached. I am using Windows in case that matters. This DOS assembler program (which does run on Windows too) does what I want via something like batchman waittil 16:30 from the Windows console but I want to do it entirely in Haskell, (i.e. without making use of that program).

Answer 1

You can start two threads: one reads a character, the other waits until the specified time is reached; they both write to a single MVar to signal completion.

This is a little tricky, but mostly due to the details: we want to have stdin in unbuffered and non-echoing mode so that a single keypress stops the waiting without printing anything, and then restore the original state afterwards; and we also need to kill both threads after either finishes, so that we, for example, stop reading from stdin once the timeout expires. Additionally, we need to ensure things are cleaned up properly if an exception occurs. bracket simplifies the clean-up logic here, but it's still pretty ugly:

import Prelude hiding (catch)
import Control.Exception
import Control.Concurrent
import System.IO

withRawStdin :: IO a -> IO a
withRawStdin = bracket uncook restore . const
  where
    uncook = do
        oldBuffering <- hGetBuffering stdin
        oldEcho <- hGetEcho stdin
        hSetBuffering stdin NoBuffering
        hSetEcho stdin False
        return (oldBuffering, oldEcho)
    restore (oldBuffering, oldEcho) = do
        hSetBuffering stdin oldBuffering
        hSetEcho stdin oldEcho

waitFor :: Int -> IO ()
waitFor delay = do
    done <- newEmptyMVar
    withRawStdin . bracket (start done) cleanUp $ \_ -> takeMVar done
  where
    start done = do
        t1 <- forkIO $ getChar >> putMVar done ()
        t2 <- forkIO $ threadDelay delay >> putMVar done ()
        return (t1, t2)
    cleanUp (t1, t2) = do
        killThread t1
        killThread t2

Even after all that, this solution still doesn't handle waiting until a specific time — just waiting a certain number of microseconds. For turning a time of day into a number of microseconds to sleep, this previous SO question may help. If the sleeps are sufficiently long, then they might not fit into an Int of microseconds, so you might have to use threadDelay in a loop, or delay from the unbounded-delays package.