{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.Text.ANSI
  ( -- $intro

    -- * Foreground color
    black,
    red,
    green,
    yellow,
    blue,
    magenta,
    cyan,
    white,
    brightBlack,
    brightRed,
    brightGreen,
    brightYellow,
    brightBlue,
    brightMagenta,
    brightCyan,
    brightWhite,
    rgb,

    -- * Background color
    blackBg,
    redBg,
    greenBg,
    yellowBg,
    blueBg,
    magentaBg,
    cyanBg,
    whiteBg,
    brightBlackBg,
    brightRedBg,
    brightGreenBg,
    brightYellowBg,
    brightBlueBg,
    brightMagentaBg,
    brightCyanBg,
    brightWhiteBg,
    rgbBg,

    -- * Style
    bold,
    faint,
    italic,
    underline,
    doubleUnderline,
    strikethrough,
    frame,
    encircle,
    overline,
  )
where

#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ((<>))
#endif
import Data.Text
import qualified Data.Text.Lazy as Text.Lazy
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as Builder
import qualified Data.Text.Lazy.Builder.Int as Builder
import Data.Word (Word8)
import Foreign.C (CInt (CInt))
import System.IO.Unsafe (unsafePerformIO)

-- $intro
--
-- Text styling for ANSI terminals using SGR codes, as defined by the
-- <https://www.ecma-international.org/publications/files/ECMA-ST/Ecma-048.pdf ECMA-48>
-- standard.
--
-- Supports foreground\/background color, bold\/faint intensity, italic,
-- single\/double underline, strikethrough, frame, encircle, and overline escape
-- sequences. Some styles may not work on your terminal.
--
-- Also features terminal detection, so redirecting styled output to a file will
-- automatically strip the ANSI escape sequences.

-- | Black foreground.
black :: Text -> Text
black :: Text -> Text
black =
  Builder -> Text -> Text
foreground Builder
"30"
{-# INLINEABLE black #-}

-- | Red foreground.
red :: Text -> Text
red :: Text -> Text
red =
  Builder -> Text -> Text
foreground Builder
"31"
{-# INLINEABLE red #-}

-- | Green foreground.
green :: Text -> Text
green :: Text -> Text
green =
  Builder -> Text -> Text
foreground Builder
"32"
{-# INLINEABLE green #-}

-- | Yellow foreground.
yellow :: Text -> Text
yellow :: Text -> Text
yellow =
  Builder -> Text -> Text
foreground Builder
"33"
{-# INLINEABLE yellow #-}

-- | Blue foreground.
blue :: Text -> Text
blue :: Text -> Text
blue =
  Builder -> Text -> Text
foreground Builder
"34"
{-# INLINEABLE blue #-}

-- | Magenta foreground.
magenta :: Text -> Text
magenta :: Text -> Text
magenta =
  Builder -> Text -> Text
foreground Builder
"35"
{-# INLINEABLE magenta #-}

-- | Cyan foreground.
cyan :: Text -> Text
cyan :: Text -> Text
cyan =
  Builder -> Text -> Text
foreground Builder
"36"
{-# INLINEABLE cyan #-}

-- | White foreground.
white :: Text -> Text
white :: Text -> Text
white =
  Builder -> Text -> Text
foreground Builder
"37"
{-# INLINEABLE white #-}

-- | Bright black foreground.
brightBlack :: Text -> Text
brightBlack :: Text -> Text
brightBlack =
  Builder -> Text -> Text
foreground Builder
"90"
{-# INLINEABLE brightBlack #-}

-- | Bright red foreground.
brightRed :: Text -> Text
brightRed :: Text -> Text
brightRed =
  Builder -> Text -> Text
foreground Builder
"91"
{-# INLINEABLE brightRed #-}

-- | Bright green foreground.
brightGreen :: Text -> Text
brightGreen :: Text -> Text
brightGreen =
  Builder -> Text -> Text
foreground Builder
"92"
{-# INLINEABLE brightGreen #-}

-- | Bright yellow foreground.
brightYellow :: Text -> Text
brightYellow :: Text -> Text
brightYellow =
  Builder -> Text -> Text
foreground Builder
"93"
{-# INLINEABLE brightYellow #-}

-- | Bright blue foreground.
brightBlue :: Text -> Text
brightBlue :: Text -> Text
brightBlue =
  Builder -> Text -> Text
foreground Builder
"94"
{-# INLINEABLE brightBlue #-}

-- | Bright magenta foreground.
brightMagenta :: Text -> Text
brightMagenta :: Text -> Text
brightMagenta =
  Builder -> Text -> Text
foreground Builder
"95"
{-# INLINEABLE brightMagenta #-}

-- | Bright cyan foreground.
brightCyan :: Text -> Text
brightCyan :: Text -> Text
brightCyan =
  Builder -> Text -> Text
foreground Builder
"96"
{-# INLINEABLE brightCyan #-}

-- | Bright white foreground.
brightWhite :: Text -> Text
brightWhite :: Text -> Text
brightWhite =
  Builder -> Text -> Text
foreground Builder
"97"
{-# INLINEABLE brightWhite #-}

-- | RGB foreground.
rgb :: Word8 -> Word8 -> Word8 -> Text -> Text
rgb :: Word8 -> Word8 -> Word8 -> Text -> Text
rgb Word8
r Word8
g Word8
b =
  Builder -> Text -> Text
foreground (Builder
"38;2;" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. Integral a => a -> Builder
Builder.decimal Word8
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
semi Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. Integral a => a -> Builder
Builder.decimal Word8
g Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
semi Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. Integral a => a -> Builder
Builder.decimal Word8
b)
{-# INLINEABLE rgb #-}

foreground :: Builder -> Text -> Text
foreground :: Builder -> Text -> Text
foreground Builder
s =
  Builder -> Builder -> Text -> Text
surround Builder
s Builder
"39"
{-# INLINE foreground #-}

-- | Black background.
blackBg :: Text -> Text
blackBg :: Text -> Text
blackBg =
  Builder -> Text -> Text
background Builder
"40"
{-# INLINEABLE blackBg #-}

-- | Red background.
redBg :: Text -> Text
redBg :: Text -> Text
redBg =
  Builder -> Text -> Text
background Builder
"41"
{-# INLINEABLE redBg #-}

-- | Green background.
greenBg :: Text -> Text
greenBg :: Text -> Text
greenBg =
  Builder -> Text -> Text
background Builder
"42"
{-# INLINEABLE greenBg #-}

-- | Yellow background.
yellowBg :: Text -> Text
yellowBg :: Text -> Text
yellowBg =
  Builder -> Text -> Text
background Builder
"43"
{-# INLINEABLE yellowBg #-}

-- | Blue background.
blueBg :: Text -> Text
blueBg :: Text -> Text
blueBg =
  Builder -> Text -> Text
background Builder
"44"
{-# INLINEABLE blueBg #-}

-- | Magenta background.
magentaBg :: Text -> Text
magentaBg :: Text -> Text
magentaBg =
  Builder -> Text -> Text
background Builder
"45"
{-# INLINEABLE magentaBg #-}

-- | Cyan background.
cyanBg :: Text -> Text
cyanBg :: Text -> Text
cyanBg =
  Builder -> Text -> Text
background Builder
"46"
{-# INLINEABLE cyanBg #-}

-- | White background.
whiteBg :: Text -> Text
whiteBg :: Text -> Text
whiteBg =
  Builder -> Text -> Text
background Builder
"47"
{-# INLINEABLE whiteBg #-}

-- | Bright black background.
brightBlackBg :: Text -> Text
brightBlackBg :: Text -> Text
brightBlackBg =
  Builder -> Text -> Text
background Builder
"100"
{-# INLINEABLE brightBlackBg #-}

-- | Bright red background.
brightRedBg :: Text -> Text
brightRedBg :: Text -> Text
brightRedBg =
  Builder -> Text -> Text
background Builder
"101"
{-# INLINEABLE brightRedBg #-}

-- | Bright green background.
brightGreenBg :: Text -> Text
brightGreenBg :: Text -> Text
brightGreenBg =
  Builder -> Text -> Text
background Builder
"102"
{-# INLINEABLE brightGreenBg #-}

-- | Bright yellow background.
brightYellowBg :: Text -> Text
brightYellowBg :: Text -> Text
brightYellowBg =
  Builder -> Text -> Text
background Builder
"103"
{-# INLINEABLE brightYellowBg #-}

-- | Bright blue background.
brightBlueBg :: Text -> Text
brightBlueBg :: Text -> Text
brightBlueBg =
  Builder -> Text -> Text
background Builder
"104"
{-# INLINEABLE brightBlueBg #-}

-- | Bright magenta background.
brightMagentaBg :: Text -> Text
brightMagentaBg :: Text -> Text
brightMagentaBg =
  Builder -> Text -> Text
background Builder
"105"
{-# INLINEABLE brightMagentaBg #-}

-- | Bright cyan background.
brightCyanBg :: Text -> Text
brightCyanBg :: Text -> Text
brightCyanBg =
  Builder -> Text -> Text
background Builder
"106"
{-# INLINEABLE brightCyanBg #-}

-- | Bright white background.
brightWhiteBg :: Text -> Text
brightWhiteBg :: Text -> Text
brightWhiteBg =
  Builder -> Text -> Text
background Builder
"107"
{-# INLINEABLE brightWhiteBg #-}

background :: Builder -> Text -> Text
background :: Builder -> Text -> Text
background Builder
s =
  Builder -> Builder -> Text -> Text
surround Builder
s Builder
"49"
{-# INLINE background #-}

-- | RGB background.
rgbBg :: Word8 -> Word8 -> Word8 -> Text -> Text
rgbBg :: Word8 -> Word8 -> Word8 -> Text -> Text
rgbBg Word8
r Word8
g Word8
b =
  Builder -> Text -> Text
background (Builder
"48;2;" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. Integral a => a -> Builder
Builder.decimal Word8
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
semi Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. Integral a => a -> Builder
Builder.decimal Word8
g Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
semi Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. Integral a => a -> Builder
Builder.decimal Word8
b)
{-# INLINEABLE rgbBg #-}

-- | __Bold__ style (high intensity).
bold :: Text -> Text
bold :: Text -> Text
bold =
  Builder -> Builder -> Text -> Text
surround Builder
"1" Builder
"22"
{-# INLINEABLE bold #-}

-- | Faint style (low intensity).
faint :: Text -> Text
faint :: Text -> Text
faint =
  Builder -> Builder -> Text -> Text
surround Builder
"2" Builder
"22"
{-# INLINEABLE faint #-}

-- | /Italic/ style.
italic :: Text -> Text
italic :: Text -> Text
italic =
  Builder -> Builder -> Text -> Text
surround Builder
"3" Builder
"23"
{-# INLINEABLE italic #-}

-- | U̲n̲d̲e̲r̲l̲i̲n̲e̲ style.
underline :: Text -> Text
underline :: Text -> Text
underline =
  Builder -> Builder -> Text -> Text
surround Builder
"4" Builder
"24"
{-# INLINEABLE underline #-}

-- | D̳o̳u̳b̳l̳e̳ ̳u̳n̳d̳e̳r̳l̳i̳n̳e̳ style.
doubleUnderline :: Text -> Text
doubleUnderline :: Text -> Text
doubleUnderline =
  Builder -> Builder -> Text -> Text
surround Builder
"21" Builder
"24"
{-# INLINEABLE doubleUnderline #-}

-- | S̶t̶r̶i̶k̶e̶t̶h̶r̶o̶u̶g̶h̶ style.
strikethrough :: Text -> Text
strikethrough :: Text -> Text
strikethrough =
  Builder -> Builder -> Text -> Text
surround Builder
"9" Builder
"29"
{-# INLINEABLE strikethrough #-}

-- | Frame style.
frame :: Text -> Text
frame :: Text -> Text
frame =
  Builder -> Builder -> Text -> Text
surround Builder
"51" Builder
"54"
{-# INLINEABLE frame #-}

-- | Encircle style.
encircle :: Text -> Text
encircle :: Text -> Text
encircle =
  Builder -> Builder -> Text -> Text
surround Builder
"52" Builder
"54"
{-# INLINEABLE encircle #-}

-- | O̅v̅e̅r̅l̅i̅n̅e̅ style.
overline :: Text -> Text
overline :: Text -> Text
overline =
  Builder -> Builder -> Text -> Text
surround Builder
"53" Builder
"55"
{-# INLINEABLE overline #-}

--------------------------------------------------------------------------------

surround :: Builder -> Builder -> Text -> Text
surround :: Builder -> Builder -> Text -> Text
surround Builder
open Builder
close Text
text
  | Bool
isatty = Text -> Text
Text.Lazy.toStrict (Builder -> Text
Builder.toLazyText (Builder
esc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
open Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
m Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Builder.fromText Text
text Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
esc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
close Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
m))
  | Bool
otherwise = Text
text
-- Don't inline before phase 1
{-# NOINLINE [1] surround #-}

esc :: Builder
esc :: Builder
esc =
  Builder
"\ESC["

m :: Builder
m :: Builder
m =
  Char -> Builder
Builder.singleton Char
'm'

semi :: Builder
semi :: Builder
semi =
  Char -> Builder
Builder.singleton Char
';'

isatty :: Bool
isatty :: Bool
isatty =
  IO CInt -> CInt
forall a. IO a -> a
unsafePerformIO (CInt -> IO CInt
c_isatty CInt
1) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1
{-# NOINLINE isatty #-}

foreign import ccall unsafe "isatty"
  c_isatty :: CInt -> IO CInt

-- Collapse surround/surround to a single surround before phase 1
{-# RULES
"surround/surround" [~1] forall a b c d s.
  surround a b (surround c d s) =
    surround (a <> semi <> c) (b <> semi <> d) s
  #-}