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) [])|]
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
rosOutChan :: Chan Log
rosOutChan = unsafePerformIO $ newChan
showLevel :: IORef (Log -> IO ())
showLevel = unsafePerformIO $ newIORef (const (return ()))
nodeName :: IORef String
nodeName = unsafePerformIO $ newIORef ""
sendMsg :: Log -> IO ()
sendMsg msg = do n <- readIORef nodeName
let msg' = msg { Log.name = n }
($ msg') =<< readIORef showLevel
writeChan rosOutChan msg'
printLog :: LogLevel -> Log -> IO ()
printLog lvl = let code = 2 ^ fromEnum lvl
in \msg -> when (Log.level msg >= code) (putStrLn (show msg))
data LogLevel = Debug | Info | Warn | Error | Fatal deriving (Eq, Enum)
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)