{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module System.Terminal.Emulator.KeyboardInput.KeyPressToPty
  ( keyPressToPty,
  )
where

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char (isControl)
import System.Terminal.Emulator.KeyboardInput (KeyModifiers (..), KeyPress (..), KeyboardState (..), SpecialKey (..))

keyPressToPty :: KeyboardState -> KeyPress -> ByteString
keyPressToPty :: KeyboardState -> KeyPress -> ByteString
keyPressToPty KeyboardState {keyboardState_Locked :: KeyboardState -> Bool
keyboardState_Locked = Bool
True} KeyPress
_ = ByteString
""
keyPressToPty KeyboardState
_ (KeyPress_Char Char
c KeyModifiers
modifiers)
  | Char -> Bool
isControl Char
c = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid Control Char for KeyPress: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c
  | Bool
otherwise = Char -> KeyModifiers -> ByteString
keyToPty Char
c KeyModifiers
modifiers
keyPressToPty KeyboardState
keyboardState (KeyPress_SpecialKey SpecialKey
specialKey KeyModifiers
modifiers) = KeyboardState -> SpecialKey -> KeyModifiers -> ByteString
specialKeyToPty KeyboardState
keyboardState SpecialKey
specialKey KeyModifiers
modifiers

keyToPty :: Char -> KeyModifiers -> ByteString
keyToPty :: Char -> KeyModifiers -> ByteString
keyToPty Char
'a' KeyModifiers {ctrl :: KeyModifiers -> Bool
ctrl = Bool
True} = ByteString
"\1"
keyToPty Char
'b' KeyModifiers {ctrl :: KeyModifiers -> Bool
ctrl = Bool
True} = ByteString
"\2"
keyToPty Char
'c' KeyModifiers {ctrl :: KeyModifiers -> Bool
ctrl = Bool
True} = ByteString
"\3"
keyToPty Char
'd' KeyModifiers {ctrl :: KeyModifiers -> Bool
ctrl = Bool
True} = ByteString
"\4"
keyToPty Char
'e' KeyModifiers {ctrl :: KeyModifiers -> Bool
ctrl = Bool
True} = ByteString
"\5"
keyToPty Char
'f' KeyModifiers {ctrl :: KeyModifiers -> Bool
ctrl = Bool
True} = ByteString
"\6"
keyToPty Char
'r' KeyModifiers {ctrl :: KeyModifiers -> Bool
ctrl = Bool
True} = ByteString
"\18"
keyToPty Char
char KeyModifiers
_ = Char -> ByteString
charToByteString Char
char

specialKeyToPty :: KeyboardState -> SpecialKey -> KeyModifiers -> ByteString
specialKeyToPty :: KeyboardState -> SpecialKey -> KeyModifiers -> ByteString
specialKeyToPty KeyboardState
keyboardState SpecialKey
specialKey KeyModifiers {Bool
alt :: KeyModifiers -> Bool
alt :: Bool
alt, Bool
ctrl :: Bool
ctrl :: KeyModifiers -> Bool
ctrl, Bool
shift :: KeyModifiers -> Bool
shift :: Bool
shift, Bool
capsLock :: KeyModifiers -> Bool
capsLock :: Bool
capsLock} =
  case SpecialKey
specialKey of
    SpecialKey
SpecialKey_Escape
      | Bool
alt -> ByteString
"\ESC\ESC"
      | Bool
otherwise -> ByteString
"\ESC"
    SpecialKey
SpecialKey_F1
      | Bool
alt -> ByteString
"\ESC[1;3P"
      | Bool
ctrl -> ByteString
"\ESC[1;5P"
      | Bool
shift -> ByteString
"\ESC[1;2P"
      | Bool
otherwise -> ByteString
"\ESCOP"
    SpecialKey
SpecialKey_F2
      | Bool
alt -> ByteString
"\ESC[1;3Q"
      | Bool
ctrl -> ByteString
"\ESC[1;5Q"
      | Bool
shift -> ByteString
"\ESC[1;2Q"
      | Bool
otherwise -> ByteString
"\ESCOQ"
    SpecialKey
SpecialKey_F3
      | Bool
alt -> ByteString
"\ESC[1;3R"
      | Bool
ctrl -> ByteString
"\ESC[1;5R"
      | Bool
shift -> ByteString
"\ESC[1;2R"
      | Bool
otherwise -> ByteString
"\ESCOR"
    SpecialKey
SpecialKey_F4
      | Bool
alt -> ByteString
"\ESC[1;3S"
      | Bool
ctrl -> ByteString
"\ESC[1;5S"
      | Bool
shift -> ByteString
"\ESC[1;2S"
      | Bool
otherwise -> ByteString
"\ESCOS"
    SpecialKey
SpecialKey_F5
      | Bool
alt -> ByteString
"\ESC[15;3~"
      | Bool
ctrl -> ByteString
"\ESC[15;5~"
      | Bool
shift -> ByteString
"\ESC[15;2~"
      | Bool
otherwise -> ByteString
"\ESC[15~"
    SpecialKey
SpecialKey_F6
      | Bool
alt -> ByteString
"\ESC[17;3~"
      | Bool
ctrl -> ByteString
"\ESC[17;5~"
      | Bool
shift -> ByteString
"\ESC[17;2~"
      | Bool
otherwise -> ByteString
"\ESC[17~"
    SpecialKey
SpecialKey_F7
      | Bool
alt -> ByteString
"\ESC[18;3~"
      | Bool
ctrl -> ByteString
"\ESC[18;5~"
      | Bool
shift -> ByteString
"\ESC[18;2~"
      | Bool
otherwise -> ByteString
"\ESC[18~"
    SpecialKey
SpecialKey_F8
      | Bool
alt -> ByteString
"\ESC[19;3~"
      | Bool
ctrl -> ByteString
"\ESC[19;5~"
      | Bool
shift -> ByteString
"\ESC[19;2~"
      | Bool
otherwise -> ByteString
"\ESC[19~"
    SpecialKey
SpecialKey_F9
      | Bool
alt -> ByteString
"\ESC[20;3~"
      | Bool
ctrl -> ByteString
"\ESC[20;5~"
      | Bool
shift -> ByteString
"\ESC[20;2~"
      | Bool
otherwise -> ByteString
"\ESC[20~"
    SpecialKey
SpecialKey_F10
      | Bool
alt -> ByteString
"\ESC[21;3~"
      | Bool
ctrl -> ByteString
"\ESC[21;5~"
      | Bool
shift -> ByteString
"\ESC[21;2~"
      | Bool
otherwise -> ByteString
"\ESC[21~"
    SpecialKey
SpecialKey_F11
      | Bool
alt -> ByteString
"\ESC[23;3~"
      | Bool
ctrl -> ByteString
"\ESC[23;5~"
      | Bool
shift -> ByteString
"\ESC[23;2~"
      | Bool
otherwise -> ByteString
"\ESC[23~"
    SpecialKey
SpecialKey_F12
      | Bool
alt -> ByteString
"\ESC[24;3~"
      | Bool
ctrl -> ByteString
"\ESC[24;5~"
      | Bool
shift -> ByteString
"\ESC[24;2~"
      | Bool
otherwise -> ByteString
"\ESC[24~"
    SpecialKey
SpecialKey_Insert -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO"
    SpecialKey
SpecialKey_Delete -> ByteString
"\ESC[3~"
    SpecialKey
SpecialKey_Home -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO"
    SpecialKey
SpecialKey_End -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO"
    SpecialKey
SpecialKey_PageUp -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO"
    SpecialKey
SpecialKey_PageDown -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO"
    SpecialKey
SpecialKey_Tab -> ByteString
"\t" -- TODO modifiers
    SpecialKey
SpecialKey_Enter
      | Bool
alt Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
shift Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ctrl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
capsLock -> ByteString
"\ESC\r"
      | Bool
otherwise -> ByteString
"\r"
    SpecialKey
SpecialKey_Backspace
      | Bool
alt Bool -> Bool -> Bool
&& Bool
shift -> ByteString
"\ESC\b"
      | Bool
alt Bool -> Bool -> Bool
&& Bool
ctrl -> ByteString
"\ESC\b"
      | Bool
alt -> ByteString
"\ESC\DEL"
      | Bool
shift -> ByteString
"\b"
      | Bool
ctrl -> ByteString
"\b"
      | Bool
capsLock -> ByteString
"\b"
      | Bool
otherwise -> ByteString
"\DEL"
    SpecialKey
SpecialKey_ArrowLeft
      | KeyboardState -> Bool
keyboardState_DECCKM KeyboardState
keyboardState -> ByteString
"\ESCOD"
      | Bool
otherwise -> ByteString
"\ESC[D"
    SpecialKey
SpecialKey_ArrowRight
      | KeyboardState -> Bool
keyboardState_DECCKM KeyboardState
keyboardState -> ByteString
"\ESCOC"
      | Bool
otherwise -> ByteString
"\ESC[C"
    SpecialKey
SpecialKey_ArrowUp
      | KeyboardState -> Bool
keyboardState_DECCKM KeyboardState
keyboardState -> ByteString
"\ESCOA"
      | Bool
otherwise -> ByteString
"\ESC[A"
    SpecialKey
SpecialKey_ArrowDown
      | KeyboardState -> Bool
keyboardState_DECCKM KeyboardState
keyboardState -> ByteString
"\ESCOB"
      | Bool
otherwise -> ByteString
"\ESC[B"

charToByteString :: Char -> ByteString
charToByteString :: Char -> ByteString
charToByteString =
  -- TODO Encode as UTF-8
  Word8 -> ByteString
B.singleton (Word8 -> ByteString) -> (Char -> Word8) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum