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