-- | Safe Coloured Text
--
-- This module is responsible for defining, building, and rendering coloured text.
--
-- The text to be coloured is 'Text', but the rendered text, while technically still (probably) valid Utf8, will be a 'ByteString' builder.
module Text.Colour
  ( -- * Building chunks
    chunk,
    Chunk (..),

    -- ** Styling

    -- *** Setting colour

    --
    -- These will only be rendered if the given 'TerminalCapabilities' supports them.
    fore,
    back,

    -- *** Setting non-colour attributes

    --
    -- These will be rendered for any 'TerminalCapabilities'
    bold,
    faint,
    italic,
    underline,
    doubleUnderline,
    noUnderline,
    slowBlinking,
    rapidBlinking,
    noBlinking,

    -- ** Colours
    Colour (..),

    -- *** 8-colour

    -- **** Dull
    black,
    red,
    green,
    yellow,
    blue,
    magenta,
    cyan,
    white,

    -- **** Bright
    brightBlack,
    brightRed,
    brightGreen,
    brightYellow,
    brightBlue,
    brightMagenta,
    brightCyan,
    brightWhite,

    -- *** 8-bit
    color256,
    colour256,

    -- *** 24-bit
    colorRGB,
    colourRGB,

    -- * Rendering

    -- ** Rendering chunks to strict bytestring in UTF8
    renderChunksUtf8BS,
    renderChunkUtf8BS,

    -- ** Rendering chunks to lazy bytestring builders in UTF8
    renderChunksUtf8BSBuilder,
    renderChunkUtf8BSBuilder,

    -- ** Rendering chunks to strict Text
    renderChunksText,
    renderChunkText,

    -- ** Rendering chunks to lazy text
    renderChunksLazyText,
    renderChunkLazyText,

    -- ** Rendering chunks to lazy text builder
    renderChunksBuilder,
    renderChunkBuilder,

    -- * IO
    TerminalCapabilities (..),

    -- ** Outputting chunks directly
    putChunksUtf8With,
    putChunksLocaleWith,
    hPutChunksUtf8With,
    hPutChunksLocaleWith,
  )
where

import qualified Data.ByteString.Builder as SBB
import qualified Data.Text.IO as TIO
import System.IO
import Text.Colour.Capabilities
import Text.Colour.Chunk

-- | Print a list of chunks to stdout with given 'TerminalCapabilities'.
putChunksUtf8With :: TerminalCapabilities -> [Chunk] -> IO ()
putChunksUtf8With :: TerminalCapabilities -> [Chunk] -> IO ()
putChunksUtf8With TerminalCapabilities
tc = TerminalCapabilities -> Handle -> [Chunk] -> IO ()
hPutChunksUtf8With TerminalCapabilities
tc Handle
stdout

-- | Print a list of chunks to stdout with given 'TerminalCapabilities' in an encoding according to the system's locale.
putChunksLocaleWith :: TerminalCapabilities -> [Chunk] -> IO ()
putChunksLocaleWith :: TerminalCapabilities -> [Chunk] -> IO ()
putChunksLocaleWith TerminalCapabilities
tc = TerminalCapabilities -> Handle -> [Chunk] -> IO ()
hPutChunksLocaleWith TerminalCapabilities
tc Handle
stdout

-- | Print a list of chunks to the given 'Handle' with given 'TerminalCapabilities'.
hPutChunksUtf8With :: TerminalCapabilities -> Handle -> [Chunk] -> IO ()
hPutChunksUtf8With :: TerminalCapabilities -> Handle -> [Chunk] -> IO ()
hPutChunksUtf8With TerminalCapabilities
tc Handle
h [Chunk]
cs = Handle -> Builder -> IO ()
SBB.hPutBuilder Handle
h (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ TerminalCapabilities -> [Chunk] -> Builder
forall (f :: * -> *).
Foldable f =>
TerminalCapabilities -> f Chunk -> Builder
renderChunksUtf8BSBuilder TerminalCapabilities
tc [Chunk]
cs

-- | Print a list of chunks to the given 'Handle' with given 'TerminalCapabilities' in an encoding according to the system's locale.
hPutChunksLocaleWith :: TerminalCapabilities -> Handle -> [Chunk] -> IO ()
hPutChunksLocaleWith :: TerminalCapabilities -> Handle -> [Chunk] -> IO ()
hPutChunksLocaleWith TerminalCapabilities
tc Handle
h [Chunk]
cs = Handle -> Text -> IO ()
TIO.hPutStr Handle
h (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ TerminalCapabilities -> [Chunk] -> Text
forall (f :: * -> *).
Foldable f =>
TerminalCapabilities -> f Chunk -> Text
renderChunksText TerminalCapabilities
tc [Chunk]
cs