module Pty where

import System.Posix.Terminal
import System.Posix
import System.Process
import System.IO
import Control.Exception

data Master a = Master a

data Slave a = Slave a

data Pty = Pty
	{ ptyMaster :: Master Handle
	, ptySlave :: Slave Handle
	}

openPty :: TerminalAttributes -> IO Pty
openPty attrs = do
	(master, slave) <- openPseudoTerminal
	setTerminalAttributes slave attrs Immediately
	hmaster <- fdToHandle master
	hslave <- fdToHandle slave
	return $ Pty (Master hmaster) (Slave hslave)

-- | Make a CreateProcess run on a Pty.
onPty :: Pty -> CreateProcess -> CreateProcess
onPty (Pty _ (Slave slave)) p = p
	{ std_in = UseHandle slave
	, std_out = UseHandle slave
	, std_err = UseHandle slave
	, close_fds = True
	-- New session makes job control work in bash, etc.
	, new_session = True
	, create_group = True
	-- ctrl-c should be sent to the process for handling.
	, delegate_ctlc = True
	}

-- | Runs an action with a child pty opened. While doing so, the
-- outer pty has echo disabled (so the child can echo), and has raw mode
-- enabled (so the child pty can see all special characters).
withChildPty :: (Pty -> IO a) -> IO a
withChildPty a = bracket setup cleanup go
  where
	setup = do
		as <- getTerminalAttributes stdInput
		-- This is similar to cfmakeraw(3).
		let masteras = as
			`withoutMode` IgnoreBreak
			`withoutMode` InterruptOnBreak
			`withoutMode` CheckParity
			`withoutMode` StripHighBit
			`withoutMode` MapLFtoCR
			`withoutMode` IgnoreCR
			`withoutMode` MapCRtoLF
			`withoutMode` StartStopOutput
			`withoutMode` ProcessOutput
			`withoutMode` EnableEcho
			`withoutMode` EchoLF
			`withoutMode` ProcessInput
			`withoutMode` KeyboardInterrupts
			`withoutMode` ExtendedFunctions
			`withoutMode` EnableParity
		setTerminalAttributes stdInput masteras Immediately
		return as
	cleanup as = setTerminalAttributes stdInput as Immediately
	go as = do
		p <- openPty as
		a p