{-# LANGUAGE Safe #-}

{-| The \'ANSI\' standards refer to the visual style of displaying characters as
their \'graphic rendition\'. The style includes the color of a character, its
background, or (where supported) its underlining; the intensity (bold, normal or
faint) of a character; or whether the character is italic or underlined (single,
double, curly, dotted or dashed), blinking (slowly or rapidly) or visible or
not. The \'ANSI\' codes to establish the graphic rendition for subsequent text
are referred to as SELECT GRAPHIC RENDITION (SGR).

This module exports types and functions used to represent SGR aspects. See also
'System.Console.ANSI.setSGR' and related functions provided by the
@ansi-terminal@ package.
-}
module System.Console.ANSI.Types
  (
  -- * Types used to represent SGR aspects

    SGR (..)
  , ConsoleLayer (..)
  , Color (..)
  , ColorIntensity (..)
  , ConsoleIntensity (..)
  , Underlining (..)
  , BlinkSpeed (..)
  -- * Constructors of xterm 256-color palette indices

  , xterm6LevelRGB
  , xterm24LevelGray
  , xtermSystem
  ) where

import Data.Ix (Ix)
import Data.Word (Word8)

import Data.Colour (Colour)

-- | ANSI's eight standard colors. They come in two intensities, which are

-- controlled by 'ColorIntensity'. Many terminals allow the colors of the

-- standard palette to be customised, so that, for example,

-- @setSGR [ SetColor Foreground Vivid Green ]@ may not result in bright green

-- characters.

data Color
  = Black
  | Red
  | Green
  | Yellow
  | Blue
  | Magenta
  | Cyan
  | White
  deriving (Color
Color -> Color -> Bounded Color
forall a. a -> a -> Bounded a
$cminBound :: Color
minBound :: Color
$cmaxBound :: Color
maxBound :: Color
Bounded, Int -> Color
Color -> Int
Color -> [Color]
Color -> Color
Color -> Color -> [Color]
Color -> Color -> Color -> [Color]
(Color -> Color)
-> (Color -> Color)
-> (Int -> Color)
-> (Color -> Int)
-> (Color -> [Color])
-> (Color -> Color -> [Color])
-> (Color -> Color -> [Color])
-> (Color -> Color -> Color -> [Color])
-> Enum Color
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Color -> Color
succ :: Color -> Color
$cpred :: Color -> Color
pred :: Color -> Color
$ctoEnum :: Int -> Color
toEnum :: Int -> Color
$cfromEnum :: Color -> Int
fromEnum :: Color -> Int
$cenumFrom :: Color -> [Color]
enumFrom :: Color -> [Color]
$cenumFromThen :: Color -> Color -> [Color]
enumFromThen :: Color -> Color -> [Color]
$cenumFromTo :: Color -> Color -> [Color]
enumFromTo :: Color -> Color -> [Color]
$cenumFromThenTo :: Color -> Color -> Color -> [Color]
enumFromThenTo :: Color -> Color -> Color -> [Color]
Enum, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq, Ord Color
Ord Color =>
((Color, Color) -> [Color])
-> ((Color, Color) -> Color -> Int)
-> ((Color, Color) -> Color -> Int)
-> ((Color, Color) -> Color -> Bool)
-> ((Color, Color) -> Int)
-> ((Color, Color) -> Int)
-> Ix Color
(Color, Color) -> Int
(Color, Color) -> [Color]
(Color, Color) -> Color -> Bool
(Color, Color) -> Color -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (Color, Color) -> [Color]
range :: (Color, Color) -> [Color]
$cindex :: (Color, Color) -> Color -> Int
index :: (Color, Color) -> Color -> Int
$cunsafeIndex :: (Color, Color) -> Color -> Int
unsafeIndex :: (Color, Color) -> Color -> Int
$cinRange :: (Color, Color) -> Color -> Bool
inRange :: (Color, Color) -> Color -> Bool
$crangeSize :: (Color, Color) -> Int
rangeSize :: (Color, Color) -> Int
$cunsafeRangeSize :: (Color, Color) -> Int
unsafeRangeSize :: (Color, Color) -> Int
Ix, Eq Color
Eq Color =>
(Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
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
$ccompare :: Color -> Color -> Ordering
compare :: Color -> Color -> Ordering
$c< :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
>= :: Color -> Color -> Bool
$cmax :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
min :: Color -> Color -> Color
Ord, ReadPrec [Color]
ReadPrec Color
Int -> ReadS Color
ReadS [Color]
(Int -> ReadS Color)
-> ReadS [Color]
-> ReadPrec Color
-> ReadPrec [Color]
-> Read Color
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Color
readsPrec :: Int -> ReadS Color
$creadList :: ReadS [Color]
readList :: ReadS [Color]
$creadPrec :: ReadPrec Color
readPrec :: ReadPrec Color
$creadListPrec :: ReadPrec [Color]
readListPrec :: ReadPrec [Color]
Read, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Color -> ShowS
showsPrec :: Int -> Color -> ShowS
$cshow :: Color -> String
show :: Color -> String
$cshowList :: [Color] -> ShowS
showList :: [Color] -> ShowS
Show)

-- | ANSI's standard colors come in two intensities

data ColorIntensity
  = Dull
  | Vivid
  deriving (ColorIntensity
ColorIntensity -> ColorIntensity -> Bounded ColorIntensity
forall a. a -> a -> Bounded a
$cminBound :: ColorIntensity
minBound :: ColorIntensity
$cmaxBound :: ColorIntensity
maxBound :: ColorIntensity
Bounded, ColorIntensity -> ColorIntensity -> Bool
(ColorIntensity -> ColorIntensity -> Bool)
-> (ColorIntensity -> ColorIntensity -> Bool) -> Eq ColorIntensity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColorIntensity -> ColorIntensity -> Bool
== :: ColorIntensity -> ColorIntensity -> Bool
$c/= :: ColorIntensity -> ColorIntensity -> Bool
/= :: ColorIntensity -> ColorIntensity -> Bool
Eq, Int -> ColorIntensity
ColorIntensity -> Int
ColorIntensity -> [ColorIntensity]
ColorIntensity -> ColorIntensity
ColorIntensity -> ColorIntensity -> [ColorIntensity]
ColorIntensity
-> ColorIntensity -> ColorIntensity -> [ColorIntensity]
(ColorIntensity -> ColorIntensity)
-> (ColorIntensity -> ColorIntensity)
-> (Int -> ColorIntensity)
-> (ColorIntensity -> Int)
-> (ColorIntensity -> [ColorIntensity])
-> (ColorIntensity -> ColorIntensity -> [ColorIntensity])
-> (ColorIntensity -> ColorIntensity -> [ColorIntensity])
-> (ColorIntensity
    -> ColorIntensity -> ColorIntensity -> [ColorIntensity])
-> Enum ColorIntensity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ColorIntensity -> ColorIntensity
succ :: ColorIntensity -> ColorIntensity
$cpred :: ColorIntensity -> ColorIntensity
pred :: ColorIntensity -> ColorIntensity
$ctoEnum :: Int -> ColorIntensity
toEnum :: Int -> ColorIntensity
$cfromEnum :: ColorIntensity -> Int
fromEnum :: ColorIntensity -> Int
$cenumFrom :: ColorIntensity -> [ColorIntensity]
enumFrom :: ColorIntensity -> [ColorIntensity]
$cenumFromThen :: ColorIntensity -> ColorIntensity -> [ColorIntensity]
enumFromThen :: ColorIntensity -> ColorIntensity -> [ColorIntensity]
$cenumFromTo :: ColorIntensity -> ColorIntensity -> [ColorIntensity]
enumFromTo :: ColorIntensity -> ColorIntensity -> [ColorIntensity]
$cenumFromThenTo :: ColorIntensity
-> ColorIntensity -> ColorIntensity -> [ColorIntensity]
enumFromThenTo :: ColorIntensity
-> ColorIntensity -> ColorIntensity -> [ColorIntensity]
Enum, Ord ColorIntensity
Ord ColorIntensity =>
((ColorIntensity, ColorIntensity) -> [ColorIntensity])
-> ((ColorIntensity, ColorIntensity) -> ColorIntensity -> Int)
-> ((ColorIntensity, ColorIntensity) -> ColorIntensity -> Int)
-> ((ColorIntensity, ColorIntensity) -> ColorIntensity -> Bool)
-> ((ColorIntensity, ColorIntensity) -> Int)
-> ((ColorIntensity, ColorIntensity) -> Int)
-> Ix ColorIntensity
(ColorIntensity, ColorIntensity) -> Int
(ColorIntensity, ColorIntensity) -> [ColorIntensity]
(ColorIntensity, ColorIntensity) -> ColorIntensity -> Bool
(ColorIntensity, ColorIntensity) -> ColorIntensity -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (ColorIntensity, ColorIntensity) -> [ColorIntensity]
range :: (ColorIntensity, ColorIntensity) -> [ColorIntensity]
$cindex :: (ColorIntensity, ColorIntensity) -> ColorIntensity -> Int
index :: (ColorIntensity, ColorIntensity) -> ColorIntensity -> Int
$cunsafeIndex :: (ColorIntensity, ColorIntensity) -> ColorIntensity -> Int
unsafeIndex :: (ColorIntensity, ColorIntensity) -> ColorIntensity -> Int
$cinRange :: (ColorIntensity, ColorIntensity) -> ColorIntensity -> Bool
inRange :: (ColorIntensity, ColorIntensity) -> ColorIntensity -> Bool
$crangeSize :: (ColorIntensity, ColorIntensity) -> Int
rangeSize :: (ColorIntensity, ColorIntensity) -> Int
$cunsafeRangeSize :: (ColorIntensity, ColorIntensity) -> Int
unsafeRangeSize :: (ColorIntensity, ColorIntensity) -> Int
Ix, Eq ColorIntensity
Eq ColorIntensity =>
(ColorIntensity -> ColorIntensity -> Ordering)
-> (ColorIntensity -> ColorIntensity -> Bool)
-> (ColorIntensity -> ColorIntensity -> Bool)
-> (ColorIntensity -> ColorIntensity -> Bool)
-> (ColorIntensity -> ColorIntensity -> Bool)
-> (ColorIntensity -> ColorIntensity -> ColorIntensity)
-> (ColorIntensity -> ColorIntensity -> ColorIntensity)
-> Ord ColorIntensity
ColorIntensity -> ColorIntensity -> Bool
ColorIntensity -> ColorIntensity -> Ordering
ColorIntensity -> ColorIntensity -> ColorIntensity
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
$ccompare :: ColorIntensity -> ColorIntensity -> Ordering
compare :: ColorIntensity -> ColorIntensity -> Ordering
$c< :: ColorIntensity -> ColorIntensity -> Bool
< :: ColorIntensity -> ColorIntensity -> Bool
$c<= :: ColorIntensity -> ColorIntensity -> Bool
<= :: ColorIntensity -> ColorIntensity -> Bool
$c> :: ColorIntensity -> ColorIntensity -> Bool
> :: ColorIntensity -> ColorIntensity -> Bool
$c>= :: ColorIntensity -> ColorIntensity -> Bool
>= :: ColorIntensity -> ColorIntensity -> Bool
$cmax :: ColorIntensity -> ColorIntensity -> ColorIntensity
max :: ColorIntensity -> ColorIntensity -> ColorIntensity
$cmin :: ColorIntensity -> ColorIntensity -> ColorIntensity
min :: ColorIntensity -> ColorIntensity -> ColorIntensity
Ord, ReadPrec [ColorIntensity]
ReadPrec ColorIntensity
Int -> ReadS ColorIntensity
ReadS [ColorIntensity]
(Int -> ReadS ColorIntensity)
-> ReadS [ColorIntensity]
-> ReadPrec ColorIntensity
-> ReadPrec [ColorIntensity]
-> Read ColorIntensity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ColorIntensity
readsPrec :: Int -> ReadS ColorIntensity
$creadList :: ReadS [ColorIntensity]
readList :: ReadS [ColorIntensity]
$creadPrec :: ReadPrec ColorIntensity
readPrec :: ReadPrec ColorIntensity
$creadListPrec :: ReadPrec [ColorIntensity]
readListPrec :: ReadPrec [ColorIntensity]
Read, Int -> ColorIntensity -> ShowS
[ColorIntensity] -> ShowS
ColorIntensity -> String
(Int -> ColorIntensity -> ShowS)
-> (ColorIntensity -> String)
-> ([ColorIntensity] -> ShowS)
-> Show ColorIntensity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColorIntensity -> ShowS
showsPrec :: Int -> ColorIntensity -> ShowS
$cshow :: ColorIntensity -> String
show :: ColorIntensity -> String
$cshowList :: [ColorIntensity] -> ShowS
showList :: [ColorIntensity] -> ShowS
Show)

-- | ANSI colors can be set on three different layers

data ConsoleLayer
  = Foreground
  | Background
  | Underlining
    -- ^ Not widely supported.

    --

    -- @since 1.1

  deriving (ConsoleLayer
ConsoleLayer -> ConsoleLayer -> Bounded ConsoleLayer
forall a. a -> a -> Bounded a
$cminBound :: ConsoleLayer
minBound :: ConsoleLayer
$cmaxBound :: ConsoleLayer
maxBound :: ConsoleLayer
Bounded, ConsoleLayer -> ConsoleLayer -> Bool
(ConsoleLayer -> ConsoleLayer -> Bool)
-> (ConsoleLayer -> ConsoleLayer -> Bool) -> Eq ConsoleLayer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConsoleLayer -> ConsoleLayer -> Bool
== :: ConsoleLayer -> ConsoleLayer -> Bool
$c/= :: ConsoleLayer -> ConsoleLayer -> Bool
/= :: ConsoleLayer -> ConsoleLayer -> Bool
Eq, Int -> ConsoleLayer
ConsoleLayer -> Int
ConsoleLayer -> [ConsoleLayer]
ConsoleLayer -> ConsoleLayer
ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
ConsoleLayer -> ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
(ConsoleLayer -> ConsoleLayer)
-> (ConsoleLayer -> ConsoleLayer)
-> (Int -> ConsoleLayer)
-> (ConsoleLayer -> Int)
-> (ConsoleLayer -> [ConsoleLayer])
-> (ConsoleLayer -> ConsoleLayer -> [ConsoleLayer])
-> (ConsoleLayer -> ConsoleLayer -> [ConsoleLayer])
-> (ConsoleLayer -> ConsoleLayer -> ConsoleLayer -> [ConsoleLayer])
-> Enum ConsoleLayer
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ConsoleLayer -> ConsoleLayer
succ :: ConsoleLayer -> ConsoleLayer
$cpred :: ConsoleLayer -> ConsoleLayer
pred :: ConsoleLayer -> ConsoleLayer
$ctoEnum :: Int -> ConsoleLayer
toEnum :: Int -> ConsoleLayer
$cfromEnum :: ConsoleLayer -> Int
fromEnum :: ConsoleLayer -> Int
$cenumFrom :: ConsoleLayer -> [ConsoleLayer]
enumFrom :: ConsoleLayer -> [ConsoleLayer]
$cenumFromThen :: ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
enumFromThen :: ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
$cenumFromTo :: ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
enumFromTo :: ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
$cenumFromThenTo :: ConsoleLayer -> ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
enumFromThenTo :: ConsoleLayer -> ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
Enum, Ord ConsoleLayer
Ord ConsoleLayer =>
((ConsoleLayer, ConsoleLayer) -> [ConsoleLayer])
-> ((ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Int)
-> ((ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Int)
-> ((ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Bool)
-> ((ConsoleLayer, ConsoleLayer) -> Int)
-> ((ConsoleLayer, ConsoleLayer) -> Int)
-> Ix ConsoleLayer
(ConsoleLayer, ConsoleLayer) -> Int
(ConsoleLayer, ConsoleLayer) -> [ConsoleLayer]
(ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Bool
(ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (ConsoleLayer, ConsoleLayer) -> [ConsoleLayer]
range :: (ConsoleLayer, ConsoleLayer) -> [ConsoleLayer]
$cindex :: (ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Int
index :: (ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Int
$cunsafeIndex :: (ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Int
unsafeIndex :: (ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Int
$cinRange :: (ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Bool
inRange :: (ConsoleLayer, ConsoleLayer) -> ConsoleLayer -> Bool
$crangeSize :: (ConsoleLayer, ConsoleLayer) -> Int
rangeSize :: (ConsoleLayer, ConsoleLayer) -> Int
$cunsafeRangeSize :: (ConsoleLayer, ConsoleLayer) -> Int
unsafeRangeSize :: (ConsoleLayer, ConsoleLayer) -> Int
Ix, Eq ConsoleLayer
Eq ConsoleLayer =>
(ConsoleLayer -> ConsoleLayer -> Ordering)
-> (ConsoleLayer -> ConsoleLayer -> Bool)
-> (ConsoleLayer -> ConsoleLayer -> Bool)
-> (ConsoleLayer -> ConsoleLayer -> Bool)
-> (ConsoleLayer -> ConsoleLayer -> Bool)
-> (ConsoleLayer -> ConsoleLayer -> ConsoleLayer)
-> (ConsoleLayer -> ConsoleLayer -> ConsoleLayer)
-> Ord ConsoleLayer
ConsoleLayer -> ConsoleLayer -> Bool
ConsoleLayer -> ConsoleLayer -> Ordering
ConsoleLayer -> ConsoleLayer -> ConsoleLayer
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
$ccompare :: ConsoleLayer -> ConsoleLayer -> Ordering
compare :: ConsoleLayer -> ConsoleLayer -> Ordering
$c< :: ConsoleLayer -> ConsoleLayer -> Bool
< :: ConsoleLayer -> ConsoleLayer -> Bool
$c<= :: ConsoleLayer -> ConsoleLayer -> Bool
<= :: ConsoleLayer -> ConsoleLayer -> Bool
$c> :: ConsoleLayer -> ConsoleLayer -> Bool
> :: ConsoleLayer -> ConsoleLayer -> Bool
$c>= :: ConsoleLayer -> ConsoleLayer -> Bool
>= :: ConsoleLayer -> ConsoleLayer -> Bool
$cmax :: ConsoleLayer -> ConsoleLayer -> ConsoleLayer
max :: ConsoleLayer -> ConsoleLayer -> ConsoleLayer
$cmin :: ConsoleLayer -> ConsoleLayer -> ConsoleLayer
min :: ConsoleLayer -> ConsoleLayer -> ConsoleLayer
Ord, ReadPrec [ConsoleLayer]
ReadPrec ConsoleLayer
Int -> ReadS ConsoleLayer
ReadS [ConsoleLayer]
(Int -> ReadS ConsoleLayer)
-> ReadS [ConsoleLayer]
-> ReadPrec ConsoleLayer
-> ReadPrec [ConsoleLayer]
-> Read ConsoleLayer
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ConsoleLayer
readsPrec :: Int -> ReadS ConsoleLayer
$creadList :: ReadS [ConsoleLayer]
readList :: ReadS [ConsoleLayer]
$creadPrec :: ReadPrec ConsoleLayer
readPrec :: ReadPrec ConsoleLayer
$creadListPrec :: ReadPrec [ConsoleLayer]
readListPrec :: ReadPrec [ConsoleLayer]
Read, Int -> ConsoleLayer -> ShowS
[ConsoleLayer] -> ShowS
ConsoleLayer -> String
(Int -> ConsoleLayer -> ShowS)
-> (ConsoleLayer -> String)
-> ([ConsoleLayer] -> ShowS)
-> Show ConsoleLayer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConsoleLayer -> ShowS
showsPrec :: Int -> ConsoleLayer -> ShowS
$cshow :: ConsoleLayer -> String
show :: ConsoleLayer -> String
$cshowList :: [ConsoleLayer] -> ShowS
showList :: [ConsoleLayer] -> ShowS
Show)

-- | ANSI blink speeds: values other than 'NoBlink' are not widely supported

data BlinkSpeed
  = SlowBlink -- ^ Less than 150 blinks per minute

  | RapidBlink -- ^ More than 150 blinks per minute

  | NoBlink
  deriving (BlinkSpeed
BlinkSpeed -> BlinkSpeed -> Bounded BlinkSpeed
forall a. a -> a -> Bounded a
$cminBound :: BlinkSpeed
minBound :: BlinkSpeed
$cmaxBound :: BlinkSpeed
maxBound :: BlinkSpeed
Bounded, BlinkSpeed -> BlinkSpeed -> Bool
(BlinkSpeed -> BlinkSpeed -> Bool)
-> (BlinkSpeed -> BlinkSpeed -> Bool) -> Eq BlinkSpeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlinkSpeed -> BlinkSpeed -> Bool
== :: BlinkSpeed -> BlinkSpeed -> Bool
$c/= :: BlinkSpeed -> BlinkSpeed -> Bool
/= :: BlinkSpeed -> BlinkSpeed -> Bool
Eq, Int -> BlinkSpeed
BlinkSpeed -> Int
BlinkSpeed -> [BlinkSpeed]
BlinkSpeed -> BlinkSpeed
BlinkSpeed -> BlinkSpeed -> [BlinkSpeed]
BlinkSpeed -> BlinkSpeed -> BlinkSpeed -> [BlinkSpeed]
(BlinkSpeed -> BlinkSpeed)
-> (BlinkSpeed -> BlinkSpeed)
-> (Int -> BlinkSpeed)
-> (BlinkSpeed -> Int)
-> (BlinkSpeed -> [BlinkSpeed])
-> (BlinkSpeed -> BlinkSpeed -> [BlinkSpeed])
-> (BlinkSpeed -> BlinkSpeed -> [BlinkSpeed])
-> (BlinkSpeed -> BlinkSpeed -> BlinkSpeed -> [BlinkSpeed])
-> Enum BlinkSpeed
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BlinkSpeed -> BlinkSpeed
succ :: BlinkSpeed -> BlinkSpeed
$cpred :: BlinkSpeed -> BlinkSpeed
pred :: BlinkSpeed -> BlinkSpeed
$ctoEnum :: Int -> BlinkSpeed
toEnum :: Int -> BlinkSpeed
$cfromEnum :: BlinkSpeed -> Int
fromEnum :: BlinkSpeed -> Int
$cenumFrom :: BlinkSpeed -> [BlinkSpeed]
enumFrom :: BlinkSpeed -> [BlinkSpeed]
$cenumFromThen :: BlinkSpeed -> BlinkSpeed -> [BlinkSpeed]
enumFromThen :: BlinkSpeed -> BlinkSpeed -> [BlinkSpeed]
$cenumFromTo :: BlinkSpeed -> BlinkSpeed -> [BlinkSpeed]
enumFromTo :: BlinkSpeed -> BlinkSpeed -> [BlinkSpeed]
$cenumFromThenTo :: BlinkSpeed -> BlinkSpeed -> BlinkSpeed -> [BlinkSpeed]
enumFromThenTo :: BlinkSpeed -> BlinkSpeed -> BlinkSpeed -> [BlinkSpeed]
Enum, Ord BlinkSpeed
Ord BlinkSpeed =>
((BlinkSpeed, BlinkSpeed) -> [BlinkSpeed])
-> ((BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Int)
-> ((BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Int)
-> ((BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Bool)
-> ((BlinkSpeed, BlinkSpeed) -> Int)
-> ((BlinkSpeed, BlinkSpeed) -> Int)
-> Ix BlinkSpeed
(BlinkSpeed, BlinkSpeed) -> Int
(BlinkSpeed, BlinkSpeed) -> [BlinkSpeed]
(BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Bool
(BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (BlinkSpeed, BlinkSpeed) -> [BlinkSpeed]
range :: (BlinkSpeed, BlinkSpeed) -> [BlinkSpeed]
$cindex :: (BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Int
index :: (BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Int
$cunsafeIndex :: (BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Int
unsafeIndex :: (BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Int
$cinRange :: (BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Bool
inRange :: (BlinkSpeed, BlinkSpeed) -> BlinkSpeed -> Bool
$crangeSize :: (BlinkSpeed, BlinkSpeed) -> Int
rangeSize :: (BlinkSpeed, BlinkSpeed) -> Int
$cunsafeRangeSize :: (BlinkSpeed, BlinkSpeed) -> Int
unsafeRangeSize :: (BlinkSpeed, BlinkSpeed) -> Int
Ix, Eq BlinkSpeed
Eq BlinkSpeed =>
(BlinkSpeed -> BlinkSpeed -> Ordering)
-> (BlinkSpeed -> BlinkSpeed -> Bool)
-> (BlinkSpeed -> BlinkSpeed -> Bool)
-> (BlinkSpeed -> BlinkSpeed -> Bool)
-> (BlinkSpeed -> BlinkSpeed -> Bool)
-> (BlinkSpeed -> BlinkSpeed -> BlinkSpeed)
-> (BlinkSpeed -> BlinkSpeed -> BlinkSpeed)
-> Ord BlinkSpeed
BlinkSpeed -> BlinkSpeed -> Bool
BlinkSpeed -> BlinkSpeed -> Ordering
BlinkSpeed -> BlinkSpeed -> BlinkSpeed
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
$ccompare :: BlinkSpeed -> BlinkSpeed -> Ordering
compare :: BlinkSpeed -> BlinkSpeed -> Ordering
$c< :: BlinkSpeed -> BlinkSpeed -> Bool
< :: BlinkSpeed -> BlinkSpeed -> Bool
$c<= :: BlinkSpeed -> BlinkSpeed -> Bool
<= :: BlinkSpeed -> BlinkSpeed -> Bool
$c> :: BlinkSpeed -> BlinkSpeed -> Bool
> :: BlinkSpeed -> BlinkSpeed -> Bool
$c>= :: BlinkSpeed -> BlinkSpeed -> Bool
>= :: BlinkSpeed -> BlinkSpeed -> Bool
$cmax :: BlinkSpeed -> BlinkSpeed -> BlinkSpeed
max :: BlinkSpeed -> BlinkSpeed -> BlinkSpeed
$cmin :: BlinkSpeed -> BlinkSpeed -> BlinkSpeed
min :: BlinkSpeed -> BlinkSpeed -> BlinkSpeed
Ord, ReadPrec [BlinkSpeed]
ReadPrec BlinkSpeed
Int -> ReadS BlinkSpeed
ReadS [BlinkSpeed]
(Int -> ReadS BlinkSpeed)
-> ReadS [BlinkSpeed]
-> ReadPrec BlinkSpeed
-> ReadPrec [BlinkSpeed]
-> Read BlinkSpeed
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BlinkSpeed
readsPrec :: Int -> ReadS BlinkSpeed
$creadList :: ReadS [BlinkSpeed]
readList :: ReadS [BlinkSpeed]
$creadPrec :: ReadPrec BlinkSpeed
readPrec :: ReadPrec BlinkSpeed
$creadListPrec :: ReadPrec [BlinkSpeed]
readListPrec :: ReadPrec [BlinkSpeed]
Read, Int -> BlinkSpeed -> ShowS
[BlinkSpeed] -> ShowS
BlinkSpeed -> String
(Int -> BlinkSpeed -> ShowS)
-> (BlinkSpeed -> String)
-> ([BlinkSpeed] -> ShowS)
-> Show BlinkSpeed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlinkSpeed -> ShowS
showsPrec :: Int -> BlinkSpeed -> ShowS
$cshow :: BlinkSpeed -> String
show :: BlinkSpeed -> String
$cshowList :: [BlinkSpeed] -> ShowS
showList :: [BlinkSpeed] -> ShowS
Show)

-- | ANSI text underlining

data Underlining
  = SingleUnderline
  | DoubleUnderline
    -- ^ Not widely supported.

  | CurlyUnderline
    -- ^ Not widely supported.

    --

    -- @since 1.1

  | DottedUnderline
    -- ^ Not widely supported.

    --

    -- @since 1.1

  | DashedUnderline
    -- ^ Not widely supported.

    --

    -- @since 1.1

  | NoUnderline
  deriving (Underlining
Underlining -> Underlining -> Bounded Underlining
forall a. a -> a -> Bounded a
$cminBound :: Underlining
minBound :: Underlining
$cmaxBound :: Underlining
maxBound :: Underlining
Bounded, Underlining -> Underlining -> Bool
(Underlining -> Underlining -> Bool)
-> (Underlining -> Underlining -> Bool) -> Eq Underlining
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Underlining -> Underlining -> Bool
== :: Underlining -> Underlining -> Bool
$c/= :: Underlining -> Underlining -> Bool
/= :: Underlining -> Underlining -> Bool
Eq, Int -> Underlining
Underlining -> Int
Underlining -> [Underlining]
Underlining -> Underlining
Underlining -> Underlining -> [Underlining]
Underlining -> Underlining -> Underlining -> [Underlining]
(Underlining -> Underlining)
-> (Underlining -> Underlining)
-> (Int -> Underlining)
-> (Underlining -> Int)
-> (Underlining -> [Underlining])
-> (Underlining -> Underlining -> [Underlining])
-> (Underlining -> Underlining -> [Underlining])
-> (Underlining -> Underlining -> Underlining -> [Underlining])
-> Enum Underlining
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Underlining -> Underlining
succ :: Underlining -> Underlining
$cpred :: Underlining -> Underlining
pred :: Underlining -> Underlining
$ctoEnum :: Int -> Underlining
toEnum :: Int -> Underlining
$cfromEnum :: Underlining -> Int
fromEnum :: Underlining -> Int
$cenumFrom :: Underlining -> [Underlining]
enumFrom :: Underlining -> [Underlining]
$cenumFromThen :: Underlining -> Underlining -> [Underlining]
enumFromThen :: Underlining -> Underlining -> [Underlining]
$cenumFromTo :: Underlining -> Underlining -> [Underlining]
enumFromTo :: Underlining -> Underlining -> [Underlining]
$cenumFromThenTo :: Underlining -> Underlining -> Underlining -> [Underlining]
enumFromThenTo :: Underlining -> Underlining -> Underlining -> [Underlining]
Enum, Ord Underlining
Ord Underlining =>
((Underlining, Underlining) -> [Underlining])
-> ((Underlining, Underlining) -> Underlining -> Int)
-> ((Underlining, Underlining) -> Underlining -> Int)
-> ((Underlining, Underlining) -> Underlining -> Bool)
-> ((Underlining, Underlining) -> Int)
-> ((Underlining, Underlining) -> Int)
-> Ix Underlining
(Underlining, Underlining) -> Int
(Underlining, Underlining) -> [Underlining]
(Underlining, Underlining) -> Underlining -> Bool
(Underlining, Underlining) -> Underlining -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (Underlining, Underlining) -> [Underlining]
range :: (Underlining, Underlining) -> [Underlining]
$cindex :: (Underlining, Underlining) -> Underlining -> Int
index :: (Underlining, Underlining) -> Underlining -> Int
$cunsafeIndex :: (Underlining, Underlining) -> Underlining -> Int
unsafeIndex :: (Underlining, Underlining) -> Underlining -> Int
$cinRange :: (Underlining, Underlining) -> Underlining -> Bool
inRange :: (Underlining, Underlining) -> Underlining -> Bool
$crangeSize :: (Underlining, Underlining) -> Int
rangeSize :: (Underlining, Underlining) -> Int
$cunsafeRangeSize :: (Underlining, Underlining) -> Int
unsafeRangeSize :: (Underlining, Underlining) -> Int
Ix, Eq Underlining
Eq Underlining =>
(Underlining -> Underlining -> Ordering)
-> (Underlining -> Underlining -> Bool)
-> (Underlining -> Underlining -> Bool)
-> (Underlining -> Underlining -> Bool)
-> (Underlining -> Underlining -> Bool)
-> (Underlining -> Underlining -> Underlining)
-> (Underlining -> Underlining -> Underlining)
-> Ord Underlining
Underlining -> Underlining -> Bool
Underlining -> Underlining -> Ordering
Underlining -> Underlining -> Underlining
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
$ccompare :: Underlining -> Underlining -> Ordering
compare :: Underlining -> Underlining -> Ordering
$c< :: Underlining -> Underlining -> Bool
< :: Underlining -> Underlining -> Bool
$c<= :: Underlining -> Underlining -> Bool
<= :: Underlining -> Underlining -> Bool
$c> :: Underlining -> Underlining -> Bool
> :: Underlining -> Underlining -> Bool
$c>= :: Underlining -> Underlining -> Bool
>= :: Underlining -> Underlining -> Bool
$cmax :: Underlining -> Underlining -> Underlining
max :: Underlining -> Underlining -> Underlining
$cmin :: Underlining -> Underlining -> Underlining
min :: Underlining -> Underlining -> Underlining
Ord, ReadPrec [Underlining]
ReadPrec Underlining
Int -> ReadS Underlining
ReadS [Underlining]
(Int -> ReadS Underlining)
-> ReadS [Underlining]
-> ReadPrec Underlining
-> ReadPrec [Underlining]
-> Read Underlining
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Underlining
readsPrec :: Int -> ReadS Underlining
$creadList :: ReadS [Underlining]
readList :: ReadS [Underlining]
$creadPrec :: ReadPrec Underlining
readPrec :: ReadPrec Underlining
$creadListPrec :: ReadPrec [Underlining]
readListPrec :: ReadPrec [Underlining]
Read, Int -> Underlining -> ShowS
[Underlining] -> ShowS
Underlining -> String
(Int -> Underlining -> ShowS)
-> (Underlining -> String)
-> ([Underlining] -> ShowS)
-> Show Underlining
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Underlining -> ShowS
showsPrec :: Int -> Underlining -> ShowS
$cshow :: Underlining -> String
show :: Underlining -> String
$cshowList :: [Underlining] -> ShowS
showList :: [Underlining] -> ShowS
Show)

-- | ANSI general console intensity: usually treated as setting the font style

-- (e.g. 'BoldIntensity' causes text to be bold)

data ConsoleIntensity
  = BoldIntensity
  -- | Not widely supported: sometimes treated as concealing text. Not supported

  -- natively on Windows 10

  | FaintIntensity
  | NormalIntensity
  deriving (ConsoleIntensity
ConsoleIntensity -> ConsoleIntensity -> Bounded ConsoleIntensity
forall a. a -> a -> Bounded a
$cminBound :: ConsoleIntensity
minBound :: ConsoleIntensity
$cmaxBound :: ConsoleIntensity
maxBound :: ConsoleIntensity
Bounded, ConsoleIntensity -> ConsoleIntensity -> Bool
(ConsoleIntensity -> ConsoleIntensity -> Bool)
-> (ConsoleIntensity -> ConsoleIntensity -> Bool)
-> Eq ConsoleIntensity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConsoleIntensity -> ConsoleIntensity -> Bool
== :: ConsoleIntensity -> ConsoleIntensity -> Bool
$c/= :: ConsoleIntensity -> ConsoleIntensity -> Bool
/= :: ConsoleIntensity -> ConsoleIntensity -> Bool
Eq, Int -> ConsoleIntensity
ConsoleIntensity -> Int
ConsoleIntensity -> [ConsoleIntensity]
ConsoleIntensity -> ConsoleIntensity
ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
ConsoleIntensity
-> ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
(ConsoleIntensity -> ConsoleIntensity)
-> (ConsoleIntensity -> ConsoleIntensity)
-> (Int -> ConsoleIntensity)
-> (ConsoleIntensity -> Int)
-> (ConsoleIntensity -> [ConsoleIntensity])
-> (ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity])
-> (ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity])
-> (ConsoleIntensity
    -> ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity])
-> Enum ConsoleIntensity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ConsoleIntensity -> ConsoleIntensity
succ :: ConsoleIntensity -> ConsoleIntensity
$cpred :: ConsoleIntensity -> ConsoleIntensity
pred :: ConsoleIntensity -> ConsoleIntensity
$ctoEnum :: Int -> ConsoleIntensity
toEnum :: Int -> ConsoleIntensity
$cfromEnum :: ConsoleIntensity -> Int
fromEnum :: ConsoleIntensity -> Int
$cenumFrom :: ConsoleIntensity -> [ConsoleIntensity]
enumFrom :: ConsoleIntensity -> [ConsoleIntensity]
$cenumFromThen :: ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
enumFromThen :: ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
$cenumFromTo :: ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
enumFromTo :: ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
$cenumFromThenTo :: ConsoleIntensity
-> ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
enumFromThenTo :: ConsoleIntensity
-> ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
Enum, Ord ConsoleIntensity
Ord ConsoleIntensity =>
((ConsoleIntensity, ConsoleIntensity) -> [ConsoleIntensity])
-> ((ConsoleIntensity, ConsoleIntensity)
    -> ConsoleIntensity -> Int)
-> ((ConsoleIntensity, ConsoleIntensity)
    -> ConsoleIntensity -> Int)
-> ((ConsoleIntensity, ConsoleIntensity)
    -> ConsoleIntensity -> Bool)
-> ((ConsoleIntensity, ConsoleIntensity) -> Int)
-> ((ConsoleIntensity, ConsoleIntensity) -> Int)
-> Ix ConsoleIntensity
(ConsoleIntensity, ConsoleIntensity) -> Int
(ConsoleIntensity, ConsoleIntensity) -> [ConsoleIntensity]
(ConsoleIntensity, ConsoleIntensity) -> ConsoleIntensity -> Bool
(ConsoleIntensity, ConsoleIntensity) -> ConsoleIntensity -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (ConsoleIntensity, ConsoleIntensity) -> [ConsoleIntensity]
range :: (ConsoleIntensity, ConsoleIntensity) -> [ConsoleIntensity]
$cindex :: (ConsoleIntensity, ConsoleIntensity) -> ConsoleIntensity -> Int
index :: (ConsoleIntensity, ConsoleIntensity) -> ConsoleIntensity -> Int
$cunsafeIndex :: (ConsoleIntensity, ConsoleIntensity) -> ConsoleIntensity -> Int
unsafeIndex :: (ConsoleIntensity, ConsoleIntensity) -> ConsoleIntensity -> Int
$cinRange :: (ConsoleIntensity, ConsoleIntensity) -> ConsoleIntensity -> Bool
inRange :: (ConsoleIntensity, ConsoleIntensity) -> ConsoleIntensity -> Bool
$crangeSize :: (ConsoleIntensity, ConsoleIntensity) -> Int
rangeSize :: (ConsoleIntensity, ConsoleIntensity) -> Int
$cunsafeRangeSize :: (ConsoleIntensity, ConsoleIntensity) -> Int
unsafeRangeSize :: (ConsoleIntensity, ConsoleIntensity) -> Int
Ix, Eq ConsoleIntensity
Eq ConsoleIntensity =>
(ConsoleIntensity -> ConsoleIntensity -> Ordering)
-> (ConsoleIntensity -> ConsoleIntensity -> Bool)
-> (ConsoleIntensity -> ConsoleIntensity -> Bool)
-> (ConsoleIntensity -> ConsoleIntensity -> Bool)
-> (ConsoleIntensity -> ConsoleIntensity -> Bool)
-> (ConsoleIntensity -> ConsoleIntensity -> ConsoleIntensity)
-> (ConsoleIntensity -> ConsoleIntensity -> ConsoleIntensity)
-> Ord ConsoleIntensity
ConsoleIntensity -> ConsoleIntensity -> Bool
ConsoleIntensity -> ConsoleIntensity -> Ordering
ConsoleIntensity -> ConsoleIntensity -> ConsoleIntensity
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
$ccompare :: ConsoleIntensity -> ConsoleIntensity -> Ordering
compare :: ConsoleIntensity -> ConsoleIntensity -> Ordering
$c< :: ConsoleIntensity -> ConsoleIntensity -> Bool
< :: ConsoleIntensity -> ConsoleIntensity -> Bool
$c<= :: ConsoleIntensity -> ConsoleIntensity -> Bool
<= :: ConsoleIntensity -> ConsoleIntensity -> Bool
$c> :: ConsoleIntensity -> ConsoleIntensity -> Bool
> :: ConsoleIntensity -> ConsoleIntensity -> Bool
$c>= :: ConsoleIntensity -> ConsoleIntensity -> Bool
>= :: ConsoleIntensity -> ConsoleIntensity -> Bool
$cmax :: ConsoleIntensity -> ConsoleIntensity -> ConsoleIntensity
max :: ConsoleIntensity -> ConsoleIntensity -> ConsoleIntensity
$cmin :: ConsoleIntensity -> ConsoleIntensity -> ConsoleIntensity
min :: ConsoleIntensity -> ConsoleIntensity -> ConsoleIntensity
Ord, ReadPrec [ConsoleIntensity]
ReadPrec ConsoleIntensity
Int -> ReadS ConsoleIntensity
ReadS [ConsoleIntensity]
(Int -> ReadS ConsoleIntensity)
-> ReadS [ConsoleIntensity]
-> ReadPrec ConsoleIntensity
-> ReadPrec [ConsoleIntensity]
-> Read ConsoleIntensity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ConsoleIntensity
readsPrec :: Int -> ReadS ConsoleIntensity
$creadList :: ReadS [ConsoleIntensity]
readList :: ReadS [ConsoleIntensity]
$creadPrec :: ReadPrec ConsoleIntensity
readPrec :: ReadPrec ConsoleIntensity
$creadListPrec :: ReadPrec [ConsoleIntensity]
readListPrec :: ReadPrec [ConsoleIntensity]
Read, Int -> ConsoleIntensity -> ShowS
[ConsoleIntensity] -> ShowS
ConsoleIntensity -> String
(Int -> ConsoleIntensity -> ShowS)
-> (ConsoleIntensity -> String)
-> ([ConsoleIntensity] -> ShowS)
-> Show ConsoleIntensity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConsoleIntensity -> ShowS
showsPrec :: Int -> ConsoleIntensity -> ShowS
$cshow :: ConsoleIntensity -> String
show :: ConsoleIntensity -> String
$cshowList :: [ConsoleIntensity] -> ShowS
showList :: [ConsoleIntensity] -> ShowS
Show)

-- | ANSI Select Graphic Rendition (SGR) command

--

-- In respect of colors, there are three alternative commands:

--

-- (1) the \'ANSI\' standards allow for eight standard colors (with two

-- intensities). Windows and many other terminals (including xterm) allow the

-- user to redefine the standard colors (so, for example 'Vivid' 'Green' may not

-- correspond to bright green;

--

-- (2) an extension of the standard that allows true colors (24 bit color depth)

-- in RGB space. This is usually the best alternative for more colors; and

--

-- (3) another extension that allows a palette of 256 colors, each color

-- specified by an index. Xterm provides a protocol for a palette of 256 colors

-- that many other terminals, including Windows 10, follow. Some terminals

-- (including xterm) allow the user to redefine some or all of the palette

-- colors.

data SGR
  -- | Default rendition, cancels the effect of any preceding occurrence of SGR

  -- (implementation-defined)

  = Reset
  -- | Set the character intensity. Partially supported natively on Windows 10

  | SetConsoleIntensity !ConsoleIntensity
  -- | Set italicized. Not widely supported: sometimes treated as swapping

  -- foreground and background. Not supported natively on Windows 10

  | SetItalicized !Bool
  -- | Set or clear underlining. Partially supported natively on Windows 10

  | SetUnderlining !Underlining
  -- | Set or clear character blinking. Not supported natively on Windows 10

  | SetBlinkSpeed !BlinkSpeed
  -- | Set revealed or concealed. Not widely supported. Not supported natively

  -- on Windows 10

  | SetVisible !Bool
  -- | Set negative or positive image. Supported natively on Windows 10

  | SetSwapForegroundBackground !Bool
  -- | Set a color from the standard palette of 16 colors (8 colors by 2

  -- color intensities). Many terminals allow the palette colors to be

  -- customised

  | SetColor !ConsoleLayer !ColorIntensity !Color
  -- | Set a true color (24 bit color depth). Supported natively on Windows 10

  -- from the Creators Update (April 2017)

  --

  -- @since 0.7

  | SetRGBColor !ConsoleLayer !(Colour Float)
  -- | Set a color from a palette of 256 colors using a numerical index

  -- (0-based). Supported natively on Windows 10 from the Creators Update (April

  -- 2017) but not on legacy Windows native terminals. See 'xtermSystem',

  -- 'xterm6LevelRGB' and 'xterm24LevelGray' to construct indices based on

  -- xterm's standard protocol for a 256-color palette.

  --

  -- @since 0.9

  | SetPaletteColor !ConsoleLayer !Word8
  -- | Set a color to the default (implementation-defined)

  --

  -- @since 0.10

  | SetDefaultColor !ConsoleLayer
  deriving (SGR -> SGR -> Bool
(SGR -> SGR -> Bool) -> (SGR -> SGR -> Bool) -> Eq SGR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SGR -> SGR -> Bool
== :: SGR -> SGR -> Bool
$c/= :: SGR -> SGR -> Bool
/= :: SGR -> SGR -> Bool
Eq, ReadPrec [SGR]
ReadPrec SGR
Int -> ReadS SGR
ReadS [SGR]
(Int -> ReadS SGR)
-> ReadS [SGR] -> ReadPrec SGR -> ReadPrec [SGR] -> Read SGR
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SGR
readsPrec :: Int -> ReadS SGR
$creadList :: ReadS [SGR]
readList :: ReadS [SGR]
$creadPrec :: ReadPrec SGR
readPrec :: ReadPrec SGR
$creadListPrec :: ReadPrec [SGR]
readListPrec :: ReadPrec [SGR]
Read, Int -> SGR -> ShowS
[SGR] -> ShowS
SGR -> String
(Int -> SGR -> ShowS)
-> (SGR -> String) -> ([SGR] -> ShowS) -> Show SGR
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SGR -> ShowS
showsPrec :: Int -> SGR -> ShowS
$cshow :: SGR -> String
show :: SGR -> String
$cshowList :: [SGR] -> ShowS
showList :: [SGR] -> ShowS
Show)

-- | Given xterm's standard protocol for a 256-color palette, returns the index

-- to that part of the palette which is a 6 level (6x6x6) color cube of 216 RGB

-- colors. Throws an error if any of the red, green or blue channels is outside

-- the range 0 to 5. An example of use is:

--

-- >>> setSGR [ SetPaletteColor $ xterm6LevelRGB 5 2 0 ] -- Dark Orange

--

-- @since 0.9

xterm6LevelRGB :: Int -> Int -> Int -> Word8
xterm6LevelRGB :: Int -> Int -> Int -> Word8
xterm6LevelRGB Int
r Int
g Int
b
  -- RGB colors are represented by index:

  -- 16 + 36 × r + 6 × g + b (0 ≤ r, g, b ≤ 5)

  | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6 Bool -> Bool -> Bool
&& Int
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6 Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6
  =  Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
36 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
g Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b
  | Bool
otherwise
  = String -> Word8
forall a. HasCallStack => String -> a
error (String -> Word8) -> String -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
g String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (r g b) is " String -> ShowS
forall a. [a] -> [a] -> [a]
++
            String
"outside of a 6 level (6x6x6) color cube."

-- | Given xterm's standard protocol for a 256-color palette, returns the index

-- to that part of the palette which is a spectrum of 24 grays, from dark

-- gray (0) to near white (23) (black and white are themselves excluded). Throws

-- an error if the gray is outside of the range 0 to 23. An example of use is:

--

-- >>> setSGR [ SetPaletteColor $ xterm24LevelGray 12 ] -- Gray50

--

-- @since 0.9

xterm24LevelGray :: Int -> Word8
xterm24LevelGray :: Int -> Word8
xterm24LevelGray Int
y
  -- Grayscale colors are represented by index:

  -- 232 + g (0 ≤ g ≤ 23)

  | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
232 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y
  | Bool
otherwise
  = String -> Word8
forall a. HasCallStack => String -> a
error (String -> Word8) -> String -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (gray) is outside of the range 0 to 23."

-- | Given xterm's standard protocol for a 256-color palette, returns the index

-- to that part of the palette which corresponds to the \'ANSI\' standards' 16

-- standard, or \'system\', colors (eight colors in two intensities). An example

-- of use is:

--

-- >>> setSGR [ SetPaletteColor $ xtermSystem Vivid Green ]

--

-- @since 0.9

xtermSystem :: ColorIntensity -> Color -> Word8
xtermSystem :: ColorIntensity -> Color -> Word8
xtermSystem ColorIntensity
intensity Color
color
  | ColorIntensity
intensity ColorIntensity -> ColorIntensity -> Bool
forall a. Eq a => a -> a -> Bool
== ColorIntensity
Dull  = Word8
index
  | Bool
otherwise          = Word8
index Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
8
 where
  index :: Word8
index = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Color -> Int
forall a. Enum a => a -> Int
fromEnum Color
color