-- | Generic facilities for adding terminal escapes to 'Text'
--
-- Recommended usage:
--
-- @
-- Colors {..} <- 'getColorsLogger' -- for example
-- pure $ "This text will be " <> red "red" <> "."
-- @
module Blammo.Logging.Colors
  ( Colors (..)
  , noColors
  , getColors
  , getColorsLogger
  , getColorsHandle
  , getColorsStdout
  , getColorsStderr
  ) where

import Prelude

import Blammo.Logging.Internal.Logger
import Blammo.Logging.LogSettings (shouldColorHandle)
import Control.Lens (to, view)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Reader (MonadReader)
import Data.Text (Text)
import System.IO (Handle, stderr, stdout)

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[" forall a. Semigroup a => a -> a -> a
<> Text
code forall a. Semigroup a => a -> a -> a
<> Text
"m" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
"\ESC[0m"

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

getColors :: Bool -> Colors
getColors :: Bool -> Colors
getColors = \case
  Bool
True -> Colors
colors
  Bool
False -> Colors
noColors

-- | Return 'Colors' consistent with whatever your logging is doing
getColorsLogger :: (MonadReader env m, HasLogger env) => m Colors
getColorsLogger :: forall env (m :: * -> *).
(MonadReader env m, HasLogger env) =>
m Colors
getColorsLogger = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasLogger env => Lens' env Logger
loggerL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Bool -> Colors
getColors forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> Bool
lShouldColor)

-- | Return 'Colors' consistent with logging, but for 'Handle'
--
-- This is useful if you are building text to print to a handle that is not the
-- one you are logging to.
--
-- For example, say you are using,
--
-- @
-- LOG_COLOR=auto
-- LOG_DESTINATION=@some-file.log
-- @
--
-- That will not log with color, so 'getColorsLogger' will be 'noColor'. If
-- you're building other text to be printed out, you probably want to respect
-- that @LOG_COLOR=auto@, so you would use this function instead.
getColorsHandle
  :: (MonadIO m, MonadReader env m, HasLogger env) => Handle -> m Colors
getColorsHandle :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Handle -> m Colors
getColorsHandle Handle
h = do
  LogSettings
ls <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasLogger env => Lens' env Logger
loggerL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Logger -> LogSettings
lLogSettings
  Bool -> Colors
getColors forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => LogSettings -> Handle -> m Bool
shouldColorHandle LogSettings
ls Handle
h

-- | Short-cut for @'getColorsHandle' 'stdout'@
getColorsStdout :: (MonadIO m, MonadReader env m, HasLogger env) => m Colors
getColorsStdout :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
m Colors
getColorsStdout = forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Handle -> m Colors
getColorsHandle Handle
stdout

-- | Short-cut for @'getColorsHandle' 'stderr'@
getColorsStderr :: (MonadIO m, MonadReader env m, HasLogger env) => m Colors
getColorsStderr :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
m Colors
getColorsStderr = forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Handle -> m Colors
getColorsHandle Handle
stderr