module Pty (Pty, runWithPty, readPty, writePty) where

import System.Posix
import System.Posix.Pty
import qualified System.Console.Terminal.Size as Console
import System.Posix.Signals.Exts
import System.Process
import Control.Exception

-- | Run a program on a Pty.
-- 
-- 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).
--
-- A SIGWINCH handler is installed, to forward resizes to the Pty.
runWithPty :: String -> [String] -> ((Pty, ProcessHandle) -> IO a) -> IO a
runWithPty cmd params a = bracket setup cleanup go
  where
	setup = do
		as <- System.Posix.getTerminalAttributes stdInput
		sz <- Console.size
		(p, ph) <- spawnWithPty Nothing True cmd params
			(maybe 80 Console.width sz, maybe 25 Console.height sz)
		_ <- installHandler windowChange (Catch (forwardresize p)) Nothing
		-- Set the pty's terminal attributes to the same ones that
		-- the outer terminal had.
		System.Posix.Pty.setTerminalAttributes p as Immediately
		-- 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
		System.Posix.setTerminalAttributes stdInput masteras Immediately
		return (p, ph, as)
	cleanup (p, ph, as) = do
		-- Needed in case the provided action throws an exception
		-- before it waits for the process.
		terminateProcess ph
		closePty p
		_ <- installHandler windowChange Default Nothing
		System.Posix.setTerminalAttributes stdInput as Immediately
	go (p, ph, _) = a (p, ph)
	forwardresize p = do
		msz <- Console.size
		case msz of
			Nothing -> return ()
			Just sz -> resizePty p (Console.width sz, Console.height sz)