|
Hi, thanks very much for caring for this problem and for your analysis. In the mean time I realized that Mads' WxProcess implementation indeed works well on Windows! My former mail was due to a misinterpretation of the output I observed, so I am currently happy with Mads' solution. One thing I have to note though: Trying to abort a process started with wxExecProcess using Process.terminateProcess does not work in Mads' solution. The process does in fact run to its end and then terminates - with an ExitFailure status. Therefore I changed the WxProcess code such that waiting for the two MVars stdOutIsFinished and stdErrIsFinished is done *after* waitForProcess and only if not killed (for which I had to introduce an additional IORef parameter to wxExecProcess). This works only, however, if the application is compiled with -threaded. The attached modified WxProcess.hs is what I currently use and which allows me to execute and abort processes from within my application perfectly. Best regards, Bernd shelarcy schrieb: Hi, On Wed, 05 Nov 2008 21:57:07 +0900, Bernd Holzmüller <[EMAIL PROTECTED]> wrote: -- Bernd Holzmüller Dipl.-Inform. BU Methods Processes Tools ICS AG Sonnenbergstraße 13 D-70184 Stuttgart Tel.: +49 (0) 711 / 2 10 37 - 41 Fax: +49 (0) 711 / 2 10 37 - 75 Mobile: +49 (0) 151 / 17449 534 mailto:[EMAIL PROTECTED] www.ics-ag.de Informatik Consulting Systems AG Sitz Stuttgart Handelsregister - Amtsgericht - Stuttgart HRB 18569 Aufsichtsratsvorsitzender: Dr. Jörg Kees Vorstand: Dr. Jürgen Hämer (Vorsitzender), Franz-Josef Winkel, Cid Kiefer |
{-# LANGUAGE PatternSignatures #-}
module WxProcess
( wxExecProcess
, ExitCode(..)
)
where
import Control.Concurrent -- forkIO, MVars
import System.Exit (ExitCode(..))
import System.Process (runInteractiveCommand, waitForProcess, ProcessHandle)
import System.IO
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Data.Word
import Data.IORef
-- import qualified Graphics.UI.WX as WX
import Graphics.UI.WX
import Graphics.UI.WX (Prop(..), on)
type OnReceive = String -> IO()
wxExecProcess :: Window a -> String -> Int -> IORef Bool -> (ExitCode -> IO())
-> OnReceive -> OnReceive
-> IO ProcessHandle
-- if the user needs to give input to the created process, we could return IO
(String -> IO StreamStatus) in stead
wxExecProcess parent cmd bufferSize killedByUser onEndProcess onOutput
onErrOutput =
do (inh,outh,errh,pid) <- runInteractiveCommand cmd
mapM_ (\hdl -> hSetBuffering hdl NoBuffering) [inh, outh, errh]
-- fork off two threads to start consuming the stdout and stderr 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 handleAnyInput mvar withOutput =
do val <- tryTakeMVar mvar
maybe (return ()) withOutput val
let handleAllInput = do handleAnyInput stdOutMVar onOutput
handleAnyInput stdErrMVar onErrOutput
checkOutput <- timer parent [ interval := 100 ] -- 10 times a second
set checkOutput [ on command := do
exitCode <- tryTakeMVar processFinished
handleAllInput
case exitCode of
Nothing -> return ()
Just code -> do onEndProcess code
set checkOutput [enabled := False]
]
forkIO $ do exitCode <- waitForProcess pid -- compile with -threaded to
allow other threads to be active concurrently!
wasKilled <- varGet killedByUser
let waitForOutputs = mapM_ takeMVar [stdOutIsFinished,
stdErrIsFinished]
signalFinished = putMVar processFinished exitCode
if wasKilled
then do signalFinished; waitForOutputs
else do waitForOutputs; signalFinished
hClose outh
hClose errh
return pid
------------------------------------------------------------------------- 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
