I am making a program which shows stdout of my haskell program on UI.
I simply hooked it up with some text area, so I expected it to run normally other than potential crashes by mishaps.
However, I got waitForProcess: does not exist (No child processes) on the child program.
Furthermore, the direct output of the child comes after the output of child of child.
To illustrate, let’s say the UI program spawned a (haskell) program A.
The program A spawns another program B through callCommand.
Now, I expect the output like this:
A: Begin
B: Begin
(Further output of B)
B: End
A: End
and then program A should not emit waitForProcess: does not exist (No child processes) unless something is messed up.
However, what I got is this:
B: Begin
(Further output of B)
B: End
A: waitForProcess: does not exist (No child processes)
A: Begin
My UI Program: waitForProcess: does not exists (No child processes)
I’m sure that the part printing A: Begin should be running, given that there is a noticeable pause (~1s) until B: Begin is printed - likely when A starts running and calls the command.
Perhaps relevant: I inspect the stdout line-by-line like this
actOnLine outp act =
hIsEOF outp >>= \case
True -> pure ()
False -> do
line <- T.hGetLine outp
T.putStrLn line
act line
actOnLine outp act
Which resides inside the bracket from withCreateProcess.
I am honestly lost on how to start debugging the problem. Would appreciate any idea on what is going on!
Can you show more of the code - for example the way you span and wait for the process?
Anyway just to be sure I’d start by disabling the output- and input-buffers ( hSetBuffering).
Especially on Windows input-/output-buffers are tricky from Haskell.
and see if this changes anything - it probably won’t as the default should be LineBuffering - meaning the buffer should get flushed after each newline - so putStrLn should flush it
Uhm, I never wait for the process from withCreateProcess - as you could see, I currently ignore the ProcessHandle.
Should I? I thought withCreateProcess will wait for the process to clean it up properly.
I was asking for the error you mentioned - if you don’t do it it’ll most likely be your callCommand (as this uses waitForProcess) - but it’s really strange that this fails within
I dried to recreate this situation with this small program:
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Concurrent (forkIO)
import System.Environment (getArgs)
import System.IO (hGetLine, hIsEOF)
import System.Process
main :: IO ()
main = do
name : path : cmds <- getArgs
let go outp =
hIsEOF outp >>= \case
True -> putStrLn $ name ++ " done"
False -> do
line <- hGetLine outp
putStrLn $ name ++ " received " ++ line
go outp
putStrLn $ name ++ " starting.."
res <- withCreateProcess (proc path cmds) {std_out = CreatePipe} $
\_ (Just outp) _ _ -> go outp
putStrLn $ name ++ " ended."
pure ()
this is not exactly the same (as it does not use callCommand and I opted out of Text for now) but this works for me as expected:
$ ./hsRun A echo "Hi"
A starting..
A received Hi
A done
A ended.
$ ./hsRun A ./hsRun B echo "Hi"
A starting..
A received B starting..
A received B received Hi
A received B done
A received B ended.
A done
A ended.
can you come up with a small example that demonstrates your problem I can try locally?
Trying several things with this example, I found another potential problem.
While the order itself is retained, the timing is weird.
With the following code,
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Concurrent
import System.Environment (getArgs)
import System.IO (hGetLine, hIsEOF)
import System.Process
main :: IO ()
main = do
name : path : cmds <- getArgs
let go outp =
hIsEOF outp >>= \case
True -> putStrLn $ name ++ " done"
False -> do
line <- hGetLine outp
putStrLn $ name ++ " received " ++ line
go outp
putStrLn $ name ++ " starting.."
threadDelay 1000000
withCreateProcess (proc path cmds){std_out = CreatePipe} $
\_ (Just outp) _ _ -> go outp
threadDelay 1000000
putStrLn $ name ++ " ended."
pure ()
Time delays are like this:
A starting..
(waits 3 seconds)
A received B starting..
A received B received Hi
A received B done
A received B ended.
A done
(waits 1 second)
A ended.
It seems like the inputs are received “after” B finishes. Which means, the outputs are somehow clumped? I don’t get why. Isn’t the default LineBuffering?
I got the strange ordering now when using in combination with callCommand.
Code without problem:
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Concurrent
import System.Environment (getArgs)
import System.IO
import System.Process
main :: IO ()
main = do
name : path : cmds <- getArgs
hSetBuffering stdout NoBuffering
let go outp =
hIsEOF outp >>= \case
True -> putStrLn $ name ++ " done"
False -> do
line <- hGetLine outp
putStrLn $ name ++ " received " ++ line
go outp
putStrLn $ name ++ " starting.."
threadDelay 1000000
withCreateProcess (proc path cmds){std_out = CreatePipe} $
\_ (Just outp) _ _ -> go outp
threadDelay 1000000
callProcess path cmds
threadDelay 1000000
putStrLn $ name ++ " ended."
pure ()
gives order
A starting..
A received B starting..
A received B received Hi
A received B done
A received Hi
A received B ended.
A done
B starting..
B received Hi
B done
Hi
B ended.
A ended.
Now, if I comment out hSetBuffering stdout NoBuffering like this:
...
name : path : cmds <- getArgs
hSetBuffering stdout NoBuffering
let go outp =
...
I got
A starting..
A received Hi
A received B starting..
A received B received Hi
A received B done
A received B ended.
A done
B starting..
B received Hi
B done
Hi
B ended.
A ended.
which doesn’t make sense to me, as the program should be fairly sequential.
It almost seems like the buffer from the different processes interfere each other…
With the default buffering, I also got waitForProcess: does not exist (No child processes) on Ctrl+C.
Oh, so I need to update the process package. Could take long, but better do it now than later.
By the way, does interrupting the current thread impact the process call?
Haddock documentation of callProcess has the following line:
If an asynchronous exception is thrown to the thread executing callProcess,
the forked process will be terminated and callProcess will wait (block)
until the process has been terminated.
…which makes me worried, because I routed the thread to block and send the child process output to another thread.
EDIT: the bugfix did not fix my problem. Uh, should I not block the thread?
…strange, waitForProcess seem to always throw in particular circumstances - even without the blocking calls. Even more strange that the error bubbles up from the process calling cabal.
Sadly, cannot reproduce it in simple examples.
This is still not working, and I’d like to add context on where this is happening.
Basically I am working on a GTK application, where I want to redirect onto some label.
runBuild setMode addLine = do
forkIO . bracket_ begin end . handle @IOException onError $ do
-- Creates pipe for merging streams
(reads, writes) <- createPipe
withCreateProcess (proc "xmonad-manage" ["build", "pulpmonad"]){std_out = UseHandle writes, std_err = UseHandle writes} $
\_ _ _ _ -> do
actOnLine reads $ \txt -> Gtk.uiSingleRun (addLine txt)
pure ()
where
begin = Gtk.uiSingleRun (setMode True)
end = threadDelay 3000000 >> Gtk.uiSingleRun (setMode False)
actOnLine outp act = fix $ \recurse ->
hIsEOF outp >>= \case
True -> pure ()
False -> (T.hGetLine outp >>= act) >> recurse
onError err = do
Gtk.uiSingleRun (addLine . T.pack $ show err)
throwIO err
where Gtk.uiSingleRun task = Gdk.threadsAddIdle PRIORITY_DEFAULT_IDLE (False <$ task) setMode and addLine modifies the Gtk UI.
Does not seem to be fault of child process, as it works well with a small test program redirecting its output to console.
Can using Gtk change things up? Admittedly, I do not understand its threading model well…