HLogger.hs

-- | Module:      $Header$
--   Description: Easy-to-use, concurrent and extendable logging framework
--   Copyright:   Copyright © 2010-2011 Jon Kristensen
--   License:     BSD-3
--   
--   Maintainer:  info@pontarius.org
--   Stability:   unstable
--   Portability: portable
--   
--   This is a work in progress for a simple logging framework that aims to be
--   easy-to-use, concurrent and extendable through plug-ins. You cannot use
--   this module for logging directly, instead you want to use an HLogger
--   implementation. If you simply want to log messages to a file, consider
--   using the SimpleLogger implementation. If you want a more complicated
--   logger, see below.
--   
--   * Implementing a Customized Logger
--   
--   If the loggers provided by the HLogger project (currently only
--   SimpleLogger) are insufficient for your application, implementing a custom
--   logging implementation on top of HLogger is simple. You can modify the
--   logger behaviour (how it logs), but not the logger's API (logging levels
--   and exported functions). Another limitation of HLogger implementations is
--   that they are immutable (operating in a static environment, cannot have
--   their state changed).
--   
--   See the SimpleLogger module for an example on how an implementation can be
--   made.


module System.Log.HLogger (LogMessage (..), Logger (..), logger) where


import Control.Concurrent (forkIO)
import Control.Concurrent.Chan (Chan, newChan, writeChan)


-- LogLevel indicates the importance of a log entry. The log levels are the
-- same as in the Syslog application. The below list is ordered by priority,
-- Debug being the least significant message.

data LogLevel = Debug     | -- Debug messages
                Info      | -- Purely informational messages
                Notice    | -- Significant messages for normal conditions
                Warning   | -- Warning condition messages
                Error     | -- Error condition messages
                Critical  | -- Critical condition messages
                Alert     | -- Indication that action must be taken
                Emergency   -- Indication that the system is unusable
                deriving (Eq, Ord, Read, Show)


-- | This object provides the logging API. Consult the documentation for the
--   logging implementation (or SimpleLogger) about how to acquire a Logger
--   object.

data Logger = Logger { -- | Logs a debug message. Debug messages are the least
                       --   significant messages.
                       logDebug :: String -> IO ()
                       
                       -- | Logs a purely informational message. Use logNotice
                       -- instead of the information message is significant.
                     , logInfo :: String -> IO ()
                       
                       -- | Logs a significant purely informational message. Use
                       --   logNotice instead of the information message is
                       --   significant.
                     , logNotice :: String -> IO ()
                       
                       -- | Logs a message signaling a warning condition.
                     , logWarning :: String -> IO ()
                       
                       -- | Logs a message signaling that a non-critical error
                       --   has occurred.
                     , logError :: String -> IO ()
                       
                       -- | Logs a message signaling that a critical error has
                       --   occurred.
                     , logCritical :: String -> IO ()
                       
                       -- | Logs a message signaling that an action must be
                       --   taken.
                     , logAlert :: String -> IO ()
                       
                       -- | Logs a message signaling that the system is
                       --   unusable.
                     , logEmergency :: String -> IO ()
                       
                       -- | Stops the logger. This action is asynchronous.
                     , stopLogger :: IO () }


-- | Used by logging implementations only. Contains information about the log
--   message.

-- TODO: Add date information?

data LogMessage = LogMessage { message :: String, level :: LogLevel }


-- | Used by logging implementations only. Provides a Logger object, given a
--   looping function operating on a 'LogMessage' channel.

logger :: (Chan (Maybe LogMessage) -> IO ()) -> IO Logger

logger l =
  do c <- newChan
     forkIO $ l c
     return Logger { logDebug = logDebug_ c
                   , logInfo = logInfo_ c
                   , logNotice = logNotice_ c
                   , logWarning = logWarning_ c
                   , logError = logError_ c
                   , logCritical = logCritical_ c
                   , logAlert = logAlert_ c
                   , logEmergency = logEmergency_ c
                   , stopLogger = stopLogger_ c }


-- Stops the logger. This action is asynchronous.

stopLogger_ :: Chan (Maybe LogMessage) -> IO ()

stopLogger_ c = writeChan c Nothing


-- Logs a debug message. Debug messages are the least significant messages.

logDebug_ :: Chan (Maybe LogMessage) -> String -> IO ()

logDebug_ c s =
  do let m = toLogMessage s Debug
     writeChan c (Just m)
     return ()


-- Logs a purely informational message. Use logNotice instead of the information
-- message is significant.

logInfo_ :: Chan (Maybe LogMessage) -> String -> IO ()

logInfo_ c s =
  do let m = toLogMessage s Info
     writeChan c (Just m)
     return ()


-- Logs a significant purely informational message.

logNotice_ :: Chan (Maybe LogMessage) -> String -> IO ()

logNotice_ c s =
  do let m = toLogMessage s Notice
     writeChan c (Just m)
     return ()


-- Logs a message signaling a warning condition.

logWarning_ :: Chan (Maybe LogMessage) -> String -> IO ()

logWarning_ c s =
  do let m = toLogMessage s Warning
     writeChan c (Just m)
     return ()


-- Logs a message signaling that a non-critical error has occurred.

logError_ :: Chan (Maybe LogMessage) -> String -> IO ()

logError_ c s =
  do let m = toLogMessage s Error
     writeChan c (Just m)
     return ()


-- Logs a message signaling that a critical error has occurred.

logCritical_ :: Chan (Maybe LogMessage) -> String -> IO ()

logCritical_ c s =
  do let m = toLogMessage s Critical
     writeChan c (Just m)
     return ()


-- Logs a message signaling that an action must be taken.

logAlert_ c s =
  do let m = toLogMessage s Alert
     writeChan c (Just m)
     return ()


-- Logs a message signaling that the system is unusable.

logEmergency_ :: Chan (Maybe LogMessage) -> String -> IO ()

logEmergency_ c s =
  do let m = toLogMessage s Emergency
     writeChan c (Just m)
     return ()


-- Function to wrap a string and a log level into a LogMessage record.

toLogMessage :: String -> LogLevel -> LogMessage

toLogMessage m l = LogMessage { message = m, level = l }