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[" 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
}
getColors :: Bool -> Colors
getColors :: Bool -> Colors
getColors = \case
Bool
True -> Colors
colors
Bool
False -> Colors
noColors
getColorsLogger :: (MonadReader env m, HasLogger env) => m Colors
getColorsLogger :: forall env (m :: * -> *).
(MonadReader env m, HasLogger env) =>
m Colors
getColorsLogger = 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 (Bool -> Colors
getColors (Bool -> Colors) -> (Logger -> Bool) -> Logger -> Colors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> Bool
lShouldColor)
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
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
getColorsStdout :: (MonadIO m, MonadReader env m, HasLogger env) => m Colors
= Handle -> m Colors
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Handle -> m Colors
getColorsHandle Handle
stdout
getColorsStderr :: (MonadIO m, MonadReader env m, HasLogger env) => m Colors
= Handle -> m Colors
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Handle -> m Colors
getColorsHandle Handle
stderr