Log.hs

{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-}
{- |
  This module provides a way (not the best way, just *a* way) to easily set up
  logging for your program without all the hassle. It uses a standard
  configuration (obtained using the @canteven-config@ package) to set up the
  @hslogger@ configuration. Maybe in the future we will use some kind of more
  general logging monad, but for now, there are no monads here.
-}
module Canteven.Log (
  setupLogging
) where

import Canteven.Log.Types (LogPriority(LP),
    LoggingConfig(LoggingConfig, logfile, level, loggers),
    LoggerDetails(LoggerDetails, loggerName, loggerLevel))
import Control.Applicative ((<$>))
import System.Directory (createDirectoryIfMissing)
import System.FilePath (dropFileName)
import System.IO (stdout)
import System.Log (Priority(DEBUG))
import System.Log.Formatter (simpleLogFormatter)
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple (fileHandler, streamHandler)
import System.Log.Logger (updateGlobalLogger, setHandlers, setLevel)
import qualified Canteven.Config as Config (canteven)


{- |
  Read the program configuration, using the @canteven-config@, and set
  up @hslogger@.
-}
setupLogging :: IO ()
setupLogging =
  installConfig =<< Config.canteven


{- |
  Do all of the things that it takes to get logging set up the way we
  want it.
-}
installConfig :: LoggingConfig -> IO ()
installConfig LoggingConfig {logfile, level = LP level, loggers} = do
  fileHandlers <-
    case logfile of
      Nothing -> return []
      Just filename -> do
        createDirectoryIfMissing True (dropFileName filename)
        file <- tweak <$> fileHandler filename DEBUG
        return [file]

  console <- tweak <$> streamHandler stdout DEBUG
  let handlers = console:fileHandlers
  updateGlobalLogger "" (setLevel level . setHandlers handlers)
  sequence_ [
      updateGlobalLogger loggerName (setLevel loggerLevel) |
      LoggerDetails {loggerName = Just loggerName, loggerLevel = LP loggerLevel} <- loggers
    ]
  where
    tweak h = setFormatter h (simpleLogFormatter logFormat)
    logFormat = "[$time] $prio $loggername[$tid]: $msg"