How can I fork standard output? - haskell

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?

Related

Editable default string in Haskell's terminal input

I want to be able to prompt the user for input (let's say a FilePath), but also to offer a mutable/interactive string as a default, so instead of having the user type the full path, I can prompt with:
C:\Users\John\project\test
and have them be able to backspace 4 times and enter final to yield C:\Users\John\project\final, rather than type the entire path.
However printing a default string with putStr or System.IO.hPutStr stdout does print this default to the terminal, but does not allow me to alter any of it. E.g.
import System.IO
main = do
hSetBuffering stdout NoBuffering
putStr "C:\\Users\\John\\project\\test"
l <- getLine
doSomethingWith l
I suspect Data.Text.IO's interact may be able to do what I want but I could not get it to work.
Any suggestions would be greatly appreciated.
getLine doesn’t offer any facility for line editing. For this you can use a library like haskeline instead, for example:
import System.Console.Haskeline
main :: IO ()
main = do
runInputT defaultSettings $ do
mInput <- getInputLineWithInitial "Enter path: "
("C:\\Users\\John\\project\\test", "")
case mInput of
Nothing -> do
outputStrLn "No entry."
Just input -> do
outputStrLn $ "Entry: " ++ show input
An alternative is to invoke the program with a wrapper that provides line editing, such as rlwrap. For building a more complex fullscreen text UI, there is also brick, which provides a simple text editing component in Brick.Widgets.Edit.

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.

Haskell createProcess and read from Handle

when i use Haskell createProcess do i need to fork before as if i was using exec in c?
From the example's i have seen and for what i have tried i don't think i do but if i read from the output Handle once i get the expected result but if i try to read twice it doesn't read even once.
For example:
beginProcess is the same as createProcess and z3 is a smt solver that reads from stdin and writes to stdout.
execute :: Process -> String -> IO String
execute (Just std_in, Just std_out,_,_) cmd = do
hPutStr std_in cmd
hFlush std_in
hGetLine std_out
main :: IO()
main = do
proc <- beginProcess "z3" ["-smt2","-in"]
execute proc "(set-option :print-success true)" >>= print
execute proc "(set-option :print-success true)" >>= print
If i do one execute i get the expected result, but if i do both nothing happens.
Am i reading or writing wrong to the handles ?
Thank you for any help you can give.
I have a hunch that you are "suffering from buffering".
Note that you are not emitting any newlines to the z3 process. Also, z3 may not be flushing its output after every command.
The best way to interact with a terminal program is through a pseudo tty. Here is an explanation of how such a set up would work: http://www.rkoucha.fr/tech_corner/pty_pdip.html

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

How can I make file I/O more transactional?

I'm writing CGI scripts in Haskell. When the user hits ‘submit’, a Haskell program runs on the server, updating (i.e. reading in, processing, overwriting) a status file. Reading then overwriting sometimes causes issues with lazy IO, as we may be able to generate a large output prefix before we've finished reading the input. Worse, users sometimes bounce on the submit button and two instances of the process run concurrently, fighting over the same file!
What's a good way to implement
transactionalUpdate :: FilePath -> (String -> String) -> IO ()
where the function (‘update’) computes the new file contents from the old file contents? It is not safe to presume that ‘update’ is strict, but it may be presumed that it is total (robustness to partial update functions is a bonus). Transactions may be attempted concurrently, but no transaction should be able to update if the file has been written by anyone else since it was read. It's ok for a transaction to abort in case of competition for file access. We may assume a source of systemwide-unique temporary filenames.
My current attempt writes to a temporary file, then uses a system copy command to overwrite. That seems to deal with the lazy IO problems, but it doesn't strike me as safe from races. Is there a tried and tested formula that we could just bottle?
The most idiomatic unixy way to do this is with flock:
http://hackage.haskell.org/package/flock
http://swoolley.org/man.cgi/2/flock
Here is a rough first cut that relies on the atomicity of the underlying mkdir. It seems to fulfill the specification, but I'm not sure how robust or fast it is:
import Control.DeepSeq
import Control.Exception
import System.Directory
import System.IO
transactionalUpdate :: FilePath -> (String -> String) -> IO ()
transactionalUpdate file upd = bracket acquire release update
where
acquire = do
let lockName = file ++ ".lock"
createDirectory lockName
return lockName
release = removeDirectory
update _ = nonTransactionalUpdate file upd
nonTransactionalUpdate :: FilePath -> (String -> String) -> IO ()
nonTransactionalUpdate file upd = do
h <- openFile file ReadMode
s <- upd `fmap` hGetContents h
s `deepseq` hClose h
h <- openFile file WriteMode
hPutStr h s
hClose h
I tested this by adding the following main and throwing a threadDelay in the middle of nonTransactionalUpdate:
main = do
[n] <- getArgs
transactionalUpdate "foo.txt" ((show n ++ "\n") ++)
putStrLn $ "successfully updated " ++ show n
Then I compiled and ran a bunch of instances with this script:
#!/bin/bash
rm foo.txt
touch foo.txt
for i in {1..50}
do
./SO $i &
done
A process that printed a successful update message if and only if the corresponding number was in foo.txt; all the others printed the expected SO: foo.txt.notveryunique: createDirectory: already exists (File exists).
Update: You actually do not want to use unique names here; it must be a consistent name across the competing processes. I've updated the code accordingly.

Resources