{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Support for colour in the terminal.

![ANSI colours](AnsiColours.png)
-}
module Core.Text.Colour
    ( AnsiColour
    , intoEscapes
    , boldColour
    , dullRed
    , brightRed
    , pureRed
    , dullGreen
    , brightGreen
    , pureGreen
    , dullBlue
    , brightBlue
    , pureBlue
    , dullCyan
    , brightCyan
    , pureCyan
    , dullMagenta
    , brightMagenta
    , pureMagenta
    , dullYellow
    , brightYellow
    , pureYellow
    , pureBlack
    , dullGrey
    , brightGrey
    , pureGrey
    , pureWhite
    , dullWhite
    , brightWhite
    , resetColour
    ) where

import Core.Text.Rope
import Data.Colour.SRGB (sRGB, sRGB24read)
import System.Console.ANSI.Codes (setSGRCode)
import System.Console.ANSI.Types (ConsoleIntensity (..), ConsoleLayer (..), SGR (..))

{- |
An accumulation of ANSI escape codes used to add colour when pretty printing
to console.
-}
newtype AnsiColour = Escapes [SGR]

{- |
Convert an AnsiColour into the ANSI escape sequences which will make that
colour appear in the user's terminal.
-}
intoEscapes :: AnsiColour -> Rope
intoEscapes :: AnsiColour -> Rope
intoEscapes (Escapes [SGR]
codes) = forall α. Textual α => α -> Rope
intoRope ([SGR] -> String
setSGRCode [SGR]
codes)

-- | Medium \"Scarlet Red\" (@#cc0000@ from the Tango color palette).
dullRed :: AnsiColour
dullRed :: AnsiColour
dullRed =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#CC0000")]

-- | Highlighted \"Scarlet Red\" (@#ef2929@ from the Tango color palette).
brightRed :: AnsiColour
brightRed :: AnsiColour
brightRed =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#EF2929")]

-- | Pure \"Red\" (full RGB red channel only).
pureRed :: AnsiColour
pureRed :: AnsiColour
pureRed =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Float
1 Float
0 Float
0)]

-- | Shadowed \"Chameleon\" (@#4e9a06@ from the Tango color palette).
dullGreen :: AnsiColour
dullGreen :: AnsiColour
dullGreen =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#4E9A06")]

-- | Highlighted \"Chameleon\" (@#8ae234@ from the Tango color palette).
brightGreen :: AnsiColour
brightGreen :: AnsiColour
brightGreen =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#8AE234")]

-- | Pure \"Green\" (full RGB green channel only).
pureGreen :: AnsiColour
pureGreen :: AnsiColour
pureGreen =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Float
0 Float
1 Float
0)]

-- | Medium \"Sky Blue\" (@#3465a4@ from the Tango color palette).
dullBlue :: AnsiColour
dullBlue :: AnsiColour
dullBlue =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#3465A4")]

-- | Highlighted \"Sky Blue\" (@#729fcf@ from the Tango color palette).
brightBlue :: AnsiColour
brightBlue :: AnsiColour
brightBlue =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#729FCF")]

-- | Pure \"Blue\" (full RGB blue channel only).
pureBlue :: AnsiColour
pureBlue :: AnsiColour
pureBlue =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Float
0 Float
0 Float
1)]

-- | Dull \"Cyan\" (from the __gnome-terminal__ console theme).
dullCyan :: AnsiColour
dullCyan :: AnsiColour
dullCyan =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#06989A")]

-- | Bright \"Cyan\" (from the __gnome-terminal__ console theme).
brightCyan :: AnsiColour
brightCyan :: AnsiColour
brightCyan =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#34E2E2")]

-- | Pure \"Cyan\" (full RGB blue + green channels).
pureCyan :: AnsiColour
pureCyan :: AnsiColour
pureCyan =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Float
0 Float
1 Float
1)]

-- | Medium \"Plum\" (@#75507b@ from the Tango color palette).
dullMagenta :: AnsiColour
dullMagenta :: AnsiColour
dullMagenta =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#75507B")]

-- | Highlighted \"Plum\" (@#ad7fa8@ from the Tango color palette).
brightMagenta :: AnsiColour
brightMagenta :: AnsiColour
brightMagenta =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#AD7FA8")]

-- | Pure \"Magenta\" (full RGB red + blue channels).
pureMagenta :: AnsiColour
pureMagenta :: AnsiColour
pureMagenta =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Float
1 Float
0 Float
1)]

-- | Shadowed \"Butter\" (@#c4a000@ from the Tango color palette).
dullYellow :: AnsiColour
dullYellow :: AnsiColour
dullYellow =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#C4A000")]

-- | Highlighted \"Butter\" (@#fce94f@ from the Tango color palette).
brightYellow :: AnsiColour
brightYellow :: AnsiColour
brightYellow =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#FCE94F")]

-- | Pure \"Yellow\" (full RGB red + green channels).
pureYellow :: AnsiColour
pureYellow :: AnsiColour
pureYellow =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Float
1 Float
1 Float
0)]

-- | Pure \"Black\" (zero in all RGB channels).
pureBlack :: AnsiColour
pureBlack :: AnsiColour
pureBlack =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Float
0 Float
0 Float
0)]

-- | Shadowed \"Deep Aluminium\" (@#2e3436@ from the Tango color palette).
dullGrey :: AnsiColour
dullGrey :: AnsiColour
dullGrey =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#2E3436")]

-- | Medium \"Dark Aluminium\" (from the Tango color palette).
brightGrey :: AnsiColour
brightGrey :: AnsiColour
brightGrey =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#555753")]

-- | Pure \"Grey\" (set at @#999999@, being just over half in all RGB channels).
pureGrey :: AnsiColour
pureGrey :: AnsiColour
pureGrey =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#999999")]

-- | Pure \"White\" (fully on in all RGB channels).
pureWhite :: AnsiColour
pureWhite :: AnsiColour
pureWhite =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Float
1 Float
1 Float
1)]

-- | Medium \"Light Aluminium\" (@#d3d7cf@ from the Tango color palette).
dullWhite :: AnsiColour
dullWhite :: AnsiColour
dullWhite =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#D3D7CF")]

-- | Highlighted \"Light Aluminium\" (@#eeeeec@ from the Tango color palette).
brightWhite :: AnsiColour
brightWhite :: AnsiColour
brightWhite =
    [SGR] -> AnsiColour
Escapes [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Foreground (forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read String
"#EEEEEC")]

{- |
Given an 'AnsiColour', lift it to bold intensity.

Note that many console fonts do /not/ have a bold face variant, and terminal
emulators that "support bold" do so by doubling the thickness of the lines in
the glyphs. This may or may not be desirable from a readibility standpoint but
really there's only so much you can do to keep users who make poor font
choices from making poor font choices.
-}
boldColour :: AnsiColour -> AnsiColour
boldColour :: AnsiColour -> AnsiColour
boldColour (Escapes [SGR]
list) =
    [SGR] -> AnsiColour
Escapes (ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity forall a. a -> [a] -> [a]
: [SGR]
list)

instance Semigroup AnsiColour where
    <> :: AnsiColour -> AnsiColour -> AnsiColour
(<>) (Escapes [SGR]
list1) (Escapes [SGR]
list2) = [SGR] -> AnsiColour
Escapes ([SGR]
list1 forall a. Semigroup a => a -> a -> a
<> [SGR]
list2)

instance Monoid AnsiColour where
    mempty :: AnsiColour
mempty = [SGR] -> AnsiColour
Escapes []

{- |
This is not a colour, obviously, but it represents reseting to the default
terminal foreground colour, whatever the user has that set to.
-}
resetColour :: AnsiColour
resetColour :: AnsiColour
resetColour =
    [SGR] -> AnsiColour
Escapes [SGR
Reset]