2
\$\begingroup\$

On StackOverflow I have asked a question a few minutes ago, but then by trying a bit more, I found the answer myself, and I'm posting the resulting working code here for review.

What the code does, is waiting for, and repeatedly prompting the user to enter a character; when the user enters one, the program echoes it back and goes back to the previous mode, waiting for further input. The program assumes an initial implicit input of 'A'.

{-# language LambdaCase #-}

import Control.Concurrent
import Data.Maybe
import System.IO

main :: IO ()
main = do
  hSetBuffering stdin NoBuffering
  future_input <- newEmptyMVar
  work future_input 'l'

work :: MVar Char -> Char -> IO ()
work future_input latest_input = do
  forkIO $ putMVar future_input =<< getChar
  wait future_input latest_input
    where
      wait :: MVar Char -> Char -> IO ()
      wait future_input latest_input =
        tryTakeMVar future_input >>=
          \case Just input -> putStrLn ("new input " ++ return input)
                              >> work future_input input
                Nothing    -> putStrLn ("old input " ++ return latest_input)
                              >> threadDelay 100000
                              >> wait future_input latest_input

Some thoughts on about the code:

  • I've tried to use applicative/monadic style wherever I could, without compromising readability too much;
  • as regards the concurrentcy-handling part, basically the wait function, I preferred using the do sugar because I could hardly get something working this way.
\$\endgroup\$
1
\$\begingroup\$

With a bit of suggestion/help on Haskell's IRC channels, I came up with this, which doesn't forkIO at every recursion.

{-# language LambdaCase #-}

import Control.Concurrent
import Data.Maybe
import System.IO

main :: IO ()
main = do
  hSetBuffering stdin NoBuffering
  future_input <- newEmptyMVar
  forkIO $ pollInput future_input
  processInput future_input 'l'

pollInput :: MVar Char -> IO ()
pollInput future_input = (putMVar future_input =<< getChar) >> pollInput future_input

processInput :: MVar Char -> Char -> IO ()
processInput future_input latest_input = tryTakeMVar future_input >>=
    \case Just input -> putStrLn ("direction change " ++ return input)
                        >> processInput future_input input
          Nothing    -> putStrLn ("keep direction " ++ return latest_input)
                        >> threadDelay 100000
                        >> processInput future_input latest_input
| improve this answer | |
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.