Logger.hsc

{-# LANGUAGE ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Conjure.Utils.Logger
-- Copyright   :  (c) Lemmih 2006
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (POSIX)
--
-----------------------------------------------------------------------------
-- FIXME: What do we do on Windows?
#include <syslog.h>
module Conjure.Utils.Logger
    ( Mask
    , Option (..)
    , Priority (..)
    , setlogmask
    , openlog
    , syslog
    , closelog
    ) where

import Foreign
import Foreign.C
import Data.Bits

foreign import ccall unsafe "openlog" c_openlog :: CString -> Int -> Int -> IO ()
foreign import ccall unsafe "syslog" c_syslog :: Int -> CString -> CString -> IO ()
foreign import ccall unsafe "closelog" closelog :: IO ()
foreign import ccall unsafe "setlogmask" c_setlogmask :: Int -> IO Int

data Mask
    = Bitmask [Priority]
    | Upto Priority

logMask, logUpTo :: (Bits t) => Priority -> t
logMask p = 1 `shiftL` fromPriority p
logUpTo p = 1 `shiftL` fromPriority p


fromMask :: (Bits a) => Mask -> a
fromMask (Bitmask ps) = foldr (.|.) 0 (map logMask ps)
fromMask (Upto p)     = logUpTo p

setlogmask :: Mask -> IO ()
setlogmask mask
    = do c_setlogmask (fromMask mask)
         return ()

data Option
    = Console
    | NoDelay
    | NoWait
    | Delay
    | PError
    | PID

fromOption :: (Num t) => Option -> t
fromOption Console = #{const LOG_CONS}
fromOption NoDelay = #{const LOG_NDELAY}
fromOption NoWait = #{const LOG_NOWAIT}
fromOption Delay = #{const LOG_ODELAY}
fromOption PError = #{const LOG_PERROR}
fromOption PID = #{const LOG_PID}

openlog :: [Option] -> String -> IO ()
openlog options ident
    = withCString ident $ \cstr ->
      c_openlog cstr (foldr (.|.) 0 (map fromOption options))
                #{const LOG_USER}

data Priority
    = Emergency
    | Alert
    | Critical
    | Error
    | Warning
    | Notice
    | Info
    | Debug

fromPriority :: Priority -> Int
fromPriority Emergency = #{const LOG_EMERG }
fromPriority Alert = #{const LOG_ALERT }
fromPriority Critical = #{const LOG_CRIT }
fromPriority Error = #{const LOG_ERR }
fromPriority Warning = #{const LOG_WARNING }
fromPriority Notice = #{const LOG_NOTICE }
fromPriority Info = #{const LOG_INFO }
fromPriority Debug= #{const LOG_DEBUG }

syslog :: Priority -> String -> IO ()
syslog priority msg
    = withCString "%s" $ \format ->
      withCString msg $ \cstr ->
      c_syslog (fromPriority priority) format cstr