module Blammo.Logging.Internal.Colors
  ( Colors (..)
  , colors
  , noColors
  , getColors
  ) where

import Prelude

import Data.Text (Text)

data Colors = Colors
  { Colors -> Text -> Text
gray :: Text -> Text
  , Colors -> Text -> Text
black :: Text -> Text
  , Colors -> Text -> Text
cyan :: Text -> Text
  , Colors -> Text -> Text
magenta :: Text -> Text
  , Colors -> Text -> Text
blue :: Text -> Text
  , Colors -> Text -> Text
yellow :: Text -> Text
  , Colors -> Text -> Text
green :: Text -> Text
  , Colors -> Text -> Text
red :: Text -> Text
  , Colors -> Text -> Text
bold :: Text -> Text
  , Colors -> Text -> Text
dim :: Text -> Text
  }

colors :: Colors
colors :: Colors
colors =
  Colors
    { gray :: Text -> Text
gray = Text -> Text -> Text
esc Text
"0;37"
    , cyan :: Text -> Text
cyan = Text -> Text -> Text
esc Text
"0;36"
    , magenta :: Text -> Text
magenta = Text -> Text -> Text
esc Text
"0;35"
    , blue :: Text -> Text
blue = Text -> Text -> Text
esc Text
"0;34"
    , yellow :: Text -> Text
yellow = Text -> Text -> Text
esc Text
"0;33"
    , green :: Text -> Text
green = Text -> Text -> Text
esc Text
"0;32"
    , red :: Text -> Text
red = Text -> Text -> Text
esc Text
"0;31"
    , black :: Text -> Text
black = Text -> Text -> Text
esc Text
"0;30"
    , bold :: Text -> Text
bold = Text -> Text -> Text
esc Text
"1"
    , dim :: Text -> Text
dim = Text -> Text -> Text
esc Text
"2"
    }
 where
  esc :: Text -> Text -> Text
  esc :: Text -> Text -> Text
esc Text
code Text
x = Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\ESC[0m"

noColors :: Colors
noColors :: Colors
noColors =
  Colors
    { gray :: Text -> Text
gray = Text -> Text
forall a. a -> a
id
    , black :: Text -> Text
black = Text -> Text
forall a. a -> a
id
    , cyan :: Text -> Text
cyan = Text -> Text
forall a. a -> a
id
    , magenta :: Text -> Text
magenta = Text -> Text
forall a. a -> a
id
    , blue :: Text -> Text
blue = Text -> Text
forall a. a -> a
id
    , yellow :: Text -> Text
yellow = Text -> Text
forall a. a -> a
id
    , green :: Text -> Text
green = Text -> Text
forall a. a -> a
id
    , red :: Text -> Text
red = Text -> Text
forall a. a -> a
id
    , bold :: Text -> Text
bold = Text -> Text
forall a. a -> a
id
    , dim :: Text -> Text
dim = Text -> Text
forall a. a -> a
id
    }

-- | Return colorful 'Colors' if given 'True'
--
-- __NOTE__: Direct use of this function is discouraged. It does not apply any
-- color modifications done through 'LogSettings'. Use one of the @get@
-- functions in "Blammo.Logging.Colors" instead, which do.
getColors :: Bool -> Colors
getColors :: Bool -> Colors
getColors = \case
  Bool
True -> Colors
colors
  Bool
False -> Colors
noColors