{-# LANGUAGE OverloadedStrings #-}

module System.Terminal.Emulator.Parsing.Internal where

import Control.Applicative ((<|>))
import Data.Attoparsec.Text
import Data.Char (isDigit)
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Read as T
import qualified Data.Vector as V
import System.Terminal.Emulator.DECPrivateMode (intToDECPrivateMode)
import System.Terminal.Emulator.Parsing.Types (ControlSequenceIntroducer (..), DeviceStatusReport (..), EraseInDisplayParam (..), EraseInLineParam (..), EscapeSequence (..), Mode (..), OperatingSystemCommand (..), SendDeviceAttributesSecondary (RequestTerminalIdentificationCode), SingleCharacterFunction (..), TermAtom (..), WindowManipulation (..), codeToSGR)
import Prelude hiding (takeWhile)

parseTermAtom :: Parser TermAtom
parseTermAtom :: Parser TermAtom
parseTermAtom =
  Parser TermAtom
parseVisibleChar Parser TermAtom -> Parser TermAtom -> Parser TermAtom
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TermAtom
parseControl

parseVisibleChar :: Parser TermAtom
parseVisibleChar :: Parser TermAtom
parseVisibleChar = Char -> TermAtom
TermAtom_VisibleChar (Char -> TermAtom) -> Parser Text Char -> Parser TermAtom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isControl)

-- | This parser always succeeds
parseControl :: Parser TermAtom
parseControl :: Parser TermAtom
parseControl = do
  Char
c <- Parser Text Char
anyChar
  if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\ESC'
    then Parser TermAtom
parseEscape
    else TermAtom -> Parser TermAtom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermAtom -> Parser TermAtom) -> TermAtom -> Parser TermAtom
forall a b. (a -> b) -> a -> b
$ case Char -> Maybe SingleCharacterFunction
singleCharacterFunction Char
c of
      Maybe SingleCharacterFunction
Nothing -> Char -> TermAtom
TermAtom_SingleCharacterFunctionUnknown Char
c
      Just SingleCharacterFunction
f -> SingleCharacterFunction -> TermAtom
TermAtom_SingleCharacterFunction SingleCharacterFunction
f

singleCharacterFunction :: Char -> Maybe SingleCharacterFunction
singleCharacterFunction :: Char -> Maybe SingleCharacterFunction
singleCharacterFunction Char
'\a' = SingleCharacterFunction -> Maybe SingleCharacterFunction
forall a. a -> Maybe a
Just SingleCharacterFunction
Control_Bell
singleCharacterFunction Char
'\b' = SingleCharacterFunction -> Maybe SingleCharacterFunction
forall a. a -> Maybe a
Just SingleCharacterFunction
Control_Backspace
singleCharacterFunction Char
'\r' = SingleCharacterFunction -> Maybe SingleCharacterFunction
forall a. a -> Maybe a
Just SingleCharacterFunction
Control_CarriageReturn
singleCharacterFunction Char
'\ENQ' = SingleCharacterFunction -> Maybe SingleCharacterFunction
forall a. a -> Maybe a
Just SingleCharacterFunction
Control_ReturnTerminalStatus
singleCharacterFunction Char
'\f' = SingleCharacterFunction -> Maybe SingleCharacterFunction
forall a. a -> Maybe a
Just SingleCharacterFunction
Control_FormFeed
singleCharacterFunction Char
'\n' = SingleCharacterFunction -> Maybe SingleCharacterFunction
forall a. a -> Maybe a
Just SingleCharacterFunction
Control_LineFeed
singleCharacterFunction Char
'\SI' = SingleCharacterFunction -> Maybe SingleCharacterFunction
forall a. a -> Maybe a
Just SingleCharacterFunction
Control_SwitchToStandardCharacterSet
singleCharacterFunction Char
'\SO' = SingleCharacterFunction -> Maybe SingleCharacterFunction
forall a. a -> Maybe a
Just SingleCharacterFunction
Control_SwitchToAlternateCharacterSet
singleCharacterFunction Char
'\t' = SingleCharacterFunction -> Maybe SingleCharacterFunction
forall a. a -> Maybe a
Just SingleCharacterFunction
Control_Tab
singleCharacterFunction Char
'\v' = SingleCharacterFunction -> Maybe SingleCharacterFunction
forall a. a -> Maybe a
Just SingleCharacterFunction
Control_VerticalTab
singleCharacterFunction Char
_ = Maybe SingleCharacterFunction
forall a. Maybe a
Nothing

-- | This parser always succeeds
parseEscape :: Parser TermAtom
parseEscape :: Parser TermAtom
parseEscape = do
  Char
c <- Parser Text Char
anyChar
  case Char
c of
    Char
'[' -> Parser TermAtom
handleCsi
    Char
']' -> Parser TermAtom
handleOsc
    Char
'(' -> Parser TermAtom
handleSetG0CharacterSet
    Char
_ -> Char -> Parser TermAtom
handleSingle Char
c
  where
    handleCsi :: Parser TermAtom
    handleCsi :: Parser TermAtom
handleCsi = do
      ControlSequenceIntroducerInput
csiInput <- Parser ControlSequenceIntroducerInput
parseControlSequenceIntroducer
      TermAtom -> Parser TermAtom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermAtom -> Parser TermAtom) -> TermAtom -> Parser TermAtom
forall a b. (a -> b) -> a -> b
$ case ControlSequenceIntroducerInput -> Maybe ControlSequenceIntroducer
processControlSequenceIntroducer ControlSequenceIntroducerInput
csiInput of
        Maybe ControlSequenceIntroducer
Nothing -> case ControlSequenceIntroducerInput -> Maybe ControlSequenceIntroducer
processOtherControlSequenceIntroducer ControlSequenceIntroducerInput
csiInput of
          Maybe ControlSequenceIntroducer
Nothing -> Text -> TermAtom
TermAtom_EscapeSequenceUnknown (ControlSequenceIntroducerInput -> Text
renderCsi ControlSequenceIntroducerInput
csiInput)
          Just ControlSequenceIntroducer
csi -> EscapeSequence -> TermAtom
TermAtom_EscapeSequence (ControlSequenceIntroducer -> EscapeSequence
Esc_CSI ControlSequenceIntroducer
csi)
        Just ControlSequenceIntroducer
csi -> EscapeSequence -> TermAtom
TermAtom_EscapeSequence (ControlSequenceIntroducer -> EscapeSequence
Esc_CSI ControlSequenceIntroducer
csi)

    handleOsc :: Parser TermAtom
    handleOsc :: Parser TermAtom
handleOsc = do
      OperatingSystemCommandInput
oscInput <- Parser OperatingSystemCommandInput
parseOperatingSystemCommand
      TermAtom -> Parser TermAtom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermAtom -> Parser TermAtom) -> TermAtom -> Parser TermAtom
forall a b. (a -> b) -> a -> b
$ case OperatingSystemCommandInput -> Maybe OperatingSystemCommand
processOperatingSystemCommand OperatingSystemCommandInput
oscInput of
        Maybe OperatingSystemCommand
Nothing -> Text -> TermAtom
TermAtom_EscapeSequenceUnknown (OperatingSystemCommandInput -> Text
renderOsc OperatingSystemCommandInput
oscInput)
        Just OperatingSystemCommand
osc -> EscapeSequence -> TermAtom
TermAtom_EscapeSequence (OperatingSystemCommand -> EscapeSequence
Esc_OSC OperatingSystemCommand
osc)

    handleSingle :: Char -> Parser TermAtom
    handleSingle :: Char -> Parser TermAtom
handleSingle Char
c = TermAtom -> Parser TermAtom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermAtom -> Parser TermAtom) -> TermAtom -> Parser TermAtom
forall a b. (a -> b) -> a -> b
$ case Char -> Maybe EscapeSequence
singleCharacterEscapeSequence Char
c of
      Just EscapeSequence
e -> EscapeSequence -> TermAtom
TermAtom_EscapeSequence EscapeSequence
e
      Maybe EscapeSequence
Nothing -> Text -> TermAtom
TermAtom_EscapeSequenceUnknown (Text
"\ESC" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c)

    handleSetG0CharacterSet :: Parser TermAtom
    handleSetG0CharacterSet :: Parser TermAtom
handleSetG0CharacterSet =
      ( [Parser Text Text] -> Parser Text Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
          [ Text -> Parser Text Text
string Text
"A",
            Text -> Parser Text Text
string Text
"B",
            Text -> Parser Text Text
string Text
"C",
            Text -> Parser Text Text
string Text
"5",
            Text -> Parser Text Text
string Text
"H",
            Text -> Parser Text Text
string Text
"7",
            Text -> Parser Text Text
string Text
"K",
            Text -> Parser Text Text
string Text
"Q",
            Text -> Parser Text Text
string Text
"9",
            Text -> Parser Text Text
string Text
"R",
            Text -> Parser Text Text
string Text
"f",
            Text -> Parser Text Text
string Text
"Y",
            Text -> Parser Text Text
string Text
"Z",
            Text -> Parser Text Text
string Text
"4",
            Text -> Parser Text Text
string Text
"\">",
            Text -> Parser Text Text
string Text
"%2",
            Text -> Parser Text Text
string Text
"%6",
            Text -> Parser Text Text
string Text
"%=",
            Text -> Parser Text Text
string Text
"=",
            Text -> Parser Text Text
string Text
"`",
            Text -> Parser Text Text
string Text
"E",
            Text -> Parser Text Text
string Text
"6",
            Text -> Parser Text Text
string Text
"0",
            Text -> Parser Text Text
string Text
"<",
            Text -> Parser Text Text
string Text
">",
            Text -> Parser Text Text
string Text
"\"4",
            Text -> Parser Text Text
string Text
"\"?",
            Text -> Parser Text Text
string Text
"%0",
            Text -> Parser Text Text
string Text
"%5",
            Text -> Parser Text Text
string Text
"&4",
            Text -> Parser Text Text
string Text
"%3",
            Text -> Parser Text Text
string Text
"&5"
          ]
          Parser Text Text -> (Text -> Parser TermAtom) -> Parser TermAtom
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TermAtom -> Parser TermAtom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermAtom -> Parser TermAtom)
-> (Text -> TermAtom) -> Text -> Parser TermAtom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EscapeSequence -> TermAtom
TermAtom_EscapeSequence (EscapeSequence -> TermAtom)
-> (Text -> EscapeSequence) -> Text -> TermAtom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> EscapeSequence
ESC_SetG0CharacterSet
      )
        Parser TermAtom -> Parser TermAtom -> Parser TermAtom
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( Parser Text Char
anyChar Parser Text Char -> (Char -> Parser TermAtom) -> Parser TermAtom
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c ->
                TermAtom -> Parser TermAtom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> TermAtom
TermAtom_EscapeSequenceUnknown (Text
"\ESC(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c))
            )

-----------------------------------------------------------------------
-- CSI (Control Sequence Introducer) sequences
-----------------------------------------------------------------------

data ControlSequenceIntroducerInput = ControlSequenceIntroducerInput !Text
  deriving (Int -> ControlSequenceIntroducerInput -> ShowS
[ControlSequenceIntroducerInput] -> ShowS
ControlSequenceIntroducerInput -> String
(Int -> ControlSequenceIntroducerInput -> ShowS)
-> (ControlSequenceIntroducerInput -> String)
-> ([ControlSequenceIntroducerInput] -> ShowS)
-> Show ControlSequenceIntroducerInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlSequenceIntroducerInput] -> ShowS
$cshowList :: [ControlSequenceIntroducerInput] -> ShowS
show :: ControlSequenceIntroducerInput -> String
$cshow :: ControlSequenceIntroducerInput -> String
showsPrec :: Int -> ControlSequenceIntroducerInput -> ShowS
$cshowsPrec :: Int -> ControlSequenceIntroducerInput -> ShowS
Show, ControlSequenceIntroducerInput
-> ControlSequenceIntroducerInput -> Bool
(ControlSequenceIntroducerInput
 -> ControlSequenceIntroducerInput -> Bool)
-> (ControlSequenceIntroducerInput
    -> ControlSequenceIntroducerInput -> Bool)
-> Eq ControlSequenceIntroducerInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControlSequenceIntroducerInput
-> ControlSequenceIntroducerInput -> Bool
$c/= :: ControlSequenceIntroducerInput
-> ControlSequenceIntroducerInput -> Bool
== :: ControlSequenceIntroducerInput
-> ControlSequenceIntroducerInput -> Bool
$c== :: ControlSequenceIntroducerInput
-> ControlSequenceIntroducerInput -> Bool
Eq)

data ControlSequenceIntroducerComponents
  = ControlSequenceIntroducerComponents
      !Bool
      -- ^ Private?
      !(NonEmpty Int)
      -- ^ Args
      !Char
      -- ^ Mode
  deriving (Int -> ControlSequenceIntroducerComponents -> ShowS
[ControlSequenceIntroducerComponents] -> ShowS
ControlSequenceIntroducerComponents -> String
(Int -> ControlSequenceIntroducerComponents -> ShowS)
-> (ControlSequenceIntroducerComponents -> String)
-> ([ControlSequenceIntroducerComponents] -> ShowS)
-> Show ControlSequenceIntroducerComponents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlSequenceIntroducerComponents] -> ShowS
$cshowList :: [ControlSequenceIntroducerComponents] -> ShowS
show :: ControlSequenceIntroducerComponents -> String
$cshow :: ControlSequenceIntroducerComponents -> String
showsPrec :: Int -> ControlSequenceIntroducerComponents -> ShowS
$cshowsPrec :: Int -> ControlSequenceIntroducerComponents -> ShowS
Show, ControlSequenceIntroducerComponents
-> ControlSequenceIntroducerComponents -> Bool
(ControlSequenceIntroducerComponents
 -> ControlSequenceIntroducerComponents -> Bool)
-> (ControlSequenceIntroducerComponents
    -> ControlSequenceIntroducerComponents -> Bool)
-> Eq ControlSequenceIntroducerComponents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControlSequenceIntroducerComponents
-> ControlSequenceIntroducerComponents -> Bool
$c/= :: ControlSequenceIntroducerComponents
-> ControlSequenceIntroducerComponents -> Bool
== :: ControlSequenceIntroducerComponents
-> ControlSequenceIntroducerComponents -> Bool
$c== :: ControlSequenceIntroducerComponents
-> ControlSequenceIntroducerComponents -> Bool
Eq)

-- | Should be run after reading the sequence @ESC [@
--
-- This parser always succeeds
parseControlSequenceIntroducer :: Parser ControlSequenceIntroducerInput
parseControlSequenceIntroducer :: Parser ControlSequenceIntroducerInput
parseControlSequenceIntroducer = do
  Text
str <- (Char -> Bool) -> Parser Text Text
takeTill ((Int -> (Int, Int) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`between` (Int
0x40, Int
0x7E)) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)
  Char
c <- Parser Text Char
anyChar
  ControlSequenceIntroducerInput
-> Parser ControlSequenceIntroducerInput
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ControlSequenceIntroducerInput
ControlSequenceIntroducerInput ((Text
str) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c))

parseControlSequenceIntroducerComponents :: ControlSequenceIntroducerInput -> Maybe ControlSequenceIntroducerComponents
parseControlSequenceIntroducerComponents :: ControlSequenceIntroducerInput
-> Maybe ControlSequenceIntroducerComponents
parseControlSequenceIntroducerComponents (ControlSequenceIntroducerInput Text
str) =
  case Parser ControlSequenceIntroducerComponents
-> Text -> Either String ControlSequenceIntroducerComponents
forall a. Parser a -> Text -> Either String a
parseOnly (Parser ControlSequenceIntroducerComponents
parser Parser ControlSequenceIntroducerComponents
-> Parser Text () -> Parser ControlSequenceIntroducerComponents
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput) Text
str of
    Left String
_ -> Maybe ControlSequenceIntroducerComponents
forall a. Maybe a
Nothing
    Right ControlSequenceIntroducerComponents
val -> ControlSequenceIntroducerComponents
-> Maybe ControlSequenceIntroducerComponents
forall a. a -> Maybe a
Just ControlSequenceIntroducerComponents
val
  where
    parser :: Parser ControlSequenceIntroducerComponents
    parser :: Parser ControlSequenceIntroducerComponents
parser = do
      Bool
private <- Bool -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Char -> Parser Text Char
char Char
'?' Parser Text Char -> Parser Text Bool -> Parser Text Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Text Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
      Char
first <- Parser Text Char
peekChar'
      [Int]
args <-
        if Char -> Bool
isDigit Char
first Bool -> Bool -> Bool
|| Char
first Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';'
          then Parser Text Int -> Parser Text Char -> Parser Text [Int]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy (Int -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Int
0 Parser Text Int
forall a. Integral a => Parser a
decimal) (Char -> Parser Text Char
char Char
';')
          else [Int] -> Parser Text [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Char
mode <- Parser Text Char
anyChar
      ControlSequenceIntroducerComponents
-> Parser ControlSequenceIntroducerComponents
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> NonEmpty Int -> Char -> ControlSequenceIntroducerComponents
ControlSequenceIntroducerComponents Bool
private (Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
listToNonEmpty Int
0 [Int]
args) Char
mode)

listToNonEmpty :: a -> [a] -> NonEmpty a
listToNonEmpty :: a -> [a] -> NonEmpty a
listToNonEmpty a
def [] = a
def a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
listToNonEmpty a
_ (a
x : [a]
xs) = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs

processControlSequenceIntroducerComponents :: ControlSequenceIntroducerComponents -> Maybe ControlSequenceIntroducer
processControlSequenceIntroducerComponents :: ControlSequenceIntroducerComponents
-> Maybe ControlSequenceIntroducer
processControlSequenceIntroducerComponents (ControlSequenceIntroducerComponents Bool
False NonEmpty Int
args Char
mode) = Char -> NonEmpty Int -> Maybe ControlSequenceIntroducer
parseCsi Char
mode NonEmpty Int
args
processControlSequenceIntroducerComponents (ControlSequenceIntroducerComponents Bool
True NonEmpty Int
args Char
mode) = Char -> NonEmpty Int -> Maybe ControlSequenceIntroducer
parsePrivCsi Char
mode NonEmpty Int
args

changeZero :: Int -> Int -> Int
changeZero :: Int -> Int -> Int
changeZero Int
toVal Int
0 = Int
toVal
changeZero Int
_ Int
val = Int
val

headChangeZero :: Int -> NonEmpty Int -> Int
headChangeZero :: Int -> NonEmpty Int -> Int
headChangeZero Int
toVal NonEmpty Int
args = Int -> Int -> Int
changeZero Int
toVal (NonEmpty Int -> Int
forall a. NonEmpty a -> a
NE.head NonEmpty Int
args)

parseCsi :: Char -> NonEmpty Int -> Maybe ControlSequenceIntroducer
parseCsi :: Char -> NonEmpty Int -> Maybe ControlSequenceIntroducer
parseCsi Char
mode NonEmpty Int
args = case Char
mode of
  Char
'A' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_CursorUp (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'B' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_CursorDown (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'C' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_CursorForward (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'D' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_CursorBack (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'K' ->
    EraseInLineParam -> ControlSequenceIntroducer
CSI_EraseInLine (EraseInLineParam -> ControlSequenceIntroducer)
-> Maybe EraseInLineParam -> Maybe ControlSequenceIntroducer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case NonEmpty Int -> Int
forall a. NonEmpty a -> a
NE.head NonEmpty Int
args of
      Int
0 -> EraseInLineParam -> Maybe EraseInLineParam
forall a. a -> Maybe a
Just EraseInLineParam
ClearFromCursorToEndOfLine
      Int
1 -> EraseInLineParam -> Maybe EraseInLineParam
forall a. a -> Maybe a
Just EraseInLineParam
ClearFromCursorToBeginningOfLine
      Int
2 -> EraseInLineParam -> Maybe EraseInLineParam
forall a. a -> Maybe a
Just EraseInLineParam
ClearEntireLine
      Int
_ -> Maybe EraseInLineParam
forall a. Maybe a
Nothing
  Char
'@' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_InsertBlankCharacters (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'P' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_DeleteChars (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'G' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_CursorCharacterAbsolute (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'H' ->
    let (Int
row, Int
col) = case NonEmpty Int
args of
          Int
r :| [] -> (Int
r, Int
0)
          Int
r :| (Int
c : [Int]
_) -> (Int
r, Int
c)
     in ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> Int -> ControlSequenceIntroducer
CSI_CursorPosition (Int -> Int -> Int
changeZero Int
1 Int
row) (Int -> Int -> Int
changeZero Int
1 Int
col))
  Char
'J' -> case NonEmpty Int -> Int
forall a. NonEmpty a -> a
NE.head NonEmpty Int
args of
    Int
0 -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (EraseInDisplayParam -> ControlSequenceIntroducer
CSI_EraseInDisplay EraseInDisplayParam
EraseBelow)
    Int
1 -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (EraseInDisplayParam -> ControlSequenceIntroducer
CSI_EraseInDisplay EraseInDisplayParam
EraseAbove)
    Int
2 -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (EraseInDisplayParam -> ControlSequenceIntroducer
CSI_EraseInDisplay EraseInDisplayParam
EraseAll)
    Int
3 -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (EraseInDisplayParam -> ControlSequenceIntroducer
CSI_EraseInDisplay EraseInDisplayParam
EraseSavedLines)
    Int
_ -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing
  Char
'L' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_InsertBlankLines (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'M' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_DeleteLines (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'S' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_ScrollUp (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'T' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_ScrollDown (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'X' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_EraseCharacters (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'`' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_CharacterPositionAbsolute (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'a' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_CharacterPositionRelative (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'c' -> case NonEmpty Int
args of
    Int
0 :| [] -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just ControlSequenceIntroducer
CSI_SendDeviceAttributes
    NonEmpty Int
_ -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing
  Char
'd' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_LinePositionAbsolute (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'e' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_LinePositionRelative (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args))
  Char
'f' ->
    let (Int
row, Int
col) = case NonEmpty Int
args of
          Int
r :| [] -> (Int
r, Int
0)
          Int
r :| (Int
c : [Int]
_) -> (Int
r, Int
c)
     in ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> Int -> ControlSequenceIntroducer
CSI_HorizontalVerticalPosition (Int -> Int -> Int
changeZero Int
1 Int
row) (Int -> Int -> Int
changeZero Int
1 Int
col))
  Char
't' -> case NonEmpty Int
args of
    Int
22 :| Int
0 : [Int]
_ -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (WindowManipulation -> ControlSequenceIntroducer
CSI_WindowManipulation WindowManipulation
SaveIconAndWindowTitleOnStack)
    Int
23 :| Int
0 : [Int]
_ -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (WindowManipulation -> ControlSequenceIntroducer
CSI_WindowManipulation WindowManipulation
RestoreIconAndWindowTitleOnStack)
    NonEmpty Int
_ -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing
  Char
'h' -> case NonEmpty Int
args of
    Int
2 :| [] -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Mode -> ControlSequenceIntroducer
CSI_SetMode Mode
KeyboardActionMode)
    Int
4 :| [] -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Mode -> ControlSequenceIntroducer
CSI_SetMode Mode
InsertReplaceMode)
    Int
12 :| [] -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Mode -> ControlSequenceIntroducer
CSI_SetMode Mode
SendReceive)
    Int
20 :| [] -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Mode -> ControlSequenceIntroducer
CSI_SetMode Mode
AutomaticNewlineNormalLinefeed)
    NonEmpty Int
_ -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing
  Char
'l' -> case NonEmpty Int
args of
    Int
2 :| [] -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Mode -> ControlSequenceIntroducer
CSI_ResetMode Mode
KeyboardActionMode)
    Int
4 :| [] -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Mode -> ControlSequenceIntroducer
CSI_ResetMode Mode
InsertReplaceMode)
    Int
12 :| [] -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Mode -> ControlSequenceIntroducer
CSI_ResetMode Mode
SendReceive)
    Int
20 :| [] -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Mode -> ControlSequenceIntroducer
CSI_ResetMode Mode
AutomaticNewlineNormalLinefeed)
    NonEmpty Int
_ -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing
  Char
'n' -> case NonEmpty Int -> Int
forall a. NonEmpty a -> a
NE.head NonEmpty Int
args of
    Int
5 -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (DeviceStatusReport -> ControlSequenceIntroducer
CSI_DeviceStatusReport DeviceStatusReport
StatusReport)
    Int
6 -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (DeviceStatusReport -> ControlSequenceIntroducer
CSI_DeviceStatusReport DeviceStatusReport
ReportCursorPosition)
    Int
_ -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing
  Char
'r' ->
    let (Int
top, Int
bottom) = case NonEmpty Int
args of
          Int
t :| [] -> (Int
t, Int
0)
          Int
t :| (Int
b : [Int]
_) -> (Int
t, Int
b)
     in ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just
          ( Maybe Int -> Maybe Int -> ControlSequenceIntroducer
CSI_DECSTBM
              (if Int
top Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
top)
              (if Int
bottom Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
bottom)
          )
  Char
'm' -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer)
-> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a b. (a -> b) -> a -> b
$ Vector SGR -> ControlSequenceIntroducer
CSI_SGR ([SGR] -> Vector SGR
forall a. [a] -> Vector a
V.fromList ((Int -> Maybe SGR) -> [Int] -> [SGR]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Int -> Maybe SGR
codeToSGR (NonEmpty Int -> [Int]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Int
args)))
  Char
_ -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing

parsePrivCsi :: Char -> NonEmpty Int -> Maybe ControlSequenceIntroducer
parsePrivCsi :: Char -> NonEmpty Int -> Maybe ControlSequenceIntroducer
parsePrivCsi Char
mode NonEmpty Int
args = case Char
mode of
  Char
'h' ->
    let n :: Int
n = (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args)
     in ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer)
-> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a b. (a -> b) -> a -> b
$ case Int -> Maybe DECPrivateMode
intToDECPrivateMode Int
n of
          Just DECPrivateMode
decset -> DECPrivateMode -> ControlSequenceIntroducer
CSI_DECSET DECPrivateMode
decset
          Maybe DECPrivateMode
Nothing -> Int -> ControlSequenceIntroducer
CSI_DECSET_Unknown Int
n
  Char
'l' ->
    let n :: Int
n = (Int -> NonEmpty Int -> Int
headChangeZero Int
1 NonEmpty Int
args)
     in ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer)
-> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a b. (a -> b) -> a -> b
$ case Int -> Maybe DECPrivateMode
intToDECPrivateMode Int
n of
          Just DECPrivateMode
decset -> DECPrivateMode -> ControlSequenceIntroducer
CSI_DECRST DECPrivateMode
decset
          Maybe DECPrivateMode
Nothing -> Int -> ControlSequenceIntroducer
CSI_DECRST_Unknown Int
n
  Char
_ -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing

processControlSequenceIntroducer :: ControlSequenceIntroducerInput -> Maybe ControlSequenceIntroducer
processControlSequenceIntroducer :: ControlSequenceIntroducerInput -> Maybe ControlSequenceIntroducer
processControlSequenceIntroducer ControlSequenceIntroducerInput
csiInput =
  ControlSequenceIntroducerInput
-> Maybe ControlSequenceIntroducerComponents
parseControlSequenceIntroducerComponents ControlSequenceIntroducerInput
csiInput
    Maybe ControlSequenceIntroducerComponents
-> (ControlSequenceIntroducerComponents
    -> Maybe ControlSequenceIntroducer)
-> Maybe ControlSequenceIntroducer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ControlSequenceIntroducerComponents
-> Maybe ControlSequenceIntroducer
processControlSequenceIntroducerComponents

processOtherControlSequenceIntroducer :: ControlSequenceIntroducerInput -> Maybe ControlSequenceIntroducer
processOtherControlSequenceIntroducer :: ControlSequenceIntroducerInput -> Maybe ControlSequenceIntroducer
processOtherControlSequenceIntroducer (ControlSequenceIntroducerInput Text
str) =
  case Text
str of
    Text
"!p" -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just ControlSequenceIntroducer
CSI_SoftTerminalReset
    Text
">c" -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (SendDeviceAttributesSecondary -> ControlSequenceIntroducer
CSI_SendDeviceAttributesSecondary SendDeviceAttributesSecondary
RequestTerminalIdentificationCode)
    Text
">0c" -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (SendDeviceAttributesSecondary -> ControlSequenceIntroducer
CSI_SendDeviceAttributesSecondary SendDeviceAttributesSecondary
RequestTerminalIdentificationCode)
    Text
_
      | Text
"?" Text -> Text -> Bool
`T.isPrefixOf` Text
str Bool -> Bool -> Bool
&& Text
"$p" Text -> Text -> Bool
`T.isSuffixOf` Text
str ->
        let modeStr :: Text
modeStr = Text -> Text
T.init (Text -> Text
T.init (Text -> Text
T.tail Text
str))
         in case Reader Int
forall a. Integral a => Reader a
T.decimal Text
modeStr of
              Left String
_ -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing
              Right (Int
mode, Text
"") -> ControlSequenceIntroducer -> Maybe ControlSequenceIntroducer
forall a. a -> Maybe a
Just (Int -> ControlSequenceIntroducer
CSI_RequestDECPrivateMode Int
mode)
              Right (Int
_, Text
_) -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing
    Text
_ -> Maybe ControlSequenceIntroducer
forall a. Maybe a
Nothing

-- | Used for error reporting
renderCsi :: ControlSequenceIntroducerInput -> Text
renderCsi :: ControlSequenceIntroducerInput -> Text
renderCsi (ControlSequenceIntroducerInput Text
str) = Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str

-----------------------------------------------------------------------
-- OSC (Operating System Command)
-----------------------------------------------------------------------

data OperatingSystemCommandInput = OperatingSystemCommandInput !Text

-- | Should be run after reading the sequence @ESC ]@
--
-- This parser always succeeds
parseOperatingSystemCommand :: Parser OperatingSystemCommandInput
parseOperatingSystemCommand :: Parser OperatingSystemCommandInput
parseOperatingSystemCommand = do
  String
str <-
    Parser Text Char -> Parser Text () -> Parser Text String
forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
manyTill'
      Parser Text Char
anyChar
      ( (Char -> Parser Text Char
char Char
'\a' Parser Text Char -> Parser Text () -> Parser Text ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
          Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text Text
string Text
"\ESC\\" Parser Text Text -> Parser Text () -> Parser Text ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      )
  OperatingSystemCommandInput -> Parser OperatingSystemCommandInput
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> OperatingSystemCommandInput
OperatingSystemCommandInput (String -> Text
T.pack String
str))

-- | Used for error reporting
renderOsc :: OperatingSystemCommandInput -> Text
renderOsc :: OperatingSystemCommandInput -> Text
renderOsc (OperatingSystemCommandInput Text
str) = Text
"\ESC]" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\a"

processOperatingSystemCommand :: OperatingSystemCommandInput -> Maybe OperatingSystemCommand
processOperatingSystemCommand :: OperatingSystemCommandInput -> Maybe OperatingSystemCommand
processOperatingSystemCommand (OperatingSystemCommandInput Text
str) =
  case Parser OperatingSystemCommand
-> Text -> Either String OperatingSystemCommand
forall a. Parser a -> Text -> Either String a
parseOnly (Parser OperatingSystemCommand
parser Parser OperatingSystemCommand
-> Parser Text () -> Parser OperatingSystemCommand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput) Text
str of
    Left String
_ -> Maybe OperatingSystemCommand
forall a. Maybe a
Nothing
    Right OperatingSystemCommand
val -> OperatingSystemCommand -> Maybe OperatingSystemCommand
forall a. a -> Maybe a
Just OperatingSystemCommand
val
  where
    parser :: Parser OperatingSystemCommand
    parser :: Parser OperatingSystemCommand
parser =
      Parser OperatingSystemCommand
parseSetTitle
        Parser OperatingSystemCommand
-> Parser OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser OperatingSystemCommand
parseChangeTextForegroundColor
        Parser OperatingSystemCommand
-> Parser OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser OperatingSystemCommand
parseRequestTextForegroundColor
        Parser OperatingSystemCommand
-> Parser OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser OperatingSystemCommand
parseChangeTextBackgroundColor
        Parser OperatingSystemCommand
-> Parser OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser OperatingSystemCommand
parseRequestTextBackgroundColor
        Parser OperatingSystemCommand
-> Parser OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser OperatingSystemCommand
parseResetTextCursorColor

    parseSetTitle :: Parser OperatingSystemCommand
    parseSetTitle :: Parser OperatingSystemCommand
parseSetTitle = do
      (Bool
icon, Bool
window) <- Parser (Bool, Bool)
parseSetTitleMode
      Char
_ <- Char -> Parser Text Char
char Char
';'
      Text
title <- Parser Text Text
takeText
      OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Bool -> Text -> OperatingSystemCommand
OSC_SetTitle Bool
icon Bool
window Text
title)

    parseSetTitleMode :: Parser (Bool, Bool)
    parseSetTitleMode :: Parser (Bool, Bool)
parseSetTitleMode =
      (Char -> Parser Text Char
char Char
'0' Parser Text Char -> Parser (Bool, Bool) -> Parser (Bool, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, Bool) -> Parser (Bool, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, Bool
True))
        Parser (Bool, Bool) -> Parser (Bool, Bool) -> Parser (Bool, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Text Char
char Char
'1' Parser Text Char -> Parser (Bool, Bool) -> Parser (Bool, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, Bool) -> Parser (Bool, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, Bool
False))
        Parser (Bool, Bool) -> Parser (Bool, Bool) -> Parser (Bool, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Text Char
char Char
'2' Parser Text Char -> Parser (Bool, Bool) -> Parser (Bool, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, Bool) -> Parser (Bool, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, Bool
True))

    parseChangeTextForegroundColor :: Parser OperatingSystemCommand
    parseChangeTextForegroundColor :: Parser OperatingSystemCommand
parseChangeTextForegroundColor = do
      Text
_ <- Text -> Parser Text Text
string Text
"10;"
      Char
c <- (Char -> Bool) -> Parser Text Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?')
      Text
color <- Parser Text Text
takeText
      OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> OperatingSystemCommand
OSC_ChangeTextForegroundColor (Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
color))

    parseRequestTextForegroundColor :: Parser OperatingSystemCommand
    parseRequestTextForegroundColor :: Parser OperatingSystemCommand
parseRequestTextForegroundColor = do
      Text
_ <- Text -> Parser Text Text
string Text
"10;?"
      OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure OperatingSystemCommand
OSC_RequestTextForegroundColor

    parseChangeTextBackgroundColor :: Parser OperatingSystemCommand
    parseChangeTextBackgroundColor :: Parser OperatingSystemCommand
parseChangeTextBackgroundColor = do
      Text
_ <- Text -> Parser Text Text
string Text
"11;"
      Char
c <- (Char -> Bool) -> Parser Text Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?')
      Text
color <- Parser Text Text
takeText
      OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> OperatingSystemCommand
OSC_ChangeTextBackgroundColor (Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
color))

    parseRequestTextBackgroundColor :: Parser OperatingSystemCommand
    parseRequestTextBackgroundColor :: Parser OperatingSystemCommand
parseRequestTextBackgroundColor = do
      Text
_ <- Text -> Parser Text Text
string Text
"11;?"
      OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure OperatingSystemCommand
OSC_RequestTextBackgroundColor

    parseResetTextCursorColor :: Parser OperatingSystemCommand
    parseResetTextCursorColor :: Parser OperatingSystemCommand
parseResetTextCursorColor = do
      Text
_ <- Text -> Parser Text Text
string Text
"112"
      OperatingSystemCommand -> Parser OperatingSystemCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure OperatingSystemCommand
OSC_ResetTextCursorColor

-----------------------------------------------------------------------
-- Single Character Escape Sequence
-----------------------------------------------------------------------

singleCharacterEscapeSequence :: Char -> Maybe EscapeSequence
singleCharacterEscapeSequence :: Char -> Maybe EscapeSequence
singleCharacterEscapeSequence Char
c =
  case Char
c of
    Char
'M' -> EscapeSequence -> Maybe EscapeSequence
forall a. a -> Maybe a
Just EscapeSequence
Esc_ReverseIndex
    Char
'c' -> EscapeSequence -> Maybe EscapeSequence
forall a. a -> Maybe a
Just EscapeSequence
Esc_RIS
    Char
'=' -> EscapeSequence -> Maybe EscapeSequence
forall a. a -> Maybe a
Just EscapeSequence
Esc_DECPAM
    Char
'>' -> EscapeSequence -> Maybe EscapeSequence
forall a. a -> Maybe a
Just EscapeSequence
Esc_DECPNM
    Char
_ -> Maybe EscapeSequence
forall a. Maybe a
Nothing

-----------------------------------------------------------------------
-- Helper functions
-----------------------------------------------------------------------

between :: Ord a => a -> (a, a) -> Bool
between :: a -> (a, a) -> Bool
between a
val (a
low, a
high) = a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
low Bool -> Bool -> Bool
&& a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
high

isControlC0 :: Char -> Bool
isControlC0 :: Char -> Bool
isControlC0 Char
c = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> (Int, Int) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`between` (Int
0, Int
0x1F) Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\DEL'

isControlC1 :: Char -> Bool
isControlC1 :: Char -> Bool
isControlC1 Char
c = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> (Int, Int) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`between` (Int
0x80, Int
0x9f)

isControl :: Char -> Bool
isControl :: Char -> Bool
isControl Char
c = Char -> Bool
isControlC0 Char
c Bool -> Bool -> Bool
|| Char -> Bool
isControlC1 Char
c