module Blammo.Logging.LogSettings
( LogSettings
, LogLevels
, LogDestination(..)
, LogFormat(..)
, LogColor(..)
, readLogLevels
, readLogDestination
, readLogFormat
, readLogColor
, defaultLogSettings
, setLogSettingsLevels
, setLogSettingsDestination
, setLogSettingsFormat
, setLogSettingsColor
, setLogSettingsBreakpoint
, setLogSettingsConcurrency
, getLogSettingsLevels
, getLogSettingsDestination
, getLogSettingsFormat
, getLogSettingsColor
, getLogSettingsBreakpoint
, getLogSettingsConcurrency
, shouldLogLevel
, shouldColorAuto
, shouldColorHandle
) where
import Prelude
import Blammo.Logging.LogSettings.LogLevels (LogLevels)
import qualified Blammo.Logging.LogSettings.LogLevels as LogLevels
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Logger.Aeson
import System.IO (Handle, hIsTerminalDevice)
data LogSettings = LogSettings
{ LogSettings -> LogLevels
lsLevels :: LogLevels
, LogSettings -> LogDestination
lsDestination :: LogDestination
, LogSettings -> LogFormat
lsFormat :: LogFormat
, LogSettings -> LogColor
lsColor :: LogColor
, LogSettings -> Int
lsBreakpoint :: Int
, LogSettings -> Maybe Int
lsConcurrency :: Maybe Int
}
readLogLevels :: String -> Either String LogLevels
readLogLevels :: String -> Either String LogLevels
readLogLevels = String -> Either String LogLevels
LogLevels.readLogLevels
data LogDestination
= LogDestinationStdout
| LogDestinationStderr
| LogDestinationFile FilePath
readLogDestination :: String -> Either String LogDestination
readLogDestination :: String -> Either String LogDestination
readLogDestination = \case
String
"stdout" -> forall a b. b -> Either a b
Right LogDestination
LogDestinationStdout
String
"stderr" -> forall a b. b -> Either a b
Right LogDestination
LogDestinationStderr
(Char
'@' : String
path) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> LogDestination
LogDestinationFile String
path
String
x ->
forall a b. a -> Either a b
Left
forall a b. (a -> b) -> a -> b
$ String
"Invalid log destination "
forall a. Semigroup a => a -> a -> a
<> String
x
forall a. Semigroup a => a -> a -> a
<> String
", must be stdout, stderr, or @{path}"
data LogFormat
= LogFormatJSON
| LogFormatTerminal
readLogFormat :: String -> Either String LogFormat
readLogFormat :: String -> Either String LogFormat
readLogFormat = \case
String
"tty" -> forall a b. b -> Either a b
Right LogFormat
LogFormatTerminal
String
"json" -> forall a b. b -> Either a b
Right LogFormat
LogFormatJSON
String
x -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Invalid log format " forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
", must be tty or json"
data LogColor
= LogColorAuto
| LogColorAlways
| LogColorNever
readLogColor :: String -> Either String LogColor
readLogColor :: String -> Either String LogColor
readLogColor String
x
| String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
autoValues
= forall a b. b -> Either a b
Right LogColor
LogColorAuto
| String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
alwaysValues
= forall a b. b -> Either a b
Right LogColor
LogColorAlways
| String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
neverValues
= forall a b. b -> Either a b
Right LogColor
LogColorNever
| Bool
otherwise
= forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Invalid log color " forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
", must be auto, always, or never"
where
autoValues :: [String]
autoValues :: [String]
autoValues = [String
"auto"]
alwaysValues :: [String]
alwaysValues :: [String]
alwaysValues = [String
"always", String
"on", String
"yes", String
"true"]
neverValues :: [String]
neverValues :: [String]
neverValues = [String
"never", String
"off", String
"no", String
"false"]
defaultLogSettings :: LogSettings
defaultLogSettings :: LogSettings
defaultLogSettings = LogSettings
{ lsLevels :: LogLevels
lsLevels = LogLevels
LogLevels.defaultLogLevels
, lsDestination :: LogDestination
lsDestination = LogDestination
LogDestinationStdout
, lsFormat :: LogFormat
lsFormat = LogFormat
LogFormatTerminal
, lsColor :: LogColor
lsColor = LogColor
LogColorAuto
, lsBreakpoint :: Int
lsBreakpoint = Int
120
, lsConcurrency :: Maybe Int
lsConcurrency = forall a. Maybe a
Nothing
}
setLogSettingsLevels :: LogLevels -> LogSettings -> LogSettings
setLogSettingsLevels :: LogLevels -> LogSettings -> LogSettings
setLogSettingsLevels LogLevels
x LogSettings
ls = LogSettings
ls { lsLevels :: LogLevels
lsLevels = LogLevels
x }
setLogSettingsDestination :: LogDestination -> LogSettings -> LogSettings
setLogSettingsDestination :: LogDestination -> LogSettings -> LogSettings
setLogSettingsDestination LogDestination
x LogSettings
ls = LogSettings
ls { lsDestination :: LogDestination
lsDestination = LogDestination
x }
setLogSettingsFormat :: LogFormat -> LogSettings -> LogSettings
setLogSettingsFormat :: LogFormat -> LogSettings -> LogSettings
setLogSettingsFormat LogFormat
x LogSettings
ls = LogSettings
ls { lsFormat :: LogFormat
lsFormat = LogFormat
x }
setLogSettingsColor :: LogColor -> LogSettings -> LogSettings
setLogSettingsColor :: LogColor -> LogSettings -> LogSettings
setLogSettingsColor LogColor
x LogSettings
ls = LogSettings
ls { lsColor :: LogColor
lsColor = LogColor
x }
setLogSettingsBreakpoint :: Int -> LogSettings -> LogSettings
setLogSettingsBreakpoint :: Int -> LogSettings -> LogSettings
setLogSettingsBreakpoint Int
x LogSettings
ls = LogSettings
ls { lsBreakpoint :: Int
lsBreakpoint = Int
x }
setLogSettingsConcurrency :: Maybe Int -> LogSettings -> LogSettings
setLogSettingsConcurrency :: Maybe Int -> LogSettings -> LogSettings
setLogSettingsConcurrency Maybe Int
x LogSettings
ls = LogSettings
ls { lsConcurrency :: Maybe Int
lsConcurrency = Maybe Int
x }
getLogSettingsLevels :: LogSettings -> LogLevels
getLogSettingsLevels :: LogSettings -> LogLevels
getLogSettingsLevels = LogSettings -> LogLevels
lsLevels
getLogSettingsDestination :: LogSettings -> LogDestination
getLogSettingsDestination :: LogSettings -> LogDestination
getLogSettingsDestination = LogSettings -> LogDestination
lsDestination
getLogSettingsFormat :: LogSettings -> LogFormat
getLogSettingsFormat :: LogSettings -> LogFormat
getLogSettingsFormat = LogSettings -> LogFormat
lsFormat
getLogSettingsColor :: LogSettings -> LogColor
getLogSettingsColor :: LogSettings -> LogColor
getLogSettingsColor = LogSettings -> LogColor
lsColor
getLogSettingsBreakpoint :: LogSettings -> Int
getLogSettingsBreakpoint :: LogSettings -> Int
getLogSettingsBreakpoint = LogSettings -> Int
lsBreakpoint
getLogSettingsConcurrency :: LogSettings -> Maybe Int
getLogSettingsConcurrency :: LogSettings -> Maybe Int
getLogSettingsConcurrency = LogSettings -> Maybe Int
lsConcurrency
shouldLogLevel :: LogSettings -> LogSource -> LogLevel -> Bool
shouldLogLevel :: LogSettings -> LogSource -> LogLevel -> Bool
shouldLogLevel = LogLevels -> LogSource -> LogLevel -> Bool
LogLevels.shouldLogLevel forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSettings -> LogLevels
getLogSettingsLevels
shouldColorAuto :: Applicative m => LogSettings -> m Bool -> m Bool
shouldColorAuto :: forall (m :: * -> *).
Applicative m =>
LogSettings -> m Bool -> m Bool
shouldColorAuto LogSettings {Int
Maybe Int
LogLevels
LogColor
LogFormat
LogDestination
lsConcurrency :: Maybe Int
lsBreakpoint :: Int
lsColor :: LogColor
lsFormat :: LogFormat
lsDestination :: LogDestination
lsLevels :: LogLevels
lsConcurrency :: LogSettings -> Maybe Int
lsBreakpoint :: LogSettings -> Int
lsColor :: LogSettings -> LogColor
lsFormat :: LogSettings -> LogFormat
lsDestination :: LogSettings -> LogDestination
lsLevels :: LogSettings -> LogLevels
..} m Bool
f = case LogColor
lsColor of
LogColor
LogColorAuto -> m Bool
f
LogColor
LogColorAlways -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
LogColor
LogColorNever -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
shouldColorHandle :: MonadIO m => LogSettings -> Handle -> m Bool
shouldColorHandle :: forall (m :: * -> *). MonadIO m => LogSettings -> Handle -> m Bool
shouldColorHandle LogSettings
settings Handle
h =
forall (m :: * -> *).
Applicative m =>
LogSettings -> m Bool -> m Bool
shouldColorAuto LogSettings
settings forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
hIsTerminalDevice Handle
h