module Blammo.Logging.LogSettings
  ( LogSettings
  , LogLevels
  , LogDestination(..)
  , LogFormat(..)
  , LogColor(..)

  -- * Reading settings, e.g. from @ENV@
  , readLogLevels
  , readLogDestination
  , readLogFormat
  , readLogColor

  -- * Construction
  , defaultLogSettings

  -- * Modify
  , setLogSettingsLevels
  , setLogSettingsDestination
  , setLogSettingsFormat
  , setLogSettingsColor
  , setLogSettingsBreakpoint
  , setLogSettingsConcurrency

  -- * Access
  , getLogSettingsLevels
  , getLogSettingsDestination
  , getLogSettingsFormat
  , getLogSettingsColor
  , getLogSettingsBreakpoint
  , getLogSettingsConcurrency

  -- * Logic
  , 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 }

-- | Set the number of 'LoggerSet' Buffers used by @fast-logger@
--
-- By default this matches 'getNumCapabilities', which is more performant but
-- does not guarantee message order. If this matters, such as in a CLI, set this
-- value to @1@.
--
-- Support for this option depends on your version of @fast-logger@:
--
-- +-----------------------------+------------+
-- | fast-logger | Destination   | Supported? |
-- +=============+===============+============+
-- | >=3.1.1     | anywhere      | yes        |
-- +-----------------------------+------------+
-- | >=3.0.5     | file          | yes        |
-- +-----------------------------+------------+
-- | >=3.0.5     | stdout/stderr | no         |
-- +-----------------------------+------------+
-- |  <3.0.5     | anywhere      | no         |
-- +-----------------------------+------------+
--
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