{-# 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 Data.Text.Lazy.Builder (Builder)
import Data.Word (Word8)
import Foreign.C (CInt(CInt))
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Builder as Builder
import qualified Data.Text.Lazy.Builder.Int as Builder

-- $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.

{-# INLINABLE black           #-}
{-# INLINABLE red             #-}
{-# INLINABLE green           #-}
{-# INLINABLE yellow          #-}
{-# INLINABLE blue            #-}
{-# INLINABLE magenta         #-}
{-# INLINABLE cyan            #-}
{-# INLINABLE white           #-}
{-# INLINABLE brightBlack     #-}
{-# INLINABLE brightRed       #-}
{-# INLINABLE brightGreen     #-}
{-# INLINABLE brightYellow    #-}
{-# INLINABLE brightBlue      #-}
{-# INLINABLE brightMagenta   #-}
{-# INLINABLE brightCyan      #-}
{-# INLINABLE brightWhite     #-}
{-# INLINABLE blackBg         #-}
{-# INLINABLE redBg           #-}
{-# INLINABLE greenBg         #-}
{-# INLINABLE yellowBg        #-}
{-# INLINABLE blueBg          #-}
{-# INLINABLE magentaBg       #-}
{-# INLINABLE cyanBg          #-}
{-# INLINABLE whiteBg         #-}
{-# INLINABLE brightBlackBg   #-}
{-# INLINABLE brightRedBg     #-}
{-# INLINABLE brightGreenBg   #-}
{-# INLINABLE brightYellowBg  #-}
{-# INLINABLE brightBlueBg    #-}
{-# INLINABLE brightMagentaBg #-}
{-# INLINABLE brightCyanBg    #-}
{-# INLINABLE brightWhiteBg   #-}

black, red, green, yellow, blue, magenta, cyan, white, brightBlack, brightRed,
  brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan,
  brightWhite, blackBg, redBg, greenBg,
  yellowBg, blueBg, magentaBg, cyanBg,
  whiteBg, brightBlackBg, brightRedBg,
  brightGreenBg, brightYellowBg, brightBlueBg,
  brightMagentaBg, brightCyanBg,
  brightWhiteBg :: Text -> Text

-- | Black foreground.
black :: Text -> Text
black           = Builder -> Builder -> Text -> Text
surround Builder
"30"  Builder
"39"
-- | Red foreground.
red :: Text -> Text
red             = Builder -> Builder -> Text -> Text
surround Builder
"31"  Builder
"39"
-- | Green foreground.
green :: Text -> Text
green           = Builder -> Builder -> Text -> Text
surround Builder
"32"  Builder
"39"
-- | Yellow foreground.
yellow :: Text -> Text
yellow          = Builder -> Builder -> Text -> Text
surround Builder
"33"  Builder
"39"
-- | Blue foreground.
blue :: Text -> Text
blue            = Builder -> Builder -> Text -> Text
surround Builder
"34"  Builder
"39"
-- | Magenta foreground.
magenta :: Text -> Text
magenta         = Builder -> Builder -> Text -> Text
surround Builder
"35"  Builder
"39"
-- | Cyan foreground.
cyan :: Text -> Text
cyan            = Builder -> Builder -> Text -> Text
surround Builder
"36"  Builder
"39"
-- | White foreground.
white :: Text -> Text
white           = Builder -> Builder -> Text -> Text
surround Builder
"37"  Builder
"39"
-- | Bright black foreground.
brightBlack :: Text -> Text
brightBlack     = Builder -> Builder -> Text -> Text
surround Builder
"90"  Builder
"39"
-- | Bright red foreground.
brightRed :: Text -> Text
brightRed       = Builder -> Builder -> Text -> Text
surround Builder
"91"  Builder
"39"
-- | Bright green foreground.
brightGreen :: Text -> Text
brightGreen     = Builder -> Builder -> Text -> Text
surround Builder
"92"  Builder
"39"
-- | Bright yellow foreground.
brightYellow :: Text -> Text
brightYellow    = Builder -> Builder -> Text -> Text
surround Builder
"93"  Builder
"39"
-- | Bright blue foreground.
brightBlue :: Text -> Text
brightBlue      = Builder -> Builder -> Text -> Text
surround Builder
"94"  Builder
"39"
-- | Bright magenta foreground.
brightMagenta :: Text -> Text
brightMagenta   = Builder -> Builder -> Text -> Text
surround Builder
"95"  Builder
"39"
-- | Bright cyan foreground.
brightCyan :: Text -> Text
brightCyan      = Builder -> Builder -> Text -> Text
surround Builder
"96"  Builder
"39"
-- | Bright white foreground.
brightWhite :: Text -> Text
brightWhite     = Builder -> Builder -> Text -> Text
surround Builder
"97"  Builder
"39"
-- | Black background.
blackBg :: Text -> Text
blackBg         = Builder -> Builder -> Text -> Text
surround Builder
"40"  Builder
"49"
-- | Red background.
redBg :: Text -> Text
redBg           = Builder -> Builder -> Text -> Text
surround Builder
"41"  Builder
"49"
-- | Green background.
greenBg :: Text -> Text
greenBg         = Builder -> Builder -> Text -> Text
surround Builder
"42"  Builder
"49"
-- | Yellow background.
yellowBg :: Text -> Text
yellowBg        = Builder -> Builder -> Text -> Text
surround Builder
"43"  Builder
"49"
-- | Blue background.
blueBg :: Text -> Text
blueBg          = Builder -> Builder -> Text -> Text
surround Builder
"44"  Builder
"49"
-- | Magenta background.
magentaBg :: Text -> Text
magentaBg       = Builder -> Builder -> Text -> Text
surround Builder
"45"  Builder
"49"
-- | Cyan background.
cyanBg :: Text -> Text
cyanBg          = Builder -> Builder -> Text -> Text
surround Builder
"46"  Builder
"49"
-- | White background.
whiteBg :: Text -> Text
whiteBg         = Builder -> Builder -> Text -> Text
surround Builder
"47"  Builder
"49"
-- | Bright black background.
brightBlackBg :: Text -> Text
brightBlackBg   = Builder -> Builder -> Text -> Text
surround Builder
"100" Builder
"49"
-- | Bright red background.
brightRedBg :: Text -> Text
brightRedBg     = Builder -> Builder -> Text -> Text
surround Builder
"101" Builder
"49"
-- | Bright green background.
brightGreenBg :: Text -> Text
brightGreenBg   = Builder -> Builder -> Text -> Text
surround Builder
"102" Builder
"49"
-- | Bright yellow background.
brightYellowBg :: Text -> Text
brightYellowBg  = Builder -> Builder -> Text -> Text
surround Builder
"103" Builder
"49"
-- | Bright blue background.
brightBlueBg :: Text -> Text
brightBlueBg    = Builder -> Builder -> Text -> Text
surround Builder
"104" Builder
"49"
-- | Bright magenta background.
brightMagentaBg :: Text -> Text
brightMagentaBg = Builder -> Builder -> Text -> Text
surround Builder
"105" Builder
"49"
-- | Bright cyan background.
brightCyanBg :: Text -> Text
brightCyanBg    = Builder -> Builder -> Text -> Text
surround Builder
"106" Builder
"49"
-- | Bright white background.
brightWhiteBg :: Text -> Text
brightWhiteBg   = Builder -> Builder -> Text -> Text
surround Builder
"107" Builder
"49"

-- | RGB foreground.
{-# INLINABLE rgb #-}
rgb :: Word8 -> Word8 -> Word8 -> Text -> Text
rgb :: Word8 -> Word8 -> Word8 -> Text -> Text
rgb Word8
r Word8
g Word8
b =
  Builder -> Builder -> Text -> Text
surround
    (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)
    Builder
"39"

-- | RGB background.
{-# INLINABLE rgbBg #-}
rgbBg :: Word8 -> Word8 -> Word8 -> Text -> Text
rgbBg :: Word8 -> Word8 -> Word8 -> Text -> Text
rgbBg Word8
r Word8
g Word8
b =
  Builder -> Builder -> Text -> Text
surround
    (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)
    Builder
"49"

{-# INLINABLE bold            #-}
{-# INLINABLE faint           #-}
{-# INLINABLE italic          #-}
{-# INLINABLE underline       #-}
{-# INLINABLE doubleUnderline #-}
{-# INLINABLE strikethrough   #-}
{-# INLINABLE frame           #-}
{-# INLINABLE encircle        #-}
{-# INLINABLE overline        #-}

bold, faint, italic, underline, doubleUnderline, strikethrough, frame,
  encircle, overline :: Text -> Text

-- | __Bold__ style (high intensity).
bold :: Text -> Text
bold            = Builder -> Builder -> Text -> Text
surround Builder
"1"  Builder
"22"
-- | Faint style (low intensity).
faint :: Text -> Text
faint           = Builder -> Builder -> Text -> Text
surround Builder
"2"  Builder
"22"
-- | /Italic/ style.
italic :: Text -> Text
italic          = Builder -> Builder -> Text -> Text
surround Builder
"3"  Builder
"32"
-- | U̲n̲d̲e̲r̲l̲i̲n̲e̲ style.
underline :: Text -> Text
underline       = Builder -> Builder -> Text -> Text
surround Builder
"4"  Builder
"24"
-- | D̳o̳u̳b̳l̳e̳ ̳u̳n̳d̳e̳r̳l̳i̳n̳e̳ style.
doubleUnderline :: Text -> Text
doubleUnderline = Builder -> Builder -> Text -> Text
surround Builder
"21" Builder
"24"
-- | S̶t̶r̶i̶k̶e̶t̶h̶r̶o̶u̶g̶h̶ style.
strikethrough :: Text -> Text
strikethrough   = Builder -> Builder -> Text -> Text
surround Builder
"9"  Builder
"29"
-- | Frame style.
frame :: Text -> Text
frame           = Builder -> Builder -> Text -> Text
surround Builder
"51" Builder
"54"
-- | Encircle style.
encircle :: Text -> Text
encircle        = Builder -> Builder -> Text -> Text
surround Builder
"52" Builder
"54"
-- | O̅v̅e̅r̅l̅i̅n̅e̅ style.
overline :: Text -> Text
overline        = Builder -> Builder -> Text -> Text
surround Builder
"53" Builder
"55"



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

-- Don't inline before phase 1
{-# NOINLINE [1] surround #-}
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

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

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

{-# NOINLINE isatty #-}
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

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
#-}