How to fake forkpty without posix-pty

pty-example.hs

#!/usr/bin/env stack
-- stack script --resolver lts --package "ioctl monad-loops process unix"
{-# LANGUAGE CPP, MultiParamTypeClasses, NondecreasingIndentation #-}
module Main where

import Control.Concurrent (forkFinally, killThread)
import Control.Concurrent.MVar (newEmptyMVar, takeMVar, tryPutMVar)
import Control.Exception (bracket, catchJust, finally)
import Control.Monad (void, when)
import Control.Monad.Fix (fix)
import Control.Monad.Loops (whileJust_)
import Foreign (Storable(..), allocaBytes, castPtr, plusPtr)
import Foreign.C (CShort)
import GHC.IO.Exception (IOErrorType(..), IOException(..))
import System.Environment (getArgs)
import System.Exit (exitWith)
import System.Posix (Handler(..), OpenFileFlags(..), OpenMode(..), TerminalMode(..), TerminalState(..), closeFd, defaultFileFlags, fdReadBuf, fdToHandle, fdWriteBuf, getTerminalAttributes, installHandler, openFd, openPseudoTerminal, setTerminalAttributes, withBits, withMinInput, withTime, withoutMode)
import System.Posix.IOCtl (IOControl(..), ioctl', ioctl_)
import System.Posix.Signals.Exts (windowChange)
import System.Process (CreateProcess(..), StdStream(..), proc, terminateProcess, waitForProcess, withCreateProcess)

#define __BEGIN_DECLS {-
#define __END_DECLS -}
#include <sys/ioctl.h>

data WinSize = WinSize
  { ws_row :: CShort
  , ws_col :: CShort
  , ws_xpixel :: CShort
  , ws_ypixel :: CShort
  }
instance Storable WinSize where
    sizeOf _ = 4 * sizeOf (0 :: CShort)
    alignment _ = alignment (0 :: CShort)
    peek p = WinSize <$>
        peekElemOff (castPtr p) 0 <*>
        peekElemOff (castPtr p) 1 <*>
        peekElemOff (castPtr p) 2 <*>
        peekElemOff (castPtr p) 3
    poke p (WinSize row col xpixel ypixel) = do
        pokeElemOff (castPtr p) 0 row
        pokeElemOff (castPtr p) 1 col
        pokeElemOff (castPtr p) 2 xpixel
        pokeElemOff (castPtr p) 3 ypixel
data IOControl_TIOCGWINSZ = IOControl_TIOCGWINSZ
instance IOControl IOControl_TIOCGWINSZ WinSize where ioctlReq _ = TIOCGWINSZ
data IOControl_TIOCSWINSZ = IOControl_TIOCSWINSZ
instance IOControl IOControl_TIOCSWINSZ WinSize where ioctlReq _ = TIOCSWINSZ

main :: IO ()
main = do
    let flags = defaultFileFlags {noctty = True}
    bracket (openFd "/dev/tty" ReadWrite Nothing flags) closeFd $ \ttyFd -> do
    bracket (getTerminalAttributes ttyFd)
        (setTerminalAttributes ttyFd `flip` WhenFlushed) $ \attrs -> do
    let raw = foldl withoutMode attrs
          [ IgnoreBreak, InterruptOnBreak, MarkParityErrors, StripHighBit
          , MapLFtoCR, IgnoreCR, MapCRtoLF, StartStopOutput, ProcessOutput
          , EnableEcho, EchoLF, ProcessInput, KeyboardInterrupts
          , ExtendedFunctions, EnableParity
          ] `withBits` 8 `withTime` 0 `withMinInput` 1
    setTerminalAttributes ttyFd raw WhenFlushed
    (masterFd, slaveFd) <- openPseudoTerminal
    let forwardWinch =
            ioctl' ttyFd IOControl_TIOCGWINSZ >>=
            ioctl_ masterFd IOControl_TIOCSWINSZ
        isEIO ex = if ioe_type ex == HardwareFault then Just ex else Nothing
        copy fdIn fdOut = allocaBytes 4096 $ \buf -> do
            let tryRead = catchJust isEIO (Just <$> fdReadBuf fdIn buf 4096)
                    (const $ return Nothing)
            whileJust_ tryRead $ \n -> flip fix 0 $ \k i ->
                when (i < n) $ fdWriteBuf fdOut (plusPtr buf $ fromIntegral i)
                    (fromIntegral $ n - i) >>= k . (i +)
    bracket (installHandler windowChange (Catch forwardWinch) Nothing)
        (installHandler windowChange `flip` Nothing) $ \_ -> do
    forwardWinch
    done <- newEmptyMVar
    void $ forkFinally (copy ttyFd masterFd) (void . tryPutMVar done)
    void $ forkFinally (copy masterFd ttyFd) (void . tryPutMVar done)
    slaveHandle <- fdToHandle slaveFd
    args <- getArgs
    let processInfo =
          ( case args of
                exe:args' -> proc exe args'
                _ -> proc "/bin/sh" []
          )
          { std_in = UseHandle slaveHandle
          , std_out = UseHandle slaveHandle
          , std_err = UseHandle slaveHandle
          , close_fds = True
          , create_group = True
          , new_session = True
          }
    withCreateProcess processInfo $ \_ _ _ processHandle -> do
    takeMVar done
    terminateProcess processHandle
    waitForProcess processHandle >>= exitWith