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
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)
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
getColorsStdout :: (MonadIO m, MonadReader env m, HasLogger env) => 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
= forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
Handle -> m Colors
getColorsHandle Handle
stderr