-- | 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.Colors
import Blammo.Logging.Internal.Logger
import Blammo.Logging.LogSettings (adjustColors, shouldColorHandle)
import Control.Lens (to, view)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Reader (MonadReader)
import System.IO (Handle, stderr, stdout)

-- | 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 = do
  Colors -> Colors
f <- Getting (Colors -> Colors) env (Colors -> Colors)
-> m (Colors -> Colors)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Colors -> Colors) env (Colors -> Colors)
 -> m (Colors -> Colors))
-> Getting (Colors -> Colors) env (Colors -> Colors)
-> m (Colors -> Colors)
forall a b. (a -> b) -> a -> b
$ (Logger -> Const (Colors -> Colors) Logger)
-> env -> Const (Colors -> Colors) env
forall env. HasLogger env => Lens' env Logger
Lens' env Logger
loggerL ((Logger -> Const (Colors -> Colors) Logger)
 -> env -> Const (Colors -> Colors) env)
-> (((Colors -> Colors)
     -> Const (Colors -> Colors) (Colors -> Colors))
    -> Logger -> Const (Colors -> Colors) Logger)
-> Getting (Colors -> Colors) env (Colors -> Colors)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Logger -> Colors -> Colors)
-> ((Colors -> Colors)
    -> Const (Colors -> Colors) (Colors -> Colors))
-> Logger
-> Const (Colors -> Colors) Logger
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (LogSettings -> Colors -> Colors
adjustColors (LogSettings -> Colors -> Colors)
-> (Logger -> LogSettings) -> Logger -> Colors -> Colors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> LogSettings
lLogSettings)
  Getting Colors env Colors -> m Colors
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Colors env Colors -> m Colors)
-> Getting Colors env Colors -> m Colors
forall a b. (a -> b) -> a -> b
$ (Logger -> Const Colors Logger) -> env -> Const Colors env
forall env. HasLogger env => Lens' env Logger
Lens' env Logger
loggerL ((Logger -> Const Colors Logger) -> env -> Const Colors env)
-> ((Colors -> Const Colors Colors)
    -> Logger -> Const Colors Logger)
-> Getting Colors env Colors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Logger -> Colors)
-> (Colors -> Const Colors Colors) -> Logger -> Const Colors Logger
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Colors -> Colors
f (Colors -> Colors) -> (Logger -> Colors) -> Logger -> Colors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Colors
getColors (Bool -> Colors) -> (Logger -> Bool) -> Logger -> Colors
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 <- Getting LogSettings env LogSettings -> m LogSettings
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting LogSettings env LogSettings -> m LogSettings)
-> Getting LogSettings env LogSettings -> m LogSettings
forall a b. (a -> b) -> a -> b
$ (Logger -> Const LogSettings Logger)
-> env -> Const LogSettings env
forall env. HasLogger env => Lens' env Logger
Lens' env Logger
loggerL ((Logger -> Const LogSettings Logger)
 -> env -> Const LogSettings env)
-> ((LogSettings -> Const LogSettings LogSettings)
    -> Logger -> Const LogSettings Logger)
-> Getting LogSettings env LogSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Logger -> LogSettings)
-> (LogSettings -> Const LogSettings LogSettings)
-> Logger
-> Const LogSettings Logger
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Logger -> LogSettings
lLogSettings
  LogSettings -> Colors -> Colors
adjustColors LogSettings
ls (Colors -> Colors) -> (Bool -> Colors) -> Bool -> Colors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Colors
getColors (Bool -> Colors) -> m Bool -> m Colors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogSettings -> Handle -> m Bool
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 = Handle -> m Colors
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 = Handle -> m Colors
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Handle -> m Colors
getColorsHandle Handle
stderr