-- | Module:      $Header$
--   Description: Simple HLogger implementation for logging to a text file
--   Copyright:   Copyright © 2010-2011 Jon Kristensen
--   License:     BSD-3
--   
--   Maintainer:  info@pontarius.org
--   Stability:   unstable
--   Portability: portable


-- | This is a simple HLogger implementation that allows developers to
--   conveniently log to a text file. A usage example would be:
--   
--   @
--     import System.Log.SimpleHLogger
--     main =
--       do logger <- simpleLogger "LoggerTest"
--          loggerLog logger Nothing Notice "This is a test message!"
--          loggerStop logger
--   @
--   
--   The above example would log "This is a test message!" to a file in the
--   current directory.

-- Note that Logger is exported. This is so that applications wont have to
-- import System.Log.HLogger.Logger.

module System.Log.SimpleHLogger (Logger (..), LogLevel (..), simpleLogger) where


import System.Log.HLogger (ModuleName, FunctionName, LogLevel (..),
                           LogMessage (..), Logger (..), logger)
import System.IO (Handle, IOMode (WriteMode), hClose, hFlush, hPutStrLn,
                  openFile)
import Control.Concurrent.Chan (Chan, readChan)
import Control.Applicative ((<$>))
import Data.Time.Clock (getCurrentTime)
import Data.Time.Format (formatTime)
import System.Locale (defaultTimeLocale)


-- | Acquires a SimpleLogger Logger object. It takes a String, @prefix@, and
--   creates a file @prefix-YYYYMMDDHHMMSS.log@ in the current directory. It
--   will use UTC time on system that supports it, and local time otherwise.

simpleLogger :: String -> IO Logger
simpleLogger p =
  do d0 <- datetime0
     h <- openFile (p ++ "-" ++ d0 ++ ".log") WriteMode
     logger $ loggerLoop h
    where
      loggerLoop :: Handle -> Chan (Maybe LogMessage) -> IO ()
      loggerLoop h c =
        do logMessage <- readChan c
           case logMessage of
             Nothing ->
               hClose h
             Just m ->
               do d1 <- datetime1
                  let context = case logMessageContext m of
                        Nothing -> ""
                        Just (x, y) -> x ++ ": " ++ y ++ ": "
                  let line = d1 ++ ": " ++ show (logMessageLevel m) ++ ": " ++
                             context ++ (logMessageString m)
                  hPutStrLn h line
                  hFlush h
                  loggerLoop h c


-- Datetime string in the format of `YYYYMMDDHHMMSS'.

datetime0 :: IO String
datetime0 = formatTime defaultTimeLocale "%Y%m%d%H%M%S" <$> getCurrentTime


-- Datetime string in the format of `YYYY-MM-DD HH:MM:SS'.

datetime1 :: IO String
datetime1 = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" <$> getCurrentTime