    {-# OPTIONS_GHC -XRecordWildCards -XCPP -XBangPatterns -fno-warn-orphans #-}
    -----------------------------------------------------------------------------
    --
    -- Module      :  IDE.Utils.Tool
    -- Copyright   :  (c) Hamish Mackenzie, Juergen Nicklisch-Franken
    -- License     :  GPL
    --
    -- Maintainer  :  <maintainer@leksah.org>
    -- Stability   :  provisional
    -- Portability :
    --
    -- | Support for running external tools.  Written mainly for GHCi but with
    -- | support for others in mind.
    --
    -----------------------------------------------------------------------------

    module IDE.Utils.Tool (
        ToolOutput(..),
        toolline,
        ToolCommand(..),
        ToolState(..),
        toolProcess,
        newToolState,
        runTool,
        runTool',
        runInteractiveTool,
        newGhci,
        newGhci',
        executeCommand,
        executeGhciCommand,
        quoteArg,
        escapeQuotes,
        runCommand,
        waitForProcess,
        interruptProcessGroupOf,
        ProcessHandle,
        getProcessExitCode,
        runInteractiveProcess,
        runProcess

    --    waitForChildren,
    --    forkChild

    ) where

    import Control.Concurrent
           (tryTakeMVar, readMVar, takeMVar, putMVar,
            newEmptyMVar, forkIO, newChan, MVar, Chan, writeChan,
            getChanContents, dupChan)
    import Control.Monad (forM_, when, unless)
    import Control.Monad.IO.Class (liftIO, MonadIO)
    import Data.List (stripPrefix)
    import Data.Maybe (catMaybes)
    #ifdef MIN_VERSION_process_leksah
    import IDE.System.Process
           (proc, waitForProcess, ProcessHandle, createProcess, CreateProcess(..),
           interruptProcessGroup, runCommand, getProcessExitCode,
           runProcess, runInteractiveProcess)
    import IDE.System.Process.Internals (StdStream(..))
    #else
    import System.Process
           (proc, waitForProcess, ProcessHandle, createProcess, CreateProcess(..),
           interruptProcessGroupOf, runCommand, getProcessExitCode,
           runProcess, runInteractiveProcess)
    import System.Process.Internals (StdStream(..))
    #endif
    #if MIN_VERSION_base(4,3,0)
    import System.IO (hGetBufSome)
    import qualified Data.ByteString.Internal as B
           (createAndTrim)
    #else
    import System.IO (hWaitForInput, hIsEOF)
    import qualified Data.ByteString as B
           (hGetNonBlocking)
    #endif
    import Control.DeepSeq
    import System.Log.Logger (debugM)
    import System.Exit (ExitCode(..))
    import System.IO (hFlush, hPutStrLn, Handle, hSetBuffering, BufferMode(..))
    import Control.Applicative ((<|>), Alternative, liftA2, liftA)
    --import Data.Enumerator.Binary as E (enumHandle)
    import Data.Enumerator as E
           (continue, tryIO, checkContinue0, (=$), (>>==), Stream(..),
            Enumeratee, Enumerator, run, ($$), ($=), (>==>))
    import qualified Data.Enumerator as E
           (enumList, returnI, Step(..), isEOF, checkDone, yield,
            Iteratee(..), sequence, run_)
    import qualified Data.Enumerator.Binary as EB (filter)
    import Data.Attoparsec.Enumerator (iterParser)
    import qualified Data.Attoparsec.Char8 as AP
           (endOfInput, takeWhile, satisfy, skipWhile, string, Parser,
            endOfLine, digit, manyTill, takeWhile1)
    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Char8 as B (unpack, pack)
    import Data.Attoparsec ((<?>))
    import qualified Data.Enumerator.List as EL
           (consume, concatMap, concatMapAccumM)
    import Data.Char (isDigit)
    import qualified System.IO as IO (Handle)
    import qualified Data.ByteString as B
           (empty, null, ByteString)
    import System.IO.Error (mkIOError, illegalOperationErrorType)

    data ToolOutput = ToolInput String
                    | ToolError String
                    | ToolOutput String
                    | ToolPrompt String
                    | ToolExit ExitCode deriving(Eq, Show)

    instance NFData ExitCode where
        rnf ExitSuccess = rnf ()
        rnf (ExitFailure failureCode) = rnf failureCode

    instance  NFData ToolOutput where
        rnf (ToolInput s) = rnf s
        rnf (ToolError s) = rnf s
        rnf (ToolOutput s) = rnf s
        rnf (ToolPrompt s) = rnf s
        rnf (ToolExit code) = rnf code

    data ToolCommand = ToolCommand String String (E.Iteratee ToolOutput IO ())
    data ToolState = ToolState {
        toolProcessMVar :: MVar ProcessHandle,
        outputClosed :: MVar Bool,
        toolCommands :: Chan ToolCommand,
        toolCommandsRead :: Chan ToolCommand,
        currentToolCommand :: MVar ToolCommand}

    toolProcess :: ToolState -> IO ProcessHandle
    toolProcess = readMVar . toolProcessMVar

    data RawToolOutput = RawToolOutput ToolOutput
                       | ToolOutClosed
                       | ToolErrClosed
                       | ToolClosed deriving(Eq, Show)

    toolline :: ToolOutput -> String
    toolline (ToolInput l)  = l
    toolline (ToolOutput l) = l
    toolline (ToolError l)  = l
    toolline (ToolPrompt l)  = l
    toolline (ToolExit _code) = ""

    quoteArg :: String -> String
    quoteArg s | ' ' `elem` s = "\"" ++ (escapeQuotes s) ++ "\""
    quoteArg s                = s

    escapeQuotes :: String -> String
    escapeQuotes = foldr (\c s -> if c == '"' then '\\':c:s else c:s) ""

    #ifdef MIN_VERSION_process_leksah
    interruptProcessGroupOf :: ProcessHandle -> IO ()
    interruptProcessGroupOf = interruptProcessGroup
    #endif

    runTool' :: FilePath -> [String] -> Maybe FilePath -> IO ([ToolOutput], ProcessHandle)
    runTool' fp args mbDir = do
        debugM "leksah-server" $ "Start: " ++ show (fp, args)
        (out,pid) <- runTool fp args mbDir
        output <- E.run_ $ out $$ EL.consume
        waitForProcess pid
        debugM "leksah-server" $ "End: " ++ show (fp, args)
        return (output,pid)

    runTool :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> IO (Enumerator ToolOutput m b, ProcessHandle)
    runTool executable arguments mbDir = do
        (Just inp,Just out,Just err,pid) <- createProcess (proc executable arguments)
            { std_in  = CreatePipe,
              std_out = CreatePipe,
              std_err = CreatePipe,
              cwd = mbDir,
    #ifdef MIN_VERSION_process_leksah
              new_group = True }
    #else
              create_group = True }
    #endif
        output <- getOutputNoPrompt inp out err pid
        return (output, pid)

    newToolState :: IO ToolState
    newToolState = do
        toolProcessMVar <- newEmptyMVar
        outputClosed <- newEmptyMVar
        toolCommands <- newChan
        toolCommandsRead <- dupChan toolCommands
        currentToolCommand <- newEmptyMVar
        return ToolState{..}

    dropToFirst :: Monad m => (a -> Bool) -> E.Iteratee a m ()
    dropToFirst p = E.continue loop where
        loop (Chunks xs) = case dropWhile p xs of
            []    -> E.continue loop
            _:xs' -> E.yield () (Chunks xs')
        loop EOF = E.yield () EOF

    isolateToFirst :: Monad m => (a -> Bool) -> Enumeratee a a m b
    isolateToFirst p (E.Continue k) = E.continue loop where
        loop (Chunks []) = E.continue loop
        loop (Chunks xs) =
            case span p xs of
                (_, [])    -> k (Chunks xs) >>== isolateToFirst p
                (s1, t:s2) -> k (Chunks (s1++[t])) >>== (\step -> E.yield step (Chunks s2))
        loop EOF = k EOF >>== (\step -> E.yield step EOF)
    isolateToFirst p step = dropToFirst p >> return step

    runInteractiveTool ::
        ToolState ->
        CommandLineReader ->
        FilePath ->
        [String] ->
        IO ()
    runInteractiveTool tool clr executable arguments = do
        (Just inp,Just out,Just err,pid) <- createProcess (proc executable arguments)
            { std_in  = CreatePipe,
              std_out = CreatePipe,
              std_err = CreatePipe,
    #ifdef MIN_VERSION_process_leksah
              new_group = True }
    #else
              create_group = True }
    #endif
        putMVar (toolProcessMVar tool) pid
        output <- getOutput clr inp out err pid

        forkIO $ do
            commands <- getChanContents (toolCommandsRead tool)
            E.run_ $ output $$ outputSequence inp $$ processCommand commands inp
            return ()
        return ()
      where
        isEndOfCommandOutput (ToolPrompt _) = True
        isEndOfCommandOutput (ToolExit _) = True
        isEndOfCommandOutput _ = False

        isolateCommandOutput = isolateToFirst (not . isEndOfCommandOutput)

        processCommand [] _ = do
            liftIO $ debugM "leksah-server" $ "No More Commands"
            return ()
        processCommand ((command@(ToolCommand commandString rawCommandString handler)):remainingCommands) inp = do
            liftIO $ putMVar (currentToolCommand tool) command
            liftIO $ hPutStrLn inp commandString
            liftIO $ hFlush inp

            (E.enumList 1 (map ToolInput (lines rawCommandString)) >==> isolateCommandOutput) =$ handler
            processCommand remainingCommands inp

        outputSequence :: Handle -> E.Enumeratee RawToolOutput ToolOutput IO b
        outputSequence inp =
            EL.concatMapAccumM writeCommandOutput (False, False, (outputSyncCommand clr), 0, "")
          where
            writeCommandOutput (False, False, (Just outSyncCmd), n, _) (RawToolOutput (ToolPrompt line)) = do
                debugM "leksah-server" $ "Pre Sync Prompt"
                hPutStrLn inp $ outSyncCmd n
                hFlush inp
                return ((True, False, (Just outSyncCmd), n, line), [])
            writeCommandOutput (True, False, mbSyncCmd, n, promptLine) (RawToolOutput (ToolPrompt _)) = do
                debugM "leksah-server" $ "Unsynced Prompt"
                return ((True, False, mbSyncCmd, n, promptLine), [])
            writeCommandOutput (True, False, mbSyncCmd, n, promptLine) (RawToolOutput o@(ToolOutput line)) = do
                let synced = (isExpectedOutput clr n line)
                when synced $ debugM "leksah-server" $ "Output Sync Found"
                return ((True, synced, mbSyncCmd, n, promptLine), if synced then [] else [o])
            writeCommandOutput (_, _, mbSyncCmd, n, promptLine) (RawToolOutput (ToolPrompt _)) = do
                debugM "leksah-server" $ "Synced Prompt - Ready For Next Command"
                tryTakeMVar (currentToolCommand tool)
                return ((False, False, mbSyncCmd, n+1, promptLine), [ToolPrompt promptLine])
            writeCommandOutput s (RawToolOutput o@(ToolExit _)) = do
                debugM "leksah-server" $ "Tool Exit"
                putMVar (outputClosed tool) True
                return (s, [o])
            writeCommandOutput s (RawToolOutput o) = do
                return (s, [o])
            writeCommandOutput s x = do
                debugM "leksah-server" $ "Unexpected output " ++ show x
                return (s, [])

    {-
    newInteractiveTool :: (Handle -> Handle -> Handle -> ProcessHandle -> IO [RawToolOutput]) -> FilePath -> [String] -> IO ToolState
    newInteractiveTool getOutput' executable arguments = do
        tool <- newToolState
        runInteractiveTool tool getOutput' executable arguments
        return tool
    -}

    ghciPrompt :: String
    ghciPrompt = "3KM2KWR7LZZbHdXfHUOA5YBBsJVYoCQnKX"

    data CommandLineReader = CommandLineReader {
        parseInitialPrompt :: AP.Parser String,
        parseFollowingPrompt :: AP.Parser String,
        errorSyncCommand :: Maybe (Int -> String),
        parseExpectedError :: AP.Parser (String, Int),
        outputSyncCommand :: Maybe (Int -> String),
        isExpectedOutput :: Int -> String -> Bool
        }

    ghciParseInitialPrompt :: AP.Parser String
    ghciParseInitialPrompt = (do
            ((AP.string $ B.pack "Prelude") <|> (AP.string $ B.pack "*"))
            AP.skipWhile (\c -> c /= '>' && c/= '\n')
            AP.string $ B.pack "> "
            return "")
        <?> "ghciParseInitialPrompt"

    ghciParseFollowingPrompt :: AP.Parser String
    ghciParseFollowingPrompt = (do
            AP.satisfy (/='\n') `AP.manyTill` (AP.string $ B.pack $ ghciPrompt))
        <?> "ghciParseFollowingPrompt"

    marker :: Int -> String
    marker n = "kMAKWRALZZbHdXfHUOAAYBB" ++ show n

    parseMarker :: AP.Parser Int
    parseMarker = (do
            AP.string $ B.pack "kMAKWRALZZbHdXfHUOAAYBB"
            nums <- AP.takeWhile isDigit
            return . read $ B.unpack nums)
        <?> "parseMarker"

    ghciParseExpectedErrorCols :: AP.Parser ()
    ghciParseExpectedErrorCols = (do
            AP.string $ B.pack "0-"
            AP.digit
            AP.digit
            return ())
        <|> (do
            AP.string $ B.pack "1-"
            AP.digit
            AP.digit
            return ())
        <|> (do
            AP.string $ B.pack "0"
            return ())
        <|> (do
            AP.string $ B.pack "1"
            return ())
        <?> "ghciParseExpectedErrorCols"

    manyTill' :: Alternative f => f a -> f b -> f ([a], b)
    manyTill' p end = scan
        where scan = liftA (\b -> ([], b)) end <|> liftA2 (\a (as, b) -> (a:as, b)) p scan

    ghciParseExpectedError :: AP.Parser (String, Int)
    ghciParseExpectedError = (do
           AP.satisfy (/='\n') `manyTill'` (do
            AP.string $ B.pack "\n<interactive>:"
            AP.takeWhile1 isDigit
            AP.string $ B.pack ":"
            ghciParseExpectedErrorCols
            AP.string $ B.pack ": Not in scope: `"
            result <- parseMarker
            AP.string $ B.pack "'\n"
            return result))
        <?> "ghciParseExpectedError"

    ghciIsExpectedOutput :: Int -> String -> Bool
    ghciIsExpectedOutput n =
        (==) (marker n)

    ghciCommandLineReader :: CommandLineReader
    ghciCommandLineReader    = CommandLineReader {
        parseInitialPrompt   = ghciParseInitialPrompt,
        parseFollowingPrompt = ghciParseFollowingPrompt,
        errorSyncCommand     = Just $ \n -> marker n,
        parseExpectedError   = ghciParseExpectedError,
        outputSyncCommand    = Just $ \n -> ":set prompt \"" ++ marker n ++ "\\n\"\n:set prompt " ++ ghciPrompt,
        isExpectedOutput     = ghciIsExpectedOutput
        }

    noInputCommandLineReader :: CommandLineReader
    noInputCommandLineReader = CommandLineReader {
        parseInitialPrompt = fail "No Prompt Expected",
        parseFollowingPrompt = fail "No Prompt Expected",
        errorSyncCommand = Nothing,
        parseExpectedError = fail "No Expected Errors",
        outputSyncCommand = Nothing,
        isExpectedOutput = \_ _ -> False
        }

    parseError :: AP.Parser (String, Int) -> AP.Parser (Either (String, Int) ByteString)
    parseError expectedErrorParser = (do
            expected <- expectedErrorParser
            return $ Left expected)
        <|> (do
            line <- AP.takeWhile (/= '\n')
            (AP.endOfInput <|> AP.endOfLine)
            return $ Right line)
        <?> "parseError"

    -- From enumerator but using hGetSome (to fix Win32)
    enumHandle :: MonadIO m
               => Integer -- ^ Buffer size
               -> IO.Handle
               -> Enumerator B.ByteString m b
    enumHandle bufferSize h = checkContinue0 $ \loop k -> do
        let intSize = fromInteger bufferSize

        bytes <- tryIO (hGetSome h intSize)
        if B.null bytes
            then continue k
            else k (Chunks [bytes]) >>== loop

    -- From byteString (for GHC 6.12.3 support)
    hGetSome :: Handle -> Int -> IO ByteString
    hGetSome hh i
    #if MIN_VERSION_base(4,3,0)
        | i >  0    = B.createAndTrim i $ \p -> hGetBufSome hh p i
    #else
        | i >  0    = let
                       loop = do
                         s <- B.hGetNonBlocking hh i
                         if not (B.null s)
                            then return s
                            else do eof <- hIsEOF hh
                                    if eof then return s
                                           else hWaitForInput hh (-1) >> loop
                                             -- for this to work correctly, the
                                             -- Handle should be in binary mode
                                             -- (see GHC ticket #3808)
                      in loop
    #endif
        | i == 0    = return B.empty
        | otherwise = illegalBufferSize hh "hGetSome" i

    illegalBufferSize :: Handle -> String -> Int -> IO a
    illegalBufferSize handle fn sz =
        ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing)
        --TODO: System.IO uses InvalidArgument here, but it's not exported :-(
        where
          msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []

    getOutput :: MonadIO m => CommandLineReader -> Handle -> Handle -> Handle -> ProcessHandle
        -> IO (Enumerator RawToolOutput m b)
    getOutput clr inp out err pid = do
        hSetBuffering out NoBuffering
        hSetBuffering err NoBuffering
        mvar <- newEmptyMVar
        foundExpectedError <- liftIO $ newEmptyMVar
        forkIO $ do
            readError mvar err foundExpectedError
            putMVar mvar ToolErrClosed
        forkIO $ do
            readOutput mvar out foundExpectedError
            putMVar mvar ToolOutClosed
        return $ enumOutput mvar
      where
        enumOutput :: MonadIO m => MVar RawToolOutput -> Enumerator RawToolOutput m b
        enumOutput = loop (0::Int) where
            loop closed mvar (E.Continue k) | closed < 2 = do
                v <- liftIO $ takeMVar mvar
                let (nowClosed, chunk) = if (v == ToolOutClosed) || (v == ToolErrClosed)
                                            then (closed + 1, [])
                                            else (closed, [v])
                if nowClosed == 2
                    then do
                        exitCode <- liftIO $ waitForProcess pid
                        k (Chunks [RawToolOutput (ToolExit exitCode)]) >>== loop nowClosed mvar
                    else k (Chunks chunk) >>== loop nowClosed mvar
            loop _ _ step = E.returnI step

        readError :: MVar RawToolOutput -> Handle -> MVar Int -> IO ()
        readError mvar errors foundExpectedError = do
            result <- E.run $ (enumHandle 2048 errors $= EB.filter (/= 13))
                        $$ (E.sequence (iterParser $ parseError (parseExpectedError clr)))
                        $$ sendErrors
            case result of
                Left e  -> putStrLn $ show e
                Right _ -> return ()
            return ()
          where
            sendErrors = E.continue loop
                where
                    loop (E.Chunks xs) = do
                        forM_ xs $ \x -> liftIO $ do
                            debugM "leksah-server" $ show x
                            case x of
                                Left (line, counter) -> do
                                    unless (null line) $ putMVar mvar $ RawToolOutput $ ToolError line
                                    putMVar foundExpectedError counter
                                Right line   -> putMVar mvar $ RawToolOutput $ ToolError (B.unpack line)
                        E.continue loop
                    loop E.EOF = E.yield () E.EOF

        outputSequence :: E.Iteratee ao IO ToolOutput -> E.Iteratee ao IO ToolOutput -> E.Enumeratee ao ToolOutput IO b
        outputSequence i1 i2 = loop i1 where
            loop i = E.checkDone check
              where
                check k = E.isEOF >>= \f -> if f
                    then E.yield (E.Continue k) EOF
                    else step k
                step k = i >>= \v ->
                    case v of
                        ToolPrompt _ -> k (Chunks [v]) >>== loop i2
                        _ -> k (Chunks [v]) >>== loop i

        readOutput :: MVar RawToolOutput -> Handle -> MVar Int -> IO ()
        readOutput mvar output foundExpectedError = do
            let parseLines parsePrompt = (do
                        lineSoFar <- parsePrompt
                        return $ ToolPrompt lineSoFar)
                    <|> (do
                        line <- AP.takeWhile (/= '\n')
                        (AP.endOfInput <|> AP.endOfLine)
                        return . ToolOutput $ B.unpack line)
                    <?> "parseLines"
                parseInitialLines = parseLines (parseInitialPrompt clr)
                parseFollowinglines = parseLines (parseFollowingPrompt clr)
            E.run_ $ (enumHandle 2048 output $= EB.filter (/= 13))
                        $$ outputSequence (iterParser parseInitialLines) (iterParser parseFollowinglines)
                        $$ sendErrors
            return ()
          where
            sendErrors = E.continue (loop 0 False "")
                where
                    loop counter errSynced promptLine (E.Chunks xs) = do
                        forM_ xs $ \x -> do
                            liftIO $ debugM "leksah-server" $ show x
                            case x of
                                ToolPrompt line -> do
                                    case (counter, errSynced, errorSyncCommand clr) of
                                        (0, _, _) -> do
                                            E.continue (loop (counter+1) errSynced line)
                                        (_, False, Just syncCmd) -> do
                                            liftIO $ do
                                                debugM "leksah-server" $ "sendErrors - Sync " ++ show counter
                                                hPutStrLn inp $ syncCmd counter
                                                hFlush inp
                                                waitForError counter
                                                debugM "leksah-server" $ "sendErrors - Synced " ++ show counter
                                            E.continue (loop (counter+1) True line)
                                        (_, True, Just _) -> do
                                            liftIO $ putMVar mvar $ RawToolOutput (ToolPrompt promptLine)
                                            E.continue (loop (counter+1) False promptLine)
                                        _ -> do
                                            liftIO $ putMVar mvar $ RawToolOutput x
                                            E.continue (loop (counter+1) False promptLine)
                                _ -> do
                                    liftIO . putMVar mvar $ RawToolOutput x
                                    E.continue (loop counter errSynced promptLine)
                    loop _ _ _ E.EOF = E.yield () E.EOF

            waitForError counter = do
                foundCount <- takeMVar foundExpectedError
                debugM "leksah-server" $ "waitForError - Found " ++ show foundCount
                when (foundCount < counter) $ waitForError counter

    fromRawOutput :: RawToolOutput -> [ToolOutput]
    fromRawOutput (RawToolOutput output) = [output]
    fromRawOutput (_) = []

    getOutputNoPrompt :: MonadIO m => Handle -> Handle -> Handle -> ProcessHandle -> IO (Enumerator ToolOutput m b)
    getOutputNoPrompt inp out err pid = do
        output <- getOutput noInputCommandLineReader inp out err pid
        return $ output $= EL.concatMap fromRawOutput

    newGhci' :: [String] -> (E.Iteratee ToolOutput IO ()) -> IO ToolState
    newGhci' flags startupOutputHandler = do
        tool <- newToolState
        writeChan (toolCommands tool) $
            ToolCommand (":set prompt " ++ ghciPrompt) "" startupOutputHandler
        runInteractiveTool tool ghciCommandLineReader "ghci" flags
        return tool

    newGhci :: [String] -> [String] -> (E.Iteratee ToolOutput IO ()) -> IO ToolState
    newGhci buildFlags interactiveFlags startupOutputHandler = do
            tool <- newToolState
            writeChan (toolCommands tool) $
                ToolCommand (":set prompt " ++ ghciPrompt) "" startupOutputHandler
            debugM "leksah-server" $ "Working out GHCi options"
            forkIO $ do
                (out, _) <- runTool "cabal" (["build","--with-ghc=leksahecho"] ++ buildFlags) Nothing
                output <- E.run_ $ out $$ EL.consume
                case catMaybes $ map (findMake . toolline) output of
                    options:_ -> do
                            let newOptions = filterUnwanted options
                            debugM "leksah-server" $ newOptions
                            debugM "leksah-server" $ "Starting GHCi"
                            debugM "leksah-server" $ unwords (words newOptions ++ ["-fforce-recomp"] ++ interactiveFlags)
                            runInteractiveTool tool ghciCommandLineReader "ghci"
                                (words newOptions ++ ["-fforce-recomp"] ++ interactiveFlags)
                    _ -> do
                        E.run $ E.enumList 1 output $$ startupOutputHandler
                        putMVar (outputClosed tool) True
            return tool
        where
            findMake [] = Nothing
            findMake line@(_:xs) =
                    case stripPrefix "--make " line of
                        Nothing -> findMake xs
                        s -> s
            filterUnwanted [] = []
            filterUnwanted line@(x:xs) =
                    case stripPrefix "-O " line of
                        Nothing -> x: filterUnwanted xs
                        Just s  -> filterUnwanted s

    executeCommand :: ToolState -> String -> String -> E.Iteratee ToolOutput IO () -> IO ()
    executeCommand tool command rawCommand handler = do
        writeChan (toolCommands tool) $ ToolCommand command rawCommand handler

    executeGhciCommand :: ToolState -> String -> E.Iteratee ToolOutput IO () -> IO ()
    executeGhciCommand tool command handler = do
        if '\n' `elem` command
            then executeCommand tool safeCommand command handler
            else executeCommand tool command command handler
        where
            filteredLines = (filter safeLine (lines command))
            safeCommand = ":cmd (return " ++ show (":{\n" ++ unlines filteredLines ++ "\n:}") ++ ")"
            safeLine ":{" = False
            safeLine ":}" = False
            safeLine _ = True

    --children :: MVar [MVar ()]
    --children = unsafePerformIO (newMVar [])
    --
    --waitForChildren :: IO ()
    --waitForChildren = do
    --  cs <- takeMVar children
    --  case cs of
    --    []   -> return ()
    --    m:ms -> do
    --       putMVar children ms
    --       takeMVar m
    --       waitForChildren
    --
    --forkChild :: IO () -> IO ThreadId
    --forkChild io = do
    --    mvar <- newEmptyMVar
    --    childs <- takeMVar children
    --    putMVar children (mvar:childs)
    --    forkIO (io `finally` putMVar mvar ())