-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# LANGUAGE OverloadedStrings #-}

module System.Logger.Settings
    ( Settings
    , Level      (..)
    , Output     (..)
    , DateFormat (..)
    , Renderer

    , defSettings
    , output
    , setOutput
    , format
    , setFormat
    , bufSize
    , setBufSize
    , delimiter
    , setDelimiter
    , setNetStrings
    , setRendererNetstr
    , setRendererDefault
    , logLevel
    , logLevelMap
    , logLevelOf
    , setLogLevel
    , setLogLevelMap
    , setLogLevelOf
    , name
    , setName
    , nameMsg
    , renderer
    , setRenderer
    , readEnvironment
    , setReadEnvironment
    , iso8601UTC
    ) where

import Data.String
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (pack)
import Data.Map.Strict as Map
import Data.Text (Text)
import Data.UnixTime
import System.Log.FastLogger (defaultBufSize)
import System.Logger.Message

import qualified Data.ByteString.Builder as B

data Settings = Settings
    { Settings -> Level
_logLevel        :: !Level              -- ^ messages below this log level will be suppressed
    , Settings -> Map Text Level
_levelMap        :: !(Map Text Level)   -- ^ log level per named logger
    , Settings -> Output
_output          :: !Output             -- ^ log sink
    , Settings -> Maybe DateFormat
_format          :: !(Maybe DateFormat) -- ^ the timestamp format (use 'Nothing' to disable timestamps)
    , Settings -> ByteString
_delimiter       :: !ByteString         -- ^ text to intersperse between fields of a log line
    , Settings -> Int
_bufSize         :: !Int                -- ^ how many bytes to buffer before commiting to sink
    , Settings -> Maybe Text
_name            :: !(Maybe Text)       -- ^ logger name
    , Settings -> Msg -> Msg
_nameMsg         :: !(Msg -> Msg)
    , Settings -> Renderer
_renderer        :: !Renderer
    , Settings -> Bool
_readEnvironment :: !Bool               -- ^ should 'new' check @LOG_*@ process environment settings?
    }

output :: Settings -> Output
output :: Settings -> Output
output = Settings -> Output
_output

setOutput :: Output -> Settings -> Settings
setOutput :: Output -> Settings -> Settings
setOutput Output
x Settings
s = Settings
s { _output = x }

-- | The time and date format used for the timestamp part of a log line.
format :: Settings -> Maybe DateFormat
format :: Settings -> Maybe DateFormat
format = Settings -> Maybe DateFormat
_format

setFormat :: Maybe DateFormat -> Settings -> Settings
setFormat :: Maybe DateFormat -> Settings -> Settings
setFormat Maybe DateFormat
x Settings
s = Settings
s { _format = x }

bufSize :: Settings -> Int
bufSize :: Settings -> Int
bufSize = Settings -> Int
_bufSize

setBufSize :: Int -> Settings -> Settings
setBufSize :: Int -> Settings -> Settings
setBufSize Int
x Settings
s = Settings
s { _bufSize = max 1 x }

-- | Delimiter string which separates log line parts.
delimiter :: Settings -> ByteString
delimiter :: Settings -> ByteString
delimiter = Settings -> ByteString
_delimiter

setDelimiter :: ByteString -> Settings -> Settings
setDelimiter :: ByteString -> Settings -> Settings
setDelimiter ByteString
x Settings
s = Settings
s { _delimiter = x }

-- | Whether to use <http://cr.yp.to/proto/netstrings.txt netstring>
-- encoding for log lines.
--
-- {#- DEPRECATED setNetStrings "Use setRendererNetstr or setRendererDefault instead" #-}
setNetStrings :: Bool -> Settings -> Settings
setNetStrings :: Bool -> Settings -> Settings
setNetStrings Bool
True  = Renderer -> Settings -> Settings
setRenderer (Renderer -> Settings -> Settings)
-> Renderer -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$ \ByteString
_ DateFormat
_ Level
_ -> [Element] -> Builder
renderNetstr
setNetStrings Bool
False = Renderer -> Settings -> Settings
setRenderer (Renderer -> Settings -> Settings)
-> Renderer -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$ \ByteString
s DateFormat
_ Level
_ -> ByteString -> [Element] -> Builder
renderDefault ByteString
s

-- | Shortcut for calling 'setRenderer' with 'renderNetstr'.
setRendererNetstr :: Settings -> Settings
setRendererNetstr :: Settings -> Settings
setRendererNetstr = Renderer -> Settings -> Settings
setRenderer (Renderer -> Settings -> Settings)
-> Renderer -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$ \ByteString
_ DateFormat
_ Level
_ -> [Element] -> Builder
renderNetstr

-- | Default rendering of log lines.
--
-- Uses the value of `delimiter` as a separator of fields and '=' between
-- field names and values.
setRendererDefault :: Settings -> Settings
setRendererDefault :: Settings -> Settings
setRendererDefault = Renderer -> Settings -> Settings
setRenderer (Renderer -> Settings -> Settings)
-> Renderer -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$ \ByteString
s DateFormat
_ Level
_ -> ByteString -> [Element] -> Builder
renderDefault ByteString
s

logLevel :: Settings -> Level
logLevel :: Settings -> Level
logLevel = Settings -> Level
_logLevel

setLogLevel :: Level -> Settings -> Settings
setLogLevel :: Level -> Settings -> Settings
setLogLevel Level
x Settings
s = Settings
s { _logLevel = x }

-- | Log level of some named logger.
logLevelOf :: Text -> Settings -> Maybe Level
logLevelOf :: Text -> Settings -> Maybe Level
logLevelOf Text
x Settings
s = Text -> Map Text Level -> Maybe Level
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
x (Settings -> Map Text Level
_levelMap Settings
s)

logLevelMap :: Settings -> Map Text Level
logLevelMap :: Settings -> Map Text Level
logLevelMap = Settings -> Map Text Level
_levelMap

-- | Specify a log level for the given named logger. When a logger is
-- 'clone'd and given a name, the 'logLevel' of the cloned logger will be
-- the provided here.
setLogLevelOf :: Text -> Level -> Settings -> Settings
setLogLevelOf :: Text -> Level -> Settings -> Settings
setLogLevelOf Text
n Level
x Settings
s = Settings
s { _levelMap = Map.insert n x (_levelMap s) }

setLogLevelMap :: Map Text Level -> Settings -> Settings
setLogLevelMap :: Map Text Level -> Settings -> Settings
setLogLevelMap Map Text Level
x Settings
s = Settings
s { _levelMap = x }

name :: Settings -> Maybe Text
name :: Settings -> Maybe Text
name = Settings -> Maybe Text
_name

setName :: Maybe Text -> Settings -> Settings
setName :: Maybe Text -> Settings -> Settings
setName Maybe Text
Nothing   Settings
s = Settings
s { _name = Nothing, _nameMsg = id }
setName (Just Text
xs) Settings
s = Settings
s { _name = Just xs, _nameMsg = "logger" .= xs }

nameMsg :: Settings -> (Msg -> Msg)
nameMsg :: Settings -> Msg -> Msg
nameMsg = Settings -> Msg -> Msg
_nameMsg

-- | Output format
renderer :: Settings -> Renderer
renderer :: Settings -> Renderer
renderer = Settings -> Renderer
_renderer

-- | Set a custom renderer.
--
-- See 'setRendererDefault' and 'setRendererNetstr' for two common special cases.
setRenderer :: Renderer -> Settings -> Settings
setRenderer :: Renderer -> Settings -> Settings
setRenderer Renderer
f Settings
s = Settings
s { _renderer = f }

readEnvironment :: Settings -> Bool
readEnvironment :: Settings -> Bool
readEnvironment = Settings -> Bool
_readEnvironment

setReadEnvironment :: Bool -> Settings -> Settings
setReadEnvironment :: Bool -> Settings -> Settings
setReadEnvironment Bool
f Settings
s = Settings
s { _readEnvironment = f }

data Level
    = Trace
    | Debug
    | Info
    | Warn
    | Error
    | Fatal
    deriving (Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
/= :: Level -> Level -> Bool
Eq, Eq Level
Eq Level =>
(Level -> Level -> Ordering)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Level)
-> (Level -> Level -> Level)
-> Ord Level
Level -> Level -> Bool
Level -> Level -> Ordering
Level -> Level -> Level
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Level -> Level -> Ordering
compare :: Level -> Level -> Ordering
$c< :: Level -> Level -> Bool
< :: Level -> Level -> Bool
$c<= :: Level -> Level -> Bool
<= :: Level -> Level -> Bool
$c> :: Level -> Level -> Bool
> :: Level -> Level -> Bool
$c>= :: Level -> Level -> Bool
>= :: Level -> Level -> Bool
$cmax :: Level -> Level -> Level
max :: Level -> Level -> Level
$cmin :: Level -> Level -> Level
min :: Level -> Level -> Level
Ord, ReadPrec [Level]
ReadPrec Level
Int -> ReadS Level
ReadS [Level]
(Int -> ReadS Level)
-> ReadS [Level]
-> ReadPrec Level
-> ReadPrec [Level]
-> Read Level
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Level
readsPrec :: Int -> ReadS Level
$creadList :: ReadS [Level]
readList :: ReadS [Level]
$creadPrec :: ReadPrec Level
readPrec :: ReadPrec Level
$creadListPrec :: ReadPrec [Level]
readListPrec :: ReadPrec [Level]
Read, Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
(Int -> Level -> ShowS)
-> (Level -> String) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Level -> ShowS
showsPrec :: Int -> Level -> ShowS
$cshow :: Level -> String
show :: Level -> String
$cshowList :: [Level] -> ShowS
showList :: [Level] -> ShowS
Show)

data Output
    = StdOut
    | StdErr
    | Path FilePath
    deriving (Output -> Output -> Bool
(Output -> Output -> Bool)
-> (Output -> Output -> Bool) -> Eq Output
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
/= :: Output -> Output -> Bool
Eq, Eq Output
Eq Output =>
(Output -> Output -> Ordering)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Output)
-> (Output -> Output -> Output)
-> Ord Output
Output -> Output -> Bool
Output -> Output -> Ordering
Output -> Output -> Output
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Output -> Output -> Ordering
compare :: Output -> Output -> Ordering
$c< :: Output -> Output -> Bool
< :: Output -> Output -> Bool
$c<= :: Output -> Output -> Bool
<= :: Output -> Output -> Bool
$c> :: Output -> Output -> Bool
> :: Output -> Output -> Bool
$c>= :: Output -> Output -> Bool
>= :: Output -> Output -> Bool
$cmax :: Output -> Output -> Output
max :: Output -> Output -> Output
$cmin :: Output -> Output -> Output
min :: Output -> Output -> Output
Ord, Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
(Int -> Output -> ShowS)
-> (Output -> String) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output -> ShowS
showsPrec :: Int -> Output -> ShowS
$cshow :: Output -> String
show :: Output -> String
$cshowList :: [Output] -> ShowS
showList :: [Output] -> ShowS
Show)

newtype DateFormat = DateFormat
    { DateFormat -> UnixTime -> ByteString
display :: UnixTime -> ByteString
    }

instance IsString DateFormat where
    fromString :: String -> DateFormat
fromString = (UnixTime -> ByteString) -> DateFormat
DateFormat ((UnixTime -> ByteString) -> DateFormat)
-> (String -> UnixTime -> ByteString) -> String -> DateFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UnixTime -> ByteString
formatUnixTimeGMT (ByteString -> UnixTime -> ByteString)
-> (String -> ByteString) -> String -> UnixTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
pack

-- | ISO 8601 date-time format.
iso8601UTC :: DateFormat
iso8601UTC :: DateFormat
iso8601UTC = DateFormat
"%Y-%0m-%0dT%0H:%0M:%0SZ"

-- | Take a custom separator, date format, log level of the event, and render
-- a list of log fields or messages into a builder.
type Renderer = ByteString -> DateFormat -> Level -> [Element] -> B.Builder

-- | Default settings:
--
--   * 'logLevel'        = 'Debug'
--
--   * 'output'          = 'StdOut'
--
--   * 'format'          = 'iso8601UTC'
--
--   * 'delimiter'       = \", \"
--
--   * 'netstrings'      = False
--
--   * 'bufSize'         = 'FL.defaultBufSize'
--
--   * 'name'            = Nothing
--
--   * 'readEnvironment' = True
--
defSettings :: Settings
defSettings :: Settings
defSettings = Level
-> Map Text Level
-> Output
-> Maybe DateFormat
-> ByteString
-> Int
-> Maybe Text
-> (Msg -> Msg)
-> Renderer
-> Bool
-> Settings
Settings
    Level
Debug
    Map Text Level
forall k a. Map k a
Map.empty
    Output
StdOut
    (DateFormat -> Maybe DateFormat
forall a. a -> Maybe a
Just DateFormat
iso8601UTC)
    ByteString
", "
    Int
defaultBufSize
    Maybe Text
forall a. Maybe a
Nothing
    Msg -> Msg
forall a. a -> a
id
    (\ByteString
s DateFormat
_ Level
_ -> ByteString -> [Element] -> Builder
renderDefault ByteString
s)
    Bool
True