{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

{-|
Module      : Text.Pretty.Simple.Internal.OutputPrinter
Copyright   : (c) Dennis Gosnell, 2016
License     : BSD-style (see LICENSE file)
Maintainer  : cdep.illabout@gmail.com
Stability   : experimental
Portability : POSIX

-}
module Text.Pretty.Simple.Internal.Color
  where

#if __GLASGOW_HASKELL__ < 710
-- We don't need this import for GHC 7.10 as it exports all required functions
-- from Prelude
import Control.Applicative
#endif

import Data.Text.Lazy.Builder (Builder, fromString)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import System.Console.ANSI
       (Color(..), ColorIntensity(..), ConsoleIntensity(..),
        ConsoleLayer(..), SGR(..), setSGRCode)

-- | These options are for colorizing the output of functions like 'pPrint'.
--
-- For example, if you set 'colorQuote' to something like 'colorVividBlueBold',
-- then the quote character (@\"@) will be output as bright blue in bold.
--
-- If you don't want to use a color for one of the options, use 'colorNull'.
data ColorOptions = ColorOptions
  { ColorOptions -> Builder
colorQuote :: Builder
  -- ^ Color to use for quote characters (@\"@) around strings.
  , ColorOptions -> Builder
colorString :: Builder
  -- ^ Color to use for strings.
  , ColorOptions -> Builder
colorError :: Builder
  -- ^ (currently not used)
  , ColorOptions -> Builder
colorNum :: Builder
  -- ^ Color to use for numbers.
  , ColorOptions -> [Builder]
colorRainbowParens :: [Builder]
  -- ^ A list of 'Builder' colors to use for rainbow parenthesis output.  Use
  -- '[]' if you don't want rainbow parenthesis.  Use just a single item if you
  -- want all the rainbow parenthesis to be colored the same.
  } deriving (ColorOptions -> ColorOptions -> Bool
(ColorOptions -> ColorOptions -> Bool)
-> (ColorOptions -> ColorOptions -> Bool) -> Eq ColorOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorOptions -> ColorOptions -> Bool
$c/= :: ColorOptions -> ColorOptions -> Bool
== :: ColorOptions -> ColorOptions -> Bool
$c== :: ColorOptions -> ColorOptions -> Bool
Eq, (forall x. ColorOptions -> Rep ColorOptions x)
-> (forall x. Rep ColorOptions x -> ColorOptions)
-> Generic ColorOptions
forall x. Rep ColorOptions x -> ColorOptions
forall x. ColorOptions -> Rep ColorOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColorOptions x -> ColorOptions
$cfrom :: forall x. ColorOptions -> Rep ColorOptions x
Generic, Int -> ColorOptions -> ShowS
[ColorOptions] -> ShowS
ColorOptions -> String
(Int -> ColorOptions -> ShowS)
-> (ColorOptions -> String)
-> ([ColorOptions] -> ShowS)
-> Show ColorOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorOptions] -> ShowS
$cshowList :: [ColorOptions] -> ShowS
show :: ColorOptions -> String
$cshow :: ColorOptions -> String
showsPrec :: Int -> ColorOptions -> ShowS
$cshowsPrec :: Int -> ColorOptions -> ShowS
Show, Typeable)

------------------------------------
-- Dark background default colors --
------------------------------------

-- | Default color options for use on a dark background.
--
-- 'colorQuote' is 'defaultColorQuoteDarkBg'. 'colorString' is
-- 'defaultColorStringDarkBg'.  'colorError' is 'defaultColorErrorDarkBg'.
-- 'colorNum' is 'defaultColorNumDarkBg'.  'colorRainbowParens' is
-- 'defaultColorRainboxParensDarkBg'.
defaultColorOptionsDarkBg :: ColorOptions
defaultColorOptionsDarkBg :: ColorOptions
defaultColorOptionsDarkBg =
  ColorOptions :: Builder
-> Builder -> Builder -> Builder -> [Builder] -> ColorOptions
ColorOptions
  { colorQuote :: Builder
colorQuote = Builder
defaultColorQuoteDarkBg
  , colorString :: Builder
colorString = Builder
defaultColorStringDarkBg
  , colorError :: Builder
colorError = Builder
defaultColorErrorDarkBg
  , colorNum :: Builder
colorNum = Builder
defaultColorNumDarkBg
  , colorRainbowParens :: [Builder]
colorRainbowParens = [Builder]
defaultColorRainbowParensDarkBg
  }

-- | Default color for 'colorQuote' for dark backgrounds. This is
-- 'colorVividWhiteBold'.
defaultColorQuoteDarkBg :: Builder
defaultColorQuoteDarkBg :: Builder
defaultColorQuoteDarkBg = Builder
colorVividWhiteBold

-- | Default color for 'colorString' for dark backgrounds. This is
-- 'colorVividBlueBold'.
defaultColorStringDarkBg :: Builder
defaultColorStringDarkBg :: Builder
defaultColorStringDarkBg = Builder
colorVividBlueBold

-- | Default color for 'colorError' for dark backgrounds.  This is
-- 'colorVividRedBold'.
defaultColorErrorDarkBg :: Builder
defaultColorErrorDarkBg :: Builder
defaultColorErrorDarkBg = Builder
colorVividRedBold

-- | Default color for 'colorNum' for dark backgrounds.  This is
-- 'colorVividGreenBold'.
defaultColorNumDarkBg :: Builder
defaultColorNumDarkBg :: Builder
defaultColorNumDarkBg = Builder
colorVividGreenBold

-- | Default colors for 'colorRainbowParens' for dark backgrounds.
defaultColorRainbowParensDarkBg :: [Builder]
defaultColorRainbowParensDarkBg :: [Builder]
defaultColorRainbowParensDarkBg =
  [ Builder
colorVividMagentaBold
  , Builder
colorVividCyanBold
  , Builder
colorVividYellowBold
  , Builder
colorDullMagenta
  , Builder
colorDullCyan
  , Builder
colorDullYellow
  , Builder
colorDullMagentaBold
  , Builder
colorDullCyanBold
  , Builder
colorDullYellowBold
  , Builder
colorVividMagenta
  , Builder
colorVividCyan
  , Builder
colorVividYellow
  ]

-------------------------------------
-- Light background default colors --
-------------------------------------

-- | Default color options for use on a light background.
--
-- 'colorQuote' is 'defaultColorQuoteLightBg'. 'colorString' is
-- 'defaultColorStringLightBg'.  'colorError' is 'defaultColorErrorLightBg'.
-- 'colorNum' is 'defaultColorNumLightBg'.  'colorRainbowParens' is
-- 'defaultColorRainboxParensLightBg'.
defaultColorOptionsLightBg :: ColorOptions
defaultColorOptionsLightBg :: ColorOptions
defaultColorOptionsLightBg =
  ColorOptions :: Builder
-> Builder -> Builder -> Builder -> [Builder] -> ColorOptions
ColorOptions
  { colorQuote :: Builder
colorQuote = Builder
defaultColorQuoteLightBg
  , colorString :: Builder
colorString = Builder
defaultColorStringLightBg
  , colorError :: Builder
colorError = Builder
defaultColorErrorLightBg
  , colorNum :: Builder
colorNum = Builder
defaultColorNumLightBg
  , colorRainbowParens :: [Builder]
colorRainbowParens = [Builder]
defaultColorRainbowParensLightBg
  }

-- | Default color for 'colorQuote' for light backgrounds. This is
-- 'colorVividWhiteBold'.
defaultColorQuoteLightBg :: Builder
defaultColorQuoteLightBg :: Builder
defaultColorQuoteLightBg = Builder
colorVividBlackBold

-- | Default color for 'colorString' for light backgrounds. This is
-- 'colorVividBlueBold'.
defaultColorStringLightBg :: Builder
defaultColorStringLightBg :: Builder
defaultColorStringLightBg = Builder
colorVividBlueBold

-- | Default color for 'colorError' for light backgrounds.  This is
-- 'colorVividRedBold'.
defaultColorErrorLightBg :: Builder
defaultColorErrorLightBg :: Builder
defaultColorErrorLightBg = Builder
colorVividRedBold

-- | Default color for 'colorNum' for light backgrounds.  This is
-- 'colorVividGreenBold'.
defaultColorNumLightBg :: Builder
defaultColorNumLightBg :: Builder
defaultColorNumLightBg = Builder
colorVividGreenBold

-- | Default colors for 'colorRainbowParens' for light backgrounds.
defaultColorRainbowParensLightBg :: [Builder]
defaultColorRainbowParensLightBg :: [Builder]
defaultColorRainbowParensLightBg =
  [ Builder
colorVividMagentaBold
  , Builder
colorVividCyanBold
  , Builder
colorDullMagenta
  , Builder
colorDullCyan
  , Builder
colorDullMagentaBold
  , Builder
colorDullCyanBold
  , Builder
colorVividMagenta
  , Builder
colorVividCyan
  ]

-----------------------
-- Vivid Bold Colors --
-----------------------

colorVividBlackBold :: Builder
colorVividBlackBold :: Builder
colorVividBlackBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorVividBlack

colorVividBlueBold :: Builder
colorVividBlueBold :: Builder
colorVividBlueBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorVividBlue

colorVividCyanBold :: Builder
colorVividCyanBold :: Builder
colorVividCyanBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorVividCyan

colorVividGreenBold :: Builder
colorVividGreenBold :: Builder
colorVividGreenBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorVividGreen

colorVividMagentaBold :: Builder
colorVividMagentaBold :: Builder
colorVividMagentaBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorVividMagenta

colorVividRedBold :: Builder
colorVividRedBold :: Builder
colorVividRedBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorVividRed

colorVividWhiteBold :: Builder
colorVividWhiteBold :: Builder
colorVividWhiteBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorVividWhite

colorVividYellowBold :: Builder
colorVividYellowBold :: Builder
colorVividYellowBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorVividYellow

-----------------------
-- Dull Bold Colors --
-----------------------

colorDullBlackBold :: Builder
colorDullBlackBold :: Builder
colorDullBlackBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorDullBlack

colorDullBlueBold :: Builder
colorDullBlueBold :: Builder
colorDullBlueBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorDullBlue

colorDullCyanBold :: Builder
colorDullCyanBold :: Builder
colorDullCyanBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorDullCyan

colorDullGreenBold :: Builder
colorDullGreenBold :: Builder
colorDullGreenBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorDullGreen

colorDullMagentaBold :: Builder
colorDullMagentaBold :: Builder
colorDullMagentaBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorDullMagenta

colorDullRedBold :: Builder
colorDullRedBold :: Builder
colorDullRedBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorDullRed

colorDullWhiteBold :: Builder
colorDullWhiteBold :: Builder
colorDullWhiteBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorDullWhite

colorDullYellowBold :: Builder
colorDullYellowBold :: Builder
colorDullYellowBold = Builder
colorBold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
colorDullYellow

------------------
-- Vivid Colors --
------------------

colorVividBlack :: Builder
colorVividBlack :: Builder
colorVividBlack = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Vivid Color
Black

colorVividBlue :: Builder
colorVividBlue :: Builder
colorVividBlue = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Vivid Color
Blue

colorVividCyan :: Builder
colorVividCyan :: Builder
colorVividCyan = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Vivid Color
Cyan

colorVividGreen :: Builder
colorVividGreen :: Builder
colorVividGreen = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Vivid Color
Green

colorVividMagenta :: Builder
colorVividMagenta :: Builder
colorVividMagenta = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Vivid Color
Magenta

colorVividRed :: Builder
colorVividRed :: Builder
colorVividRed = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Vivid Color
Red

colorVividWhite :: Builder
colorVividWhite :: Builder
colorVividWhite = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Vivid Color
White

colorVividYellow :: Builder
colorVividYellow :: Builder
colorVividYellow = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Vivid Color
Yellow

------------------
-- Dull Colors --
------------------

colorDullBlack :: Builder
colorDullBlack :: Builder
colorDullBlack = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Dull Color
Black

colorDullBlue :: Builder
colorDullBlue :: Builder
colorDullBlue = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Dull Color
Blue

colorDullCyan :: Builder
colorDullCyan :: Builder
colorDullCyan = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Dull Color
Cyan

colorDullGreen :: Builder
colorDullGreen :: Builder
colorDullGreen = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Dull Color
Green

colorDullMagenta :: Builder
colorDullMagenta :: Builder
colorDullMagenta = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Dull Color
Magenta

colorDullRed :: Builder
colorDullRed :: Builder
colorDullRed = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Dull Color
Red

colorDullWhite :: Builder
colorDullWhite :: Builder
colorDullWhite = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Dull Color
White

colorDullYellow :: Builder
colorDullYellow :: Builder
colorDullYellow = ColorIntensity -> Color -> Builder
colorHelper ColorIntensity
Dull Color
Yellow

--------------------
-- Special Colors --
--------------------

-- | Change the intensity to 'BoldIntensity'.
colorBold :: Builder
colorBold :: Builder
colorBold = [SGR] -> Builder
setSGRCodeBuilder [ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity]

-- | 'Reset' the console color back to normal.
colorReset :: Builder
colorReset :: Builder
colorReset = [SGR] -> Builder
setSGRCodeBuilder [SGR
Reset]

-- | Empty string.
colorNull :: Builder
colorNull :: Builder
colorNull = ""

-------------
-- Helpers --
-------------

-- | Helper for creating a 'Builder' for an ANSI escape sequence color based on
-- a 'ColorIntensity' and a 'Color'.
colorHelper :: ColorIntensity -> Color -> Builder
colorHelper :: ColorIntensity -> Color -> Builder
colorHelper colorIntensity :: ColorIntensity
colorIntensity color :: Color
color =
  [SGR] -> Builder
setSGRCodeBuilder [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
colorIntensity Color
color]

-- | Convert a list of 'SGR' to a 'Builder'.
setSGRCodeBuilder :: [SGR] -> Builder
setSGRCodeBuilder :: [SGR] -> Builder
setSGRCodeBuilder = String -> Builder
fromString (String -> Builder) -> ([SGR] -> String) -> [SGR] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> String
setSGRCode