Colour.hs

{-# 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 (Escapes codes) = intoRope (setSGRCode codes)

-- | Medium \"Scarlet Red\" (@#cc0000@ from the Tango color palette).
dullRed :: AnsiColour
dullRed =
    Escapes [SetRGBColor Foreground (sRGB24read "#CC0000")]

-- | Highlighted \"Scarlet Red\" (@#ef2929@ from the Tango color palette).
brightRed :: AnsiColour
brightRed =
    Escapes [SetRGBColor Foreground (sRGB24read "#EF2929")]

-- | Pure \"Red\" (full RGB red channel only).
pureRed :: AnsiColour
pureRed =
    Escapes [SetRGBColor Foreground (sRGB 1 0 0)]

-- | Shadowed \"Chameleon\" (@#4e9a06@ from the Tango color palette).
dullGreen :: AnsiColour
dullGreen =
    Escapes [SetRGBColor Foreground (sRGB24read "#4E9A06")]

-- | Highlighted \"Chameleon\" (@#8ae234@ from the Tango color palette).
brightGreen :: AnsiColour
brightGreen =
    Escapes [SetRGBColor Foreground (sRGB24read "#8AE234")]

-- | Pure \"Green\" (full RGB green channel only).
pureGreen :: AnsiColour
pureGreen =
    Escapes [SetRGBColor Foreground (sRGB 0 1 0)]

-- | Medium \"Sky Blue\" (@#3465a4@ from the Tango color palette).
dullBlue :: AnsiColour
dullBlue =
    Escapes [SetRGBColor Foreground (sRGB24read "#3465A4")]

-- | Highlighted \"Sky Blue\" (@#729fcf@ from the Tango color palette).
brightBlue :: AnsiColour
brightBlue =
    Escapes [SetRGBColor Foreground (sRGB24read "#729FCF")]

-- | Pure \"Blue\" (full RGB blue channel only).
pureBlue :: AnsiColour
pureBlue =
    Escapes [SetRGBColor Foreground (sRGB 0 0 1)]

-- | Dull \"Cyan\" (from the __gnome-terminal__ console theme).
dullCyan :: AnsiColour
dullCyan =
    Escapes [SetRGBColor Foreground (sRGB24read "#06989A")]

-- | Bright \"Cyan\" (from the __gnome-terminal__ console theme).
brightCyan :: AnsiColour
brightCyan =
    Escapes [SetRGBColor Foreground (sRGB24read "#34E2E2")]

-- | Pure \"Cyan\" (full RGB blue + green channels).
pureCyan :: AnsiColour
pureCyan =
    Escapes [SetRGBColor Foreground (sRGB 0 1 1)]

-- | Medium \"Plum\" (@#75507b@ from the Tango color palette).
dullMagenta :: AnsiColour
dullMagenta =
    Escapes [SetRGBColor Foreground (sRGB24read "#75507B")]

-- | Highlighted \"Plum\" (@#ad7fa8@ from the Tango color palette).
brightMagenta :: AnsiColour
brightMagenta =
    Escapes [SetRGBColor Foreground (sRGB24read "#AD7FA8")]

-- | Pure \"Magenta\" (full RGB red + blue channels).
pureMagenta :: AnsiColour
pureMagenta =
    Escapes [SetRGBColor Foreground (sRGB 1 0 1)]

-- | Shadowed \"Butter\" (@#c4a000@ from the Tango color palette).
dullYellow :: AnsiColour
dullYellow =
    Escapes [SetRGBColor Foreground (sRGB24read "#C4A000")]

-- | Highlighted \"Butter\" (@#fce94f@ from the Tango color palette).
brightYellow :: AnsiColour
brightYellow =
    Escapes [SetRGBColor Foreground (sRGB24read "#FCE94F")]

-- | Pure \"Yellow\" (full RGB red + green channels).
pureYellow :: AnsiColour
pureYellow =
    Escapes [SetRGBColor Foreground (sRGB 1 1 0)]

-- | Pure \"Black\" (zero in all RGB channels).
pureBlack :: AnsiColour
pureBlack =
    Escapes [SetRGBColor Foreground (sRGB 0 0 0)]

-- | Shadowed \"Deep Aluminium\" (@#2e3436@ from the Tango color palette).
dullGrey :: AnsiColour
dullGrey =
    Escapes [SetRGBColor Foreground (sRGB24read "#2E3436")]

-- | Medium \"Dark Aluminium\" (from the Tango color palette).
brightGrey :: AnsiColour
brightGrey =
    Escapes [SetRGBColor Foreground (sRGB24read "#555753")]

-- | Pure \"Grey\" (set at @#999999@, being just over half in all RGB channels).
pureGrey :: AnsiColour
pureGrey =
    Escapes [SetRGBColor Foreground (sRGB24read "#999999")]

-- | Pure \"White\" (fully on in all RGB channels).
pureWhite :: AnsiColour
pureWhite =
    Escapes [SetRGBColor Foreground (sRGB 1 1 1)]

-- | Medium \"Light Aluminium\" (@#d3d7cf@ from the Tango color palette).
dullWhite :: AnsiColour
dullWhite =
    Escapes [SetRGBColor Foreground (sRGB24read "#D3D7CF")]

-- | Highlighted \"Light Aluminium\" (@#eeeeec@ from the Tango color palette).
brightWhite :: AnsiColour
brightWhite =
    Escapes [SetRGBColor Foreground (sRGB24read "#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 (Escapes list) =
    Escapes (SetConsoleIntensity BoldIntensity : list)

instance Semigroup AnsiColour where
    (<>) (Escapes list1) (Escapes list2) = Escapes (list1 <> list2)

instance Monoid AnsiColour where
    mempty = 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 =
    Escapes [Reset]