content: {-# LANGUAGE TemplateHaskell #-}
  -- |Support for publishing log messages at various severity
  -- levels. The log messages are annotated with the filename and line
  -- number where they are generated.
  module Ros.Logging (Log, LogLevel(..), enableLogging,
                      logDebug, logWarn, logInfo, logError, logFatal) where
  import Control.Concurrent.Chan
  import Control.Monad (when)
  import Data.IORef
  import Data.Word (Word8)
  import Language.Haskell.TH
  import System.IO.Unsafe
  
  import Ros.Internal.Log (Log(Log))
  import qualified Ros.Internal.Log as Log
  import Ros.Internal.Header
  import Ros.Node
  import Ros.Topic.Util (fromList)
  
  emptyHeader :: Header
  emptyHeader = Header 0 (0,0) ""
  
  mkLogMsg :: Word8 -> String -> Q Exp
  mkLogMsg level msg = do Loc fname _ _ start _ <- location
                          let (line, _char) = start
                              litS = return . LitE . StringL
                              litI :: Integral a => a -> Q Exp
                              litI = return . LitE . IntegerL . fromIntegral
                          [|sendMsg (Log emptyHeader $(litI level) "" $(litS msg) 
                                         $(litS fname) "" $(litI line) [])|]
  
  -- |Template Haskell functions to splice in a 'Log' value. Usage: 
  -- 
  -- > $(logDebug "This is my message to you")
  logDebug, logWarn, logInfo, logError, logFatal :: String -> Q Exp
  logDebug = mkLogMsg Log.dEBUG
  logInfo  = mkLogMsg Log.iNFO
  logWarn  = mkLogMsg Log.wARN
  logError = mkLogMsg Log.eRROR
  logFatal = mkLogMsg Log.fATAL
  
  -- The 'Chan' into which all log messages are funneled. This Chan's
  -- contents are fed into the /rosout 'Topic'.
  rosOutChan :: Chan Log
  rosOutChan = unsafePerformIO $ newChan
  {-# NOINLINE rosOutChan #-}
  
  -- Stash a function that knows whether or not 'Log' messages of
  -- various levels should be printed to stdout.
  showLevel :: IORef (Log -> IO ())
  showLevel = unsafePerformIO $ newIORef (const (return ()))
  {-# NOINLINE showLevel #-}
  
  -- Stash the node name away so that it can be inserted into runtime
  -- log messages.
  nodeName :: IORef String
  nodeName = unsafePerformIO $ newIORef ""
  {-# NOINLINE nodeName #-}
  
  -- Publish a log message.
  sendMsg :: Log -> IO ()
  sendMsg msg = do n <- readIORef nodeName
                   let msg' = msg { Log.name = n }
                   ($ msg') =<< readIORef showLevel
                   writeChan rosOutChan msg'
  
  -- Prints messages whose level is greater than or equal to the
  -- specified level.
  printLog :: LogLevel -> Log -> IO ()
  printLog lvl = let code = 2 ^ fromEnum lvl
                 in \msg -> when (Log.level msg >= code) (putStrLn (show msg))
  
  -- |Log message levels. These allow for simple filtering of messages.
  data LogLevel = Debug | Info | Warn | Error | Fatal deriving (Eq, Enum)
  
  -- |Enable logging for this node. The argument indicates the level of
  -- log messages that should be echoed to standard out. If 'Nothing',
  -- then no messages are printed; if 'Just lvl', then all messages of
  -- greater than or equal level are printed.
  enableLogging :: Maybe LogLevel -> Node ()
  enableLogging ll = do xs <- liftIO $ getChanContents rosOutChan
                        liftIO $ maybe (return ())
                                       (writeIORef showLevel . printLog)
                                       ll
                        liftIO . writeIORef nodeName =<< getName
                        advertise "/rosout" (fromList xs :: Topic IO Log)
  