{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DuplicateRecordFields #-}

module Logging.Types.Record ( LogRecord(..) ) where

import           Data.Time.Clock
import           Data.Time.LocalTime
import           GHC.Generics
import           Text.Format

import           Logging.Types.Level
import           Logging.Types.Logger


-- |A 'LogRecord' represents an event being logged.
--
-- 'LogRecord's are created every time something is logged. They
-- contain all the information related to the event being logged.
--
-- It includes the main message as well as information such as
-- when the record was created, the source line where the logging call was made.
--
-- 'LogRecord' can be formatted into string by 'Text.Format'
-- from 'vformat' package, see 'Text.Format.format1' for more information.
--
-- Currently, the useful attributes in a LogRecord are described by:
--
-- @
--  logger        name of the logger, see 'Logger'
--  level         logging level for the message, see 'Level'
--  message       the main message passed to logv debug info ..
--  pathname      full pathname of the source file where the logging call was issued (if available)
--  filename      filename portion of pathname
--  pkgname       package name where the logging call was issued (if available)
--  modulename    module name (e.g. Main, Logging.Types)
--  lineno        source line number where the logging call was issued (if available)
--  asctime       'ZonedTime' when the LogRecord was created
--  utctime       'UTCTime' when the LogRecord was created
--  created       timestamp when the LogRecord was created
--  msecs         millisecond portion of the creation time
-- @
--
-- Format examples:
--
-- @
--  "{message}"
--  "{logger} {level}: {message}"
--  "{logger:<20.20s} {level:<8s}: {message}"
--  "{asctime:%Y-%m-%dT%H:%M:%S%6Q%z} - {level} - {logger}] {message}"
-- @
--
data LogRecord = LogRecord { logger     :: Logger
                           , level      :: Level
                           , message    :: String
                           , pathname   :: String
                           , filename   :: String
                           , pkgname    :: String
                           , modulename :: String
                           , lineno     :: Int
                           , asctime    :: ZonedTime
                           , utctime    :: UTCTime
                           , created    :: Double
                           , msecs      :: Integer
                           } deriving Generic

instance FormatArg LogRecord