{-# LANGUAGE Safe          #-}
{-# LANGUAGE TupleSections #-}

{-| 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".
-}
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
  , Parameter
  , SubParam
  , ParamWithSubs
  , csi
  , csi'
  , osc
  , sgrToCode
  , sgrToCode'
  ) where

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

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

import System.Console.ANSI.Types

-- | Type synonym representing parameter values (without parameter substrings).

-- To represent a paramater value followed by a parameter substring, see

-- 'ParamWithSubs'.

--

-- @since 1.1

type Parameter = Int

-- | Type synonym representing parameter elements of a parameter

-- substring. An empty parameter element (which represents a default value for

-- the parameter element) has value 'Nothing'.

--

-- @since 1.1

type SubParam = Maybe Int

-- | Type synonym representing parameter values optionally followed by a

-- parameter substring. Parameter substrings were introduced by 13.1.8 of T.416

-- (03/93) for SGR parameter values 38 and 48 and have subsequently been adapted

-- for other uses.

--

-- @since 1.1

type ParamWithSubs = (Parameter, [SubParam])

-- | '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. See 'csi'' for a function that handles parameter values

-- that may be followed by a parameter substring.

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

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

  -> String
csi :: [Int] -> String -> String
csi = (Int -> String) -> [Int] -> String -> String
forall a. (a -> String) -> [a] -> String -> String
renderCsi Int -> String
forall a. Show a => a -> String
show

-- | Like 'csi' but extended to parameters that may be followed by a parameter

-- substring. The parameter elements of a parameter substring are separated from

-- the parameter value and each other by \'@:@\'.

--

-- @since 1.1

csi' ::
     [ParamWithSubs]
     -- ^ List of parameters (each of which may be followed by a parameter

     -- substring).

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

  -> String
csi' :: [ParamWithSubs] -> String -> String
csi' = (ParamWithSubs -> String) -> [ParamWithSubs] -> String -> String
forall a. (a -> String) -> [a] -> String -> String
renderCsi ParamWithSubs -> String
forall {a} {a}. (Show a, Show a) => (a, [Maybe a]) -> String
render
 where
  render :: (a, [Maybe a]) -> String
render (a
p, []) = a -> String
forall a. Show a => a -> String
show a
p
  render (a
p, [Maybe a]
pes) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
":" (a -> String
forall a. Show a => a -> String
show a
p String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Maybe a -> String) -> [Maybe a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] a -> String
forall a. Show a => a -> String
show) [Maybe a]
pes)

-- | Helper function to render different types of parameters.

renderCsi :: (a -> String) -> [a] -> String -> String
renderCsi :: forall a. (a -> String) -> [a] -> String -> String
renderCsi a -> String
render [a]
args String
code =
  String
"\ESC[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
";" ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
render [a]
args) String -> String -> String
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]" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pS String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pT String -> String -> String
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@. If the parameter is followed by a parameter

-- substring returns an empty list. See 'sgrToCode'' for a function that handles

-- also parameter values that are followed by a parameter substring.

sgrToCode ::
     SGR -- ^ The SGR aspect

  -> [Parameter]
sgrToCode :: SGR -> [Int]
sgrToCode SGR
sgr = case SGR -> Either ParamWithSubs [Int]
sgrToCode' SGR
sgr of
  Right [Int]
args -> [Int]
args
  Left ParamWithSubs
_ -> []

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

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

--

-- @since 1.1

sgrToCode' ::
     SGR -- ^ The SGR aspect

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

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

  -> String
cursorUpCode :: Int -> String
cursorUpCode Int
n = if Int
n Int -> Int -> Bool
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 Int -> Int -> Bool
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 Int -> Int -> Bool
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 Int -> Int -> Bool
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 Int -> Int -> Bool
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 Int -> Int -> Bool
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 Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
m Int -> Int -> Int
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 foreground or backgrond 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'.

--

-- Underlining is not supported.

--

-- @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
"?"
reportLayerColorCode ConsoleLayer
Underlining = [] -- Not supported.


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 Int -> Int -> Bool
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 Int -> Int -> Bool
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 = [ParamWithSubs] -> String -> String
csi' ((SGR -> [ParamWithSubs]) -> [SGR] -> [ParamWithSubs]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SGR -> [ParamWithSubs]
sgrToCode'' [SGR]
sgrs) String
"m"
 where
  sgrToCode'' :: SGR -> [ParamWithSubs]
sgrToCode'' = (ParamWithSubs -> [ParamWithSubs])
-> ([Int] -> [ParamWithSubs])
-> Either ParamWithSubs [Int]
-> [ParamWithSubs]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParamWithSubs -> [ParamWithSubs] -> [ParamWithSubs]
forall a. a -> [a] -> [a]
:[]) ((Int -> ParamWithSubs) -> [Int] -> [ParamWithSubs]
forall a b. (a -> b) -> [a] -> [b]
map (,[] :: [SubParam])) (Either ParamWithSubs [Int] -> [ParamWithSubs])
-> (SGR -> Either ParamWithSubs [Int]) -> SGR -> [ParamWithSubs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGR -> Either ParamWithSubs [Int]
sgrToCode'

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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
link String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
osc String
"8" String
";"
 where
  pT :: String
pT = String
params' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
uri
  params' :: String
params' = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
":" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
k, String
v) -> String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=" String -> String -> 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" ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isPrint String
title)