{-# LANGUAGE CPP #-}
module System.Logging.Facade.Sink (
LogSink
, defaultLogSink
, getLogSink
, setLogSink
, swapLogSink
, withLogSink
) where
import Control.Concurrent
import Data.IORef
import System.IO
import System.IO.Unsafe (unsafePerformIO)
import Control.Exception
import System.Logging.Facade.Types
type LogSink = LogRecord -> IO ()
logSink :: IORef LogSink
logSink :: IORef LogSink
logSink = forall a. IO a -> a
unsafePerformIO (IO LogSink
defaultLogSink forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO (IORef a)
newIORef)
{-# NOINLINE logSink #-}
getLogSink :: IO LogSink
getLogSink :: IO LogSink
getLogSink = forall a. IORef a -> IO a
readIORef IORef LogSink
logSink
setLogSink :: LogSink -> IO ()
setLogSink :: LogSink -> IO ()
setLogSink = forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef LogSink
logSink
swapLogSink :: LogSink -> IO LogSink
swapLogSink :: LogSink -> IO LogSink
swapLogSink LogSink
new = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef LogSink
logSink forall a b. (a -> b) -> a -> b
$ \LogSink
old -> (LogSink
new, LogSink
old)
withLogSink :: LogSink -> IO () -> IO ()
withLogSink :: LogSink -> IO () -> IO ()
withLogSink LogSink
sink IO ()
action = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (LogSink -> IO LogSink
swapLogSink LogSink
sink) LogSink -> IO ()
setLogSink (forall a b. a -> b -> a
const IO ()
action)
defaultLogSink :: IO LogSink
defaultLogSink :: IO LogSink
defaultLogSink = MVar () -> LogSink
defaultLogSink_ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. a -> IO (MVar a)
newMVar ()
defaultLogSink_ :: MVar () -> LogSink
defaultLogSink_ :: MVar () -> LogSink
defaultLogSink_ MVar ()
mvar LogRecord
record = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
mvar (\() -> Handle -> String -> IO ()
hPutStrLn Handle
stderr String
output)
where
level :: LogLevel
level = LogRecord -> LogLevel
logRecordLevel LogRecord
record
mLocation :: Maybe Location
mLocation = LogRecord -> Maybe Location
logRecordLocation LogRecord
record
message :: String
message = LogRecord -> String
logRecordMessage LogRecord
record
output :: String
output = forall a. Show a => a -> String -> String
shows LogLevel
level forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
location forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
": " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
message forall a b. (a -> b) -> a -> b
$ String
""
location :: String -> String
location = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> String -> String
showString String
"") ((String -> String -> String
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location -> String -> String
formatLocation) Maybe Location
mLocation
formatLocation :: Location -> ShowS
formatLocation :: Location -> String -> String
formatLocation Location
loc = String -> String -> String
showString (Location -> String
locationFile Location
loc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
colon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String -> String
shows (Location -> Int
locationLine Location
loc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
colon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String -> String
shows (Location -> Int
locationColumn Location
loc)
where colon :: String -> String
colon = String -> String -> String
showString String
":"
#if !MIN_VERSION_base(4,6,0)
atomicWriteIORef :: IORef a -> a -> IO ()
atomicWriteIORef ref a = do
x <- atomicModifyIORef ref (\_ -> (a, ()))
x `seq` return ()
#endif