#include "Common-Safe-Haskell.hs"

{-| This module exports functions that return 'String' values containing codes
in accordance with the \'ANSI\' standards for control character sequences
described in the documentation of module "System.Console.ANSI".

The module "System.Console.ANSI" exports functions with the same names as those
in this module. On some versions of Windows, the terminal in use may not be
ANSI-capable. When that is the case, the same-named functions exported by module
"System.Console.ANSI" return \"\", for the reasons set out in the documentation
of that module.

Consequently, if module "System.Console.ANSI" is also imported, this module is
intended to be imported qualified, to avoid name clashes with those functions.
For example:

> import qualified System.Console.ANSI.Codes as ANSI
-}
module System.Console.ANSI.Codes
  (
    -- * Basic data types

    module System.Console.ANSI.Types

    -- * Cursor movement by character

    --

    -- | These functions yield @\"\"@ when the number is @0@ as, on some

    -- terminals, a @0@ parameter for the underlying \'ANSI\' code specifies a

    -- default parameter of @1@.

  , cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode

    -- * Cursor movement by line

    --

    -- | These functions yield the equivalent of @setCursorColumnCode 0@ when

    -- the number is @0@ as, on some terminals, a @0@ parameter for the

    -- underlying \'ANSI\' code specifies a default parameter of @1@.

  , cursorUpLineCode, cursorDownLineCode

    -- * Directly changing cursor position

  , setCursorColumnCode, setCursorPositionCode

    -- * Saving, restoring and reporting cursor position

  , saveCursorCode, restoreCursorCode, reportCursorPositionCode

    -- * Clearing parts of the screen

  , clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode
  , clearScreenCode, clearFromCursorToLineEndCode
  , clearFromCursorToLineBeginningCode, clearLineCode

    -- * Scrolling the screen

    --

    -- | These functions yield @\"\"@ when the number is @0@ as, on some

    -- terminals, a @0@ parameter for the underlying \'ANSI\' code specifies a

    -- default parameter of @1@.

  , scrollPageUpCode, scrollPageDownCode

    -- * Using screen buffers

  , useAlternateScreenBufferCode, useNormalScreenBufferCode

    -- * Reporting background or foreground colors

  , reportLayerColorCode

    -- * Select Graphic Rendition mode: colors and other whizzy stuff

  , setSGRCode

    -- * Cursor visibilty changes

  , hideCursorCode, showCursorCode

    -- * Hyperlinks

    -- | Some, but not all, terminals support hyperlinks - that is, clickable

    -- text that points to a URI.

  , hyperlinkCode, hyperlinkWithIdCode, hyperlinkWithParamsCode

    -- * Changing the title

  , setTitleCode

    -- * Utilities

  , colorToCode, csi, osc, sgrToCode
  ) where

import Data.Char (isPrint)
import Data.List (intercalate)

import Data.Colour.SRGB (toSRGB24, RGB (..))

import System.Console.ANSI.Types

-- | 'csi' @parameters controlFunction@, where @parameters@ is a list of 'Int',

-- returns the control sequence comprising the control function CONTROL

-- SEQUENCE INTRODUCER (CSI) followed by the parameter(s) (separated by \';\')

-- and ending with the @controlFunction@ character(s) that identifies the

-- control function.

csi :: [Int]  -- ^ List of parameters for the control sequence

    -> String -- ^ Character(s) that identify the control function

    -> String
csi :: [Int] -> String -> String
csi [Int]
args String
code = String
"\ESC[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
";" (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Int]
args) forall a. [a] -> [a] -> [a]
++ String
code

-- | 'osc' @parameterS parametersT@, where @parameterS@ specifies the type of

-- operation to perform and @parametersT@ is the other parameter(s) (if any),

-- returns the control sequence comprising the control function OPERATING SYSTEM

-- COMMAND (OSC) followed by the parameters (separated by \';\') and ending with

-- the STRING TERMINATOR (ST) @\"\\ESC\\\\\"@.

--

-- @since 0.11.4

osc :: String -- ^ Ps parameter

    -> String -- ^ Pt parameter(s)

    -> String
osc :: String -> String -> String
osc String
pS String
pT = String
"\ESC]" forall a. [a] -> [a] -> [a]
++ String
pS forall a. [a] -> [a] -> [a]
++ String
";" forall a. [a] -> [a] -> [a]
++ String
pT forall a. [a] -> [a] -> [a]
++ String
"\ESC\\"

-- | 'colorToCode' @color@ returns the 0-based index of the color (one of the

-- eight colors in the ANSI standard).

colorToCode :: Color -> Int
colorToCode :: Color -> Int
colorToCode Color
color = case Color
color of
  Color
Black   -> Int
0
  Color
Red     -> Int
1
  Color
Green   -> Int
2
  Color
Yellow  -> Int
3
  Color
Blue    -> Int
4
  Color
Magenta -> Int
5
  Color
Cyan    -> Int
6
  Color
White   -> Int
7

-- | 'sgrToCode' @sgr@ returns the parameter of the SELECT GRAPHIC RENDITION

-- (SGR) aspect identified by @sgr@.

sgrToCode :: SGR -- ^ The SGR aspect

          -> [Int]
sgrToCode :: SGR -> [Int]
sgrToCode SGR
sgr = case SGR
sgr of
  SGR
Reset -> [Int
0]
  SetConsoleIntensity ConsoleIntensity
intensity -> case ConsoleIntensity
intensity of
    ConsoleIntensity
BoldIntensity   -> [Int
1]
    ConsoleIntensity
FaintIntensity  -> [Int
2]
    ConsoleIntensity
NormalIntensity -> [Int
22]
  SetItalicized Bool
True  -> [Int
3]
  SetItalicized Bool
False -> [Int
23]
  SetUnderlining Underlining
underlining -> case Underlining
underlining of
    Underlining
SingleUnderline -> [Int
4]
    Underlining
DoubleUnderline -> [Int
21]
    Underlining
NoUnderline     -> [Int
24]
  SetBlinkSpeed BlinkSpeed
blink_speed -> case BlinkSpeed
blink_speed of
    BlinkSpeed
SlowBlink   -> [Int
5]
    BlinkSpeed
RapidBlink  -> [Int
6]
    BlinkSpeed
NoBlink     -> [Int
25]
  SetVisible Bool
False -> [Int
8]
  SetVisible Bool
True  -> [Int
28]
  SetSwapForegroundBackground Bool
True  -> [Int
7]
  SetSwapForegroundBackground Bool
False -> [Int
27]
  SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
color  -> [Int
30 forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
  SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
color -> [Int
90 forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
  SetColor ConsoleLayer
Background ColorIntensity
Dull Color
color  -> [Int
40 forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
  SetColor ConsoleLayer
Background ColorIntensity
Vivid Color
color -> [Int
100 forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
  SetPaletteColor ConsoleLayer
Foreground Word8
index -> [Int
38, Int
5, forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
index]
  SetPaletteColor ConsoleLayer
Background Word8
index -> [Int
48, Int
5, forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
index]
  SetRGBColor ConsoleLayer
Foreground Colour Float
color -> [Int
38, Int
2] forall a. [a] -> [a] -> [a]
++ forall {b} {b}. (Num b, RealFrac b, Floating b) => Colour b -> [b]
toRGB Colour Float
color
  SetRGBColor ConsoleLayer
Background Colour Float
color -> [Int
48, Int
2] forall a. [a] -> [a] -> [a]
++ forall {b} {b}. (Num b, RealFrac b, Floating b) => Colour b -> [b]
toRGB Colour Float
color
  SetDefaultColor ConsoleLayer
Foreground -> [Int
39]
  SetDefaultColor ConsoleLayer
Background -> [Int
49]
 where
  toRGB :: Colour b -> [b]
toRGB Colour b
color = let RGB Word8
r Word8
g Word8
b = forall b. (RealFrac b, Floating b) => Colour b -> RGB Word8
toSRGB24 Colour b
color
                in  forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8
r, Word8
g, Word8
b]

cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode
  :: Int -- ^ Number of lines or characters to move

  -> String
cursorUpCode :: Int -> String
cursorUpCode Int
n = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then String
"" else [Int] -> String -> String
csi [Int
n] String
"A"
cursorDownCode :: Int -> String
cursorDownCode Int
n = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then String
"" else [Int] -> String -> String
csi [Int
n] String
"B"
cursorForwardCode :: Int -> String
cursorForwardCode Int
n = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then String
"" else [Int] -> String -> String
csi [Int
n] String
"C"
cursorBackwardCode :: Int -> String
cursorBackwardCode Int
n = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then String
"" else [Int] -> String -> String
csi [Int
n] String
"D"

cursorDownLineCode, cursorUpLineCode :: Int -- ^ Number of lines to move

                                     -> String
cursorDownLineCode :: Int -> String
cursorDownLineCode Int
n = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then [Int] -> String -> String
csi [Int
1] String
"G" else [Int] -> String -> String
csi [Int
n] String
"E"
cursorUpLineCode :: Int -> String
cursorUpLineCode Int
n = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then [Int] -> String -> String
csi [Int
1] String
"G" else [Int] -> String -> String
csi [Int
n] String
"F"

-- | Code to move the cursor to the specified column. The column numbering is

-- 0-based (that is, the left-most column is numbered 0).

setCursorColumnCode :: Int -- ^ 0-based column to move to

                    -> String
setCursorColumnCode :: Int -> String
setCursorColumnCode Int
n = [Int] -> String -> String
csi [Int
n forall a. Num a => a -> a -> a
+ Int
1] String
"G"

-- | Code to move the cursor to the specified position (row and column). The

-- position is 0-based (that is, the top-left corner is at row 0 column 0).

setCursorPositionCode :: Int -- ^ 0-based row to move to

                      -> Int -- ^ 0-based column to move to

                      -> String
setCursorPositionCode :: Int -> Int -> String
setCursorPositionCode Int
n Int
m = [Int] -> String -> String
csi [Int
n forall a. Num a => a -> a -> a
+ Int
1, Int
m forall a. Num a => a -> a -> a
+ Int
1] String
"H"

-- | @since 0.7.1

saveCursorCode, restoreCursorCode :: String
saveCursorCode :: String
saveCursorCode = String
"\ESC7"
restoreCursorCode :: String
restoreCursorCode = String
"\ESC8"

-- | Code to emit the cursor position into the console input stream, immediately

-- after being recognised on the output stream, as:

-- @ESC [ \<cursor row> ; \<cursor column> R@

--

-- Note that the information that is emitted is 1-based (the top-left corner is

-- at row 1 column 1) but 'setCursorPositionCode' is 0-based.

--

-- In isolation of 'System.Console.ANSI.getReportedCursorPosition' or

-- 'System.Console.ANSI.getCursorPosition', this function may be of limited use

-- on Windows operating systems because of difficulties in obtaining the data

-- emitted into the console input stream.

--

-- @since 0.7.1

reportCursorPositionCode :: String
reportCursorPositionCode :: String
reportCursorPositionCode = [Int] -> String -> String
csi [] String
"6n"

-- | Code to emit the layer color into the console input stream, immediately

-- after being recognised on the output stream, as:

-- @ESC ] \<Ps> ; rgb: \<red> ; \<green> ; \<blue> \<ST>@

-- where @\<Ps>@ is @10@ for 'Foreground' and @11@ for 'Background'; @\<red>@,

-- @\<green>@ and @\<blue>@ are the color channel values in hexadecimal (4, 8,

-- 12 and 16 bit values are possible, although 16 bit values are most common);

-- and @\<ST>@ is the STRING TERMINATOR (ST). ST depends on the terminal

-- software and may be the @BEL@ character or @ESC \\@ characters.

--

-- This function may be of limited, or no, use on Windows operating systems

-- because (1) the control character sequence is not supported on native

-- terminals (2) of difficulties in obtaining the data emitted into the

-- console input stream. See 'System.Console.ANSI.getReportedLayerColor'.

--

-- @since 0.11.4

reportLayerColorCode :: ConsoleLayer -> String
reportLayerColorCode :: ConsoleLayer -> String
reportLayerColorCode ConsoleLayer
Foreground = String -> String -> String
osc String
"10" String
"?"
reportLayerColorCode ConsoleLayer
Background = String -> String -> String
osc String
"11" String
"?"

clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode,
  clearScreenCode :: String
clearFromCursorToLineEndCode, clearFromCursorToLineBeginningCode,
  clearLineCode :: String

clearFromCursorToScreenEndCode :: String
clearFromCursorToScreenEndCode = [Int] -> String -> String
csi [Int
0] String
"J"
clearFromCursorToScreenBeginningCode :: String
clearFromCursorToScreenBeginningCode = [Int] -> String -> String
csi [Int
1] String
"J"
clearScreenCode :: String
clearScreenCode = [Int] -> String -> String
csi [Int
2] String
"J"
clearFromCursorToLineEndCode :: String
clearFromCursorToLineEndCode = [Int] -> String -> String
csi [Int
0] String
"K"
clearFromCursorToLineBeginningCode :: String
clearFromCursorToLineBeginningCode = [Int] -> String -> String
csi [Int
1] String
"K"
clearLineCode :: String
clearLineCode = [Int] -> String -> String
csi [Int
2] String
"K"

scrollPageUpCode, scrollPageDownCode :: Int -- ^ Number of lines to scroll by

                                     -> String
scrollPageUpCode :: Int -> String
scrollPageUpCode Int
n = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then String
"" else [Int] -> String -> String
csi [Int
n] String
"S"
scrollPageDownCode :: Int -> String
scrollPageDownCode Int
n = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then String
"" else [Int] -> String -> String
csi [Int
n] String
"T"

useAlternateScreenBufferCode, useNormalScreenBufferCode :: String
useAlternateScreenBufferCode :: String
useAlternateScreenBufferCode = [Int] -> String -> String
csi [] String
"?1049h"
useNormalScreenBufferCode :: String
useNormalScreenBufferCode = [Int] -> String -> String
csi [] String
"?1049l"

setSGRCode :: [SGR] -- ^ Commands: these will typically be applied on top of the

                    -- current console SGR mode. An empty list of commands is

                    -- equivalent to the list @[Reset]@. Commands are applied

                    -- left to right.

           -> String
setSGRCode :: [SGR] -> String
setSGRCode [SGR]
sgrs = [Int] -> String -> String
csi (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SGR -> [Int]
sgrToCode [SGR]
sgrs) String
"m"

hideCursorCode, showCursorCode :: String
hideCursorCode :: String
hideCursorCode = [Int] -> String -> String
csi [] String
"?25l"
showCursorCode :: String
showCursorCode = [Int] -> String -> String
csi [] String
"?25h"

-- | Code to introduce a hyperlink with (key, value) parameters. Some terminals

-- support an @id@ parameter key, so that hyperlinks with the same @id@ value

-- are treated as connected.

--

-- @since 0.11.3

hyperlinkWithParamsCode
  :: [(String, String)]
  -- ^ Parameters

  -> String
  -- ^ URI

  -> String
  -- ^ Link text

  -> String
hyperlinkWithParamsCode :: [(String, String)] -> String -> String -> String
hyperlinkWithParamsCode [(String, String)]
params String
uri String
link =
  String -> String -> String
osc String
"8" String
pT forall a. [a] -> [a] -> [a]
++ String
link forall a. [a] -> [a] -> [a]
++ String -> String -> String
osc String
"8" String
";"
 where
  pT :: String
pT = String
params' forall a. [a] -> [a] -> [a]
++ String
";" forall a. [a] -> [a] -> [a]
++ String
uri
  params' :: String
params' = forall a. [a] -> [[a]] -> [a]
intercalate String
":" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(String
k, String
v) -> String
k forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ String
v) [(String, String)]
params

-- | Code to introduce a hyperlink.

--

-- @since 0.11.3

hyperlinkCode
  :: String
  -- ^ URI

  -> String
  -- ^ Link text

  -> String
hyperlinkCode :: String -> String -> String
hyperlinkCode = [(String, String)] -> String -> String -> String
hyperlinkWithParamsCode []

-- | Code to introduce a hyperlink with an identifier for the link. Some

-- terminals support an identifier, so that hyperlinks with the same identifier

-- are treated as connected.

--

-- @since 0.11.3

hyperlinkWithIdCode
  :: String
  -- ^ Identifier for the link

  -> String
  -- ^ URI

  -> String
  -- ^ Link text

  -> String
hyperlinkWithIdCode :: String -> String -> String -> String
hyperlinkWithIdCode String
linkId = [(String, String)] -> String -> String -> String
hyperlinkWithParamsCode [(String
"id", String
linkId)]

-- | Code to set the terminal window title and the icon name (that is, the text

-- for the window in the Start bar, or similar).


-- Thanks to Brandon S. Allbery and Curt Sampson for pointing me in the right

-- direction on xterm title setting on haskell-cafe. The "0" signifies that both

-- the title and "icon" text should be set. This is chosen for consistent

-- behaviour between Unixes and Windows.

setTitleCode :: String -- ^ New window title and icon name

             -> String
setTitleCode :: String -> String
setTitleCode String
title = String -> String -> String
osc String
"0" (forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isPrint String
title)