{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Prelude.Logger.Internal where
import GHCup.Types
import GHCup.Types.Optics
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Text ( Text )
import Optics
import Prelude hiding ( appendFile )
import System.Console.Pretty
import qualified Data.Text as T
logInfo :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logInfo :: forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo = forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
LogLevel -> Text -> m ()
logInternal LogLevel
Info
logWarn :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logWarn :: forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn = forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
LogLevel -> Text -> m ()
logInternal LogLevel
Warn
logDebug :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logDebug :: forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug = forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
LogLevel -> Text -> m ()
logInternal LogLevel
Debug
logError :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logError :: forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError = forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
LogLevel -> Text -> m ()
logInternal LogLevel
Error
logInternal :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
) => LogLevel
-> Text
-> m ()
logInternal :: forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
LogLevel -> Text -> m ()
logInternal LogLevel
logLevel Text
msg = do
LoggerConfig {Bool
Text -> IO ()
$sel:fancyColors:LoggerConfig :: LoggerConfig -> Bool
$sel:fileOutter:LoggerConfig :: LoggerConfig -> Text -> IO ()
$sel:consoleOutter:LoggerConfig :: LoggerConfig -> Text -> IO ()
$sel:lcPrintDebug:LoggerConfig :: LoggerConfig -> Bool
fancyColors :: Bool
fileOutter :: Text -> IO ()
consoleOutter :: Text -> IO ()
lcPrintDebug :: Bool
..} <- forall (f :: Symbol) a env (m :: * -> *).
(MonadReader env m, LabelOptic' f A_Lens env a) =>
m a
gets @"loggerConfig"
let color' :: Color -> Text -> Text
color' Color
c = if Bool
fancyColors then forall a. Pretty a => Color -> a -> a
color Color
c else forall a. a -> a
id
let style' :: Text -> Text
style' = case LogLevel
logLevel of
LogLevel
Debug -> forall a. Pretty a => Style -> a -> a
style Style
Bold forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text -> Text
color' Color
Blue
LogLevel
Info -> forall a. Pretty a => Style -> a -> a
style Style
Bold forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text -> Text
color' Color
Green
LogLevel
Warn -> forall a. Pretty a => Style -> a -> a
style Style
Bold forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text -> Text
color' Color
Yellow
LogLevel
Error -> forall a. Pretty a => Style -> a -> a
style Style
Bold forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text -> Text
color' Color
Red
let l :: Text
l = case LogLevel
logLevel of
LogLevel
Debug -> Text -> Text
style' Text
"[ Debug ]"
LogLevel
Info -> Text -> Text
style' Text
"[ Info ]"
LogLevel
Warn -> Text -> Text
style' Text
"[ Warn ]"
LogLevel
Error -> Text -> Text
style' Text
"[ Error ]"
let strs :: [Text]
strs = (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
msg
let out :: Text
out = case [Text]
strs of
[] -> Text
T.empty
(Text
x:[Text]
xs) ->
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Text
a Text
b -> Text
a forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
b) forall a. Monoid a => a
mempty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text
l forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
x) forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
line' -> Text -> Text
style' Text
"[ ... ] " forall a. Semigroup a => a -> a -> a
<> Text
line' )
forall a b. (a -> b) -> a -> b
$ [Text]
xs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
lcPrintDebug Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
lcPrintDebug Bool -> Bool -> Bool
&& (LogLevel
logLevel forall a. Eq a => a -> a -> Bool
/= LogLevel
Debug)))
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
consoleOutter Text
out
let lr :: Text
lr = case LogLevel
logLevel of
LogLevel
Debug -> Text
"Debug:"
LogLevel
Info -> Text
"Info:"
LogLevel
Warn -> Text
"Warn:"
LogLevel
Error -> Text
"Error:"
let outr :: Text
outr = Text
lr forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
msg forall a. Semigroup a => a -> a -> a
<> Text
"\n"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
fileOutter Text
outr