module System.Terminal.Encoder where

import qualified Data.Text as T

import           System.Terminal.Terminal
import           System.Terminal.MonadScreen

-- | See https://en.wikipedia.org/wiki/List_of_Unicode_characters
safeChar :: Char -> Bool
safeChar :: Char -> Bool
safeChar Char
c
  | Char
c  Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\SP'  = Bool
False -- All other C0 control characters.
  | Char
c  Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\DEL' = Bool
True  -- Printable remainder of ASCII. Start of C1.
  | Char
c  Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\xa0' = Bool
False -- C1 up to start of Latin-1.
  | Bool
otherwise   = Bool
True
{-# INLINE safeChar #-}

sanitizeChar :: Char -> Char
sanitizeChar :: Char -> Char
sanitizeChar Char
c = if Char -> Bool
safeChar Char
c then Char
c else Char
'�'
{-# INLINE sanitizeChar #-}

sanitizeText :: T.Text -> T.Text
sanitizeText :: Text -> Text
sanitizeText Text
t
    | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
safeChar) Text
t = (Char -> Char) -> Text -> Text
T.map Char -> Char
sanitizeChar Text
t
    | Bool
otherwise                = Text
t
{-# INLINE sanitizeText #-}

defaultEncode :: Command -> T.Text
defaultEncode :: Command -> Text
defaultEncode = \case
    Command
PutLn                                    -> Text
"\n"
    PutText Text
t                                -> Text -> Text
sanitizeText Text
t
    SetAttribute Attribute
Bold                        -> Text
"\ESC[1m"
    SetAttribute Attribute
Italic                      -> Text
""
    SetAttribute Attribute
Underlined                  -> Text
"\ESC[4m"
    SetAttribute Attribute
Inverted                    -> Text
"\ESC[7m"
    SetAttribute (Foreground       Color
Black  )  -> Text
"\ESC[30m"
    SetAttribute (Foreground       Color
Red    )  -> Text
"\ESC[31m"
    SetAttribute (Foreground       Color
Green  )  -> Text
"\ESC[32m"
    SetAttribute (Foreground       Color
Yellow )  -> Text
"\ESC[33m"
    SetAttribute (Foreground       Color
Blue   )  -> Text
"\ESC[34m"
    SetAttribute (Foreground       Color
Magenta)  -> Text
"\ESC[35m"
    SetAttribute (Foreground       Color
Cyan   )  -> Text
"\ESC[36m"
    SetAttribute (Foreground       Color
White  )  -> Text
"\ESC[37m"
    SetAttribute (Foreground Color
BrightBlack  )  -> Text
"\ESC[90m"
    SetAttribute (Foreground Color
BrightRed    )  -> Text
"\ESC[91m"
    SetAttribute (Foreground Color
BrightGreen  )  -> Text
"\ESC[92m"
    SetAttribute (Foreground Color
BrightYellow )  -> Text
"\ESC[93m"
    SetAttribute (Foreground Color
BrightBlue   )  -> Text
"\ESC[94m"
    SetAttribute (Foreground Color
BrightMagenta)  -> Text
"\ESC[95m"
    SetAttribute (Foreground Color
BrightCyan   )  -> Text
"\ESC[96m"
    SetAttribute (Foreground Color
BrightWhite  )  -> Text
"\ESC[97m"
    SetAttribute (Background       Color
Black  )  -> Text
"\ESC[40m"
    SetAttribute (Background       Color
Red    )  -> Text
"\ESC[41m"
    SetAttribute (Background       Color
Green  )  -> Text
"\ESC[42m"
    SetAttribute (Background       Color
Yellow )  -> Text
"\ESC[43m"
    SetAttribute (Background       Color
Blue   )  -> Text
"\ESC[44m"
    SetAttribute (Background       Color
Magenta)  -> Text
"\ESC[45m"
    SetAttribute (Background       Color
Cyan   )  -> Text
"\ESC[46m"
    SetAttribute (Background       Color
White  )  -> Text
"\ESC[47m"
    SetAttribute (Background Color
BrightBlack  )  -> Text
"\ESC[100m"
    SetAttribute (Background Color
BrightRed    )  -> Text
"\ESC[101m"
    SetAttribute (Background Color
BrightGreen  )  -> Text
"\ESC[102m"
    SetAttribute (Background Color
BrightYellow )  -> Text
"\ESC[103m"
    SetAttribute (Background Color
BrightBlue   )  -> Text
"\ESC[104m"
    SetAttribute (Background Color
BrightMagenta)  -> Text
"\ESC[105m"
    SetAttribute (Background Color
BrightCyan   )  -> Text
"\ESC[106m"
    SetAttribute (Background Color
BrightWhite  )  -> Text
"\ESC[107m"
    ResetAttribute Attribute
Bold                      -> Text
"\ESC[22m"
    ResetAttribute Attribute
Italic                    -> Text
""
    ResetAttribute Attribute
Underlined                -> Text
"\ESC[24m"
    ResetAttribute Attribute
Inverted                  -> Text
"\ESC[27m"
    ResetAttribute (Foreground Color
_)            -> Text
"\ESC[39m"
    ResetAttribute (Background Color
_)            -> Text
"\ESC[49m"
    Command
ResetAttributes                          -> Text
"\ESC[m"
    Command
ShowCursor                               -> Text
"\ESC[?25h"
    Command
HideCursor                               -> Text
"\ESC[?25l"
    Command
SaveCursor                               -> Text
"\ESC7"
    Command
RestoreCursor                            -> Text
"\ESC8"
    MoveCursorUp          Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0         -> Text
""
                            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0         -> Text
"\ESC[A"
                            | Bool
otherwise      -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"A"
    MoveCursorDown        Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0         -> Text
""
                            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0         -> Text
"\ESC[B"
                            | Bool
otherwise      -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"B"
    MoveCursorForward     Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0         -> Text
""
                            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0         -> Text
"\ESC[C"
                            | Bool
otherwise      -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"C"
    MoveCursorBackward    Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0         -> Text
""
                            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0         -> Text
"\ESC[D"
                            | Bool
otherwise      -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"D"
    Command
GetCursorPosition                        -> Text
"\ESC[6n"
    SetCursorPosition (Position Int
x Int
y)         -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"H"
    SetCursorRow      Int
i                      -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"d"
    SetCursorColumn   Int
i                      -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"G"
    InsertChars Int
i   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0                 -> Text
""
                    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1                 -> Text
"\ESC[@"
                    | Bool
otherwise              -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@"
    DeleteChars Int
i   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0                 -> Text
""
                    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1                 -> Text
"\ESC[P"
                    | Bool
otherwise              -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"P"
    EraseChars  Int
i   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0                 -> Text
""
                    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1                 -> Text
"\ESC[X"
                    | Bool
otherwise              -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"X"
    InsertLines Int
i   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0                 -> Text
""
                    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1                 -> Text
"\ESC[L"
                    | Bool
otherwise              -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"L"
    DeleteLines Int
i   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0                 -> Text
""
                    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1                 -> Text
"\ESC[M"
                    | Bool
otherwise              -> Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"M"
    EraseInLine     EraseMode
EraseForward             -> Text
"\ESC[0K"
    EraseInLine     EraseMode
EraseBackward            -> Text
"\ESC[1K"
    EraseInLine     EraseMode
EraseAll                 -> Text
"\ESC[2K"
    EraseInDisplay  EraseMode
EraseForward             -> Text
"\ESC[0J"
    EraseInDisplay  EraseMode
EraseBackward            -> Text
"\ESC[1J"
    EraseInDisplay  EraseMode
EraseAll                 -> Text
"\ESC[2J"
    SetAutoWrap Bool
True                         -> Text
"\ESC[?7h"
    SetAutoWrap Bool
False                        -> Text
"\ESC[?7l"
    SetAlternateScreenBuffer Bool
True            -> Text
"\ESC[?1049h"
    SetAlternateScreenBuffer Bool
False           -> Text
"\ESC[?1049l"

-- http://www.noah.org/python/pexpect/ANSI-X3.64.htm
-- Erasing parts of the display (EL and ED) in the VT100 is performed thus:
--
--  Erase from cursor to end of line           Esc [ 0 K    or Esc [ K
--  Erase from beginning of line to cursor     Esc [ 1 K
--  Erase line containing cursor               Esc [ 2 K
--  Erase from cursor to end of screen         Esc [ 0 J    or Esc [ J
--  Erase from beginning of screen to cursor   Esc [ 1 J
--  Erase entire screen                        Esc [ 2 J