module Yi.Debug (
initDebug
,trace
,traceM
,traceM_
,logPutStrLn
,logError
,logStream
,Yi.Debug.error
) where
import Control.Concurrent
import Control.Monad.Trans
import Data.IORef
import System.IO
import System.IO.Unsafe ( unsafePerformIO )
import Data.Time
import System.Locale
dbgHandle :: IORef (Maybe Handle)
dbgHandle = unsafePerformIO $ newIORef Nothing
initDebug :: FilePath -> IO ()
initDebug f = do
hndl <- readIORef dbgHandle
case hndl of
Nothing -> do openFile f WriteMode >>= writeIORef dbgHandle . Just
logPutStrLn "Logging initialized."
Just _ -> do logPutStrLn "Attempt to re-initialize the logging system."
trace :: String -> a -> a
trace s e = unsafePerformIO $ do logPutStrLn s
return e
error :: String -> a
error s = unsafePerformIO $ do logPutStrLn s
Prelude.error s
logPutStrLn :: (MonadIO m) => String -> m ()
logPutStrLn s = liftIO $ do
mh <- readIORef dbgHandle
case mh of
Nothing -> return ()
Just h -> do
time <- getCurrentTime
tId <- myThreadId
hPutStrLn h $ formatTime defaultTimeLocale rfc822DateFormat' time ++ " " ++ show tId ++ " " ++ s
hFlush h
where
rfc822DateFormat' = "%a, %d %b %Y %H:%M:%S %Z"
logError :: (MonadIO m) => String -> m ()
logError s = logPutStrLn $ "error: " ++ s
logStream :: Show a => String -> Chan a -> IO ()
logStream msg ch = do
logPutStrLn $ "Logging stream " ++ msg
_ <- forkIO $ logStreamThread msg ch
return ()
logStreamThread :: Show a => String -> Chan a -> IO ()
logStreamThread msg ch = do
stream <- getChanContents =<< dupChan ch
mapM_ logPutStrLn [msg ++ "(" ++ show i ++ ")" ++ show event | (event, i) <- zip stream [(0::Int)..]]
traceM :: Monad m => String -> a -> m a
traceM x y = trace x $ return y
traceM_ :: Monad m => String -> m ()
traceM_ x = traceM x ()