How does hWaitForInput work? - haskell

This bit of code gets characters from stdin and converts them to a String. There is a timeout on the input implemented with hWaitForInput. I have included the tryIOError function to capture isEOFError. It times out correctly when the program is run and no input has taken place ie.it is waiting for input. However once a character has been entered it no longer times out. No matter what the input wait time is.
-- get string from stdin
getFrmStdIn :: Int -> IO String
getFrmStdIn timeout = do
inAvail <- tryIOError $ hWaitForInput stdin timeout
let tOut = either (const False) id inAvail
if isLeft inAvail
then return []
else
if not tOut
then die "00 timed out"
else
(:) <$> hGetChar stdin <*> getFrmStdIn timeout

What OS and GHC version are you using?
AFAIK with the resent GHC versions hWaitForInput doesn't work on linux at all when timeout is not 0. On windows the whole IO subsystem is "a bit lacking" too.

However once a character has been entered it no longer times out. No matter what the input wait time is.
That's how it's supposed to work according to the docs:
Computation hWaitForInput hdl t waits until input is available on handle hdl. It returns True as soon as input is available on hdl, or False if no input is available within t milliseconds.
Here's a usage example of hWaitForInput where it will wait for five seconds and then check if there are characters in stdin. If not, it will say "Timeout reached". Otherwise it'll wait for the user to hit enter (hGetLine checks for the end of line) and print the user-entered string:
main :: IO ()
main =
hWaitForInput stdin 5000 >>= \inputIsAvailable ->
if inputIsAvailable
then hGetLine stdin >>= \input -> putStrLn $ "There is input: " ++ input
else putStrLn "Timeout reached"

Related

How can I fork standard output?

I have a program that I want to run and wait for it to initialize before proceeding, but I also want the program to write to the terminal as usual, which it would do if I simply called it with callProcess. To this end, I have devised the following hack:
(In this case I listen to the standard error, but I suppose this is inessential.)
…
withCreateProcess applicationProcessDescription \ _ _ maybeApplicationStdErr _ -> do
case maybeApplicationStdErr of
Nothing -> throwIO $ DeploymentException $ "Unable to grab application's standard error stream!"
Just applicationStdErr -> do
maybeTimeout <- timeout waitingTime (waitForApplication applicationStdErr)
when (isNothing maybeTimeout) $ throwIO $ DeploymentException $ "Application took too long initializing!"
redirectHandle applicationStdErr stderr
…
waitForApplication :: Handle -> IO ( )
waitForApplication stdErr = do
line <- hGetLine stdErr
hPutStrLn stderr line
if line == "Application initialized."
then return ( )
else waitForApplication stdErr
redirectHandle :: Handle -> Handle -> IO ( )
redirectHandle from to = void $ forkFinally
do forever do
line <- hGetLine from
hPutStrLn to line
\ _ -> return ( )
I intercept whatever the subprocess is saying, line by line, analyze the lines in some way and put them to the main process's standard error. When I am done, I still have to keep listening and relaying. This seems like an absurd way of going about it.
What I would like to do is fork the subprocess's standard error stream in some way, so that I may eavesdrop on it passively while I need to, and then simply disconnect. It is important for me that whatever the subprocess is saying was delivered to the human as faithfully as possible — without delay and omission.
Is there a nice way to do it?

typed-process withProcessWait_ and getExitCode race condition?

import System.Process.Typed
import Control.Monad.STM
import Control.Concurrent.STM.TVar
processConf = setStderr byteStringOutput . setStdout byteStringOutput
main :: IO ()
main = do
withProcessWait_ (processConf $ proc "sleep" ["1"])
$ \p -> do
atomically (getStdout p) >>= print
atomically (getStderr p) >>= print
getExitCode p >>= print
print "test"
The above code mostly returns Nothing for the exit code, while other times it'll return Just ExitSuccess, so seemingly random / race condition.
Why might this occur?
The function in question is: http://hackage.haskell.org/package/typed-process-0.2.6.0/docs/System-Process-Typed.html#v:withProcessWait_
withProcessWait_ :: MonadUnliftIO m => ProcessConfig stdin stdout stderr -> (Process stdin stdout stderr -> m a) -> m a
My understanding of what the function will do is, run the process, wait till it's terminated and then run the IO a. However... I just noticed there is a readProcess function which sounds like what I should actually be using instead http://hackage.haskell.org/package/typed-process-0.2.6.0/docs/System-Process-Typed.html#v:readProcess
None the less, it would be useful to know what is actually happening in the above / withProcessWait_.
The race condition is that three separate threads are consuming all available standard output (first thread) and standard error (second thread) and waiting on the exit code (third thread). The standard output and standard error thread can complete and publish the full output to STM before the third thread publishes the exit code.
Since getExitCode checks the exit code TMVar but doesn't wait on it, the exit code may not be available. (In fact, if the child process closes standard output and error before exiting, it may genuinely still be running at this point!)
If you replace getExitCode with waitExitCode, you reliably get ExitSuccess. Of course, withProcessWait_ is already waiting on the exit code and will raise an exception if it's not ExitSuccess, so there's no particular reason to do this anyway.

How to make a Haskell program display a preliminary result in response to user input?

I am writing a program in Haskell which repeatedly takes its most recent result and uses this to compute the next result. I want to be able to see the newest result in response to user input, so I tried something like this:
main = mainhelper 0
mainhelper count = do
count <- return (count + 1)
line <- getLine
if null line
then do mainhelper count
else do
putStrLn $ show count
return ()
I was hoping that getLine would return an empty line if the user hasn't entered anything, but this doesn't happen, instead the program does nothing until it receives user input. Is there a way around this?
One simple solution is to fork a thread for the complicated computation and communicate with the main UI thread via MVar. For example:
import Control.Exception
import Control.Monad
import Control.Concurrent
thinkReallyHard x = do
threadDelay 1000000 -- as a proxy for something that's actually difficult
evaluate (x+1)
main = do
v <- newMVar 0
forkIO (forever (modifyMVar_ v thinkReallyHard))
forever (getLine >> readMVar v >>= print)
You may wonder about the role of evaluate in thinkReallyHard. The subtlety there is that MVars are lazy -- they can contain thunks just as easily as computed values. In particular, this means it's easy to accidentally push all the pure computation from the forked thread into the thread that's reading and using the contents of the MVar. The call to evaluate simply forces the forked thread to finish the pure computation before writing to the MVar.
It does return an empty line if you hit enter without entering text -- you just immediately prompt for more input, so it might look like nothing is happening. But if you run the program, hit enter three times, then enter something non-empty, you'll see that the final count reflects the multiple entries.
Here's a modified version of your code that does the same thing, but is slightly more canonical:
main = mainhelper 0
mainhelper count = do
let count' = count + 1
line <- getLine
if null line
then mainhelper count'
else print count'
Rather than count <- return (count + 1), you can write let count' = count + 1 -- this is a pure binding, not something that needs to invoke the IO monad (as you're doing with <- and return). But I used count' instead of count because otherwise that will create a recursive binding. The '-suffixing is a standard idiom for a "modified version" of an identifier.
Next I switched putStrLn . show to print, which is part of the Prelude and does exactly that.
I got rid of the return () because print (and putStrLn) already have the type IO (). This allows you to elide the do statements, as there's now a single IO expression in each branch of the if.
It's not really clear what you're trying to do here that's different from what you are doing -- the code does (in imperative terms) increment a counter every time the user presses enter, and displays the state of the counter every time the user enters some non-empty text.
Here's another version that prints the counter every time, but only increments it when prompted, which may or may not be helpful to you:
main = mainhelper 0
mainhelper count = do
print count
line <- getLine
mainhelper (if null line then count else succ count)
I'm using succ, the successor function, instead of the explicit + 1, which is just a style preference.

Haskell: Why does this function keep asking for user input and not terminating

I'm learning some Haskell and I came across this small program
reverseLines :: String -> String
reverseLines input =
unlines (map reverse (lines input))
main :: IO ()
main = interact reverseLines
This program will keep asking the user for more input and reverse the input and print it on the screen.
Most of this is straight forward but one thing I can't wrap my head around is why does this function keeps running and ask the user for more input whereas if I just replace the reverseLines function with a function the simply returns some string it will not happen.
This program will stop after one execution:
foo input = "Stops"
main :: IO ()
main = interact foo
Why?
If you look at the source of interact you see this:
interact f = do s <- getContents
putStr (f s)
see the getContents? This is where the magic starts - it will read everything till EOF
Now in Haskell this is lazy-IO which can be bad but here is almost magical - see the string is read lazily and passed to your reverseLines - this one of course will only generate output as soon as it saw \n characters (the lines) and so it seems your program is some kind of REPL.
In the second one you don't consume any of the lazy-string at all so it stops ASAP
As I wrote in the comments you can play with this by either passing content into the program using a file (or echo) and pipes on the terminal:
echo "Hello World\nBye Bye" | runhaskell LazyIO.hs
or using CTRL-D to pass in the EOF yourself.
To get a feeling for it I would play with the functions more - what happens if you use something that needs to see the complete input first (try reverse without the maps)? What happens with words instead of lines, ...?
Have fun!

Game server in Haskell

I'm using Network and Gloss for a game server in Haskell. It works fine, except that the client has to close for the server to receive the data it sent. I bet it's a case of laziness...
Minimalist server:
import Network
import System.IO
main = do
sock <- listenOn (PortNumber (fromIntegral 12345))
loop sock
loop sock = do
(hIn, _, _) <- accept sock
str <- hGetContents hIn
print str
loop sock
Minimalist client:
import Network
import System.IO
import Graphics.Gloss.Interface.IO.Game
main = playIO
(InWindow "Test Multi" (500, 500) (500, 500))
white
60
Nothing
draw
(\_ x -> return x)
advance
draw Nothing = return blank
draw (Just x) = return (Text (show x))
advance _ Nothing = do
hOut <- connectTo "000.000.0.0" (PortNumber (fromIntegral 12345))
hSetBuffering hOut NoBuffering
hPutStr hOut "Hello!"
return (Just hOut)
advance _ x = return x
I start the server, wait 10 seconds, then start the client, wait 15 seconds, see that nothing happens on the server, closes the client, see "Hello!" suddenly appear on the server.
I would like "Hello!" to appear while the client is running, in an advance call, otherwise I can't make a multiplayer game (sob)!
However, if I change the client's code to
main = loop Nothing
loop x = do
x' <- advance 0 x
getLine
the sever immediatly shows "Hello!" while the client is waiting for my input.
I tried, as suggested in another question, to use bang patterns and hClose:
-- ...
!str <- hGetContents hIn
hClose hIn
-- ...
which makes the output appear immediatly, without the client closing. That's great. But, I plan to use bytestrings because the data I send to the server is serialized, so I import qualified Data.ByteString as B and change hGetContents to B.hGetContents, which makes the problem re-appear.
The problem was indeed a case of laziness. hGetContents reads lazily all the contents of the Handle, so it finishes only when it's closed, when the client aborts the connection. Instead, I used hGetLine that returns the content each time it encounters a \n, which I use as a end-of-message tag.
I might be completely wrong, but isn't the problem hGetContents? Surely that should wait till the entire contents sent through your socket have arrived before the next line (print...) starts. hGetContents is designed to give you all the contents sent until the socket is closed. Something like hGetLine could terminate straight away and you can leave the socket open to send more data through later. Your client could then use a hPutStrLn instead of hPutStr.
It defaults to line-buffered output, which is why hPutStr (which doesn't provide a line ending) doesn't output anything until you flush the buffer. There are two ways you can solve this:
a) Call hFlush stdout manually any time you want to flush the output.
b) Use hSetBuffering to set the buffering to NoBuffering
All of those functions are found in the System.IO module.
Edit: Never mind, I just saw where you did that in the client. I retract my answer with apologies.
Probably, you need to disable algorithm Nagle.
Try this code:
import Network.Socket
setSocketOption sock NoDelay 1

Resources