module System.Terminal.Emulator.Parsing.Types where

import Data.Text (Text)
import Data.Vector (Vector)
import System.Console.ANSI.Types (SGR)
import qualified System.Console.ANSI.Types as SGR
import System.Terminal.Emulator.DECPrivateMode (DECPrivateMode)

data TermAtom
  = TermAtom_VisibleChar !Char
  | TermAtom_SingleCharacterFunction !SingleCharacterFunction
  | TermAtom_SingleCharacterFunctionUnknown !Char
  | TermAtom_EscapeSequence !EscapeSequence
  | TermAtom_EscapeSequenceUnknown !Text
  deriving (Int -> TermAtom -> ShowS
[TermAtom] -> ShowS
TermAtom -> String
(Int -> TermAtom -> ShowS)
-> (TermAtom -> String) -> ([TermAtom] -> ShowS) -> Show TermAtom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TermAtom] -> ShowS
$cshowList :: [TermAtom] -> ShowS
show :: TermAtom -> String
$cshow :: TermAtom -> String
showsPrec :: Int -> TermAtom -> ShowS
$cshowsPrec :: Int -> TermAtom -> ShowS
Show, TermAtom -> TermAtom -> Bool
(TermAtom -> TermAtom -> Bool)
-> (TermAtom -> TermAtom -> Bool) -> Eq TermAtom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TermAtom -> TermAtom -> Bool
$c/= :: TermAtom -> TermAtom -> Bool
== :: TermAtom -> TermAtom -> Bool
$c== :: TermAtom -> TermAtom -> Bool
Eq)

data SingleCharacterFunction
  = -- | @BEL@ Bell (BEL  is Ctrl-G).
    Control_Bell
  | -- | @BS@ Backspace (BS  is Ctrl-H).
    Control_Backspace
  | -- | @CR@ Carriage Return (CR  is Ctrl-M).
    Control_CarriageReturn
  | -- | @ENQ@ Return Terminal Status (ENQ  is Ctrl-E).  Default response is an empty string
    Control_ReturnTerminalStatus
  | -- | @FF@ Form Feed or New Page (NP ).  (FF  is Ctrl-L).  FF  is treated the same as LF .
    Control_FormFeed
  | -- | @LF@ Line Feed or New Line (NL).  (LF  is Ctrl-J).
    Control_LineFeed
  | -- | @SI@ Switch to Standard Character Set (Ctrl-O is Shift In or LS0). This invokes the G0 character set (the default) as GL. VT200 and up implement LS0.
    Control_SwitchToStandardCharacterSet
  | -- | @SO@ Switch to Alternate Character Set (Ctrl-N is Shift Out or LS1).  This invokes the G1 character set as GL. VT200 and up implement LS1.
    Control_SwitchToAlternateCharacterSet
  | -- | @TAB@ Horizontal Tab (HTS  is Ctrl-I).
    Control_Tab
  | -- | @VT@ Vertical Tab (VT  is Ctrl-K).  This is treated the same as LF.
    Control_VerticalTab
  deriving (Int -> SingleCharacterFunction -> ShowS
[SingleCharacterFunction] -> ShowS
SingleCharacterFunction -> String
(Int -> SingleCharacterFunction -> ShowS)
-> (SingleCharacterFunction -> String)
-> ([SingleCharacterFunction] -> ShowS)
-> Show SingleCharacterFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SingleCharacterFunction] -> ShowS
$cshowList :: [SingleCharacterFunction] -> ShowS
show :: SingleCharacterFunction -> String
$cshow :: SingleCharacterFunction -> String
showsPrec :: Int -> SingleCharacterFunction -> ShowS
$cshowsPrec :: Int -> SingleCharacterFunction -> ShowS
Show, SingleCharacterFunction -> SingleCharacterFunction -> Bool
(SingleCharacterFunction -> SingleCharacterFunction -> Bool)
-> (SingleCharacterFunction -> SingleCharacterFunction -> Bool)
-> Eq SingleCharacterFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
$c/= :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
== :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
$c== :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
Eq, Eq SingleCharacterFunction
Eq SingleCharacterFunction
-> (SingleCharacterFunction -> SingleCharacterFunction -> Ordering)
-> (SingleCharacterFunction -> SingleCharacterFunction -> Bool)
-> (SingleCharacterFunction -> SingleCharacterFunction -> Bool)
-> (SingleCharacterFunction -> SingleCharacterFunction -> Bool)
-> (SingleCharacterFunction -> SingleCharacterFunction -> Bool)
-> (SingleCharacterFunction
    -> SingleCharacterFunction -> SingleCharacterFunction)
-> (SingleCharacterFunction
    -> SingleCharacterFunction -> SingleCharacterFunction)
-> Ord SingleCharacterFunction
SingleCharacterFunction -> SingleCharacterFunction -> Bool
SingleCharacterFunction -> SingleCharacterFunction -> Ordering
SingleCharacterFunction
-> SingleCharacterFunction -> SingleCharacterFunction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SingleCharacterFunction
-> SingleCharacterFunction -> SingleCharacterFunction
$cmin :: SingleCharacterFunction
-> SingleCharacterFunction -> SingleCharacterFunction
max :: SingleCharacterFunction
-> SingleCharacterFunction -> SingleCharacterFunction
$cmax :: SingleCharacterFunction
-> SingleCharacterFunction -> SingleCharacterFunction
>= :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
$c>= :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
> :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
$c> :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
<= :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
$c<= :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
< :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
$c< :: SingleCharacterFunction -> SingleCharacterFunction -> Bool
compare :: SingleCharacterFunction -> SingleCharacterFunction -> Ordering
$ccompare :: SingleCharacterFunction -> SingleCharacterFunction -> Ordering
$cp1Ord :: Eq SingleCharacterFunction
Ord, Int -> SingleCharacterFunction
SingleCharacterFunction -> Int
SingleCharacterFunction -> [SingleCharacterFunction]
SingleCharacterFunction -> SingleCharacterFunction
SingleCharacterFunction
-> SingleCharacterFunction -> [SingleCharacterFunction]
SingleCharacterFunction
-> SingleCharacterFunction
-> SingleCharacterFunction
-> [SingleCharacterFunction]
(SingleCharacterFunction -> SingleCharacterFunction)
-> (SingleCharacterFunction -> SingleCharacterFunction)
-> (Int -> SingleCharacterFunction)
-> (SingleCharacterFunction -> Int)
-> (SingleCharacterFunction -> [SingleCharacterFunction])
-> (SingleCharacterFunction
    -> SingleCharacterFunction -> [SingleCharacterFunction])
-> (SingleCharacterFunction
    -> SingleCharacterFunction -> [SingleCharacterFunction])
-> (SingleCharacterFunction
    -> SingleCharacterFunction
    -> SingleCharacterFunction
    -> [SingleCharacterFunction])
-> Enum SingleCharacterFunction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SingleCharacterFunction
-> SingleCharacterFunction
-> SingleCharacterFunction
-> [SingleCharacterFunction]
$cenumFromThenTo :: SingleCharacterFunction
-> SingleCharacterFunction
-> SingleCharacterFunction
-> [SingleCharacterFunction]
enumFromTo :: SingleCharacterFunction
-> SingleCharacterFunction -> [SingleCharacterFunction]
$cenumFromTo :: SingleCharacterFunction
-> SingleCharacterFunction -> [SingleCharacterFunction]
enumFromThen :: SingleCharacterFunction
-> SingleCharacterFunction -> [SingleCharacterFunction]
$cenumFromThen :: SingleCharacterFunction
-> SingleCharacterFunction -> [SingleCharacterFunction]
enumFrom :: SingleCharacterFunction -> [SingleCharacterFunction]
$cenumFrom :: SingleCharacterFunction -> [SingleCharacterFunction]
fromEnum :: SingleCharacterFunction -> Int
$cfromEnum :: SingleCharacterFunction -> Int
toEnum :: Int -> SingleCharacterFunction
$ctoEnum :: Int -> SingleCharacterFunction
pred :: SingleCharacterFunction -> SingleCharacterFunction
$cpred :: SingleCharacterFunction -> SingleCharacterFunction
succ :: SingleCharacterFunction -> SingleCharacterFunction
$csucc :: SingleCharacterFunction -> SingleCharacterFunction
Enum, SingleCharacterFunction
SingleCharacterFunction
-> SingleCharacterFunction -> Bounded SingleCharacterFunction
forall a. a -> a -> Bounded a
maxBound :: SingleCharacterFunction
$cmaxBound :: SingleCharacterFunction
minBound :: SingleCharacterFunction
$cminBound :: SingleCharacterFunction
Bounded)

data EscapeSequence
  = -- | @ESC M@ Reverse Index (RI  is 0x8d).
    Esc_ReverseIndex
  | -- | @ESC c@ Reset terminal to initial state (RIS)
    Esc_RIS
  | -- | @ESC =@ Application Keypad (DECPAM)
    Esc_DECPAM
  | -- | @ESC >@ Set numeric keypad mode (DECPNM)
    Esc_DECPNM
  | -- | @ESC (@ Designate G0 Character Set, VT100, ISO 2022.
    ESC_SetG0CharacterSet !Text
  | Esc_CSI !ControlSequenceIntroducer
  | Esc_OSC !OperatingSystemCommand
  deriving (Int -> EscapeSequence -> ShowS
[EscapeSequence] -> ShowS
EscapeSequence -> String
(Int -> EscapeSequence -> ShowS)
-> (EscapeSequence -> String)
-> ([EscapeSequence] -> ShowS)
-> Show EscapeSequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EscapeSequence] -> ShowS
$cshowList :: [EscapeSequence] -> ShowS
show :: EscapeSequence -> String
$cshow :: EscapeSequence -> String
showsPrec :: Int -> EscapeSequence -> ShowS
$cshowsPrec :: Int -> EscapeSequence -> ShowS
Show, EscapeSequence -> EscapeSequence -> Bool
(EscapeSequence -> EscapeSequence -> Bool)
-> (EscapeSequence -> EscapeSequence -> Bool) -> Eq EscapeSequence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EscapeSequence -> EscapeSequence -> Bool
$c/= :: EscapeSequence -> EscapeSequence -> Bool
== :: EscapeSequence -> EscapeSequence -> Bool
$c== :: EscapeSequence -> EscapeSequence -> Bool
Eq)

data ControlSequenceIntroducer
  = -- | @CSI Ps `@  Character Position Absolute  [column] (default = [row,1]) (HPA).
    CSI_CharacterPositionAbsolute !Int
  | -- | @CSI Ps a@ Character Position Relative  [columns] (default = [row,col+1]) (HPR).
    CSI_CharacterPositionRelative !Int
  | -- | @CSI Ps A@ Cursor Up Ps Times (default = 1) (CUU).
    CSI_CursorUp !Int
  | -- | @CSI Ps B@ Cursor Down Ps Times (default = 1) (CUD).
    CSI_CursorDown !Int
  | -- | @CSI Ps C@ Cursor Forward Ps Times (default = 1) (CUF).
    CSI_CursorForward !Int
  | -- | @CSI Ps D@ Cursor Backward Ps Times (default = 1) (CUB).
    CSI_CursorBack !Int
  | -- | @CSI Ps K@ Erase in Line (EL), VT100.
    CSI_EraseInLine !EraseInLineParam
  | -- | @CSI Ps \@@ Insert Ps (Blank) Character(s) (default = 1) (ICH)
    CSI_InsertBlankCharacters !Int
  | -- | @CSI Ps L@ Insert Ps Line(s) (default = 1) (IL)
    CSI_InsertBlankLines !Int
  | -- | @CSI Ps P@ Delete Ps Character(s) (default = 1) (DCH).
    CSI_DeleteChars !Int
  | -- | @CSI Ps M@ Delete Ps Line(s) (default = 1) (DL).
    CSI_DeleteLines !Int
  | -- | @CSI Ps G@ Cursor Character Absolute  [column] (default = [row,1]) (CHA).
    CSI_CursorCharacterAbsolute !Int
  | -- | @CSI Ps ; Ps H@ Cursor Position [row;column] (default = [1,1]) (CUP).
    CSI_CursorPosition !Int !Int
  | -- | @CSI Ps ; Ps f@ Horizontal and Vertical Position [row;column] (default = [1,1]) (HVP).
    CSI_HorizontalVerticalPosition !Int !Int
  | -- | @CSI Ps d@ Line Position Absolute  [row] (default = [1,column]) (VPA).
    CSI_LinePositionAbsolute !Int
  | -- | @CSI Ps e@ Line Position Relative  [rows] (default = [row+1,column]) (VPR).
    CSI_LinePositionRelative !Int
  | -- | @CSI Ps S@ Scroll up Ps lines (default = 1) (SU), VT420, ECMA-48.
    CSI_ScrollUp !Int
  | -- | @CSI Ps T@ Scroll down Ps lines (default = 1) (SD), VT420.
    CSI_ScrollDown !Int
  | -- | @CSI Ps J@ Erase in Display (ED), VT100
    CSI_EraseInDisplay !EraseInDisplayParam
  | -- | @CSI Ps X@ Erase Ps Character(s) (default = 1) (ECH).
    CSI_EraseCharacters !Int
  | -- | @CSI Ps ; Ps ; Ps t@ Window manipulation (XTWINOPS), dtterm, extended by xterm. These controls may be disabled using the allowWindowOps resource.
    CSI_WindowManipulation !WindowManipulation
  | -- | @CSI Ps n@ Device Status Report (DSR).
    CSI_DeviceStatusReport !DeviceStatusReport
  | -- | @CSI ! p@ Soft terminal reset (DECSTR), VT220 and up.
    CSI_SoftTerminalReset
  | -- | @CSI Pm h@ Set Mode (SM).
    CSI_SetMode !Mode
  | -- | @CSI Pm l@ Reset Mode (RM).
    CSI_ResetMode !Mode
  | -- | @CSI Ps c@ Send Device Attributes (Primary DA).
    CSI_SendDeviceAttributes
  | -- | @CSI > Ps c@ Send Device Attributes (Secondary DA).
    CSI_SendDeviceAttributesSecondary !SendDeviceAttributesSecondary
  | -- | @CSI ? Ps $ p@ Request DEC private mode (DECRQM).
    CSI_RequestDECPrivateMode !Int
  | -- | Set Scrolling Region [top;bottom] (default = full size of window) (DECSTBM)
    CSI_DECSTBM !(Maybe Int) !(Maybe Int)
  | -- | DEC Private Mode Set
    CSI_DECSET !DECPrivateMode
  | -- | Unknown DECSET (DEC Private Mode Set) code
    CSI_DECSET_Unknown !Int
  | -- | DEC Private Mode Reset
    CSI_DECRST !DECPrivateMode
  | -- | Unknown DECRST (DEC Private Mode Reset) code
    CSI_DECRST_Unknown !Int
  | CSI_SGR !(Vector SGR)
  deriving (Int -> ControlSequenceIntroducer -> ShowS
[ControlSequenceIntroducer] -> ShowS
ControlSequenceIntroducer -> String
(Int -> ControlSequenceIntroducer -> ShowS)
-> (ControlSequenceIntroducer -> String)
-> ([ControlSequenceIntroducer] -> ShowS)
-> Show ControlSequenceIntroducer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlSequenceIntroducer] -> ShowS
$cshowList :: [ControlSequenceIntroducer] -> ShowS
show :: ControlSequenceIntroducer -> String
$cshow :: ControlSequenceIntroducer -> String
showsPrec :: Int -> ControlSequenceIntroducer -> ShowS
$cshowsPrec :: Int -> ControlSequenceIntroducer -> ShowS
Show, ControlSequenceIntroducer -> ControlSequenceIntroducer -> Bool
(ControlSequenceIntroducer -> ControlSequenceIntroducer -> Bool)
-> (ControlSequenceIntroducer -> ControlSequenceIntroducer -> Bool)
-> Eq ControlSequenceIntroducer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControlSequenceIntroducer -> ControlSequenceIntroducer -> Bool
$c/= :: ControlSequenceIntroducer -> ControlSequenceIntroducer -> Bool
== :: ControlSequenceIntroducer -> ControlSequenceIntroducer -> Bool
$c== :: ControlSequenceIntroducer -> ControlSequenceIntroducer -> Bool
Eq)

data EraseInLineParam
  = -- | @Ps = 0@ Erase to Right (default).
    ClearFromCursorToEndOfLine
  | -- | @Ps = 1@  Erase to Left.
    ClearFromCursorToBeginningOfLine
  | -- | @Ps = 2@  Erase All.
    ClearEntireLine
  deriving (Int -> EraseInLineParam -> ShowS
[EraseInLineParam] -> ShowS
EraseInLineParam -> String
(Int -> EraseInLineParam -> ShowS)
-> (EraseInLineParam -> String)
-> ([EraseInLineParam] -> ShowS)
-> Show EraseInLineParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EraseInLineParam] -> ShowS
$cshowList :: [EraseInLineParam] -> ShowS
show :: EraseInLineParam -> String
$cshow :: EraseInLineParam -> String
showsPrec :: Int -> EraseInLineParam -> ShowS
$cshowsPrec :: Int -> EraseInLineParam -> ShowS
Show, EraseInLineParam -> EraseInLineParam -> Bool
(EraseInLineParam -> EraseInLineParam -> Bool)
-> (EraseInLineParam -> EraseInLineParam -> Bool)
-> Eq EraseInLineParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EraseInLineParam -> EraseInLineParam -> Bool
$c/= :: EraseInLineParam -> EraseInLineParam -> Bool
== :: EraseInLineParam -> EraseInLineParam -> Bool
$c== :: EraseInLineParam -> EraseInLineParam -> Bool
Eq, Eq EraseInLineParam
Eq EraseInLineParam
-> (EraseInLineParam -> EraseInLineParam -> Ordering)
-> (EraseInLineParam -> EraseInLineParam -> Bool)
-> (EraseInLineParam -> EraseInLineParam -> Bool)
-> (EraseInLineParam -> EraseInLineParam -> Bool)
-> (EraseInLineParam -> EraseInLineParam -> Bool)
-> (EraseInLineParam -> EraseInLineParam -> EraseInLineParam)
-> (EraseInLineParam -> EraseInLineParam -> EraseInLineParam)
-> Ord EraseInLineParam
EraseInLineParam -> EraseInLineParam -> Bool
EraseInLineParam -> EraseInLineParam -> Ordering
EraseInLineParam -> EraseInLineParam -> EraseInLineParam
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EraseInLineParam -> EraseInLineParam -> EraseInLineParam
$cmin :: EraseInLineParam -> EraseInLineParam -> EraseInLineParam
max :: EraseInLineParam -> EraseInLineParam -> EraseInLineParam
$cmax :: EraseInLineParam -> EraseInLineParam -> EraseInLineParam
>= :: EraseInLineParam -> EraseInLineParam -> Bool
$c>= :: EraseInLineParam -> EraseInLineParam -> Bool
> :: EraseInLineParam -> EraseInLineParam -> Bool
$c> :: EraseInLineParam -> EraseInLineParam -> Bool
<= :: EraseInLineParam -> EraseInLineParam -> Bool
$c<= :: EraseInLineParam -> EraseInLineParam -> Bool
< :: EraseInLineParam -> EraseInLineParam -> Bool
$c< :: EraseInLineParam -> EraseInLineParam -> Bool
compare :: EraseInLineParam -> EraseInLineParam -> Ordering
$ccompare :: EraseInLineParam -> EraseInLineParam -> Ordering
$cp1Ord :: Eq EraseInLineParam
Ord, Int -> EraseInLineParam
EraseInLineParam -> Int
EraseInLineParam -> [EraseInLineParam]
EraseInLineParam -> EraseInLineParam
EraseInLineParam -> EraseInLineParam -> [EraseInLineParam]
EraseInLineParam
-> EraseInLineParam -> EraseInLineParam -> [EraseInLineParam]
(EraseInLineParam -> EraseInLineParam)
-> (EraseInLineParam -> EraseInLineParam)
-> (Int -> EraseInLineParam)
-> (EraseInLineParam -> Int)
-> (EraseInLineParam -> [EraseInLineParam])
-> (EraseInLineParam -> EraseInLineParam -> [EraseInLineParam])
-> (EraseInLineParam -> EraseInLineParam -> [EraseInLineParam])
-> (EraseInLineParam
    -> EraseInLineParam -> EraseInLineParam -> [EraseInLineParam])
-> Enum EraseInLineParam
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EraseInLineParam
-> EraseInLineParam -> EraseInLineParam -> [EraseInLineParam]
$cenumFromThenTo :: EraseInLineParam
-> EraseInLineParam -> EraseInLineParam -> [EraseInLineParam]
enumFromTo :: EraseInLineParam -> EraseInLineParam -> [EraseInLineParam]
$cenumFromTo :: EraseInLineParam -> EraseInLineParam -> [EraseInLineParam]
enumFromThen :: EraseInLineParam -> EraseInLineParam -> [EraseInLineParam]
$cenumFromThen :: EraseInLineParam -> EraseInLineParam -> [EraseInLineParam]
enumFrom :: EraseInLineParam -> [EraseInLineParam]
$cenumFrom :: EraseInLineParam -> [EraseInLineParam]
fromEnum :: EraseInLineParam -> Int
$cfromEnum :: EraseInLineParam -> Int
toEnum :: Int -> EraseInLineParam
$ctoEnum :: Int -> EraseInLineParam
pred :: EraseInLineParam -> EraseInLineParam
$cpred :: EraseInLineParam -> EraseInLineParam
succ :: EraseInLineParam -> EraseInLineParam
$csucc :: EraseInLineParam -> EraseInLineParam
Enum, EraseInLineParam
EraseInLineParam -> EraseInLineParam -> Bounded EraseInLineParam
forall a. a -> a -> Bounded a
maxBound :: EraseInLineParam
$cmaxBound :: EraseInLineParam
minBound :: EraseInLineParam
$cminBound :: EraseInLineParam
Bounded)

data EraseInDisplayParam
  = -- | @Ps = 0@ Erase Below (default).
    EraseBelow
  | -- | @Ps = 1@ Erase Above.
    EraseAbove
  | -- | @Ps = 2@ Erase All.
    EraseAll
  | -- | @Ps = 3@ Erase Saved Lines, xterm.
    EraseSavedLines
  deriving (Int -> EraseInDisplayParam -> ShowS
[EraseInDisplayParam] -> ShowS
EraseInDisplayParam -> String
(Int -> EraseInDisplayParam -> ShowS)
-> (EraseInDisplayParam -> String)
-> ([EraseInDisplayParam] -> ShowS)
-> Show EraseInDisplayParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EraseInDisplayParam] -> ShowS
$cshowList :: [EraseInDisplayParam] -> ShowS
show :: EraseInDisplayParam -> String
$cshow :: EraseInDisplayParam -> String
showsPrec :: Int -> EraseInDisplayParam -> ShowS
$cshowsPrec :: Int -> EraseInDisplayParam -> ShowS
Show, EraseInDisplayParam -> EraseInDisplayParam -> Bool
(EraseInDisplayParam -> EraseInDisplayParam -> Bool)
-> (EraseInDisplayParam -> EraseInDisplayParam -> Bool)
-> Eq EraseInDisplayParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
$c/= :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
== :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
$c== :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
Eq, Eq EraseInDisplayParam
Eq EraseInDisplayParam
-> (EraseInDisplayParam -> EraseInDisplayParam -> Ordering)
-> (EraseInDisplayParam -> EraseInDisplayParam -> Bool)
-> (EraseInDisplayParam -> EraseInDisplayParam -> Bool)
-> (EraseInDisplayParam -> EraseInDisplayParam -> Bool)
-> (EraseInDisplayParam -> EraseInDisplayParam -> Bool)
-> (EraseInDisplayParam
    -> EraseInDisplayParam -> EraseInDisplayParam)
-> (EraseInDisplayParam
    -> EraseInDisplayParam -> EraseInDisplayParam)
-> Ord EraseInDisplayParam
EraseInDisplayParam -> EraseInDisplayParam -> Bool
EraseInDisplayParam -> EraseInDisplayParam -> Ordering
EraseInDisplayParam -> EraseInDisplayParam -> EraseInDisplayParam
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EraseInDisplayParam -> EraseInDisplayParam -> EraseInDisplayParam
$cmin :: EraseInDisplayParam -> EraseInDisplayParam -> EraseInDisplayParam
max :: EraseInDisplayParam -> EraseInDisplayParam -> EraseInDisplayParam
$cmax :: EraseInDisplayParam -> EraseInDisplayParam -> EraseInDisplayParam
>= :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
$c>= :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
> :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
$c> :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
<= :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
$c<= :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
< :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
$c< :: EraseInDisplayParam -> EraseInDisplayParam -> Bool
compare :: EraseInDisplayParam -> EraseInDisplayParam -> Ordering
$ccompare :: EraseInDisplayParam -> EraseInDisplayParam -> Ordering
$cp1Ord :: Eq EraseInDisplayParam
Ord, Int -> EraseInDisplayParam
EraseInDisplayParam -> Int
EraseInDisplayParam -> [EraseInDisplayParam]
EraseInDisplayParam -> EraseInDisplayParam
EraseInDisplayParam -> EraseInDisplayParam -> [EraseInDisplayParam]
EraseInDisplayParam
-> EraseInDisplayParam
-> EraseInDisplayParam
-> [EraseInDisplayParam]
(EraseInDisplayParam -> EraseInDisplayParam)
-> (EraseInDisplayParam -> EraseInDisplayParam)
-> (Int -> EraseInDisplayParam)
-> (EraseInDisplayParam -> Int)
-> (EraseInDisplayParam -> [EraseInDisplayParam])
-> (EraseInDisplayParam
    -> EraseInDisplayParam -> [EraseInDisplayParam])
-> (EraseInDisplayParam
    -> EraseInDisplayParam -> [EraseInDisplayParam])
-> (EraseInDisplayParam
    -> EraseInDisplayParam
    -> EraseInDisplayParam
    -> [EraseInDisplayParam])
-> Enum EraseInDisplayParam
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EraseInDisplayParam
-> EraseInDisplayParam
-> EraseInDisplayParam
-> [EraseInDisplayParam]
$cenumFromThenTo :: EraseInDisplayParam
-> EraseInDisplayParam
-> EraseInDisplayParam
-> [EraseInDisplayParam]
enumFromTo :: EraseInDisplayParam -> EraseInDisplayParam -> [EraseInDisplayParam]
$cenumFromTo :: EraseInDisplayParam -> EraseInDisplayParam -> [EraseInDisplayParam]
enumFromThen :: EraseInDisplayParam -> EraseInDisplayParam -> [EraseInDisplayParam]
$cenumFromThen :: EraseInDisplayParam -> EraseInDisplayParam -> [EraseInDisplayParam]
enumFrom :: EraseInDisplayParam -> [EraseInDisplayParam]
$cenumFrom :: EraseInDisplayParam -> [EraseInDisplayParam]
fromEnum :: EraseInDisplayParam -> Int
$cfromEnum :: EraseInDisplayParam -> Int
toEnum :: Int -> EraseInDisplayParam
$ctoEnum :: Int -> EraseInDisplayParam
pred :: EraseInDisplayParam -> EraseInDisplayParam
$cpred :: EraseInDisplayParam -> EraseInDisplayParam
succ :: EraseInDisplayParam -> EraseInDisplayParam
$csucc :: EraseInDisplayParam -> EraseInDisplayParam
Enum, EraseInDisplayParam
EraseInDisplayParam
-> EraseInDisplayParam -> Bounded EraseInDisplayParam
forall a. a -> a -> Bounded a
maxBound :: EraseInDisplayParam
$cmaxBound :: EraseInDisplayParam
minBound :: EraseInDisplayParam
$cminBound :: EraseInDisplayParam
Bounded)

data WindowManipulation
  = -- | @22;0@ Save xterm icon and window title on stack.
    SaveIconAndWindowTitleOnStack
  | -- | @23;0@ Restore xterm icon and window title from stack.
    RestoreIconAndWindowTitleOnStack
  deriving (Int -> WindowManipulation -> ShowS
[WindowManipulation] -> ShowS
WindowManipulation -> String
(Int -> WindowManipulation -> ShowS)
-> (WindowManipulation -> String)
-> ([WindowManipulation] -> ShowS)
-> Show WindowManipulation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowManipulation] -> ShowS
$cshowList :: [WindowManipulation] -> ShowS
show :: WindowManipulation -> String
$cshow :: WindowManipulation -> String
showsPrec :: Int -> WindowManipulation -> ShowS
$cshowsPrec :: Int -> WindowManipulation -> ShowS
Show, WindowManipulation -> WindowManipulation -> Bool
(WindowManipulation -> WindowManipulation -> Bool)
-> (WindowManipulation -> WindowManipulation -> Bool)
-> Eq WindowManipulation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowManipulation -> WindowManipulation -> Bool
$c/= :: WindowManipulation -> WindowManipulation -> Bool
== :: WindowManipulation -> WindowManipulation -> Bool
$c== :: WindowManipulation -> WindowManipulation -> Bool
Eq, Eq WindowManipulation
Eq WindowManipulation
-> (WindowManipulation -> WindowManipulation -> Ordering)
-> (WindowManipulation -> WindowManipulation -> Bool)
-> (WindowManipulation -> WindowManipulation -> Bool)
-> (WindowManipulation -> WindowManipulation -> Bool)
-> (WindowManipulation -> WindowManipulation -> Bool)
-> (WindowManipulation -> WindowManipulation -> WindowManipulation)
-> (WindowManipulation -> WindowManipulation -> WindowManipulation)
-> Ord WindowManipulation
WindowManipulation -> WindowManipulation -> Bool
WindowManipulation -> WindowManipulation -> Ordering
WindowManipulation -> WindowManipulation -> WindowManipulation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WindowManipulation -> WindowManipulation -> WindowManipulation
$cmin :: WindowManipulation -> WindowManipulation -> WindowManipulation
max :: WindowManipulation -> WindowManipulation -> WindowManipulation
$cmax :: WindowManipulation -> WindowManipulation -> WindowManipulation
>= :: WindowManipulation -> WindowManipulation -> Bool
$c>= :: WindowManipulation -> WindowManipulation -> Bool
> :: WindowManipulation -> WindowManipulation -> Bool
$c> :: WindowManipulation -> WindowManipulation -> Bool
<= :: WindowManipulation -> WindowManipulation -> Bool
$c<= :: WindowManipulation -> WindowManipulation -> Bool
< :: WindowManipulation -> WindowManipulation -> Bool
$c< :: WindowManipulation -> WindowManipulation -> Bool
compare :: WindowManipulation -> WindowManipulation -> Ordering
$ccompare :: WindowManipulation -> WindowManipulation -> Ordering
$cp1Ord :: Eq WindowManipulation
Ord, Int -> WindowManipulation
WindowManipulation -> Int
WindowManipulation -> [WindowManipulation]
WindowManipulation -> WindowManipulation
WindowManipulation -> WindowManipulation -> [WindowManipulation]
WindowManipulation
-> WindowManipulation -> WindowManipulation -> [WindowManipulation]
(WindowManipulation -> WindowManipulation)
-> (WindowManipulation -> WindowManipulation)
-> (Int -> WindowManipulation)
-> (WindowManipulation -> Int)
-> (WindowManipulation -> [WindowManipulation])
-> (WindowManipulation
    -> WindowManipulation -> [WindowManipulation])
-> (WindowManipulation
    -> WindowManipulation -> [WindowManipulation])
-> (WindowManipulation
    -> WindowManipulation
    -> WindowManipulation
    -> [WindowManipulation])
-> Enum WindowManipulation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WindowManipulation
-> WindowManipulation -> WindowManipulation -> [WindowManipulation]
$cenumFromThenTo :: WindowManipulation
-> WindowManipulation -> WindowManipulation -> [WindowManipulation]
enumFromTo :: WindowManipulation -> WindowManipulation -> [WindowManipulation]
$cenumFromTo :: WindowManipulation -> WindowManipulation -> [WindowManipulation]
enumFromThen :: WindowManipulation -> WindowManipulation -> [WindowManipulation]
$cenumFromThen :: WindowManipulation -> WindowManipulation -> [WindowManipulation]
enumFrom :: WindowManipulation -> [WindowManipulation]
$cenumFrom :: WindowManipulation -> [WindowManipulation]
fromEnum :: WindowManipulation -> Int
$cfromEnum :: WindowManipulation -> Int
toEnum :: Int -> WindowManipulation
$ctoEnum :: Int -> WindowManipulation
pred :: WindowManipulation -> WindowManipulation
$cpred :: WindowManipulation -> WindowManipulation
succ :: WindowManipulation -> WindowManipulation
$csucc :: WindowManipulation -> WindowManipulation
Enum, WindowManipulation
WindowManipulation
-> WindowManipulation -> Bounded WindowManipulation
forall a. a -> a -> Bounded a
maxBound :: WindowManipulation
$cmaxBound :: WindowManipulation
minBound :: WindowManipulation
$cminBound :: WindowManipulation
Bounded)

data DeviceStatusReport
  = -- | Status Report. Result ("OK") is @CSI 0 n@
    StatusReport
  | -- | Report Cursor Position (CPR) [row;column]. Result is @CSI r ; c R@
    ReportCursorPosition
  deriving (Int -> DeviceStatusReport -> ShowS
[DeviceStatusReport] -> ShowS
DeviceStatusReport -> String
(Int -> DeviceStatusReport -> ShowS)
-> (DeviceStatusReport -> String)
-> ([DeviceStatusReport] -> ShowS)
-> Show DeviceStatusReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeviceStatusReport] -> ShowS
$cshowList :: [DeviceStatusReport] -> ShowS
show :: DeviceStatusReport -> String
$cshow :: DeviceStatusReport -> String
showsPrec :: Int -> DeviceStatusReport -> ShowS
$cshowsPrec :: Int -> DeviceStatusReport -> ShowS
Show, DeviceStatusReport -> DeviceStatusReport -> Bool
(DeviceStatusReport -> DeviceStatusReport -> Bool)
-> (DeviceStatusReport -> DeviceStatusReport -> Bool)
-> Eq DeviceStatusReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceStatusReport -> DeviceStatusReport -> Bool
$c/= :: DeviceStatusReport -> DeviceStatusReport -> Bool
== :: DeviceStatusReport -> DeviceStatusReport -> Bool
$c== :: DeviceStatusReport -> DeviceStatusReport -> Bool
Eq, Eq DeviceStatusReport
Eq DeviceStatusReport
-> (DeviceStatusReport -> DeviceStatusReport -> Ordering)
-> (DeviceStatusReport -> DeviceStatusReport -> Bool)
-> (DeviceStatusReport -> DeviceStatusReport -> Bool)
-> (DeviceStatusReport -> DeviceStatusReport -> Bool)
-> (DeviceStatusReport -> DeviceStatusReport -> Bool)
-> (DeviceStatusReport -> DeviceStatusReport -> DeviceStatusReport)
-> (DeviceStatusReport -> DeviceStatusReport -> DeviceStatusReport)
-> Ord DeviceStatusReport
DeviceStatusReport -> DeviceStatusReport -> Bool
DeviceStatusReport -> DeviceStatusReport -> Ordering
DeviceStatusReport -> DeviceStatusReport -> DeviceStatusReport
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeviceStatusReport -> DeviceStatusReport -> DeviceStatusReport
$cmin :: DeviceStatusReport -> DeviceStatusReport -> DeviceStatusReport
max :: DeviceStatusReport -> DeviceStatusReport -> DeviceStatusReport
$cmax :: DeviceStatusReport -> DeviceStatusReport -> DeviceStatusReport
>= :: DeviceStatusReport -> DeviceStatusReport -> Bool
$c>= :: DeviceStatusReport -> DeviceStatusReport -> Bool
> :: DeviceStatusReport -> DeviceStatusReport -> Bool
$c> :: DeviceStatusReport -> DeviceStatusReport -> Bool
<= :: DeviceStatusReport -> DeviceStatusReport -> Bool
$c<= :: DeviceStatusReport -> DeviceStatusReport -> Bool
< :: DeviceStatusReport -> DeviceStatusReport -> Bool
$c< :: DeviceStatusReport -> DeviceStatusReport -> Bool
compare :: DeviceStatusReport -> DeviceStatusReport -> Ordering
$ccompare :: DeviceStatusReport -> DeviceStatusReport -> Ordering
$cp1Ord :: Eq DeviceStatusReport
Ord, Int -> DeviceStatusReport
DeviceStatusReport -> Int
DeviceStatusReport -> [DeviceStatusReport]
DeviceStatusReport -> DeviceStatusReport
DeviceStatusReport -> DeviceStatusReport -> [DeviceStatusReport]
DeviceStatusReport
-> DeviceStatusReport -> DeviceStatusReport -> [DeviceStatusReport]
(DeviceStatusReport -> DeviceStatusReport)
-> (DeviceStatusReport -> DeviceStatusReport)
-> (Int -> DeviceStatusReport)
-> (DeviceStatusReport -> Int)
-> (DeviceStatusReport -> [DeviceStatusReport])
-> (DeviceStatusReport
    -> DeviceStatusReport -> [DeviceStatusReport])
-> (DeviceStatusReport
    -> DeviceStatusReport -> [DeviceStatusReport])
-> (DeviceStatusReport
    -> DeviceStatusReport
    -> DeviceStatusReport
    -> [DeviceStatusReport])
-> Enum DeviceStatusReport
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DeviceStatusReport
-> DeviceStatusReport -> DeviceStatusReport -> [DeviceStatusReport]
$cenumFromThenTo :: DeviceStatusReport
-> DeviceStatusReport -> DeviceStatusReport -> [DeviceStatusReport]
enumFromTo :: DeviceStatusReport -> DeviceStatusReport -> [DeviceStatusReport]
$cenumFromTo :: DeviceStatusReport -> DeviceStatusReport -> [DeviceStatusReport]
enumFromThen :: DeviceStatusReport -> DeviceStatusReport -> [DeviceStatusReport]
$cenumFromThen :: DeviceStatusReport -> DeviceStatusReport -> [DeviceStatusReport]
enumFrom :: DeviceStatusReport -> [DeviceStatusReport]
$cenumFrom :: DeviceStatusReport -> [DeviceStatusReport]
fromEnum :: DeviceStatusReport -> Int
$cfromEnum :: DeviceStatusReport -> Int
toEnum :: Int -> DeviceStatusReport
$ctoEnum :: Int -> DeviceStatusReport
pred :: DeviceStatusReport -> DeviceStatusReport
$cpred :: DeviceStatusReport -> DeviceStatusReport
succ :: DeviceStatusReport -> DeviceStatusReport
$csucc :: DeviceStatusReport -> DeviceStatusReport
Enum, DeviceStatusReport
DeviceStatusReport
-> DeviceStatusReport -> Bounded DeviceStatusReport
forall a. a -> a -> Bounded a
maxBound :: DeviceStatusReport
$cmaxBound :: DeviceStatusReport
minBound :: DeviceStatusReport
$cminBound :: DeviceStatusReport
Bounded)

data Mode
  = -- | Keyboard Action Mode (KAM)
    KeyboardActionMode
  | -- | Insert/Replace Mode (IRM)
    InsertReplaceMode
  | -- | Send/receive (SRM)
    SendReceive
  | -- | Automatic Newline / Normal Linefeed (LNM).
    AutomaticNewlineNormalLinefeed
  deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show, Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Eq Mode
Eq Mode
-> (Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
$cp1Ord :: Eq Mode
Ord, Int -> Mode
Mode -> Int
Mode -> [Mode]
Mode -> Mode
Mode -> Mode -> [Mode]
Mode -> Mode -> Mode -> [Mode]
(Mode -> Mode)
-> (Mode -> Mode)
-> (Int -> Mode)
-> (Mode -> Int)
-> (Mode -> [Mode])
-> (Mode -> Mode -> [Mode])
-> (Mode -> Mode -> [Mode])
-> (Mode -> Mode -> Mode -> [Mode])
-> Enum Mode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
$cenumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
enumFromTo :: Mode -> Mode -> [Mode]
$cenumFromTo :: Mode -> Mode -> [Mode]
enumFromThen :: Mode -> Mode -> [Mode]
$cenumFromThen :: Mode -> Mode -> [Mode]
enumFrom :: Mode -> [Mode]
$cenumFrom :: Mode -> [Mode]
fromEnum :: Mode -> Int
$cfromEnum :: Mode -> Int
toEnum :: Int -> Mode
$ctoEnum :: Int -> Mode
pred :: Mode -> Mode
$cpred :: Mode -> Mode
succ :: Mode -> Mode
$csucc :: Mode -> Mode
Enum, Mode
Mode -> Mode -> Bounded Mode
forall a. a -> a -> Bounded a
maxBound :: Mode
$cmaxBound :: Mode
minBound :: Mode
$cminBound :: Mode
Bounded)

data SendDeviceAttributesSecondary
  = RequestTerminalIdentificationCode
  deriving (Int -> SendDeviceAttributesSecondary -> ShowS
[SendDeviceAttributesSecondary] -> ShowS
SendDeviceAttributesSecondary -> String
(Int -> SendDeviceAttributesSecondary -> ShowS)
-> (SendDeviceAttributesSecondary -> String)
-> ([SendDeviceAttributesSecondary] -> ShowS)
-> Show SendDeviceAttributesSecondary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendDeviceAttributesSecondary] -> ShowS
$cshowList :: [SendDeviceAttributesSecondary] -> ShowS
show :: SendDeviceAttributesSecondary -> String
$cshow :: SendDeviceAttributesSecondary -> String
showsPrec :: Int -> SendDeviceAttributesSecondary -> ShowS
$cshowsPrec :: Int -> SendDeviceAttributesSecondary -> ShowS
Show, SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
(SendDeviceAttributesSecondary
 -> SendDeviceAttributesSecondary -> Bool)
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary -> Bool)
-> Eq SendDeviceAttributesSecondary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
$c/= :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
== :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
$c== :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
Eq, Eq SendDeviceAttributesSecondary
Eq SendDeviceAttributesSecondary
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary -> Ordering)
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary -> Bool)
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary -> Bool)
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary -> Bool)
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary -> Bool)
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary)
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary)
-> Ord SendDeviceAttributesSecondary
SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Ordering
SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary
$cmin :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary
max :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary
$cmax :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary
>= :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
$c>= :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
> :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
$c> :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
<= :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
$c<= :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
< :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
$c< :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Bool
compare :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Ordering
$ccompare :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> Ordering
$cp1Ord :: Eq SendDeviceAttributesSecondary
Ord, Int -> SendDeviceAttributesSecondary
SendDeviceAttributesSecondary -> Int
SendDeviceAttributesSecondary -> [SendDeviceAttributesSecondary]
SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary
SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> [SendDeviceAttributesSecondary]
SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary
-> [SendDeviceAttributesSecondary]
(SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary)
-> (SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary)
-> (Int -> SendDeviceAttributesSecondary)
-> (SendDeviceAttributesSecondary -> Int)
-> (SendDeviceAttributesSecondary
    -> [SendDeviceAttributesSecondary])
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary
    -> [SendDeviceAttributesSecondary])
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary
    -> [SendDeviceAttributesSecondary])
-> (SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary
    -> SendDeviceAttributesSecondary
    -> [SendDeviceAttributesSecondary])
-> Enum SendDeviceAttributesSecondary
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary
-> [SendDeviceAttributesSecondary]
$cenumFromThenTo :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary
-> [SendDeviceAttributesSecondary]
enumFromTo :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> [SendDeviceAttributesSecondary]
$cenumFromTo :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> [SendDeviceAttributesSecondary]
enumFromThen :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> [SendDeviceAttributesSecondary]
$cenumFromThen :: SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary -> [SendDeviceAttributesSecondary]
enumFrom :: SendDeviceAttributesSecondary -> [SendDeviceAttributesSecondary]
$cenumFrom :: SendDeviceAttributesSecondary -> [SendDeviceAttributesSecondary]
fromEnum :: SendDeviceAttributesSecondary -> Int
$cfromEnum :: SendDeviceAttributesSecondary -> Int
toEnum :: Int -> SendDeviceAttributesSecondary
$ctoEnum :: Int -> SendDeviceAttributesSecondary
pred :: SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary
$cpred :: SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary
succ :: SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary
$csucc :: SendDeviceAttributesSecondary -> SendDeviceAttributesSecondary
Enum, SendDeviceAttributesSecondary
SendDeviceAttributesSecondary
-> SendDeviceAttributesSecondary
-> Bounded SendDeviceAttributesSecondary
forall a. a -> a -> Bounded a
maxBound :: SendDeviceAttributesSecondary
$cmaxBound :: SendDeviceAttributesSecondary
minBound :: SendDeviceAttributesSecondary
$cminBound :: SendDeviceAttributesSecondary
Bounded)

data OperatingSystemCommand
  = -- | Change Icon Name and Window Title
    OSC_SetTitle
      !Bool
      -- ^ Set icon name to the string
      !Bool
      -- ^ Set window title to the string
      !Text
      -- ^ The string that should be used for the title
  | -- | Change VT100 text foreground color
    OSC_ChangeTextForegroundColor !Text
  | -- | Request VT100 text foreground color
    OSC_RequestTextForegroundColor
  | -- | Change VT100 text background color
    OSC_ChangeTextBackgroundColor !Text
  | -- | Request VT100 text background color
    OSC_RequestTextBackgroundColor
  | -- | @Ps = 112@ Reset text cursor color.
    OSC_ResetTextCursorColor
  deriving (Int -> OperatingSystemCommand -> ShowS
[OperatingSystemCommand] -> ShowS
OperatingSystemCommand -> String
(Int -> OperatingSystemCommand -> ShowS)
-> (OperatingSystemCommand -> String)
-> ([OperatingSystemCommand] -> ShowS)
-> Show OperatingSystemCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperatingSystemCommand] -> ShowS
$cshowList :: [OperatingSystemCommand] -> ShowS
show :: OperatingSystemCommand -> String
$cshow :: OperatingSystemCommand -> String
showsPrec :: Int -> OperatingSystemCommand -> ShowS
$cshowsPrec :: Int -> OperatingSystemCommand -> ShowS
Show, OperatingSystemCommand -> OperatingSystemCommand -> Bool
(OperatingSystemCommand -> OperatingSystemCommand -> Bool)
-> (OperatingSystemCommand -> OperatingSystemCommand -> Bool)
-> Eq OperatingSystemCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
$c/= :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
== :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
$c== :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
Eq, Eq OperatingSystemCommand
Eq OperatingSystemCommand
-> (OperatingSystemCommand -> OperatingSystemCommand -> Ordering)
-> (OperatingSystemCommand -> OperatingSystemCommand -> Bool)
-> (OperatingSystemCommand -> OperatingSystemCommand -> Bool)
-> (OperatingSystemCommand -> OperatingSystemCommand -> Bool)
-> (OperatingSystemCommand -> OperatingSystemCommand -> Bool)
-> (OperatingSystemCommand
    -> OperatingSystemCommand -> OperatingSystemCommand)
-> (OperatingSystemCommand
    -> OperatingSystemCommand -> OperatingSystemCommand)
-> Ord OperatingSystemCommand
OperatingSystemCommand -> OperatingSystemCommand -> Bool
OperatingSystemCommand -> OperatingSystemCommand -> Ordering
OperatingSystemCommand
-> OperatingSystemCommand -> OperatingSystemCommand
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OperatingSystemCommand
-> OperatingSystemCommand -> OperatingSystemCommand
$cmin :: OperatingSystemCommand
-> OperatingSystemCommand -> OperatingSystemCommand
max :: OperatingSystemCommand
-> OperatingSystemCommand -> OperatingSystemCommand
$cmax :: OperatingSystemCommand
-> OperatingSystemCommand -> OperatingSystemCommand
>= :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
$c>= :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
> :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
$c> :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
<= :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
$c<= :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
< :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
$c< :: OperatingSystemCommand -> OperatingSystemCommand -> Bool
compare :: OperatingSystemCommand -> OperatingSystemCommand -> Ordering
$ccompare :: OperatingSystemCommand -> OperatingSystemCommand -> Ordering
$cp1Ord :: Eq OperatingSystemCommand
Ord)

codeToSGR :: Int -> Maybe SGR.SGR
codeToSGR :: Int -> Maybe SGR
codeToSGR Int
0 = SGR -> Maybe SGR
forall a. a -> Maybe a
Just SGR
SGR.Reset
codeToSGR Int
1 = SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ ConsoleIntensity -> SGR
SGR.SetConsoleIntensity ConsoleIntensity
SGR.BoldIntensity
codeToSGR Int
2 = SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ ConsoleIntensity -> SGR
SGR.SetConsoleIntensity ConsoleIntensity
SGR.FaintIntensity
codeToSGR Int
4 = SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ Underlining -> SGR
SGR.SetUnderlining Underlining
SGR.SingleUnderline
codeToSGR Int
21 = SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ Underlining -> SGR
SGR.SetUnderlining Underlining
SGR.DoubleUnderline
codeToSGR Int
22 = SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ ConsoleIntensity -> SGR
SGR.SetConsoleIntensity ConsoleIntensity
SGR.NormalIntensity
codeToSGR Int
24 = SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ Underlining -> SGR
SGR.SetUnderlining Underlining
SGR.NoUnderline
codeToSGR Int
39 = SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ ConsoleLayer -> SGR
SGR.SetDefaultColor ConsoleLayer
SGR.Foreground
codeToSGR Int
49 = SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ ConsoleLayer -> SGR
SGR.SetDefaultColor ConsoleLayer
SGR.Background
codeToSGR Int
code
  | Int
code Int -> (Int, Int) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`between` (Int
30, Int
37) = do
    Color
color <- Int -> Maybe Color
codeToColor (Int
code Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
30)
    SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ ConsoleLayer -> ColorIntensity -> Color -> SGR
SGR.SetColor ConsoleLayer
SGR.Foreground ColorIntensity
SGR.Dull Color
color
  | Int
code Int -> (Int, Int) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`between` (Int
90, Int
97) = do
    Color
color <- Int -> Maybe Color
codeToColor (Int
code Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
90)
    SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ ConsoleLayer -> ColorIntensity -> Color -> SGR
SGR.SetColor ConsoleLayer
SGR.Foreground ColorIntensity
SGR.Vivid Color
color
  | Int
code Int -> (Int, Int) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`between` (Int
40, Int
47) = do
    Color
color <- Int -> Maybe Color
codeToColor (Int
code Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
40)
    SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ ConsoleLayer -> ColorIntensity -> Color -> SGR
SGR.SetColor ConsoleLayer
SGR.Background ColorIntensity
SGR.Dull Color
color
  | Int
code Int -> (Int, Int) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`between` (Int
100, Int
107) = do
    Color
color <- Int -> Maybe Color
codeToColor (Int
code Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
100)
    SGR -> Maybe SGR
forall a. a -> Maybe a
Just (SGR -> Maybe SGR) -> SGR -> Maybe SGR
forall a b. (a -> b) -> a -> b
$ ConsoleLayer -> ColorIntensity -> Color -> SGR
SGR.SetColor ConsoleLayer
SGR.Background ColorIntensity
SGR.Vivid Color
color
  | Bool
otherwise = Maybe SGR
forall a. Maybe a
Nothing

codeToColor :: Int -> Maybe SGR.Color
codeToColor :: Int -> Maybe Color
codeToColor Int
0 = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
SGR.Black
codeToColor Int
1 = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
SGR.Red
codeToColor Int
2 = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
SGR.Green
codeToColor Int
3 = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
SGR.Yellow
codeToColor Int
4 = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
SGR.Blue
codeToColor Int
5 = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
SGR.Magenta
codeToColor Int
6 = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
SGR.Cyan
codeToColor Int
7 = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
SGR.White
codeToColor Int
_ = Maybe Color
forall a. Maybe a
Nothing

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