-----------------------------------------------------------------------------
-- 
-- Module      :  Evaluator.hs
-- Copyright   :  (c) Neil Mitchell 2007
-- License     :  
--
-- Maintainer  :  
-- Stability   :  unstable
-- Portability :  not portable, uses Gtk2Hs
--
-- Evaluator functions.
--
-----------------------------------------------------------------------------

module Evaluator (
	switchEvaluator, startEvaluator, stopEvaluator,
	startWithFile, runExternal
	) where

import Control.Concurrent
import Data.Char
import System.Directory
import System.IO
import System.Process

import PropLang.Variable

import Data
import Text.EscapeCodes
import Util


prompt :: String
prompt = "\x1B[0;32m%s>\x1B[0m \x1B[50m"

--
-- Switch the currently running evaluator
--
switchEvaluator :: Data -> IO ()
switchEvaluator dat = do
    hndl <- getHandles dat
    case hndl of
	Nothing -> do
	    startEvaluator dat Nothing
	Just (Handles inp _ _ _) -> do
	    appendText dat "\nSwitching...\n"
	    putStrLn "Switching evaluators"
	    hPutStrLn inp $ ""

--
-- Start an evaluator
--
startEvaluator :: Data -> Maybe [String] -> IO ()
startEvaluator dat args = do
	name <- getVar $ current dat
	path <- getCompilerPath name
	case path of
	    Nothing -> do
		errorMessage dat $ show name ++ " not found, please install."
	    Just x -> do
		runCompiler x
    where
	runCompiler path = do
	    name <- getVar $ current dat
	    (inp,out,err,pid) <- runExternal path args

	    appendText dat $ "\nLoading " ++ show name ++ "...\n"
	    hPutStrLn inp $ promptCmd name prompt
	    hPutStrLn inp $ "putChar '\\01'"

	    oid <- forkIO (readOut name out)
	    eid <- forkIO (readErr name err)

	    setHandles dat (Just $ Handles inp pid oid eid)

	readOut :: Evaluator -> Handle -> IO ()
	readOut Hugs hndl = do
            c <- hGetContents hndl
            let c2 = filter (/= '\r') $ tail $ dropWhile (/= '\01') c
            mapM_ app $ parseEscapeCodes c2
        readOut GHCi hndl = do
            c <- hGetContents hndl
            let c2 = filter (/= '\r') $ tail $ dropWhile (/= '\01') c
            mapM_ app $ parseEscapeCodes c2

	readErr :: Evaluator -> Handle -> IO ()
	readErr Hugs _ = return ()
        readErr GHCi hndl = do
            c <- hGetContents hndl
            let c2 = filter (/= '\r') c
            mapM_ (\x -> appendRed dat [x]) c2

        app (Left c) = appendText dat [c]
        app (Right (FormatUnknown 50)) = running dat -< False
        app (Right e) = applyEscape dat e

	getCompilerPath c = do
	    case c of
		Hugs -> getHugsPath
		_    -> getOtherPath c

--
-- Useful wrapper around runInteractiveProcess
--
runExternal :: FilePath -> Maybe [String] -> IO (Handle, Handle, Handle, ProcessHandle)
runExternal path args = do
      hndls@(inp, out, err, _) <- runInteractiveProcess path
				    (maybe [] id args)
				    Nothing Nothing
      putStrLn $ "Starting external tool: " ++ path
      hSetBuffering out NoBuffering
      hSetBuffering err NoBuffering
      hSetBuffering inp NoBuffering
      hSetBinaryMode out True
      hSetBinaryMode err True
      return hndls

--
-- Stop the currently running evaluator
--
stopEvaluator :: Data -> IO ()
stopEvaluator dat = do
    hndls <- getHandles dat
    case hndls of
	Nothing -> return ()
	Just (Handles inp pid _ _) -> do
	    setHandles dat Nothing
	    hPutStrLn inp "\n:quit\n"
	    waitForProcess pid
	    return ()

--
-- Run a compiler with a file
--
startWithFile :: Data -> IO ()
startWithFile dat = do
    path <- getVar $ filename dat
    case path of
	Nothing -> 
	    errorMessage dat "No file selected for evaluation."
	Just p  -> do
	    stopEvaluator dat
	    appendText dat "Evaluating file...\n"
	    startEvaluator dat $ Just [p]

getHugsPath :: IO (Maybe FilePath)
getHugsPath = do
    path <- findExecutable "hugs"
    case path of
        Just x -> return $ Just x
        Nothing -> do
            let guesses = ["c:\\Program Files\\WinHugs\\hugs.exe"]
            res <- mapM doesFileExist guesses
            let ans = map snd $ filter fst $ zip res guesses
            return $ if null ans then Nothing else Just (head ans)

getOtherPath :: Evaluator -> IO (Maybe FilePath)
getOtherPath = findExecutable . map toLower . show