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

module Text.Colour.Code where

import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as SBB
import qualified Data.ByteString.Internal as SBI
import qualified Data.ByteString.Lazy as LB
import Data.List
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 :: Word8
asciiEscape :: Word8
asciiEscape = Char -> Word8
SBI.c2w Char
'\ESC'

csiStart :: Word8
csiStart :: Word8
csiStart = Char -> Word8
SBI.c2w Char
'['

csiDelimiter :: Word8
csiDelimiter :: Word8
csiDelimiter = Char -> Word8
SBI.c2w 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
showList :: [CSI] -> ShowS
$cshowList :: [CSI] -> ShowS
show :: CSI -> String
$cshow :: CSI -> String
showsPrec :: Int -> CSI -> ShowS
$cshowsPrec :: Int -> CSI -> ShowS
Show, CSI -> CSI -> Bool
(CSI -> CSI -> Bool) -> (CSI -> CSI -> Bool) -> Eq CSI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSI -> CSI -> Bool
$c/= :: CSI -> CSI -> Bool
== :: CSI -> CSI -> Bool
$c== :: 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
$cto :: forall x. Rep CSI x -> CSI
$cfrom :: forall x. CSI -> Rep CSI x
Generic)

instance Validity CSI

-- | Render a CSI directly to bytestring.
-- You probably want to use 'renderCSI' instead.
-- This is just for testing.
renderCSIBS :: CSI -> ByteString
renderCSIBS :: CSI -> ByteString
renderCSIBS = ByteString -> ByteString
LB.toStrict (ByteString -> ByteString)
-> (CSI -> ByteString) -> CSI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
SBB.toLazyByteString (Builder -> ByteString) -> (CSI -> Builder) -> CSI -> ByteString
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 -> Builder
renderCSI :: CSI -> Builder
renderCSI =
  let csi :: [Word8] -> Word8 -> Builder
csi [Word8]
ps Word8
c =
        [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
          [ Word8 -> Builder
SBB.word8 Word8
asciiEscape,
            Word8 -> Builder
SBB.word8 Word8
csiStart,
            [Word8] -> Builder
csiParamsToWords [Word8]
ps,
            Word8 -> Builder
SBB.word8 Word8
c
          ]
   in \case
        SGR [SGR]
sgrs -> [Word8] -> Word8 -> Builder
csi ((SGR -> [Word8]) -> [SGR] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SGR -> [Word8]
sgrToCSIParams [SGR]
sgrs) (Char -> Word8
SBI.c2w Char
'm')

-- https://en.wikipedia.org/wiki/ANSI_escape_code#SGR_(Select_Graphic_Rendition)_parameters
data SGR
  = Reset
  | SetItalic !Bool
  | SetUnderlining !Underlining
  | 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
showList :: [SGR] -> ShowS
$cshowList :: [SGR] -> ShowS
show :: SGR -> String
$cshow :: SGR -> String
showsPrec :: Int -> SGR -> ShowS
$cshowsPrec :: Int -> SGR -> ShowS
Show, SGR -> SGR -> Bool
(SGR -> SGR -> Bool) -> (SGR -> SGR -> Bool) -> Eq SGR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SGR -> SGR -> Bool
$c/= :: SGR -> SGR -> Bool
== :: SGR -> SGR -> Bool
$c== :: 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
$cto :: forall x. Rep SGR x -> SGR
$cfrom :: forall x. SGR -> Rep SGR x
Generic)

instance Validity SGR

csiParamsToWords :: [Word8] -> Builder
csiParamsToWords :: [Word8] -> Builder
csiParamsToWords = [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 (Word8 -> Builder
SBB.word8 Word8
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
csiParamToWord

csiParamToWord :: Word8 -> Builder
csiParamToWord :: Word8 -> Builder
csiParamToWord = \case
  Word8
0 -> Builder
forall a. Monoid a => a
mempty
  Word8
w -> Word8 -> Builder
SBB.word8Dec Word8
w

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

instance Validity Underlining

-- | 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
showList :: [ConsoleIntensity] -> ShowS
$cshowList :: [ConsoleIntensity] -> ShowS
show :: ConsoleIntensity -> String
$cshow :: ConsoleIntensity -> String
showsPrec :: Int -> ConsoleIntensity -> ShowS
$cshowsPrec :: Int -> ConsoleIntensity -> ShowS
Show, ConsoleIntensity -> ConsoleIntensity -> Bool
(ConsoleIntensity -> ConsoleIntensity -> Bool)
-> (ConsoleIntensity -> ConsoleIntensity -> Bool)
-> Eq ConsoleIntensity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConsoleIntensity -> ConsoleIntensity -> Bool
$c/= :: ConsoleIntensity -> ConsoleIntensity -> Bool
== :: ConsoleIntensity -> ConsoleIntensity -> Bool
$c== :: 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
$cto :: forall x. Rep ConsoleIntensity x -> ConsoleIntensity
$cfrom :: forall x. ConsoleIntensity -> Rep ConsoleIntensity x
Generic, ConsoleIntensity
ConsoleIntensity -> ConsoleIntensity -> Bounded ConsoleIntensity
forall a. a -> a -> Bounded a
maxBound :: ConsoleIntensity
$cmaxBound :: ConsoleIntensity
minBound :: ConsoleIntensity
$cminBound :: 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
enumFromThenTo :: ConsoleIntensity
-> ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
$cenumFromThenTo :: ConsoleIntensity
-> ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
enumFromTo :: ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
$cenumFromTo :: ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
enumFromThen :: ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
$cenumFromThen :: ConsoleIntensity -> ConsoleIntensity -> [ConsoleIntensity]
enumFrom :: ConsoleIntensity -> [ConsoleIntensity]
$cenumFrom :: ConsoleIntensity -> [ConsoleIntensity]
fromEnum :: ConsoleIntensity -> Int
$cfromEnum :: ConsoleIntensity -> Int
toEnum :: Int -> ConsoleIntensity
$ctoEnum :: Int -> ConsoleIntensity
pred :: ConsoleIntensity -> ConsoleIntensity
$cpred :: ConsoleIntensity -> ConsoleIntensity
succ :: ConsoleIntensity -> ConsoleIntensity
$csucc :: 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
showList :: [ColourIntensity] -> ShowS
$cshowList :: [ColourIntensity] -> ShowS
show :: ColourIntensity -> String
$cshow :: ColourIntensity -> String
showsPrec :: Int -> ColourIntensity -> ShowS
$cshowsPrec :: Int -> ColourIntensity -> ShowS
Show, ColourIntensity -> ColourIntensity -> Bool
(ColourIntensity -> ColourIntensity -> Bool)
-> (ColourIntensity -> ColourIntensity -> Bool)
-> Eq ColourIntensity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColourIntensity -> ColourIntensity -> Bool
$c/= :: ColourIntensity -> ColourIntensity -> Bool
== :: ColourIntensity -> ColourIntensity -> Bool
$c== :: 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
$cto :: forall x. Rep ColourIntensity x -> ColourIntensity
$cfrom :: forall x. ColourIntensity -> Rep ColourIntensity x
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
enumFromThenTo :: ColourIntensity
-> ColourIntensity -> ColourIntensity -> [ColourIntensity]
$cenumFromThenTo :: ColourIntensity
-> ColourIntensity -> ColourIntensity -> [ColourIntensity]
enumFromTo :: ColourIntensity -> ColourIntensity -> [ColourIntensity]
$cenumFromTo :: ColourIntensity -> ColourIntensity -> [ColourIntensity]
enumFromThen :: ColourIntensity -> ColourIntensity -> [ColourIntensity]
$cenumFromThen :: ColourIntensity -> ColourIntensity -> [ColourIntensity]
enumFrom :: ColourIntensity -> [ColourIntensity]
$cenumFrom :: ColourIntensity -> [ColourIntensity]
fromEnum :: ColourIntensity -> Int
$cfromEnum :: ColourIntensity -> Int
toEnum :: Int -> ColourIntensity
$ctoEnum :: Int -> ColourIntensity
pred :: ColourIntensity -> ColourIntensity
$cpred :: ColourIntensity -> ColourIntensity
succ :: ColourIntensity -> ColourIntensity
$csucc :: ColourIntensity -> ColourIntensity
Enum, ColourIntensity
ColourIntensity -> ColourIntensity -> Bounded ColourIntensity
forall a. a -> a -> Bounded a
maxBound :: ColourIntensity
$cmaxBound :: ColourIntensity
minBound :: ColourIntensity
$cminBound :: 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
showList :: [ConsoleLayer] -> ShowS
$cshowList :: [ConsoleLayer] -> ShowS
show :: ConsoleLayer -> String
$cshow :: ConsoleLayer -> String
showsPrec :: Int -> ConsoleLayer -> ShowS
$cshowsPrec :: Int -> ConsoleLayer -> ShowS
Show, ConsoleLayer -> ConsoleLayer -> Bool
(ConsoleLayer -> ConsoleLayer -> Bool)
-> (ConsoleLayer -> ConsoleLayer -> Bool) -> Eq ConsoleLayer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConsoleLayer -> ConsoleLayer -> Bool
$c/= :: ConsoleLayer -> ConsoleLayer -> Bool
== :: ConsoleLayer -> ConsoleLayer -> Bool
$c== :: 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
$cto :: forall x. Rep ConsoleLayer x -> ConsoleLayer
$cfrom :: forall x. ConsoleLayer -> Rep ConsoleLayer x
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
enumFromThenTo :: ConsoleLayer -> ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
$cenumFromThenTo :: ConsoleLayer -> ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
enumFromTo :: ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
$cenumFromTo :: ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
enumFromThen :: ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
$cenumFromThen :: ConsoleLayer -> ConsoleLayer -> [ConsoleLayer]
enumFrom :: ConsoleLayer -> [ConsoleLayer]
$cenumFrom :: ConsoleLayer -> [ConsoleLayer]
fromEnum :: ConsoleLayer -> Int
$cfromEnum :: ConsoleLayer -> Int
toEnum :: Int -> ConsoleLayer
$ctoEnum :: Int -> ConsoleLayer
pred :: ConsoleLayer -> ConsoleLayer
$cpred :: ConsoleLayer -> ConsoleLayer
succ :: ConsoleLayer -> ConsoleLayer
$csucc :: ConsoleLayer -> ConsoleLayer
Enum, ConsoleLayer
ConsoleLayer -> ConsoleLayer -> Bounded ConsoleLayer
forall a. a -> a -> Bounded a
maxBound :: ConsoleLayer
$cmaxBound :: ConsoleLayer
minBound :: ConsoleLayer
$cminBound :: 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
showList :: [TerminalColour] -> ShowS
$cshowList :: [TerminalColour] -> ShowS
show :: TerminalColour -> String
$cshow :: TerminalColour -> String
showsPrec :: Int -> TerminalColour -> ShowS
$cshowsPrec :: Int -> TerminalColour -> ShowS
Show, TerminalColour -> TerminalColour -> Bool
(TerminalColour -> TerminalColour -> Bool)
-> (TerminalColour -> TerminalColour -> Bool) -> Eq TerminalColour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerminalColour -> TerminalColour -> Bool
$c/= :: TerminalColour -> TerminalColour -> Bool
== :: TerminalColour -> TerminalColour -> Bool
$c== :: 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
$cto :: forall x. Rep TerminalColour x -> TerminalColour
$cfrom :: forall x. TerminalColour -> Rep TerminalColour x
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
enumFromThenTo :: TerminalColour
-> TerminalColour -> TerminalColour -> [TerminalColour]
$cenumFromThenTo :: TerminalColour
-> TerminalColour -> TerminalColour -> [TerminalColour]
enumFromTo :: TerminalColour -> TerminalColour -> [TerminalColour]
$cenumFromTo :: TerminalColour -> TerminalColour -> [TerminalColour]
enumFromThen :: TerminalColour -> TerminalColour -> [TerminalColour]
$cenumFromThen :: TerminalColour -> TerminalColour -> [TerminalColour]
enumFrom :: TerminalColour -> [TerminalColour]
$cenumFrom :: TerminalColour -> [TerminalColour]
fromEnum :: TerminalColour -> Int
$cfromEnum :: TerminalColour -> Int
toEnum :: Int -> TerminalColour
$ctoEnum :: Int -> TerminalColour
pred :: TerminalColour -> TerminalColour
$cpred :: TerminalColour -> TerminalColour
succ :: TerminalColour -> TerminalColour
$csucc :: TerminalColour -> TerminalColour
Enum, TerminalColour
TerminalColour -> TerminalColour -> Bounded TerminalColour
forall a. a -> a -> Bounded a
maxBound :: TerminalColour
$cmaxBound :: TerminalColour
minBound :: TerminalColour
$cminBound :: 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