{-# options_ghc -Wall #-}
module Control.Monad.Log.Colors where
import Control.Monad.Log
import Data.String
import System.Console.ANSI
import Data.Text.Prettyprint.Doc
wrapSGRCode :: (IsString a, Monoid a) => [SGR] -> a -> a
wrapSGRCode :: [SGR] -> a -> a
wrapSGRCode [SGR]
codes a
t = [a] -> a
forall a. Monoid a => [a] -> a
mconcat
[ String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [SGR] -> String
setSGRCode [SGR]
codes
, a
t
, String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [SGR] -> String
setSGRCode [SGR
Reset]
]
severitySgr :: Severity -> [SGR]
severitySgr :: Severity -> [SGR]
severitySgr = \case
Severity
Emergency ->
[ ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Background ColorIntensity
Vivid Color
Red
, ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Black
, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity
]
Severity
Alert ->
[ ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red
, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity
]
Severity
Critical ->
[ ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red
, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity
]
Severity
Error ->
[ ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Red
]
Severity
Warning ->
[ ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Yellow
]
Severity
Notice ->
[ ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Blue
]
Severity
Informational -> []
Severity
Debug ->
[ ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Green
]
colorizeWith
:: (Monoid msg, IsString msg)
=> (Severity -> [SGR])
-> WithSeverity msg
-> WithSeverity msg
colorizeWith :: (Severity -> [SGR]) -> WithSeverity msg -> WithSeverity msg
colorizeWith Severity -> [SGR]
f (WithSeverity Severity
sev msg
msg) =
Severity -> msg -> WithSeverity msg
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
sev (msg -> WithSeverity msg) -> msg -> WithSeverity msg
forall a b. (a -> b) -> a -> b
$ [SGR] -> msg -> msg
forall a. (IsString a, Monoid a) => [SGR] -> a -> a
wrapSGRCode (Severity -> [SGR]
f Severity
sev) msg
msg
colorize
:: (Monoid msg, IsString msg)
=> WithSeverity msg
-> WithSeverity msg
colorize :: WithSeverity msg -> WithSeverity msg
colorize = (Severity -> [SGR]) -> WithSeverity msg -> WithSeverity msg
forall msg.
(Monoid msg, IsString msg) =>
(Severity -> [SGR]) -> WithSeverity msg -> WithSeverity msg
colorizeWith Severity -> [SGR]
severitySgr
renderWithColor :: (Monoid msg, IsString msg, Pretty msg) => WithSeverity msg -> Doc ann
renderWithColor :: WithSeverity msg -> Doc ann
renderWithColor = (msg -> Doc ann) -> WithSeverity msg -> Doc ann
forall a ann. (a -> Doc ann) -> WithSeverity a -> Doc ann
renderWithSeverity msg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (WithSeverity msg -> Doc ann)
-> (WithSeverity msg -> WithSeverity msg)
-> WithSeverity msg
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithSeverity msg -> WithSeverity msg
forall msg.
(Monoid msg, IsString msg) =>
WithSeverity msg -> WithSeverity msg
colorize