Process.hs

module Main where

import Graphics.UI.WXCore 
import Graphics.UI.WX

main :: IO ()
main
  = start gui

gui :: IO ()
gui
  = do f      <- frame [text := "Process test"]
       p      <- panel f []                       -- panel for tab-management etc.
       input  <- comboBox p [processEnter := True, text := "cmd"]
       output <- textCtrlRich p [bgcolor := black, textColor := red, font := fontFixed{ _fontSize = 12 }]
       stop   <- button p       [text := "kill", enabled := False]
       focusOn input
       textCtrlSetEditable output False
       set f [layout := container p $
                        margin 10 $ column 5 [fill (widget output)
                                             ,row 5 [hfill (widget input), widget stop]]
             ,clientSize  := sz 600 400
             ]

       let message txt = appendText output txt
       set input [on command := startProcess f input stop message]
       return ()
  where
    startProcess f input stop message
      = do txt <- get input text
           appendText input txt
           (send,process,pid) <- processExecAsyncTimed f txt True {- process all input on termination -}
                                  (onEndProcess f input stop message) (onReceive message) (onReceive message)
           let sendLn txt = send (txt ++ "\n")
           if (pid /= 0)
            then do message ("-- start process: '" ++ txt ++ "' --\n")
                    set input [on command := sendCommand input sendLn]
                    set stop  [enabled := True, on command  := unitIO (kill pid wxSIGKILL)]
            else return ()

    sendCommand input send
      = do txt   <- get input text
           count <- comboBoxGetCount input
           appendText input txt
           set input [selection := count]
           send txt
           return ()


    onEndProcess f input stop message exitcode
      = do message ("\n-- process ended with exitcode " ++ show exitcode ++ " --\n")
           set input [on command := startProcess f input stop message]
           set stop  [enabled := False, on command  := return ()]

    onReceive message txt streamStatus
      = message txt