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

{-|
Module      : Text.Pretty.Simple.Internal.Color
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.Typeable (Typeable)
import GHC.Generics (Generic)
import Prettyprinter.Render.Terminal
  (AnsiStyle, Intensity(Dull,Vivid), Color(..))
import qualified Prettyprinter.Render.Terminal as Ansi

-- | These options are for colorizing the output of functions like 'pPrint'.
--
-- If you don't want to use a color for one of the options, use 'colorNull'.
data ColorOptions = ColorOptions
  { ColorOptions -> Style
colorQuote :: Style
  -- ^ Color to use for quote characters (@\"@) around strings.
  , ColorOptions -> Style
colorString :: Style
  -- ^ Color to use for strings.
  , ColorOptions -> Style
colorError :: Style
  -- ^ Color for errors, e.g. unmatched brackets.
  , ColorOptions -> Style
colorNum :: Style
  -- ^ Color to use for numbers.
  , ColorOptions -> [Style]
colorRainbowParens :: [Style]
  -- ^ A list of 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)

-- | Default color options for use on a dark background.
defaultColorOptionsDarkBg :: ColorOptions
defaultColorOptionsDarkBg :: ColorOptions
defaultColorOptionsDarkBg =
  ColorOptions :: Style -> Style -> Style -> Style -> [Style] -> ColorOptions
ColorOptions
  { colorQuote :: Style
colorQuote = Intensity -> Color -> Style
colorBold Intensity
Vivid Color
White
  , colorString :: Style
colorString = Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Blue
  , colorError :: Style
colorError = Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Red
  , colorNum :: Style
colorNum = Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Green
  , colorRainbowParens :: [Style]
colorRainbowParens =
    [ Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Magenta
    , Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Cyan
    , Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Yellow
    , Intensity -> Color -> Style
color Intensity
Dull Color
Magenta
    , Intensity -> Color -> Style
color Intensity
Dull Color
Cyan
    , Intensity -> Color -> Style
color Intensity
Dull Color
Yellow
    , Intensity -> Color -> Style
colorBold Intensity
Dull Color
Magenta
    , Intensity -> Color -> Style
colorBold Intensity
Dull Color
Cyan
    , Intensity -> Color -> Style
colorBold Intensity
Dull Color
Yellow
    , Intensity -> Color -> Style
color Intensity
Vivid Color
Magenta
    , Intensity -> Color -> Style
color Intensity
Vivid Color
Cyan
    , Intensity -> Color -> Style
color Intensity
Vivid Color
Yellow
    ]
  }

-- | Default color options for use on a light background.
defaultColorOptionsLightBg :: ColorOptions
defaultColorOptionsLightBg :: ColorOptions
defaultColorOptionsLightBg =
  ColorOptions :: Style -> Style -> Style -> Style -> [Style] -> ColorOptions
ColorOptions
  { colorQuote :: Style
colorQuote = Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Black
  , colorString :: Style
colorString = Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Blue
  , colorError :: Style
colorError = Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Red
  , colorNum :: Style
colorNum = Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Green
  , colorRainbowParens :: [Style]
colorRainbowParens =
    [ Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Magenta
    , Intensity -> Color -> Style
colorBold Intensity
Vivid Color
Cyan
    , Intensity -> Color -> Style
color Intensity
Dull Color
Magenta
    , Intensity -> Color -> Style
color Intensity
Dull Color
Cyan
    , Intensity -> Color -> Style
colorBold Intensity
Dull Color
Magenta
    , Intensity -> Color -> Style
colorBold Intensity
Dull Color
Cyan
    , Intensity -> Color -> Style
color Intensity
Vivid Color
Magenta
    , Intensity -> Color -> Style
color Intensity
Vivid Color
Cyan
    ]
  }

-- | No styling.
colorNull :: Style
colorNull :: Style
colorNull = Style :: Maybe (Color, Intensity) -> Bool -> Bool -> Bool -> Style
Style
  { styleColor :: Maybe (Color, Intensity)
styleColor = Maybe (Color, Intensity)
forall a. Maybe a
Nothing
  , styleBold :: Bool
styleBold = Bool
False
  , styleItalic :: Bool
styleItalic = Bool
False
  , styleUnderlined :: Bool
styleUnderlined = Bool
False
  }

-- | Ways to style terminal output.
data Style = Style
  { Style -> Maybe (Color, Intensity)
styleColor :: Maybe (Color, Intensity)
  , Style -> Bool
styleBold :: Bool
  , Style -> Bool
styleItalic :: Bool
  , Style -> Bool
styleUnderlined :: Bool
  }
  deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq, (forall x. Style -> Rep Style x)
-> (forall x. Rep Style x -> Style) -> Generic Style
forall x. Rep Style x -> Style
forall x. Style -> Rep Style x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Style x -> Style
$cfrom :: forall x. Style -> Rep Style x
Generic, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Style] -> ShowS
$cshowList :: [Style] -> ShowS
show :: Style -> String
$cshow :: Style -> String
showsPrec :: Int -> Style -> ShowS
$cshowsPrec :: Int -> Style -> ShowS
Show, Typeable)

color :: Intensity -> Color -> Style
color :: Intensity -> Color -> Style
color Intensity
i Color
c = Style
colorNull {styleColor :: Maybe (Color, Intensity)
styleColor = (Color, Intensity) -> Maybe (Color, Intensity)
forall a. a -> Maybe a
Just (Color
c, Intensity
i)}

colorBold :: Intensity -> Color -> Style
colorBold :: Intensity -> Color -> Style
colorBold Intensity
i Color
c = (Intensity -> Color -> Style
color Intensity
i Color
c) {styleBold :: Bool
styleBold = Bool
True}

convertStyle :: Style -> AnsiStyle
convertStyle :: Style -> AnsiStyle
convertStyle Style {Bool
Maybe (Color, Intensity)
styleUnderlined :: Bool
styleItalic :: Bool
styleBold :: Bool
styleColor :: Maybe (Color, Intensity)
styleUnderlined :: Style -> Bool
styleItalic :: Style -> Bool
styleBold :: Style -> Bool
styleColor :: Style -> Maybe (Color, Intensity)
..} =
  [AnsiStyle] -> AnsiStyle
forall a. Monoid a => [a] -> a
mconcat
    [ AnsiStyle
-> ((Color, Intensity) -> AnsiStyle)
-> Maybe (Color, Intensity)
-> AnsiStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AnsiStyle
forall a. Monoid a => a
mempty ((Color -> Intensity -> AnsiStyle)
-> (Color, Intensity) -> AnsiStyle
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Color -> Intensity -> AnsiStyle)
 -> (Color, Intensity) -> AnsiStyle)
-> (Color -> Intensity -> AnsiStyle)
-> (Color, Intensity)
-> AnsiStyle
forall a b. (a -> b) -> a -> b
$ (Intensity -> Color -> AnsiStyle)
-> Color -> Intensity -> AnsiStyle
forall a b c. (a -> b -> c) -> b -> a -> c
flip Intensity -> Color -> AnsiStyle
col) Maybe (Color, Intensity)
styleColor
    , if Bool
styleBold then AnsiStyle
Ansi.bold else AnsiStyle
forall a. Monoid a => a
mempty
    , if Bool
styleItalic then AnsiStyle
Ansi.italicized else AnsiStyle
forall a. Monoid a => a
mempty
    , if Bool
styleUnderlined then AnsiStyle
Ansi.underlined else AnsiStyle
forall a. Monoid a => a
mempty
    ]
  where
    col :: Intensity -> Color -> AnsiStyle
col = \case
      Intensity
Vivid -> Color -> AnsiStyle
Ansi.color
      Intensity
Dull -> Color -> AnsiStyle
Ansi.colorDull