module System.Logging.Facade.Sink (
LogSink
, defaultLogSink
, setLogSink
, getLogSink
) where
import Data.IORef
import System.IO
import System.IO.Unsafe (unsafePerformIO)
import System.Logging.Facade.Types
type LogSink = LogRecord -> IO ()
logSink :: IORef LogSink
logSink = unsafePerformIO (newIORef defaultLogSink)
getLogSink :: IO LogSink
getLogSink = readIORef logSink
setLogSink :: LogSink -> IO ()
setLogSink = atomicWriteIORef logSink
defaultLogSink :: LogSink
defaultLogSink record = hPutStrLn stderr output
where
level = logRecordLevel record
mLocation = logRecordLocation record
message = logRecordMessage record
output = shows level . location . showString ": " . showString message $ ""
location = maybe (showString "") ((showString " " .) . formatLocation) mLocation
formatLocation :: Location -> ShowS
formatLocation loc = showString (locationFile loc) . colon . shows (locationLine loc) . colon . shows (locationColumn loc)
where colon = showString ":"