{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}

module Text.Colour.Code where

import Data.ByteString (ByteString)
import Data.List
import Data.Text (Text)
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as LTB
import qualified Data.Text.Lazy.Builder as Text
import qualified Data.Text.Lazy.Builder.Int as LTB
import Data.Validity
import Data.Validity.ByteString ()
import Data.Validity.Text ()
import Data.Word
import GHC.Generics (Generic)

-- https://en.wikipedia.org/wiki/Escape_character#ASCII_escape_character
asciiEscape :: Char
asciiEscape :: Char
asciiEscape = Char
'\ESC'

csiStart :: Char
csiStart :: Char
csiStart = Char
'['

csiDelimiter :: Char
csiDelimiter :: Char
csiDelimiter = Char
';'

newtype CSI
  = SGR [SGR]
  deriving (Int -> CSI -> ShowS
[CSI] -> ShowS
CSI -> String
(Int -> CSI -> ShowS)
-> (CSI -> String) -> ([CSI] -> ShowS) -> Show CSI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CSI -> ShowS
showsPrec :: Int -> CSI -> ShowS
$cshow :: CSI -> String
show :: CSI -> String
$cshowList :: [CSI] -> ShowS
showList :: [CSI] -> ShowS
Show, CSI -> CSI -> Bool
(CSI -> CSI -> Bool) -> (CSI -> CSI -> Bool) -> Eq CSI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CSI -> CSI -> Bool
== :: CSI -> CSI -> Bool
$c/= :: CSI -> CSI -> Bool
/= :: CSI -> CSI -> Bool
Eq, (forall x. CSI -> Rep CSI x)
-> (forall x. Rep CSI x -> CSI) -> Generic CSI
forall x. Rep CSI x -> CSI
forall x. CSI -> Rep CSI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CSI -> Rep CSI x
from :: forall x. CSI -> Rep CSI x
$cto :: forall x. Rep CSI x -> CSI
to :: forall x. Rep CSI x -> CSI
Generic)

instance Validity CSI

-- | Render a CSI directly to 'ByteString' using UTF8.
--
-- You probably want to use 'renderCSI' instead.
-- This is just for testing.
renderCSIUtf8BS :: CSI -> ByteString
renderCSIUtf8BS :: CSI -> ByteString
renderCSIUtf8BS = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (CSI -> Text) -> CSI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSI -> Text
renderCSIText

-- | Render a CSI directly to strict 'Text'.
--
-- You probably want to use 'renderCSI' instead.
-- This is just for testing.
renderCSIText :: CSI -> Text
renderCSIText :: CSI -> Text
renderCSIText = Text -> Text
LT.toStrict (Text -> Text) -> (CSI -> Text) -> CSI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSI -> Text
renderCSILazyText

-- | Render a CSI directly to lazy 'LT.Text'.
--
-- You probably want to use 'renderCSI' instead.
-- This is just for testing.
renderCSILazyText :: CSI -> LT.Text
renderCSILazyText :: CSI -> Text
renderCSILazyText = Builder -> Text
LTB.toLazyText (Builder -> Text) -> (CSI -> Builder) -> CSI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSI -> Builder
renderCSI

-- https://en.wikipedia.org/wiki/ANSI_escape_code#CSI_(Control_Sequence_Introducer)_sequences
renderCSI :: CSI -> Text.Builder
renderCSI :: CSI -> Builder
renderCSI =
  let csi :: [Word8] -> Char -> Builder
csi [Word8]
ps Char
c =
        [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
          [ Char -> Builder
LTB.singleton Char
asciiEscape,
            Char -> Builder
LTB.singleton Char
csiStart,
            [Word8] -> Builder
renderCSIParams [Word8]
ps,
            Char -> Builder
LTB.singleton Char
c
          ]
   in \case
        SGR [SGR]
sgrs -> [Word8] -> Char -> Builder
csi ((SGR -> [Word8]) -> [SGR] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SGR -> [Word8]
sgrToCSIParams [SGR]
sgrs) Char
'm'

-- https://en.wikipedia.org/wiki/ANSI_escape_code#SGR_(Select_Graphic_Rendition)_parameters
data SGR
  = Reset
  | SetItalic !Bool
  | SetUnderlining !Underlining
  | SetBlinking !Blinking
  | SetConsoleIntensity !ConsoleIntensity
  | SetColour !ColourIntensity !ConsoleLayer !TerminalColour
  | Set8BitColour !ConsoleLayer !Word8
  | Set24BitColour
      !ConsoleLayer
      !Word8 -- Red
      !Word8 -- Green
      !Word8 -- Blue
  deriving (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, 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, (forall x. SGR -> Rep SGR x)
-> (forall x. Rep SGR x -> SGR) -> Generic SGR
forall x. Rep SGR x -> SGR
forall x. SGR -> Rep SGR x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SGR -> Rep SGR x
from :: forall x. SGR -> Rep SGR x
$cto :: forall x. Rep SGR x -> SGR
to :: forall x. Rep SGR x -> SGR
Generic)

instance Validity SGR

renderCSIParams :: [Word8] -> Text.Builder
renderCSIParams :: [Word8] -> Builder
renderCSIParams =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    ([Builder] -> Builder)
-> ([Word8] -> [Builder]) -> [Word8] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
LTB.singleton Char
csiDelimiter)
    ([Builder] -> [Builder])
-> ([Word8] -> [Builder]) -> [Word8] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Builder) -> [Word8] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Builder
forall a. Integral a => a -> Builder
LTB.decimal

sgrToCSIParams :: SGR -> [Word8]
sgrToCSIParams :: SGR -> [Word8]
sgrToCSIParams = \case
  SGR
Reset -> [] -- [0] would be fine too
  SetItalic Bool
b -> [if Bool
b then Word8
3 else Word8
23]
  SetUnderlining Underlining
u ->
    [ case Underlining
u of
        Underlining
SingleUnderline -> Word8
4
        Underlining
DoubleUnderline -> Word8
21
        Underlining
NoUnderline -> Word8
24
    ]
  SetBlinking Blinking
b ->
    [ case Blinking
b of
        Blinking
SlowBlinking -> Word8
5
        Blinking
RapidBlinking -> Word8
6
        Blinking
NoBlinking -> Word8
25
    ]
  SetConsoleIntensity ConsoleIntensity
ci ->
    [ case ConsoleIntensity
ci of
        ConsoleIntensity
BoldIntensity -> Word8
1
        ConsoleIntensity
FaintIntensity -> Word8
2
        ConsoleIntensity
NormalIntensity -> Word8
22
    ]
  SetColour ColourIntensity
i ConsoleLayer
l TerminalColour
c ->
    [ case ColourIntensity
i of
        ColourIntensity
Dull -> case ConsoleLayer
l of
          ConsoleLayer
Foreground -> Word8
30 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ TerminalColour -> Word8
terminalColourSGRParameter TerminalColour
c
          ConsoleLayer
Background -> Word8
40 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ TerminalColour -> Word8
terminalColourSGRParameter TerminalColour
c
        ColourIntensity
Bright -> case ConsoleLayer
l of
          ConsoleLayer
Foreground -> Word8
90 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ TerminalColour -> Word8
terminalColourSGRParameter TerminalColour
c
          ConsoleLayer
Background -> Word8
100 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ TerminalColour -> Word8
terminalColourSGRParameter TerminalColour
c
    ]
  Set8BitColour ConsoleLayer
l Word8
w ->
    [ case ConsoleLayer
l of
        ConsoleLayer
Foreground -> Word8
38
        ConsoleLayer
Background -> Word8
48,
      Word8
5,
      Word8
w
    ]
  Set24BitColour ConsoleLayer
l Word8
r Word8
g Word8
b ->
    [ case ConsoleLayer
l of
        ConsoleLayer
Foreground -> Word8
38
        ConsoleLayer
Background -> Word8
48,
      Word8
2,
      Word8
r,
      Word8
g,
      Word8
b
    ]

-- | ANSI text underlining
data Underlining
  = SingleUnderline
  | DoubleUnderline
  | NoUnderline
  deriving (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, 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, (forall x. Underlining -> Rep Underlining x)
-> (forall x. Rep Underlining x -> Underlining)
-> Generic Underlining
forall x. Rep Underlining x -> Underlining
forall x. Underlining -> Rep Underlining x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Underlining -> Rep Underlining x
from :: forall x. Underlining -> Rep Underlining x
$cto :: forall x. Rep Underlining x -> Underlining
to :: forall x. Rep Underlining x -> Underlining
Generic, Underlining
Underlining -> Underlining -> Bounded Underlining
forall a. a -> a -> Bounded a
$cminBound :: Underlining
minBound :: Underlining
$cmaxBound :: Underlining
maxBound :: Underlining
Bounded, 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)

instance Validity Underlining

-- | ANSI text blinking
data Blinking
  = SlowBlinking
  | RapidBlinking
  | NoBlinking
  deriving (Int -> Blinking -> ShowS
[Blinking] -> ShowS
Blinking -> String
(Int -> Blinking -> ShowS)
-> (Blinking -> String) -> ([Blinking] -> ShowS) -> Show Blinking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Blinking -> ShowS
showsPrec :: Int -> Blinking -> ShowS
$cshow :: Blinking -> String
show :: Blinking -> String
$cshowList :: [Blinking] -> ShowS
showList :: [Blinking] -> ShowS
Show, Blinking -> Blinking -> Bool
(Blinking -> Blinking -> Bool)
-> (Blinking -> Blinking -> Bool) -> Eq Blinking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Blinking -> Blinking -> Bool
== :: Blinking -> Blinking -> Bool
$c/= :: Blinking -> Blinking -> Bool
/= :: Blinking -> Blinking -> Bool
Eq, (forall x. Blinking -> Rep Blinking x)
-> (forall x. Rep Blinking x -> Blinking) -> Generic Blinking
forall x. Rep Blinking x -> Blinking
forall x. Blinking -> Rep Blinking x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Blinking -> Rep Blinking x
from :: forall x. Blinking -> Rep Blinking x
$cto :: forall x. Rep Blinking x -> Blinking
to :: forall x. Rep Blinking x -> Blinking
Generic, Blinking
Blinking -> Blinking -> Bounded Blinking
forall a. a -> a -> Bounded a
$cminBound :: Blinking
minBound :: Blinking
$cmaxBound :: Blinking
maxBound :: Blinking
Bounded, Int -> Blinking
Blinking -> Int
Blinking -> [Blinking]
Blinking -> Blinking
Blinking -> Blinking -> [Blinking]
Blinking -> Blinking -> Blinking -> [Blinking]
(Blinking -> Blinking)
-> (Blinking -> Blinking)
-> (Int -> Blinking)
-> (Blinking -> Int)
-> (Blinking -> [Blinking])
-> (Blinking -> Blinking -> [Blinking])
-> (Blinking -> Blinking -> [Blinking])
-> (Blinking -> Blinking -> Blinking -> [Blinking])
-> Enum Blinking
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 :: Blinking -> Blinking
succ :: Blinking -> Blinking
$cpred :: Blinking -> Blinking
pred :: Blinking -> Blinking
$ctoEnum :: Int -> Blinking
toEnum :: Int -> Blinking
$cfromEnum :: Blinking -> Int
fromEnum :: Blinking -> Int
$cenumFrom :: Blinking -> [Blinking]
enumFrom :: Blinking -> [Blinking]
$cenumFromThen :: Blinking -> Blinking -> [Blinking]
enumFromThen :: Blinking -> Blinking -> [Blinking]
$cenumFromTo :: Blinking -> Blinking -> [Blinking]
enumFromTo :: Blinking -> Blinking -> [Blinking]
$cenumFromThenTo :: Blinking -> Blinking -> Blinking -> [Blinking]
enumFromThenTo :: Blinking -> Blinking -> Blinking -> [Blinking]
Enum)

instance Validity Blinking

-- | ANSI general console intensity: usually treated as setting the font style
-- (e.g. 'BoldIntensity' causes text to be bold)
data ConsoleIntensity
  = BoldIntensity
  | FaintIntensity
  | NormalIntensity
  deriving (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, 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, (forall x. ConsoleIntensity -> Rep ConsoleIntensity x)
-> (forall x. Rep ConsoleIntensity x -> ConsoleIntensity)
-> Generic ConsoleIntensity
forall x. Rep ConsoleIntensity x -> ConsoleIntensity
forall x. ConsoleIntensity -> Rep ConsoleIntensity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConsoleIntensity -> Rep ConsoleIntensity x
from :: forall x. ConsoleIntensity -> Rep ConsoleIntensity x
$cto :: forall x. Rep ConsoleIntensity x -> ConsoleIntensity
to :: forall x. Rep ConsoleIntensity x -> ConsoleIntensity
Generic, ConsoleIntensity
ConsoleIntensity -> ConsoleIntensity -> Bounded ConsoleIntensity
forall a. a -> a -> Bounded a
$cminBound :: ConsoleIntensity
minBound :: ConsoleIntensity
$cmaxBound :: ConsoleIntensity
maxBound :: ConsoleIntensity
Bounded, 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)

instance Validity ConsoleIntensity

-- | ANSI's standard colours come in two intensities
data ColourIntensity
  = Dull
  | Bright
  deriving (Int -> ColourIntensity -> ShowS
[ColourIntensity] -> ShowS
ColourIntensity -> String
(Int -> ColourIntensity -> ShowS)
-> (ColourIntensity -> String)
-> ([ColourIntensity] -> ShowS)
-> Show ColourIntensity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColourIntensity -> ShowS
showsPrec :: Int -> ColourIntensity -> ShowS
$cshow :: ColourIntensity -> String
show :: ColourIntensity -> String
$cshowList :: [ColourIntensity] -> ShowS
showList :: [ColourIntensity] -> ShowS
Show, ColourIntensity -> ColourIntensity -> Bool
(ColourIntensity -> ColourIntensity -> Bool)
-> (ColourIntensity -> ColourIntensity -> Bool)
-> Eq ColourIntensity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColourIntensity -> ColourIntensity -> Bool
== :: ColourIntensity -> ColourIntensity -> Bool
$c/= :: ColourIntensity -> ColourIntensity -> Bool
/= :: ColourIntensity -> ColourIntensity -> Bool
Eq, (forall x. ColourIntensity -> Rep ColourIntensity x)
-> (forall x. Rep ColourIntensity x -> ColourIntensity)
-> Generic ColourIntensity
forall x. Rep ColourIntensity x -> ColourIntensity
forall x. ColourIntensity -> Rep ColourIntensity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColourIntensity -> Rep ColourIntensity x
from :: forall x. ColourIntensity -> Rep ColourIntensity x
$cto :: forall x. Rep ColourIntensity x -> ColourIntensity
to :: forall x. Rep ColourIntensity x -> ColourIntensity
Generic, Int -> ColourIntensity
ColourIntensity -> Int
ColourIntensity -> [ColourIntensity]
ColourIntensity -> ColourIntensity
ColourIntensity -> ColourIntensity -> [ColourIntensity]
ColourIntensity
-> ColourIntensity -> ColourIntensity -> [ColourIntensity]
(ColourIntensity -> ColourIntensity)
-> (ColourIntensity -> ColourIntensity)
-> (Int -> ColourIntensity)
-> (ColourIntensity -> Int)
-> (ColourIntensity -> [ColourIntensity])
-> (ColourIntensity -> ColourIntensity -> [ColourIntensity])
-> (ColourIntensity -> ColourIntensity -> [ColourIntensity])
-> (ColourIntensity
    -> ColourIntensity -> ColourIntensity -> [ColourIntensity])
-> Enum ColourIntensity
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 :: ColourIntensity -> ColourIntensity
succ :: ColourIntensity -> ColourIntensity
$cpred :: ColourIntensity -> ColourIntensity
pred :: ColourIntensity -> ColourIntensity
$ctoEnum :: Int -> ColourIntensity
toEnum :: Int -> ColourIntensity
$cfromEnum :: ColourIntensity -> Int
fromEnum :: ColourIntensity -> Int
$cenumFrom :: ColourIntensity -> [ColourIntensity]
enumFrom :: ColourIntensity -> [ColourIntensity]
$cenumFromThen :: ColourIntensity -> ColourIntensity -> [ColourIntensity]
enumFromThen :: ColourIntensity -> ColourIntensity -> [ColourIntensity]
$cenumFromTo :: ColourIntensity -> ColourIntensity -> [ColourIntensity]
enumFromTo :: ColourIntensity -> ColourIntensity -> [ColourIntensity]
$cenumFromThenTo :: ColourIntensity
-> ColourIntensity -> ColourIntensity -> [ColourIntensity]
enumFromThenTo :: ColourIntensity
-> ColourIntensity -> ColourIntensity -> [ColourIntensity]
Enum, ColourIntensity
ColourIntensity -> ColourIntensity -> Bounded ColourIntensity
forall a. a -> a -> Bounded a
$cminBound :: ColourIntensity
minBound :: ColourIntensity
$cmaxBound :: ColourIntensity
maxBound :: ColourIntensity
Bounded)

instance Validity ColourIntensity

-- | ANSI colours can be set on two different layers
data ConsoleLayer
  = Foreground
  | Background
  deriving (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, 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, (forall x. ConsoleLayer -> Rep ConsoleLayer x)
-> (forall x. Rep ConsoleLayer x -> ConsoleLayer)
-> Generic ConsoleLayer
forall x. Rep ConsoleLayer x -> ConsoleLayer
forall x. ConsoleLayer -> Rep ConsoleLayer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConsoleLayer -> Rep ConsoleLayer x
from :: forall x. ConsoleLayer -> Rep ConsoleLayer x
$cto :: forall x. Rep ConsoleLayer x -> ConsoleLayer
to :: forall x. Rep ConsoleLayer x -> ConsoleLayer
Generic, 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, ConsoleLayer
ConsoleLayer -> ConsoleLayer -> Bounded ConsoleLayer
forall a. a -> a -> Bounded a
$cminBound :: ConsoleLayer
minBound :: ConsoleLayer
$cmaxBound :: ConsoleLayer
maxBound :: ConsoleLayer
Bounded)

instance Validity ConsoleLayer

data TerminalColour
  = Black
  | Red
  | Green
  | Yellow
  | Blue
  | Magenta
  | Cyan
  | White
  deriving (Int -> TerminalColour -> ShowS
[TerminalColour] -> ShowS
TerminalColour -> String
(Int -> TerminalColour -> ShowS)
-> (TerminalColour -> String)
-> ([TerminalColour] -> ShowS)
-> Show TerminalColour
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TerminalColour -> ShowS
showsPrec :: Int -> TerminalColour -> ShowS
$cshow :: TerminalColour -> String
show :: TerminalColour -> String
$cshowList :: [TerminalColour] -> ShowS
showList :: [TerminalColour] -> ShowS
Show, TerminalColour -> TerminalColour -> Bool
(TerminalColour -> TerminalColour -> Bool)
-> (TerminalColour -> TerminalColour -> Bool) -> Eq TerminalColour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TerminalColour -> TerminalColour -> Bool
== :: TerminalColour -> TerminalColour -> Bool
$c/= :: TerminalColour -> TerminalColour -> Bool
/= :: TerminalColour -> TerminalColour -> Bool
Eq, (forall x. TerminalColour -> Rep TerminalColour x)
-> (forall x. Rep TerminalColour x -> TerminalColour)
-> Generic TerminalColour
forall x. Rep TerminalColour x -> TerminalColour
forall x. TerminalColour -> Rep TerminalColour x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TerminalColour -> Rep TerminalColour x
from :: forall x. TerminalColour -> Rep TerminalColour x
$cto :: forall x. Rep TerminalColour x -> TerminalColour
to :: forall x. Rep TerminalColour x -> TerminalColour
Generic, Int -> TerminalColour
TerminalColour -> Int
TerminalColour -> [TerminalColour]
TerminalColour -> TerminalColour
TerminalColour -> TerminalColour -> [TerminalColour]
TerminalColour
-> TerminalColour -> TerminalColour -> [TerminalColour]
(TerminalColour -> TerminalColour)
-> (TerminalColour -> TerminalColour)
-> (Int -> TerminalColour)
-> (TerminalColour -> Int)
-> (TerminalColour -> [TerminalColour])
-> (TerminalColour -> TerminalColour -> [TerminalColour])
-> (TerminalColour -> TerminalColour -> [TerminalColour])
-> (TerminalColour
    -> TerminalColour -> TerminalColour -> [TerminalColour])
-> Enum TerminalColour
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 :: TerminalColour -> TerminalColour
succ :: TerminalColour -> TerminalColour
$cpred :: TerminalColour -> TerminalColour
pred :: TerminalColour -> TerminalColour
$ctoEnum :: Int -> TerminalColour
toEnum :: Int -> TerminalColour
$cfromEnum :: TerminalColour -> Int
fromEnum :: TerminalColour -> Int
$cenumFrom :: TerminalColour -> [TerminalColour]
enumFrom :: TerminalColour -> [TerminalColour]
$cenumFromThen :: TerminalColour -> TerminalColour -> [TerminalColour]
enumFromThen :: TerminalColour -> TerminalColour -> [TerminalColour]
$cenumFromTo :: TerminalColour -> TerminalColour -> [TerminalColour]
enumFromTo :: TerminalColour -> TerminalColour -> [TerminalColour]
$cenumFromThenTo :: TerminalColour
-> TerminalColour -> TerminalColour -> [TerminalColour]
enumFromThenTo :: TerminalColour
-> TerminalColour -> TerminalColour -> [TerminalColour]
Enum, TerminalColour
TerminalColour -> TerminalColour -> Bounded TerminalColour
forall a. a -> a -> Bounded a
$cminBound :: TerminalColour
minBound :: TerminalColour
$cmaxBound :: TerminalColour
maxBound :: TerminalColour
Bounded)

instance Validity TerminalColour

terminalColourSGRParameter :: TerminalColour -> Word8
terminalColourSGRParameter :: TerminalColour -> Word8
terminalColourSGRParameter = \case
  TerminalColour
Black -> Word8
0
  TerminalColour
Red -> Word8
1
  TerminalColour
Green -> Word8
2
  TerminalColour
Yellow -> Word8
3
  TerminalColour
Blue -> Word8
4
  TerminalColour
Magenta -> Word8
5
  TerminalColour
Cyan -> Word8
6
  TerminalColour
White -> Word8
7

terminalColourFromIndex :: Word8 -> Maybe TerminalColour
terminalColourFromIndex :: Word8 -> Maybe TerminalColour
terminalColourFromIndex = \case
  Word8
0 -> TerminalColour -> Maybe TerminalColour
forall a. a -> Maybe a
Just TerminalColour
Black
  Word8
1 -> TerminalColour -> Maybe TerminalColour
forall a. a -> Maybe a
Just TerminalColour
Red
  Word8
2 -> TerminalColour -> Maybe TerminalColour
forall a. a -> Maybe a
Just TerminalColour
Green
  Word8
3 -> TerminalColour -> Maybe TerminalColour
forall a. a -> Maybe a
Just TerminalColour
Yellow
  Word8
4 -> TerminalColour -> Maybe TerminalColour
forall a. a -> Maybe a
Just TerminalColour
Blue
  Word8
5 -> TerminalColour -> Maybe TerminalColour
forall a. a -> Maybe a
Just TerminalColour
Magenta
  Word8
6 -> TerminalColour -> Maybe TerminalColour
forall a. a -> Maybe a
Just TerminalColour
Cyan
  Word8
7 -> TerminalColour -> Maybe TerminalColour
forall a. a -> Maybe a
Just TerminalColour
White
  Word8
_ -> Maybe TerminalColour
forall a. Maybe a
Nothing