#include "Common-Safe-Haskell.hs"
module System.Console.ANSI.Codes
(
module System.Console.ANSI.Types
, cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode
, cursorUpLineCode, cursorDownLineCode
, setCursorColumnCode, setCursorPositionCode
, saveCursorCode, restoreCursorCode, reportCursorPositionCode
, clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode
, clearScreenCode, clearFromCursorToLineEndCode
, clearFromCursorToLineBeginningCode, clearLineCode
, scrollPageUpCode, scrollPageDownCode
, setSGRCode
, hideCursorCode, showCursorCode
, setTitleCode
, colorToCode, csi, sgrToCode
) where
import Data.List (intersperse)
import Data.Colour.SRGB (toSRGB24, RGB (..))
import System.Console.ANSI.Types
csi :: [Int]
-> String
-> String
csi :: [Int] -> String -> String
csi args :: [Int]
args code :: String
code = "\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ";" ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int]
args)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
code
colorToCode :: Color -> Int
colorToCode :: Color -> Int
colorToCode color :: Color
color = case Color
color of
Black -> 0
Red -> 1
Green -> 2
Yellow -> 3
Blue -> 4
Magenta -> 5
Cyan -> 6
White -> 7
sgrToCode :: SGR
-> [Int]
sgrToCode :: SGR -> [Int]
sgrToCode sgr :: SGR
sgr = case SGR
sgr of
Reset -> [0]
SetConsoleIntensity intensity :: ConsoleIntensity
intensity -> case ConsoleIntensity
intensity of
BoldIntensity -> [1]
FaintIntensity -> [2]
NormalIntensity -> [22]
SetItalicized True -> [3]
SetItalicized False -> [23]
SetUnderlining underlining :: Underlining
underlining -> case Underlining
underlining of
SingleUnderline -> [4]
DoubleUnderline -> [21]
NoUnderline -> [24]
SetBlinkSpeed blink_speed :: BlinkSpeed
blink_speed -> case BlinkSpeed
blink_speed of
SlowBlink -> [5]
RapidBlink -> [6]
NoBlink -> [25]
SetVisible False -> [8]
SetVisible True -> [28]
SetSwapForegroundBackground True -> [7]
SetSwapForegroundBackground False -> [27]
SetColor Foreground Dull color :: Color
color -> [30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
SetColor Foreground Vivid color :: Color
color -> [90 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
SetColor Background Dull color :: Color
color -> [40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
SetColor Background Vivid color :: Color
color -> [100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
SetPaletteColor Foreground index :: Word8
index -> [38, 5, Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
index]
SetPaletteColor Background index :: Word8
index -> [48, 5, Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
index]
SetRGBColor Foreground color :: Colour Float
color -> [38, 2] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Colour Float -> [Int]
forall b b. (Num b, RealFrac b, Floating b) => Colour b -> [b]
toRGB Colour Float
color
SetRGBColor Background color :: Colour Float
color -> [48, 2] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Colour Float -> [Int]
forall b b. (Num b, RealFrac b, Floating b) => Colour b -> [b]
toRGB Colour Float
color
SetDefaultColor Foreground -> [39]
SetDefaultColor Background -> [49]
where
toRGB :: Colour b -> [b]
toRGB color :: Colour b
color = let RGB r :: Word8
r g :: Word8
g b :: Word8
b = Colour b -> RGB Word8
forall b. (RealFrac b, Floating b) => Colour b -> RGB Word8
toSRGB24 Colour b
color
in (Word8 -> b) -> [Word8] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8
r, Word8
g, Word8
b]
cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode
:: Int
-> String
cursorUpCode :: Int -> String
cursorUpCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "A"
cursorDownCode :: Int -> String
cursorDownCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "B"
cursorForwardCode :: Int -> String
cursorForwardCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "C"
cursorBackwardCode :: Int -> String
cursorBackwardCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "D"
cursorDownLineCode, cursorUpLineCode :: Int
-> String
cursorDownLineCode :: Int -> String
cursorDownLineCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "E"
cursorUpLineCode :: Int -> String
cursorUpLineCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "F"
setCursorColumnCode :: Int
-> String
setCursorColumnCode :: Int -> String
setCursorColumnCode n :: Int
n = [Int] -> String -> String
csi [Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1] "G"
setCursorPositionCode :: Int
-> Int
-> String
setCursorPositionCode :: Int -> Int -> String
setCursorPositionCode n :: Int
n m :: Int
m = [Int] -> String -> String
csi [Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1] "H"
saveCursorCode, restoreCursorCode :: String
saveCursorCode :: String
saveCursorCode = "\ESC7"
restoreCursorCode :: String
restoreCursorCode = "\ESC8"
reportCursorPositionCode :: String
reportCursorPositionCode :: String
reportCursorPositionCode = [Int] -> String -> String
csi [] "6n"
clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode,
clearScreenCode :: String
clearFromCursorToLineEndCode, clearFromCursorToLineBeginningCode,
clearLineCode :: String
clearFromCursorToScreenEndCode :: String
clearFromCursorToScreenEndCode = [Int] -> String -> String
csi [0] "J"
clearFromCursorToScreenBeginningCode :: String
clearFromCursorToScreenBeginningCode = [Int] -> String -> String
csi [1] "J"
clearScreenCode :: String
clearScreenCode = [Int] -> String -> String
csi [2] "J"
clearFromCursorToLineEndCode :: String
clearFromCursorToLineEndCode = [Int] -> String -> String
csi [0] "K"
clearFromCursorToLineBeginningCode :: String
clearFromCursorToLineBeginningCode = [Int] -> String -> String
csi [1] "K"
clearLineCode :: String
clearLineCode = [Int] -> String -> String
csi [2] "K"
scrollPageUpCode, scrollPageDownCode :: Int
-> String
scrollPageUpCode :: Int -> String
scrollPageUpCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "S"
scrollPageDownCode :: Int -> String
scrollPageDownCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "T"
setSGRCode :: [SGR]
-> String
setSGRCode :: [SGR] -> String
setSGRCode sgrs :: [SGR]
sgrs = [Int] -> String -> String
csi ((SGR -> [Int]) -> [SGR] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SGR -> [Int]
sgrToCode [SGR]
sgrs) "m"
hideCursorCode, showCursorCode :: String
hideCursorCode :: String
hideCursorCode = [Int] -> String -> String
csi [] "?25l"
showCursorCode :: String
showCursorCode = [Int] -> String -> String
csi [] "?25h"
setTitleCode :: String
-> String
setTitleCode :: String -> String
setTitleCode title :: String
title = "\ESC]0;" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\007') String
title String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\007"