I'm trying to set up a "bridge" between my Haskell code and an interactive command-line process. More specifically, I'm trying to run an Elm REPL and send/receive through stdin/stdout. I wasn't sure exactly which library to use for this, but I went with typed-process.
The issue I have is that my Haskell program finishes (or quits) while the REPL process is still running. How do I avoid this?
Also, another problem is that the REPL process isn't getting any input from the stdin handle.
My current code looks like this:
run :: Document -> IO (Result () Text)
run (Document moduleName tests) = do
let config = createConfig
p <- startProcess config
hSetBuffering (getStdin p) NoBuffering
hSetBuffering (getStdout p) NoBuffering
Data.Text.IO.hPutStr (getStdin p) "True\n"
Data.Text.IO.hGetChunk (getStdout p) >>= print
_ <- waitExitCode p
return (Ok ())
{-| Config for process.
-}
createConfig =
shell "elm repl"
|> setStdin createPipe
|> setStdout createPipe
|> setStderr closed
From the docs, it seems that stopProcess forces the process to stop (it sends SIGTERM on unix). This is because the docs state that it calls terminateProcess, and then waits.
We only want to wait without terminating the process. I would try waitExitCode or similar functions, instead.
Related
So I have a Haskell program that interacts with a subprocess using the System.Process.Typed library. I am trying to capture the stderr of the subprocess during the entire duration of the subprocess's lifespan. The current method doesn't work if the subprocess finishes before I get to line *. I think to do this I need to use STM but I don't know anything about STM and so was wondering if there was a simpler way.
fun :: MyType -> IO MyOtherType
fun inparam = withProcessWait config $ \process -> do
hPutStrLn (getStdin process) (getStr1 inparam)
hFlush (getStdin process)
response1 <- hGetLine (getStdout process)
hPutStrLn (getStdin process) (getStr2 inparam)
hFlush (getStdin process)
response2 <- hGetLine (getStdout process)
err <- hGetContents (getStderr process) -- this is line *
hClose (getStdin process)
exitCode <- timedWaitExitCode 100 process
return $ MyOtherType response1 response2 err
where
config = setStdin createPipe
$ setStdout createPipe
$ setStderr createPipe
$ fromString (fp inparam)
Thank you in advance.
Edit 1: Fixed the * label
Edit 2: When I try to run the code I get Exception: [..] hGetContents: illegal operation (delayed read on closed handle)
You did not specify what exactly “doesn’t work” in your code, so I’ll try to guess. One potential issue that I can immediately see is that you are returning values that you read from file handles (response1, response2, err) from your function. The problem here is that Haskell is a lazy language, so the values that you return are not actually read from those handles until they are really needed. And by the time they are needed, the child process has exited and the handles are closed, so it is impossible to read from them.
The simplest fix would be to force those entire strings to be read before you “return” from your function. One standard recipe for this is to use force followed by evaluate. This will make your program actually read the values and remember them, so the handles can be closed.
So, instead of:
value <- hGetContents handle
you should do:
value' <- hGetContents handle
value <- evaluate $ force value'
The next simple code works fine in GHCi (the window with graphics appears), but after compiling in GHC, when one run it from command line, nothing happens. Why is it so?
import Graphics.Gnuplot.Simple
main :: IO ()
main = do
plotFunc [] (linearScale 1000 (-10.0::Double,10.0)) (\x -> x^2)
GHC 8.2.2
gnuplot 0.5.5.1
Don't exit your program immediately after opening the window, since that will close it down.
For instance, wait for the user:
import Graphics.Gnuplot.Simple
main :: IO ()
main = do
plotFunc [] (linearScale 1000 (-10.0::Double,10.0)) (\x -> x^2)
putStrLn "Press enter to exit."
getLine
return ()
Your best bet is to switch from Graphics.Gnuplot.Simple to Graphics.Gnuplot.Advanced. You can use plotSync to wait for GNUPlot to exit. I don't think plotAsync has much to offer, since it doesn't offer a way to wait for the thread it creates. Here's a better version:
myPlotAsync
:: (Terminal.C terminal, Display.C gfx)
=> terminal -> gfx -> IO (ThreadId, MVar ExitStatus)
myPlotAsync term gfx = do
resultMV <- newEmptyMVar
tid <- forkIO $ plotSync term gfx
>>= putMVar resultMV
`onException` putMVar resultMV ExitSuccess
pure (tid, resultMV)
After your program calls myPlotAsync, it can do whatever else it needs to do and then call readMVar on the MVar to wait for GNUPlot to exit and get its exit status. It also has the option of holding on to the thread ID so it can kill the GNUPlot thread using throwTo.
I'm using the async library in conjunction with stm in my program.
The main thread forks two threads which run until one of them (it could be either one) encounters a solution. The solution is returned via a TMVar. Neither of them ever waits on any TMVar except to call putTMVar when the solution is found and one of them is guaranteed to run forever unless killed. So how could I possibly be getting "thread blocked indefinitely in an STM transaction" (which seems to happen approximately one in every twenty times) given that at least one of the child threads doesn't execute any blocking STM transactions (or die) until storing a result.
Note the two child threads communicate somewhat with each other using TVars, but not with TMVars.
Simplified code:
main :: IO ()
main = do
output <- newEmptyTMVar
result <- withAsync (child1 output) $ \_ -> withAsync (child2 output) $ \_ ->
let go = do
result <- atomically $ takeTMVar output
if someCondition result
then return result
else go
in go
print result
child1 :: TMVar Result -> IO ()
child1 output = go 0
where
go i = do
case computation1 i of
Nothing -> return ()
Just x -> atomically $ putTMVar x
go (i + 1)
child2 :: TMVar Result -> IO ()
-- Does some other stuff, but also only interacts with its argument to
-- give back a result, same as child1.
I'm trying to write a simple shell in Haskell, but I cant get the signal handling to work. If no command is running, sending SIGINT to the shell process triggers the signal handler. But when a blocking call to getProcessStatus is made, the signal is ignored. Sending a signal immediately to the child process of course kills the child and makes the blocking call return.
Replacing the blocking call with Control.Concurrent.threadDelay does not prevent the signal, i.e., everything works as intended. Replacing the blocking flag to getProcessStatus with False makes the function return before the child process has finished.
Reference to process package: https://hackage.haskell.org/package/unix-2.7.1.0/docs/System-Posix-Process.html#v:getProcessStatus
The relevant code is below, see the (only) commented line.
main :: IO ()
main = do
pidRef <- (newIORef [] :: IO (IORef [ProcessID]))
setSigHant pidRef
doPrompt pidRef
printPrompt :: IO ()
printPrompt = fdWrite stdError "λ➔ " >> return ()
doPrompt :: IORef [ProcessID] -> IO ()
doPrompt pidRef = do
printPrompt
tryLine <- try getLine :: IO (Either SomeException String)
case tryLine of
Left _ -> do
putStrLn ""
exitSuccess
Right line -> do
tryCl <- try (parse line) :: IO (Either SomeException [Command])
case tryCl of
Left e -> fdWrite stdError (show e ++ "\n") >> return ()
Right cl ->
if length cl > 0 && (cmd . head) cl == "cd" then
cd (head cl)
else do
execCommands pidRef cl (stdInput, stdOutput)
pids <- readIORef pidRef
-- This call to getProcessStatus blocks the signals
_ <- sequence $ map (getProcessStatus True False) pids
_ <- writeIORef pidRef []
return ()
doPrompt pidRef
setSigHant :: (IORef [ProcessID]) -> IO ()
setSigHant pidRef = do
let handler = Catch (sigIntHandler pidRef)
installHandler sigINT handler Nothing
return ()
sigIntHandler :: (IORef [ProcessID]) -> IO ()
sigIntHandler pidRef = do
pids <- readIORef pidRef
sequence_ $ map (signalProcess sigINT) pids
fdWrite stdError "\n"
printPrompt
getProcessStatus uses an interruptible FFI call internally. But why is -threaded necessary?
This blog post about handling ctrl-c in Haskell suggests that signal handling is done in a separate thread that kills the main thread using an asynchronous exception:
When the user hits Ctrl-C, GHC raises an async exception of type
UserInterrupt on the main thread. This happens because GHC installs an
interrupt handler which raises that exception, sending it to the main
thread with throwTo.
But the documentation for the async package mentions that:
Different Haskell implementations have different characteristics with
regard to which operations block all threads.
Using GHC without the -threaded option, all foreign calls will block
all other Haskell threads in the system, although I/O operations will
not. With the -threaded option, only foreign calls with the unsafe
attribute will block all other threads.
So maybe that's why proper handling of SIGINT in presence of interruptible ffi calls requires -threaded: otherwise, the thread that throws the asynchronous exception will be prevented from running.
I built a really simple read-eval-print-loop in Haskell that catches Control-C (UserInterrupt). However, whenever I compile and run this program, it always catches the first Control-C and always aborts on the second Control-C with exit code 130. It doesn't matter how many lines of input I give it before and between the two Control-Cs, it always happens this way. I know I must be missing something simple... please help, thanks!
Note: this is with base-4 exceptions, so Control.Exception and not Control.OldException.
import Control.Exception as E
import System.IO
main :: IO ()
main = do hSetBuffering stdout NoBuffering
hSetBuffering stdin NoBuffering
repLoop
repLoop :: IO ()
repLoop
= do putStr "> "
line <- interruptible "<interrupted>" getLine
if line == "exit"
then putStrLn "goodbye"
else do putStrLn $ "input was: " ++ line
repLoop
interruptible :: a -> IO a -> IO a
interruptible a m
= E.handleJust f return m
where
f UserInterrupt
= Just a
f _
= Nothing
Wei Hu is correct; the Haskell runtime system deliberately aborts the program when a second control-C is pressed. To get the behavior one might expect:
import Control.Exception as E
import Control.Concurrent
import System.Posix.Signals
main = do
tid <- myThreadId
installHandler keyboardSignal (Catch (throwTo tid UserInterrupt)) Nothing
... -- rest of program
Disclaimer: I'm not familiar with GHC internals and my answer is based on grepping the source code, reading the comments, and making guesses.
The main function you define is in fact wrapped by runMainIO defined in GHC.TopHandler (this is further confirmed by looking at TcRnDriver.lhs):
-- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is
-- called in the program). It catches otherwise uncaught exceptions,
-- and also flushes stdout\/stderr before exiting.
runMainIO :: IO a -> IO a
runMainIO main =
do
main_thread_id <- myThreadId
weak_tid <- mkWeakThreadId main_thread_id
install_interrupt_handler $ do
m <- deRefWeak weak_tid
case m of
Nothing -> return ()
Just tid -> throwTo tid (toException UserInterrupt)
a <- main
cleanUp
return a
`catch`
topHandler
And install_interrupt_handler is defined as:
install_interrupt_handler :: IO () -> IO ()
#ifdef mingw32_HOST_OS
install_interrupt_handler handler = do
_ <- GHC.ConsoleHandler.installHandler $
Catch $ \event ->
case event of
ControlC -> handler
Break -> handler
Close -> handler
_ -> return ()
return ()
#else
#include "rts/Signals.h"
-- specialised version of System.Posix.Signals.installHandler, which
-- isn't available here.
install_interrupt_handler handler = do
let sig = CONST_SIGINT :: CInt
_ <- setHandler sig (Just (const handler, toDyn handler))
_ <- stg_sig_install sig STG_SIG_RST nullPtr
-- STG_SIG_RST: the second ^C kills us for real, just in case the
-- RTS or program is unresponsive.
return ()
On Linux, stg_sig_install is a C function that calls out to sigaction. The parameter STG_SIG_RST is translated to SA_RESETHAND. On Windows, things are done differently, which probably explains ja's observation.
The most reliable solution for me (at least on Linux), has been to install a signal handler using System.Posix.Signals. I was hoping for a solution that would not require this, but the real reason I posted the question was that I wanted to know why GHC behaved the way it did. As explained on #haskell, a likely explanation is that GHC behaves this way so that the user can always Control-C an application if it hangs. Still, it would be nice if GHC provided a way to affect this behavior without the somewhat lower-level method that we resorted to :).