Hi Bernd
Bernd Holzmüller wrote:
> Hi all,
>
> I am developing a test management GUI where processes are started and
> their output (on stdout and stderr) are shown on corresponding console
> windows. The process management worked quite OK with version 0.9.4 but
> does no longer work in version 0.10.3 (using ghc 6.8.3 on Windows XP).
>
> The attached small example application shows what happens: with
> processExecAsync only garbage is shown on both the stdout and the stderr
> console window, with processExecAsyncTimed the stdout console works
> fine, but the stderr console shows nothing. Main.hs is the wxHaskell GUI
> with two buttons, both calling the application compiled from
> Testproc.hs, one using processExecAsync, one using the Timed variant.
> The attached makefile builds everything.
>
> If someone with understanding of the internals of wxHaskell could have a
> look on this topic, I would be very grateful. Perhaps the (soon?) coming
> new wxHaskell version 0.11 will do correctly?
>
> Thanks,
> Bernd
>
Your processExecAsyncTimed example works on Linux. But of cause that do
not help you much. The processExecAsync example do not work on Linux
either.
A while ago I got tired of the hard-to-get-to-work nature of
processExecAsyncTimed and therefore wrote my own process executor. I
have attached my own process executor and an adapted version of your
code, which works for me (on Linux). You will have to adapt it a little
bit to work on windows (properly just changing "./testproc.exe" to
"testproc" should do).
I would love to hear if it works on your machine.
Greetings,
Mads Lindstrøm
module Main where
import Graphics.UI.WX
import Graphics.UI.WXCore
import WxProcess
main = start $ do
f <- frame [ text := "Test Process Handling in wxHaskell" ]
p <- panel f []
stdoutConsole <- textCtrlRich p [ font := fontFixed {_fontSize = 8} ]
stderrConsole <- textCtrlRich p [ font := fontFixed {_fontSize = 8} ]
let write console txt = textCtrlAppendText console txt
clear c = set c [text := ""]
clearAll = do clear stdoutConsole; clear stderrConsole
onEndProcess exitcode = write stdoutConsole $ "\nprocess terminated with exitcode " ++ show exitcode
onStdout txt _ = write stdoutConsole $ "Stdout: " ++ txt
onStderr txt _ = write stderrConsole $ "Stderr: " ++ txt
spawnTimed = processExecAsyncTimed p "./testproc.exe" True onEndProcess onStdout onStderr
spawnThreaded = processExecAsync p "./testproc.exe" 100 onEndProcess onStdout onStderr
--
onStdout' txt = write stdoutConsole $ "Stdout: " ++ txt
onStderr' txt = write stderrConsole $ "Stderr: " ++ txt
spawnWxExecProcess = wxExecProcess p "./testproc.exe" 100 onEndProcess onStdout' onStderr'
startThreadedButton <- button p [ text := "processExecAsync"
, on command := do clearAll; spawnThreaded; return ()]
startTimedButton <- button p [ text := "processExecAsyncTimed"
, on command := do clearAll; spawnTimed; return ()]
startWxProcessButton <- button p [ text := "wxExecProcess"
, on command := do clearAll; spawnWxExecProcess; return ()]
-- stopProcessButton <- button p []
set p [ layout := column 5
[ row 5 [widget startThreadedButton, hglue]
, row 5 [widget startTimedButton, hglue]
, row 5 [widget startWxProcessButton, hglue]
, row 5 [ column 5 [hfill $ label "stdout", fill $ widget stdoutConsole]
, column 5 [hfill $ label "stderr", fill $ widget stderrConsole ]]]
]
set f [ layout := margin 5 $ hfill $ widget p
, clientSize := sz 860 550
]
{-# LANGUAGE MultiParamTypeClasses, PatternSignatures, RecursiveDo #-}
module WxProcess
( wxExecProcess
, ExitCode(..)
)
where
import Control.Concurrent
import System.Exit
import System.Process
import System.IO
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Data.Word
import qualified Graphics.UI.WX as WX
import Graphics.UI.WX (Prop(..), on)
type OnReceive = String -> IO()
wxExecProcess :: WX.Window a -> String -> Int -> (ExitCode -> IO()) -> OnReceive -> OnReceive
-> IO ()
-- if the user needs to give input to the created process, we could return IO (String -> IO StreamStatus) in stead
wxExecProcess parent cmd bufferSize onEndProcess onOutput onErrOutput =
do (inh,outh,errh,pid) <- runInteractiveCommand cmd
mapM_ (\hdl -> hSetBuffering hdl NoBuffering) [inh, outh, errh]
-- fork off a thread to start consuming the output
stdOutMVar <- newEmptyMVar
stdErrMVar <- newEmptyMVar
stdOutIsFinished <- newEmptyMVar
stdErrIsFinished <- newEmptyMVar
processFinished <- newEmptyMVar
let consume handle isFinished outputMVar =
do buf <- mallocArray bufferSize
consume' handle isFinished outputMVar buf
free buf
consume' handle isFinished outputMVar buf =
do outIsEOF <- hIsEOF handle
if outIsEOF
then putMVar isFinished ()
else do hWaitForInput handle 1000 -- 1000 = one second
count <- hGetBufNonBlocking handle buf bufferSize
(x :: [Word8]) <- peekArray count buf
putMVar outputMVar (map (toEnum . fromIntegral) x)
consume' handle isFinished outputMVar buf
forkIO $ consume outh stdOutIsFinished stdOutMVar
forkIO $ consume errh stdErrIsFinished stdErrMVar
let handleAllInput = do handleAnyInput stdOutMVar onOutput
handleAnyInput stdErrMVar onErrOutput
mdo t <- WX.timer parent [ WX.interval := 100 -- 10 times a second
, on WX.command := do handleAllInput
exitCode <- tryTakeMVar processFinished
case exitCode of
Nothing -> return ()
Just code -> do handleAllInput -- handle remaining input
onEndProcess code
WX.objectDelete t
]
return ()
forkIO (do takeMVar stdOutIsFinished
takeMVar stdErrIsFinished
waitForProcess pid >>= putMVar processFinished
hClose outh
hClose errh
)
return ()
where
handleAnyInput mvar withOutput =
do val <- tryTakeMVar mvar
case val of
Nothing -> return ()
Just xs -> withOutput xs
-------------------------------------------------------------------------
This SF.Net email is sponsored by the Moblin Your Move Developer's challenge
Build the coolest Linux based applications with Moblin SDK & win great prizes
Grand prize is a trip for two to an Open Source event anywhere in the world
http://moblin-contest.org/redirect.php?banner_id=100&url=/
_______________________________________________
wxhaskell-devel mailing list
wxhaskell-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/wxhaskell-devel
