I compiled the following program
-- Alice.hs
main = do
putStrLn "Hello"
l <- getLine
putStrLn $ "you said " ++ l
I want to communicate with Alice in another program: Bob.hs. My failed attempt is:
-- Bob.hs
import System.IO (hGetLine, hPutStrLn)
import System.Process (runInteractiveProcess)
main = do
(hin, hout, herr, ph) <- runInteractiveProcess "./Alice" [] Nothing Nothing
hello <- hGetLine hout
putStrLn hello
hPutStrLn hin "something"
reply <- hGetLine hout
putStrLn reply
Bob gets stuck before Hello is printed.
Related
The following code keeps waiting for user input, and echoes it back to screen when it gets it. Then it goes back in waiting-for-input mode. When it's in this state, it keeps writing a constant message on screen.
import Control.Concurrent
import Data.Maybe
import System.IO
main = do
hSetBuffering stdin NoBuffering
future_input <- newEmptyMVar
forkIO $ (>>) <$> putMVar future_input
<*> (putStrLn . ("pressed key: " ++) . return)
=<< getChar
wait future_input
where wait future_input = do
input <- tryTakeMVar future_input
if isJust input
then main
else putStrLn "keep waiting" >> threadDelay 1000000 >> wait future_input
What I would like to obtain, is that the message keep waiting be accompained by the lates available user input.
The only idea I had so far, is that I should
declare another MVar, latest_input together with future_input
have the forked thread fill it in at the same time as future_input
in the else of if isJust input, I should tryTakeMVar from latest_input and, if there is something in it (which is, by virtue of point 2, always the case except the first time), I could use it in the output.
However, in this smokey idea of mine, I think I should also have wait take both MVars, because I don't have to lose track of any of them when waiting. Similarly, even in the then branch of if isJust input, I should probably pass latest_input, which means I have to use a function other than main, which would be called by main.
For now, I've got here:
import Control.Concurrent
import Data.Maybe
import System.IO
main = do
hSetBuffering stdin NoBuffering
future_input <- newEmptyMVar
latest_input <- newEmptyMVar
forkIO $ ((>>) .) . (>>)
<$> putMVar future_input
<*> putMVar latest_input
<*> (putStrLn . ("pressed key: " ++) . return)
=<< getChar
wait future_input
where wait future_input = do
input <- tryTakeMVar future_input
if isJust input
then main
else putStrLn "keep moving" >> threadDelay 1000000 >> wait future_input
Uh, I think I got it :D (and I've put it in Code Review).
import Control.Concurrent
import Data.Maybe
import System.IO
main = do
hSetBuffering stdin NoBuffering
future_input <- newEmptyMVar
latest_input <- newEmptyMVar
putMVar latest_input 'A' -- assuming a previous input the first time
work future_input latest_input
work :: MVar Char -> MVar Char -> IO ()
work future_input latest_input = do
forkIO $ ((>>) .) . (>>)
<$> putMVar future_input
<*> tryPutMVar latest_input
<*> (putStrLn . ("pressed key: " ++) . return)
=<< getChar
wait future_input latest_input
where wait future_input latest_input = do
input <- tryTakeMVar future_input
old_input <- takeMVar latest_input
if isJust input
then do
putMVar latest_input (fromJust input)
work future_input latest_input
else do
putMVar latest_input old_input
putStrLn ("latest input was " ++ (return old_input))
>> threadDelay 1000000
>> wait future_input latest_input
This is an exercise to learn the StateT monad. The program implements the game Morra. The two players are the computer and a person. The state accumulates the score of the computer and player. The program works for one iteration of function morra. However I am at a loss how to loop it. I have tried a few things but nothing seems to work.
module Morra where
import Control.Monad.Trans.State.Lazy
import Control.Monad.IO.Class
import Data.Char (isDigit, digitToInt)
import System.Random (randomRIO)
import Control.Monad (when)
morra :: StateT (Int, Int) IO ()
morra = do
p <- liftIO getChar
when (isDigit p) $
do
let p' = digitToInt p
c <- liftIO $ randomRIO (1, 2)
liftIO $ putStrLn ['P',':',' ',p] --"P: " ++ p)
liftIO $ putStrLn ("C: " ++ show c)
(pt, ct) <- get
if even (c + p') then
do
liftIO $ putStrLn "Computer Wins"
put (pt, ct + 1)
else
do
liftIO $ putStrLn "Player Wins"
put (pt + 1, ct)
main :: IO ()
main = do
putStrLn "-- p is Player"
putStrLn "-- c is Computer"
putStrLn "-- Player is odds, Computer is evens."
fScore <- runStateT morra (0,0)
let personS = fst . snd $ fScore
compS = snd . snd $ fScore
putStrLn ("Person Score: " ++ show personS)
putStrLn ("Computer Score: " ++ show compS)
if personS > compS then
putStrLn "Winner is Person"
else
putStrLn "Winner is Computer"
You're 99% there. Just add main on a new line right after the last putStrLn, and main will call itself, effectively restarting the program.
A few tricks to simplify some things in your code:
Use execStateT:: StateT s m a -> s -> m s to take just the final state of the round. This way, you don't need to use the let bindings to extract the score, and can do it inline instead: (personS,compS) <- execStateT morra (0,0)
['P',':',' ',p] can be written as ("P: " ++ [p])
It's a matter of style and preference, but you can reduce a lot of the indentation and formatting whitespace by rearranging your ifs, elses and dos:
if condition
then do
doSomethingA
doSomethingB
else someFunction $ do
doSomethingElseA
doSomethingElseB
Overall, nice job :)
I replaced p <- liftIO getChar with p <- liftIO getLine and made a few other minor changes to allow for the fact that p is now a String rather than a Char. Now it works. Seems that it has something to do with Windows as it works using getChar on linux. This is the final code:
module Morra where
import Control.Monad.Trans.State.Lazy
import Control.Monad.IO.Class
import Data.Char (isDigit, digitToInt)
import System.Random (randomRIO)
import Control.Monad (when)
morra :: StateT (Int, Int) IO ()
morra = do
p <- liftIO getLine
let p1 = head p
when (isDigit p1) $ do
let p' = digitToInt p1
c <- liftIO $ randomRIO (1, 2)
liftIO $ putStrLn ("P: " ++ p)
liftIO $ putStrLn ("C: " ++ show c)
(pt, ct) <- get
if even (c + p') then do
liftIO $ putStrLn "Computer Wins"
put (pt, ct + 1)
else do
liftIO $ putStrLn "Player Wins"
put (pt + 1, ct)
morra
main :: IO ()
main = do
putStrLn "-- p is Player"
putStrLn "-- c is Computer"
putStrLn "-- Player is odds, Computer is evens."
(personS,compS) <- execStateT morra (0,0)
putStrLn ("Person Score: " ++ show personS)
putStrLn ("Computer Score: " ++ show compS)
if personS == compS then
putStrLn "No Winner"
else if personS > compS then
putStrLn "Winner is Person"
else
putStrLn "Winner is Computer"
What is the best way to write to the stdin and read from the stdout of a subprocess without blocking?
The subprocess was created via System.IO.createProcess which returns handles for writing to and reading from the subprocess. The writing and reading is done in text format.
For example, my best attempt at doing non-blocking read is timeout 1 $ hGetLine out which returns a Just "some line" or Nothing if no line exists to be read. However, this seems an hack to me, so I am looking for a more "standard" way.
Thanks
Here are some examples of how to interact with a spawned process in a fashion mentioned by #jberryman.
The program interacts with a script ./compute which simply reads lines from stdin in the form <x> <y> and returns x+1 after a delay of y seconds. More details at this gist.
There are many caveats when interacting with spawned processes. In order to avoid "suffering from buffering" you need to flush the outgoing pipe whenever you send input and the spawned process needs to flush stdout every time it sends a response. Interacting with the process via a pseudo-tty is an alternative if you find that stdout is not flushed promptly enough.
Also, the examples assume that closing the input pipe will lead to termination of the spawn process. If this is not the case you will have to send it a signal to ensure termination.
Here is the example code - see the main routine at the end for sample invocations.
import System.Environment
import System.Timeout (timeout)
import Control.Concurrent
import Control.Concurrent (forkIO, threadDelay, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import System.Process
import System.IO
-- blocking IO
main1 cmd tmicros = do
r <- createProcess (proc "./compute" []) { std_out = CreatePipe, std_in = CreatePipe }
let (Just inp, Just outp, _, phandle) = r
hSetBuffering inp NoBuffering
hPutStrLn inp cmd -- send a command
-- block until the response is received
contents <- hGetLine outp
putStrLn $ "got: " ++ contents
hClose inp -- and close the pipe
putStrLn "waiting for process to terminate"
waitForProcess phandle
-- non-blocking IO, send one line, wait the timeout period for a response
main2 cmd tmicros = do
r <- createProcess (proc "./compute" []) { std_out = CreatePipe, std_in = CreatePipe }
let (Just inp, Just outp, _, phandle) = r
hSetBuffering inp NoBuffering
hPutStrLn inp cmd -- send a command, will respond after 4 seconds
mvar <- newEmptyMVar
tid <- forkIO $ hGetLine outp >>= putMVar mvar
-- wait the timeout period for the response
result <- timeout tmicros (takeMVar mvar)
killThread tid
case result of
Nothing -> putStrLn "timed out"
Just x -> putStrLn $ "got: " ++ x
hClose inp -- and close the pipe
putStrLn "waiting for process to terminate"
waitForProcess phandle
-- non-block IO, send one line, report progress every timeout period
main3 cmd tmicros = do
r <- createProcess (proc "./compute" []) { std_out = CreatePipe, std_in = CreatePipe }
let (Just inp, Just outp, _, phandle) = r
hSetBuffering inp NoBuffering
hPutStrLn inp cmd -- send command
mvar <- newEmptyMVar
tid <- forkIO $ hGetLine outp >>= putMVar mvar
-- loop until response received; report progress every timeout period
let loop = do result <- timeout tmicros (takeMVar mvar)
case result of
Nothing -> putStrLn "still waiting..." >> loop
Just x -> return x
x <- loop
killThread tid
putStrLn $ "got: " ++ x
hClose inp -- and close the pipe
putStrLn "waiting for process to terminate"
waitForProcess phandle
{-
Usage: ./prog which delay timeout
where
which = main routine to run: 1, 2 or 3
delay = delay in seconds to send to compute script
timeout = timeout in seconds to wait for response
E.g.:
./prog 1 4 3 -- note: timeout is ignored for main1
./prog 2 2 3 -- should timeout
./prog 2 4 3 -- should get response
./prog 3 4 1 -- should see "still waiting..." a couple of times
-}
main = do
(which : vtime : tout : _) <- fmap (map read) getArgs
let cmd = "10 " ++ show vtime
tmicros = 1000000*tout :: Int
case which of
1 -> main1 cmd tmicros
2 -> main2 cmd tmicros
3 -> main3 cmd tmicros
_ -> error "huh?"
I have a main function that outputs unicode which looks like this:
main = do
hSetEncoding stdout utf8
input <- getContents
mapM_ putStr $ myfunc input
How can I write this function without do notation?
I get <stdout>: commitBuffer: invalid argument (invalid character) when I try to compile this main function:
main = getContents >>= mapM_ putStr . myfunc
Just use sequence (>>):
main = do
hSetEncoding stdout utf8
input <- getContents
mapM_ putStr $ myfunc input
~~>
main = hSetEncoding stdout utf8 >> getContents >>= \input -> mapM_ putStr $ lines input
~~>
main = hSetEncoding stdout utf8 >> getContents >>= mapM_ putStr . lines
I have this simple code which reads a string and prints it, indefinitely.
main :: IO ()
main = getLine >>= putStrLn >> main
Now I want to exit after the getLine call if the line is either "quit" or "exit".
My attempt:
main :: IO ()
main = do
line <- getLine
if line == "exit" || line == "quit"
then return ()
else putStrLn line >> main
Doesn't look idiomatic to me. Is there a better way?
Control.Monad.unless (and it's slightly more popular cousin, when) abstract this pattern out of your code:
import Control.Monad (unless)
main = do
line <- getLine
unless (line == "exit" || line == "quit") $ do
putStrLn line
main
-- or
when (line /= "exit" && line /= "quit") $ do
putStrLn line
main
A conditional return () followed by unconditional code won't do the trick, as return is just a function, not a flow control keyword as in most other languages.
Using pipes-4.0:
import Pipes
import qualified Pipes.Prelude as P
main = runEffect $
P.stdinLn >-> P.takeWhile (`notElem` ["quit", "exit"]) >-> P.stdoutLn
It seems that you are concerned about the sequential feel of the code because of using if/else and the do notation. You can try something like:
main = getLine >>= proc
where
proc s | s == "exit" || s == "quit" = return ()
| otherwise = putStrLn s >> main
An attempt to be fashionable:
module Main where
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Class
import System.IO
isValid s = s ≠ "quit" && s ≠ "exit"
getL ∷ MaybeT IO String
getL = do s ← lift getLine
guard (isValid s)
return s
main = runMaybeT main' where
main' = do
lift $ putStr "Enter line: "
lift $ hFlush stdout
s ← getL
lift $ putStrLn $ "Your line is: " ⧺ s
main'
We can create a helper function that repeats a given action while it returns value:
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
while :: (Monad m) => MaybeT m b -> m ()
while k = runMaybeT (forever k) >> return ()
Once k returns mzero, the loop stops. Then we can use it nicely to interrupt the loop at any place using the standard MonadPlus combinators:
main = while $ do
l <- lift getLine
guard $ l /= "quit"
lift $ putStrLn l
Or on one line:
main = while $ mfilter (/= "quit") (lift getLine) >>= lift . putStrLn
Update: Perhaps the simplest solutions is using whileJust_ from monad-loops:
isValid s | s /= "quit" = Just s
| otherwise = Nothing
main = whileJust_ (isValid `liftM` getLine) putStrLn