GhciGui.hs

{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -Wall #-}

-- FIXME: Change OPTIONS pragmas to LANGUAGE pragmas

module GhciGui where

import Graphics.UI.AF.WxFormAll
import qualified Protocol as P
import ECOptions()

import System(getArgs)
import System.IO (Handle, hPutStrLn, stderr)
import Network (Socket, accept, withSocketsDo)

main :: IO()
main = do args <- getArgs
          case args of
            [ghcPath] -> startGui ghcPath `catch` (\e -> hPutStrLn stderr $ "Exception raised: " ++ show e)
            _         -> do putStrLn "ghcGui <path to ghc lib>"
                            putStrLn "And your PATH=<location of GhciGui and GhcProcess>"
    where startGui ghcPath = withSocketsDo $
           do (inSocket,  inPortNumber)  <- P.listenOnRandomPort 10
              (outSocket, outPortNumber) <- P.listenOnRandomPort 10
              (runAF $ mainWindow ghcPath inSocket inPortNumber outSocket outPortNumber)
                   

data GuiState =
    GuiState { inHandle      :: Handle
             , outHandle     :: Handle
             , isExecuting   :: Bool
             }

mainWindow :: String -> Socket -> Int -> Socket -> Int -> WxM()
mainWindow ghcPath inSocket inPortNumber outSocket outPortNumber
    = do window menus
           $ addTimer 200 updateState
           $ addButtons buttons
           $ comStateM state component
         
    where
      -- It is important to "hide" away the outputArea (the sndCom bit), so that we not risk
      -- calling pickGetVal on it, as it will ruin performance.
      -- Maybe we just need to make pickGetVal lazy in the AutoForms library :)
      component  = sndCom $ join outputArea inputArea
      inputArea  = giveFocus $ multiLineEC ""
      outputArea = noValue $ label "Output" $ startGhcProcess $ multiLineEC ""
      
      state = do (inHandle', _, _)  <- io $ accept inSocket
                 (outHandle', _, _) <- io $ accept outSocket
                 return $ constState $ GuiState inHandle' outHandle' False
      startGhcProcess = executeProcess ("./GhcProcess " ++ show (ghcPath, inPortNumber, outPortNumber))
                                             onEnd doOutput doError where
          doOutput str = do appendVal (str ++ "\n")  -- have to make a newline, otherwise WxHaskell gets really slow
                                                     -- on large data series.
          doError str  = do appendVal ("Error: " ++ str ++ "\n")
          onEnd exitCode = do errorDialog "Error" ("The GhcProcess failed with exit code: " ++ show exitCode)
                              closeWindow
      updateState
          = do s <- getState
               executing <- io $ P.isExecuting $ inHandle s
               maybe (return ()) (\x -> setState s { isExecuting = x }) executing

      menus = [ ("&File", [ MenuItem optionsAction
                          , MenuItem quitAction
                          ]
                )
              , ("&Help", [ MenuItem $ alwaysEnabled "&About" $ infoDialog "GHCi GUI" aboutText
                          ]
                )
              ]
          where
            aboutText = unlines [ "GHCi GUI made with AutoForms."
                                , ""
                                , "The program was made by Mads Lindstrom."  -- FIXME: should use real ø
                                , ""
                                , "See http://autoforms.sourceforge.net"
                                ]
            optionsAction = alwaysEnabled "&Options..." $
                        do options <- doInGhc P.getOptions
                           maybeNewOptions <- lift $ blockingSettingsDialog (mkCom options)
                           maybe (return()) (doInGhc . P.setOptions) maybeNewOptions
                           
      buttons = [killButton, exec, quitAction] where
          killButton
              = Action "&Cancel" (\_ s -> isExecuting s) $ doInGhc P.kill
          exec = alwaysEnabled "&Exec" $
                   do stmt <- getVal
                      doInGhc (P.executeStmt stmt)
      doInGhc cmd = do s <- getState
                       io $ cmd $ outHandle s 

                      

{- Design rationale: Why the seperate GhcProcess?

* It seems to be the only cross-platform way. "GHC as a library"
  writes directly to stdout. Thus we need to capture this output. It
  could be done using System.Posix, but that is Unix-only. Also see
  http://www.mail-archive.com/glasgow-haskell-users@haskell.org/msg12000.html

* We can then, in the future, have multiply GhcProcesses. We can not
  do that without a seperate process, as "GHC as a library" is a one
  session-per-process design - as far as I know.

* Good seperation between GUI and "GHC as a library".

* I had major problems with deadlocks, and stronger seperation between
  GUI and "GHC as a library" helped me pinpoint where the problem was
  located.

* WxHaskell is not multi-threaded. Thus if we want a responsive GUI
  (and we do), then we need to use processExecAsyncTimed, which starts
  another process. See http://wxhaskell.sourceforge.net/faq.html

-}