Formatter.hs

{-# LANGUAGE RecordWildCards #-}

module Logging.Types.Formatter ( Formatter(..) ) where

import           Data.Default
import qualified Data.Time.Format                as TF
import           System.FilePath
import           Text.Printf

import           Logging.Types.Class.Formattable
import           Logging.Types.Record
import           Logging.Utils


-- |'Formatter's are used to convert a LogRecord to text.
--
-- 'Formatter's need to know how a 'LogRecord' is constructed. They are
-- responsible for converting a 'LogRecord' to (usually) a string which can
-- be interpreted by either a human or an external system. The base 'Formatter'
-- allows a formatting string to be specified. If none is supplied, the
-- default value, "%(message)s" is used.
--
--
-- The 'Formatter' can be initialized with a format string which makes use of
-- knowledge of the 'LogRecord' attributes - e.g. the default value mentioned
-- above makes use of a 'LogRecord''s message attribute. Currently, the useful
-- attributes in a 'LogRecord' are described by:
--
-- [@%(logger)s@]     Name of the logger (logging channel)
-- [@%(level)s@]      Numeric logging level for the message (DEBUG, INFO, WARN,
--                    ERROR, FATAL, LEVEL v)
-- [@%(pathname)s@]   Full pathname of the source file where the logging
--                    call was issued (if available)
-- [@%(filename)s@]   Filename portion of pathname
-- [@%(module)s@]     Module (name portion of filename)
-- [@%(lineno)d@]     Source line number where the logging call was issued
--                    (if available)
-- [@%(created)f@]    Time when the LogRecord was created (picoseconds
--                    since '1970-01-01 00:00:00')
-- [@%(asctime)s@]    Textual time when the 'LogRecord' was created
-- [@%(msecs)d@]      Millisecond portion of the creation time
-- [@%(message)s@]    The main message passed to 'logv' 'debug' 'info' ..
--
data Formatter = Formatter { fmt     :: String
                           , datefmt :: String -- ^ see "Data.Time.Format"
                           } deriving (Eq)

instance Default Formatter where
  def = Formatter "%(message)s" "%Y-%m-%dT%H:%M:%S%6Q%z"

instance Formattable Formatter where
  format f@Formatter{..} rcd@LogRecord{..} = formats fmt
    where
      diffTime = zonedTimeToPOSIXSeconds created

      formats :: String -> String
      formats ('%':'%':cs) = ('%' :) $ formats cs
      formats ('%':'(':cs) =
        case break (== ')') cs of
          (attr, ')':c:cs') -> (formatAttr attr c) ++ (formats cs')
          _ -> error "Logging.Types.Formattable: no parse (Formatter)"
      formats (c:cs) = (c :) $ formats cs
      formats ""           = ""

      formatAttr :: String -> Char -> String
      formatAttr "logger" fc   = printf ['%', fc] logger -- %(logger)s
      formatAttr "level" fc    = printf ['%', fc] $ show level -- %(level)s
      formatAttr "pathname" fc = printf ['%', fc] $ takeDirectory filename -- %(pathname)s
      formatAttr "filename" fc = printf ['%', fc] $ takeFileName filename -- %(filename)s
      formatAttr "module" fc   = printf ['%', fc] modulename -- %(module)s
      formatAttr "lineno" fc   = printf ['%', fc] lineno -- %(lineno)d
      formatAttr "created" fc  = printf ['%', fc] $ timestamp diffTime -- %(created)f
      formatAttr "asctime" fc  = printf ['%', fc] $ formatTime f rcd -- %(asctime)s
      formatAttr "msecs" fc    = printf ['%', fc] $ microseconds diffTime -- %(msecs)d
      formatAttr "message" fc  = printf ['%', fc] message -- %(message)s
      formatAttr _ _           = "unknown"

  formatTime Formatter{..} LogRecord{..} =
    TF.formatTime TF.defaultTimeLocale datefmt created